PROGRAM MERGEHKL C C program for merging HKLF4 data C Version: 12-OCT-2004 C C compilation: f77 -o mergehkl mergehkl.f C C PARAMETER (NREF=2000000) INTEGER H_LAUE(NREF) INTEGER K_LAUE(NREF) INTEGER L_LAUE(NREF) INTEGER H_UNIQUE(NREF) INTEGER K_UNIQUE(NREF) INTEGER L_UNIQUE(NREF) INTEGER NTOT(NREF) REAL S(NREF),F(NREF) REAL WFTOT(NREF) REAL WSIGTOT(NREF) REAL FMED(NREF) REAL W(NREF),WSUM(NREF) REAL WSIGMA(NREF),WSTOT(NREF) REAL SIGEXT(NREF) REAL SIGMEAN(NREF) REAL WRINTR(NREF),SIGINT(NREF) REAL SIG_UNIQUE(NREF) CHARACTER*6 PS CHARACTER*20 FILE_IN,FILE_OUT CHARACTER*6 PGNAMES(42) CHARACTER*12 SYSTEMATIC(46) CHARACTER*7 SPGRNAME(230) LOGICAL HKLEXIST LOGICAL ABSCOND(46) LOGICAL REJECT INTEGER EFORMULA DATA PGNAMES /'1','-1','2','M','2/M','222','MM2','MMM', + '4','-4','4/M','422','4MM','-42M','-4M2','4/MMM','3', + '-3','312','321','31M','3M1','-31M','-3M1','6','-6', + '6/M','622','6MM','-6M2','-62M','6/MMM','R3','R-3','R32', + 'R3M','R-3M','23','M3','432','-43M','M3M'/ DATA SYSTEMATIC + /'HKL,H+K=2N','HKL,K+L=2N','HKL,H+L=2N','HHL,H=2N', + 'HKL,H+K+L=2N','HKL,-H+K+L=3N','HKH,H=2N','HK-H,H=2N', + 'HK0,H=2N','H-HL,H=2N','HK0,H+K=2N','HK0,H+K=4N', + '0KL,K=2N','0KL,L=2N','0KL,K+L=2N','0KL,K+L=4N', + 'H0L,L=2N','H0L,H=2N','H0L,H+L=2N','H0L,H+L=4N', + '2H-HL,L=2N','H-HL,L=2N','H-HL,2H-L=4N','HHL,L=2N', + 'HKH,K=2N','HKK,H=2N','HHL,2H+L=4N','HKH,2H+K=4N', + 'HKK,2K+H=4N','H00,H=2N','H00,H=4N','0K0,K=2N', + '0K0,K=4N','00L,L=2N','00L,L=4N','HK-H,2H+K=4N', + '00L,L=3N','00L,L=6N','HK-K,H-2K=4N','H-HL,2H+L=4N', + 'H-2HL,L=2N','H0L,2H+L=6N','H-HL,2H-L=6N', + '0KL,2K-L=6N','HK-K,H=2N','HK-H,K=2N' / DATA SPGRNAME +/ 'P1','P-1','P2','P21','C2','Pm','Pc','Cm','Cc','P2/m','P21/m', + 'C2/m','P2/c','P21/c','C2/c','P222','P2221','P21212','P212121', + 'C2221','C222','F222','I222','I212121','Pmm2','Pmc21','Pcc2', + 'Pma2','Pca21','Pnc2','Pmn21','Pba2','Pna21','Pnn2','Cmm2', + 'Cmc21','Ccc2','Amm2','Abm2','Ama2','Aba2','Fmm2','Fdd2', + 'Imm2','Iba2','Ima2','Pmmm','Pnnn','Pccm','Pban','Pmma','Pnna', + 'Pmna','Pcca','Pbam','Pccn','Pbcm','Pnnm','Pmmn','Pbcn','Pbca', + 'Pnma','Cmcm','Cmca','Cmmm','Cccm','Cmma','Ccca','Fmmm','Fddd', + 'Immm','Ibam','Ibca','Imma','P4','P41','P42','P43','I4','I41', + 'P-4','I-4','P4/m','P42/m','P4/n','P42/n','I4/m','I41/a', + 'P422','P4212','P4122','P41212','P4222','P42212','P4322', + 'P43212','I422','I4122','P4mm','P4bm','P42cm','P42nm','P4cc', + 'P4nc','P42mc','P42bc','I4mm','I4cm','I41md','I41cd','P-42m', + 'P-42c','P-421m','P-421c','P-4m2','P-4c2','P-4b2','P-4n2', + 'I-4m2','I-4c2','I-42m','I-42d','P4/mmm','P4/mcc','P4/nbm', + 'P4/nnc','P4/mbm','P4/mnc','P4/nmm','P4/ncc','P42/mmc', + 'P42/mcm','P42/nbc','P42/nnm','P42/mbc','P42/mnm','P42/nmc', + 'P42/ncm','I4/mmm','I4/mcm','I41/amd','I41/acd','P3','P31', + 'P32','R3:H','P-3','R-3:H','P312','P321','P3112','P3121', + 'P3212','P3221','R32:H','P3m1','P31m','P3c1','P31c','R3m:H', + 'R3c:H','P-31m','P-31c','P-3m1','P-3c1','R-3m:H','R-3c:H','P6', + 'P61','P65','P62','P64','P63','P-6','P6/m','P63/m','P622', + 'P6122','P6522','P6222','P6422','P6322','P6mm','P6cc','P63cm', + 'P63mc','P-6m2','P-6c2','P-62m','P-62c','P6/mmm','P6/mcc', + 'P63/mcm','P63/mmc','P23','F23','I23','P213','I213','Pm-3', + 'Pn-3','Fm-3','Fd-3','Im-3','Pa-3','Ia-3','P432','P4232', + 'F432','F4132','I432','P4332','P4132','I4132','P-43m','F-43m', + 'I-43m','P-43n','F-43c','I-43d','Pm-3m','Pn-3n','Pm-3n', + 'Pn-3m','Fm-3m','Fm-3c','Fd-3m','Fd-3c','Im-3m','Ia-3d' / C C OUTPUT PROGRAM INFORMATION C WRITE(*,*) WRITE(*,*) 'PROGRAM MERGEHKL' WRITE(*,*) 'VERSION 12-OCT-2004' WRITE(*,*) 'WRITTEN BY MARTIN LUTZ, UTRECHT UNIVERSITY' WRITE(*,*) WRITE(*,*) 'USE AT YOUR OWN RISK' WRITE(*,*) 'PLEASE REPORT BUGS TO m.lutz@chem.uu.nl' WRITE(*,*) WRITE(*,*) WRITE(*,*) C C INPUT HKLF4 FILENAME C 10 WRITE(*,20) 20 FORMAT( ' FILENAME OF HKLF4 INPUT FILE ',$) READ(*,30) FILE_IN 30 FORMAT(A) INQUIRE(FILE=FILE_IN,EXIST=HKLEXIST) IF(.NOT.HKLEXIST) THEN WRITE(*,*) 'HKLF4 FILE DOES NOT EXIST' GOTO 10 ENDIF C C INPUT FILENAME FOR MERGED DATA C WRITE(*,35) 35 FORMAT( ' FILENAME OF MERGED OUTPUT FILE ',$) READ(*,36) FILE_OUT 36 FORMAT(A) C C INPUT SPACEGROUP NUMBER C ISPGR=0 40 WRITE(*,50) 50 FORMAT( ' SPACE GROUP NUMBER ',$) READ(*,*) ISPGR IF ((ISPGR.EQ.0).OR.(ISPGR.GT.230)) THEN WRITE(*,*) 'SPACE GROUP NUMBER NOT POSSIBLE' GOTO 40 ENDIF CALL SPGRINFO(ISPGR,NPOINT,ABSCOND) WRITE(*,*) WRITE(*,*) 'SPACE GROUP ',SPGRNAME(ISPGR) WRITE(*,*) 'POINT GROUP ',PGNAMES(NPOINT) WRITE(*,*) WRITE(*,*) 'REFLECTION CONDITIONS:' DO I=1,46 IF (ABSCOND(I)) WRITE(*,51) SYSTEMATIC(I) 51 FORMAT(1X,A12) ENDDO C C SELECT WEIGHTING SCHEMES C IWSCHEME=999 IWSIG=999 WRITE(*,*) WRITE(*,*) 'WEIGHTING SCHEMES FOR INTENSITY MERGING:' WRITE(*,*) '1: wi=1 (unit weights)' WRITE(*,*) '2: wi=1/sig**2 (statistical weights)' WRITE(*,*) '3: wi=max(int/sig,3)/sig (SHELXL)' 100 WRITE(*,110) 110 FORMAT(' SELECT WEIGHTING SCHEME ',$) READ(*,120) IWSCHEME 120 FORMAT(I1) IF ((IWSCHEME.GT.3).OR.(IWSCHEME.LT.1)) THEN WRITE(*,*) 'WEIGHTING SCHEME NOT DEFINED!' GOTO 100 ENDIF WRITE(*,*) WRITE(*,*) 'WEIGHTING SCHEMES FOR SIGMA MERGING:' WRITE(*,*) '1: ws=1 (unit weights)' WRITE(*,*) '2: ws=1/sig**2 (statistical weights,SHELXL)' 200 WRITE(*,210) 210 FORMAT(' SELECT WEIGHTING SCHEME ',$) READ(*,220) IWSIG 220 FORMAT(I1) IF ((IWSIG.GT.2).OR.(IWSIG.LT.1)) THEN WRITE(*,*) 'WEIGHTING SCHEME NOT DEFINED!' GOTO 200 ENDIF WRITE(*,*) WRITE(*,*) 'FORMULA FOR EXTERNAL SIGMA:' WRITE(*,*) + '1: sigext=sqrt(sum[ws*sig**2]/[n*sum(ws)]) (SHELXL)' WRITE(*,*) + '2: sigext=sqrt(sum[ws*sig**2]/sum(ws))' 221 WRITE(*,222) 222 FORMAT(' SELECT FORMULA FOR EXTERNAL SIGMA ',$) READ(*,223) EFORMULA 223 FORMAT(I1) IF ((EFORMULA.GT.2).OR.(EFORMULA.LT.1)) THEN WRITE(*,*) 'FORMULA NOT DEFINED!' GOTO 221 ENDIF WRITE(*,*) WRITE(*,*) 'FORMULA FOR INTERNAL SIGMA:' WRITE(*,224) WRITE(*,225) 224 FORMAT(' 1: sigint=sqrt{sum[ws*(int-intmean)**2]/',$) 225 FORMAT('[(n-1)*sum(ws)]} (ACTA CRYST A51,565)') WRITE(*,226) WRITE(*,227) 226 FORMAT(' 2: sigint=sqrt{n*sum[ws*(int-intmean)**2]/',$) 227 FORMAT('[(n-1)*sum(ws)]} (SORTAV)') WRITE(*,*) + '3: sigint=sqrt{sum[ws*(int-intmean)**2]/sum(ws)} (CRYSTALS)' WRITE(*,*) + '4: sigint=sum[abs(int-intmean)]/[n*sqrt(n-1)] (SHELXL)' 230 WRITE(*,240) 240 FORMAT(' SELECT FORMULA FOR INTERNAL SIGMA ',$) READ(*,250) IFORMULA 250 FORMAT(I1) IF ((IFORMULA.GT.4).OR.(IFORMULA.LT.1)) THEN WRITE(*,*) 'FORMULA NOT DEFINED!' GOTO 230 ENDIF WRITE(*,*) WRITE(*,*) 'FORMULA FOR MEAN SIGMA:' WRITE(*,*) '1: sigmean=sigext' WRITE(*,*) '2: sigmean=sigint' WRITE(*,*) '3: sigmean=max(sigext,sigint) (SHELXL)' 260 WRITE(*,270) 270 FORMAT(' SELECT FORMULA FOR MEAN SIGMA ',$) READ(*,280) IMEANFORM 280 FORMAT(I1) IF ((IMEANFORM.GT.3).OR.(IMEANFORM.LT.1)) THEN WRITE(*,*) 'FORMULA NOT DEFINED!' GOTO 260 ENDIF C C Output as F^2 or as F C IOUTPUT=999 WRITE(*,*) WRITE(*,*) 'OUTPUT REFLECTIONS:' WRITE(*,*) '1: F^2, sig(F^2)' WRITE(*,*) '2: F, sig(F)' 300 WRITE(*,310) 310 FORMAT(' SELECT OUTPUT ',$) READ(*,320) IOUTPUT 320 FORMAT(I1) IF ((IOUTPUT.GT.2).OR.(IOUTPUT.LT.1)) THEN WRITE(*,*) 'OUTPUT NOT DEFINED!' GOTO 300 ENDIF C C INPUT REFLECTIONS C WRITE(*,*) WRITE(*,*) 'PLEASE WAIT: READING REFLECTIONS...' WRITE(*,*) OPEN(UNIT=1,FILE=FILE_IN,STATUS='OLD') NHKL=0 NREJECT=0 NEGATIVE=0 410 READ(1,420,END=430) IH,IK,IL,FOBS,SIG 420 FORMAT(3I4,2F8.0) IF ((IH.EQ.0).AND.(IK.EQ.0).AND.(IL.EQ.0)) THEN GOTO 430 ELSE CALL CHECKABSENT(IH,IK,IL,ABSCOND,REJECT) IF (REJECT) THEN NREJECT=NREJECT+1 ELSE IF (FOBS.LT.-2*SIG) THEN NEGATIVE=NEGATIVE+1 ELSE NHKL=NHKL+1 CALL MYLAUE(NPOINT,IH,IK,IL,ILH,ILK,ILL) H_LAUE(NHKL)=ILH K_LAUE(NHKL)=ILK L_LAUE(NHKL)=ILL F(NHKL)=FOBS S(NHKL)=SIG ENDIF ENDIF IF (NHKL+1.GT.NREF) THEN WRITE(*,*)'ARRAYSIZE TOO SMALL' STOP ELSE GOTO 410 ENDIF 430 CLOSE(1) WRITE(*,*) WRITE(*,440) NHKL+NREJECT+NEGATIVE WRITE(*,450) NREJECT WRITE(*,460) NEGATIVE 440 FORMAT(' NUMBER OF INPUT REFLECTIONS: ',I7) 450 FORMAT(' REJECTED SYMMETRY FORBIDDEN REFLECTIONS: ',I7) 460 FORMAT(' REJECTED TOO NEGATIVE REFLECTIONS: ',I7) C C SORT REFLECTIONS C CALL LSORT(H_LAUE,K_LAUE,L_LAUE,F,S,NHKL) CALL KSORT(H_LAUE,K_LAUE,L_LAUE,F,S,NHKL) CALL HSORT(H_LAUE,K_LAUE,L_LAUE,F,S,NHKL) C C FIRST RUN, SUM UP EVERYTHING C NR_UNIQUE=0 DO I=1,NHKL C C WEIGHT FOR INTENSITY C IF (IWSCHEME.EQ.1) THEN W(I)=1.0 ELSE IF (IWSCHEME.EQ.2) THEN W(I)=1.0/(S(I)*S(I)) ELSE IF (IWSCHEME.EQ.3) THEN W(I)=AMAX1(F(I)/S(I),3.0)/S(I) ENDIF C C WEIGHT FOR SIGMA C IF (IWSIG.EQ.1) THEN WSIGMA(I)=1.0 ELSE IF (IWSIG.EQ.2) THEN WSIGMA(I)=1.0/(S(I)*S(I)) ENDIF C C DETECT NEW UNIQUE REFLECTION C IF ((I.EQ.1) + .OR.((I.GT.1).AND.(H_LAUE(I).NE.H_LAUE(I-1))) + .OR.((I.GT.1).AND.(K_LAUE(I).NE.K_LAUE(I-1))) + .OR.((I.GT.1).AND.(L_LAUE(I).NE.L_LAUE(I-1)))) THEN NR_UNIQUE=NR_UNIQUE+1 NTOT(NR_UNIQUE)=0 WFTOT(NR_UNIQUE)=0.0 WSUM(NR_UNIQUE)=0.0 WSTOT(NR_UNIQUE)=0.0 WSIGTOT(NR_UNIQUE)=0.0 ENDIF NTOT(NR_UNIQUE)=NTOT(NR_UNIQUE)+1 ! Redundancy WFTOT(NR_UNIQUE)=WFTOT(NR_UNIQUE)+W(I)*F(I) ! Sum of weighted Fsq WSUM(NR_UNIQUE)=WSUM(NR_UNIQUE)+W(I) ! Sum of intensity weights WSIGTOT(NR_UNIQUE)=WSIGTOT(NR_UNIQUE) + +WSIGMA(I)*S(I)*S(I) ! Sum of weighted sigma's WSTOT(NR_UNIQUE)=WSTOT(NR_UNIQUE)+WSIGMA(I) ! Sum of sigma weights H_UNIQUE(NR_UNIQUE)=H_LAUE(I) K_UNIQUE(NR_UNIQUE)=K_LAUE(I) L_UNIQUE(NR_UNIQUE)=L_LAUE(I) SIG_UNIQUE(NR_UNIQUE)=S(I) ENDDO WRITE(*,470) NR_UNIQUE 470 FORMAT(' NUMBER OF UNIQUE REFLECTIONS : ',I7) C C Calculation of F-MED C FMED_MAX=0.0 SIGEXT_MAX=0.0 DO I=1,NR_UNIQUE FMED(I)=WFTOT(I)/WSUM(I) IF (EFORMULA.EQ.1) THEN SIGEXT(I)=SQRT(WSIGTOT(I)/(NTOT(I)*WSTOT(I))) ! SHELXL ELSE SIGEXT(I)=SQRT(WSIGTOT(I)/WSTOT(I)) ENDIF FMED_MAX=AMAX1(FMED_MAX,FMED(I)) SIGEXT_MAX=AMAX1(SIGEXT_MAX,SIGEXT(I)) ENDDO C C Calculation of R-INT C NR=0 DELTA=0.0 TOTAL=0.0 N_ONCE=0 DO I=1,NHKL IF ((I.EQ.1) + .OR.((I.GT.1).AND.(H_LAUE(I).NE.H_LAUE(I-1))) + .OR.((I.GT.1).AND.(K_LAUE(I).NE.K_LAUE(I-1))) + .OR.((I.GT.1).AND.(L_LAUE(I).NE.L_LAUE(I-1)))) THEN NR=NR+1 ENDIF IF (NTOT(NR).GT.1) THEN DELTA=DELTA+ABS(F(I)-FMED(NR)) TOTAL=TOTAL+F(I) ELSE N_ONCE=N_ONCE+1 ENDIF ENDDO IF (TOTAL.NE.0.0) THEN RINT=DELTA/TOTAL ELSE WRITE(*,*) 'SUM OF ALL INTENSITIES IS 0.0' RINT=999.0 ENDIF WRITE(*,480) N_ONCE 480 FORMAT(' REFLECTIONS, MEASURED ONLY ONCE : ',I7) C C CALCULATION OF INTERNAL SIGMA C C C Schwarzenbach et al. FORMULA C IF (IFORMULA.EQ.1) THEN NR=0 DO I=1,NHKL IF ((I.EQ.1) + .OR.((I.GT.1).AND.(H_LAUE(I).NE.H_LAUE(I-1))) + .OR.((I.GT.1).AND.(K_LAUE(I).NE.K_LAUE(I-1))) + .OR.((I.GT.1).AND.(L_LAUE(I).NE.L_LAUE(I-1)))) THEN NR=NR+1 ENDIF WRINTR(NR)=WRINTR(NR)+ + WSIGMA(I)*(F(I)-FMED(NR))*(F(I)-FMED(NR)) ENDDO SIGINT_MAX=0.0 DO I=1,NR IF (NTOT(I).GT.1) THEN SIGINT(I)=SQRT(WRINTR(I)/(WSTOT(I)*(NTOT(I)-1))) ELSE SIGINT(I)=SIG_UNIQUE(I) ENDIF SIGINT_MAX=AMAX1(SIGINT_MAX,SIGINT(I)) ENDDO C C SORTAV FORMULA (R. Blessing) C ELSE IF (IFORMULA.EQ.2) THEN NR=0 DO I=1,NHKL IF ((I.EQ.1) + .OR.((I.GT.1).AND.(H_LAUE(I).NE.H_LAUE(I-1))) + .OR.((I.GT.1).AND.(K_LAUE(I).NE.K_LAUE(I-1))) + .OR.((I.GT.1).AND.(L_LAUE(I).NE.L_LAUE(I-1)))) THEN NR=NR+1 ENDIF WRINTR(NR)=WRINTR(NR)+ + WSIGMA(I)*(F(I)-FMED(NR))*(F(I)-FMED(NR)) ENDDO SIGINT_MAX=0.0 DO I=1,NR IF (NTOT(I).GT.1) THEN SIGINT(I)=SQRT(NTOT(I)*WRINTR(I)/ + (WSTOT(I)*(NTOT(I)-1))) ELSE SIGINT(I)=SIG_UNIQUE(I) ENDIF SIGINT_MAX=AMAX1(SIGINT_MAX,SIGINT(I)) ENDDO C C CRYSTALS FORMULA (D. Watkin) C ELSE IF (IFORMULA.EQ.3) THEN NR=0 DO I=1,NHKL IF ((I.EQ.1) + .OR.((I.GT.1).AND.(H_LAUE(I).NE.H_LAUE(I-1))) + .OR.((I.GT.1).AND.(K_LAUE(I).NE.K_LAUE(I-1))) + .OR.((I.GT.1).AND.(L_LAUE(I).NE.L_LAUE(I-1)))) THEN NR=NR+1 ENDIF WRINTR(NR)=WRINTR(NR)+ + WSIGMA(I)*(F(I)-FMED(NR))*(F(I)-FMED(NR)) ENDDO SIGINT_MAX=0.0 DO I=1,NR IF (NTOT(I).GT.1) THEN SIGINT(I)=SQRT(WRINTR(I)/WSTOT(I)) ELSE SIGINT(I)=SIG_UNIQUE(I) ENDIF SIGINT_MAX=AMAX1(SIGINT_MAX,SIGINT(I)) ENDDO C C SHELXL FORMULA !!!! C ELSE IF (IFORMULA.EQ.4) THEN NR=0 DO I=1,NHKL IF ((I.EQ.1) + .OR.((I.GT.1).AND.(H_LAUE(I).NE.H_LAUE(I-1))) + .OR.((I.GT.1).AND.(K_LAUE(I).NE.K_LAUE(I-1))) + .OR.((I.GT.1).AND.(L_LAUE(I).NE.L_LAUE(I-1)))) THEN NR=NR+1 ENDIF WRINTR(NR)=WRINTR(NR)+ABS(F(I)-FMED(NR)) ENDDO SIGINT_MAX=0.0 DO I=1,NR IF (NTOT(I).GT.1) THEN SIGINT(I)=WRINTR(I)/(NTOT(I)*SQRT(REAL(NTOT(I)-1))) ELSE SIGINT(I)=SIG_UNIQUE(I) ENDIF SIGINT_MAX=AMAX1(SIGINT_MAX,SIGINT(I)) ENDDO ENDIF C C OUTPUT R-INT VALUE C WRITE(*,*) WRITE(*,500) RINT 500 FORMAT(' R-INT: ',F8.4) C C DETERMINATION OF SCALE FACTOR C IF (IMEANFORM.EQ.1) THEN SIG_MAX=SIGEXT_MAX ELSE IF (IMEANFORM.EQ.2) THEN SIG_MAX=SIGINT_MAX ELSE IF (IMEANFORM.EQ.3) THEN SIG_MAX=AMAX1(SIGINT_MAX,SIGEXT_MAX) ENDIF IF (FMED_MAX.GT.9999999. .OR. + SIG_MAX.GT.9999999.) THEN SCALEFACTOR=9999999./AMAX1(FMED_MAX,SIG_MAX) WRITE(*,590) SCALEFACTOR 590 FORMAT(' DATASET RE-SCALED WITH SCALEFACTOR ',F8.4) ELSE SCALEFACTOR=1.0 ENDIF C C OUTPUT MERGED DATA C SUMSIGMERGED=0.0 SUMINTMERGED=0.0 OPEN(UNIT=3,FILE=FILE_OUT,STATUS='UNKNOWN') DO I=1,NR_UNIQUE FMED(I)=SCALEFACTOR*FMED(I) IF (IMEANFORM.EQ.1) THEN SIGMEAN(I)=SCALEFACTOR*SIGEXT(I) ELSE IF (IMEANFORM.EQ.2) THEN SIGMEAN(I)=SCALEFACTOR*SIGINT(I) ELSE IF (IMEANFORM.EQ.3) THEN SIGMEAN(I)=SCALEFACTOR*AMAX1(SIGINT(I),SIGEXT(I)) ENDIF C C Conversion to F, sig(F) C IF (IOUTPUT.EQ.2) THEN IF (FMED(I).GE.0.0) THEN FMED(I) = SQRT(FMED(I)) ELSE FMED(I) = SQRT(ABS(FMED(I))) FMED(I) = -FMED(I) ENDIF SIGMEAN(I) = ABS(SIGMEAN(I)/FMED(I))/2 ENDIF IF (FMED(I).LT.100000 .AND. + SIGMEAN(I).LT.100000) THEN WRITE(3,600) H_UNIQUE(I),K_UNIQUE(I),L_UNIQUE(I), + FMED(I),SIGMEAN(I) 600 FORMAT(3I4,2F8.2) ELSE WRITE(3,610) H_UNIQUE(I),K_UNIQUE(I),L_UNIQUE(I), + FMED(I),SIGMEAN(I) 610 FORMAT(3I4,2F8.0) ENDIF SUMSIGMERGED=SUMSIGMERGED+SIGMEAN(I) SUMINTMERGED=SUMINTMERGED+FMED(I) ENDDO CLOSE(3) C C OUTPUT R-SIGMA VALUE C WRITE(*,700) SUMSIGMERGED/SUMINTMERGED 700 FORMAT(' R-SIGMA: ',F8.4) WRITE(*,*) END SUBROUTINE MYLAUE(NPOINT,IH,IK,IL,IHNEW,IKNEW,ILNEW) INTEGER X,Y,Z IHNEW=IH IKNEW=IK ILNEW=IL GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22, + 23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39, + 40,41,42) NPOINT C C 1 C 1 RETURN C C -1 C 2 IF (ILNEW.GT.0) RETURN IHNEW=-IHNEW IKNEW=-IKNEW ILNEW=-ILNEW IF (ILNEW.GT.0) RETURN IF (IKNEW.GT.0) RETURN IHNEW=-IHNEW IKNEW=-IKNEW IF (IKNEW.GT.0) RETURN IF (IHNEW.GE.0) RETURN IHNEW=-IHNEW RETURN C C 2 C 3 IF (ILNEW.GT.0) RETURN IHNEW=-IHNEW ILNEW=-ILNEW IF (ILNEW.GT.0) RETURN IF (IHNEW.GE.0) RETURN IHNEW=-IHNEW RETURN C C M C 4 IKNEW=ABS(IKNEW) RETURN C C 2/M C 5 IKNEW=ABS(IKNEW) GO TO 3 C C 222 C 6 IF (IHNEW.EQ.0.OR.IKNEW.EQ.0.OR.ILNEW.EQ.0) THEN IHNEW=ABS(IHNEW) IKNEW=ABS(IKNEW) ILNEW=ABS(ILNEW) RETURN END IF IF (IHNEW.GE.0.AND.IKNEW.GE.0) RETURN X=IHNEW Y=IKNEW Z=ILNEW IHNEW=-X IKNEW=-Y ILNEW=Z IF (IHNEW.GE.0.AND.IKNEW.GE.0) RETURN IHNEW=-X IKNEW=Y ILNEW=-Z IF (IHNEW.GE.0.AND.IKNEW.GE.0) RETURN IHNEW=X IKNEW=-Y ILNEW=-Z RETURN C C MM2 C 7 IHNEW=ABS(IHNEW) IKNEW=ABS(IKNEW) RETURN C C MMM C 8 ILNEW=ABS(ILNEW) GO TO 7 C C 4 C 9 IF (IHNEW.EQ.0.AND.IKNEW.EQ.0) RETURN IF (IHNEW.GT.0.AND.IKNEW.GE.0) RETURN X=IHNEW Y=IKNEW IHNEW=-Y IKNEW=X IF (IHNEW.GT.0.AND.IKNEW.GE.0) RETURN IHNEW=-X IKNEW=-Y IF (IHNEW.GT.0.AND.IKNEW.GE.0) RETURN IHNEW=Y IKNEW=-X RETURN C C -4 C 10 IF (IHNEW.EQ.0.AND.IKNEW.EQ.0) THEN ILNEW=ABS(ILNEW) RETURN END IF IF (IHNEW.GT.0.AND.IKNEW.GE.0) RETURN X=IHNEW Y=IKNEW IHNEW=-X IKNEW=-Y IF (IHNEW.GT.0.AND.IKNEW.GE.0) RETURN IHNEW=Y IKNEW=-X ILNEW=-ILNEW IF (IHNEW.GT.0.AND.IKNEW.GE.0) RETURN IHNEW=-Y IKNEW=X RETURN C C 4/M C 11 ILNEW=ABS(ILNEW) GO TO 9 C C 422 C 12 IF (IHNEW.EQ.0.OR.IKNEW.EQ.0.OR.ABS(IHNEW).EQ.ABS(IKNEW)) & ILNEW=ABS(ILNEW) 512 IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN X=IHNEW Y=IKNEW IHNEW=-X IKNEW=-Y IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=-Y IKNEW=X IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=Y IKNEW=-X IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=-X IKNEW=Y ILNEW=-ILNEW GO TO 512 C C 4MM C 13 IHNEW=ABS(IHNEW) IKNEW=ABS(IKNEW) IF (IHNEW.GE.IKNEW) RETURN X=IHNEW IHNEW=IKNEW IKNEW=X RETURN C C -42M C 14 IF (IHNEW.EQ.0.OR.IKNEW.EQ.0) ILNEW=ABS(ILNEW) 514 IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN X=IHNEW Y=IKNEW IHNEW=-X IKNEW=-Y IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=Y IKNEW=-X ILNEW=-ILNEW IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=-Y IKNEW=X IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=-X IKNEW=Y GO TO 514 C C -4M2 C 15 IHNEW=ABS(IHNEW) IKNEW=ABS(IKNEW) IF (IHNEW.EQ.IKNEW) ILNEW=ABS(ILNEW) IF (IHNEW.GE.IKNEW) RETURN X=IHNEW IHNEW=IKNEW IKNEW=X ILNEW=-ILNEW RETURN C C 4/MMM C 16 ILNEW=ABS(ILNEW) GO TO 13 C C 3 C 17 IF (IHNEW.EQ.0.AND.IKNEW.EQ.0) RETURN IF (IHNEW.LT.0.AND.IKNEW.GE.0) RETURN X=IHNEW Y=IKNEW I=-IHNEW-IKNEW IHNEW=I IKNEW=X IF (IHNEW.LT.0.AND.IKNEW.GE.0) RETURN IHNEW=Y IKNEW=I RETURN C C -3 C 18 IF (IHNEW.EQ.0.AND.IKNEW.EQ.0) THEN ILNEW=ABS(ILNEW) RETURN END IF 518 IF (IHNEW.LT.0.AND.IKNEW.GE.0.AND.(ILNEW.GT.0.OR.(ILNEW.EQ.0.AND. & IHNEW.LT.-IKNEW))) RETURN X=IHNEW Y=IKNEW I=-IHNEW-IKNEW IHNEW=I IKNEW=X IF (IHNEW.LT.0.AND.IKNEW.GE.0.AND.(ILNEW.GT.0.OR.(ILNEW.EQ.0.AND. & IHNEW.LT.-IKNEW))) RETURN IHNEW=Y IKNEW=I IF (IHNEW.LT.0.AND.IKNEW.GE.0.AND.(ILNEW.GT.0.OR.(ILNEW.EQ.0.AND. & IHNEW.LT.-IKNEW))) RETURN IHNEW=-X IKNEW=-Y ILNEW=-ILNEW GO TO 518 C C 312 C 19 IF (IHNEW.EQ.0.OR.IKNEW.EQ.0.OR.-IHNEW.EQ.IKNEW) ILNEW=ABS(ILNEW) 519 IF (IHNEW.GE.0.AND.IKNEW.GE.0) RETURN X=IHNEW Y=IKNEW I=-IHNEW-IKNEW IHNEW=I IKNEW=X IF (IHNEW.GE.0.AND.IKNEW.GE.0) RETURN IHNEW=Y IKNEW=I IF (IHNEW.GE.0.AND.IKNEW.GE.0) RETURN IHNEW=-Y IKNEW=-X ILNEW=-ILNEW GO TO 519 C C 321 C 20 IF (IHNEW.EQ.IKNEW.OR.-2*IHNEW.EQ.IKNEW.OR.-IHNEW.EQ.2*IKNEW) & ILNEW=ABS(ILNEW) 520 IF (IHNEW.GE.0.AND.-IHNEW/2.LE.IKNEW.AND.IKNEW.LE.IHNEW) RETURN X=IHNEW Y=IKNEW I=-IHNEW-IKNEW IHNEW=I IKNEW=X IF (IHNEW.GE.0.AND.-IHNEW/2.LE.IKNEW.AND.IKNEW.LE.IHNEW) RETURN IHNEW=Y IKNEW=I IF (IHNEW.GE.0.AND.-IHNEW/2.LE.IKNEW.AND.IKNEW.LE.IHNEW) RETURN IHNEW=Y IKNEW=X ILNEW=-ILNEW GO TO 520 C C 31M C 21 IF (IHNEW.GE.0.AND.-IHNEW/2.LE.IKNEW.AND.IKNEW.LE.IHNEW) RETURN X=IHNEW Y=IKNEW I=-IHNEW-IKNEW IHNEW=I IKNEW=X IF (IHNEW.GE.0.AND.-IHNEW/2.LE.IKNEW.AND.IKNEW.LE.IHNEW) RETURN IHNEW=Y IKNEW=I IF (IHNEW.GE.0.AND.-IHNEW/2.LE.IKNEW.AND.IKNEW.LE.IHNEW) RETURN IHNEW=Y IKNEW=X GO TO 21 C C 3M1 C 22 IF (IHNEW.GE.0.AND.IKNEW.GE.0) RETURN X=IHNEW Y=IKNEW I=-IHNEW-IKNEW IHNEW=I IKNEW=X IF (IHNEW.GE.0.AND.IKNEW.GE.0) RETURN IHNEW=Y IKNEW=I IF (IHNEW.GE.0.AND.IKNEW.GE.0) RETURN IHNEW=-Y IKNEW=-X GO TO 22 C C -31M C 23 IF (IHNEW.EQ.0.OR.IKNEW.EQ.0.OR.-IHNEW.EQ.IKNEW) ILNEW=ABS(ILNEW) 523 IF (IHNEW.GE.0.AND.-IHNEW/2.LE.IKNEW.AND.IKNEW.LE.IHNEW.AND. & (ILNEW.GT.0.OR.(ILNEW.EQ.0.AND. & IKNEW.GE.0))) RETURN X=IHNEW Y=IKNEW I=-IHNEW-IKNEW IHNEW=I IKNEW=X IF (IHNEW.GE.0.AND.-IHNEW/2.LE.IKNEW.AND.IKNEW.LE.IHNEW.AND. & (ILNEW.GT.0.OR.(ILNEW.EQ.0.AND. & IKNEW.GE.0))) RETURN IHNEW=Y IKNEW=I IF (IHNEW.GE.0.AND.-IHNEW/2.LE.IKNEW.AND.IKNEW.LE.IHNEW.AND. & (ILNEW.GT.0.OR.(ILNEW.EQ.0.AND. & IKNEW.GE.0))) RETURN IHNEW=Y IKNEW=X IF (IHNEW.GE.0.AND.-IHNEW/2.LE.IKNEW.AND.IKNEW.LE.IHNEW.AND. & (ILNEW.GT.0.OR.(ILNEW.EQ.0.AND. & IKNEW.GE.0))) RETURN IHNEW=X IKNEW=I IF (IHNEW.GE.0.AND.-IHNEW/2.LE.IKNEW.AND.IKNEW.LE.IHNEW.AND. & (ILNEW.GT.0.OR.(ILNEW.EQ.0.AND. & IKNEW.GE.0))) RETURN IHNEW=I IKNEW=Y IF (IHNEW.GE.0.AND.-IHNEW/2.LE.IKNEW.AND.IKNEW.LE.IHNEW.AND. & (ILNEW.GT.0.OR.(ILNEW.EQ.0.AND. & IKNEW.GE.0))) RETURN IHNEW=-X IKNEW=-Y ILNEW=-ILNEW GO TO 523 C C -3M1 C 24 IF (IHNEW.EQ.IKNEW.OR.-2*IHNEW.EQ.IKNEW.OR.-IHNEW.EQ.2*IKNEW) & ILNEW=ABS(ILNEW) 524 IF (IHNEW.GE.0.AND.IKNEW.GE.0.AND.(ILNEW.GT.0.OR.(ILNEW.EQ.0.AND. & IHNEW.GE.IKNEW))) RETURN X=IHNEW Y=IKNEW I=-IHNEW-IKNEW IHNEW=I IKNEW=X IF (IHNEW.GE.0.AND.IKNEW.GE.0.AND.(ILNEW.GT.0.OR.(ILNEW.EQ.0.AND. & IHNEW.GE.IKNEW))) RETURN IHNEW=Y IKNEW=I IF (IHNEW.GE.0.AND.IKNEW.GE.0.AND.(ILNEW.GT.0.OR.(ILNEW.EQ.0.AND. & IHNEW.GE.IKNEW))) RETURN IHNEW=Y IKNEW=X ILNEW=-ILNEW IF (IHNEW.GE.0.AND.IKNEW.GE.0.AND.(ILNEW.GT.0.OR.(ILNEW.EQ.0.AND. & IHNEW.GE.IKNEW))) RETURN IHNEW=X IKNEW=I IF (IHNEW.GE.0.AND.IKNEW.GE.0.AND.(ILNEW.GT.0.OR.(ILNEW.EQ.0.AND. & IHNEW.GE.IKNEW))) RETURN IHNEW=I IKNEW=Y IF (IHNEW.GE.0.AND.IKNEW.GE.0.AND.(ILNEW.GT.0.OR.(ILNEW.EQ.0.AND. & IHNEW.GE.IKNEW))) RETURN IHNEW=-X IKNEW=-Y GO TO 524 C C 6 C 25 IF (IHNEW.EQ.0.AND.IKNEW.EQ.0) RETURN IF (IHNEW.GT.0.AND.IKNEW.GE.0) RETURN X=IHNEW Y=IKNEW I=-IHNEW-IKNEW IHNEW=I IKNEW=X IF (IHNEW.GT.0.AND.IKNEW.GE.0) RETURN IHNEW=Y IKNEW=I IF (IHNEW.GT.0.AND.IKNEW.GE.0) RETURN IHNEW=-X IKNEW=-Y IF (IHNEW.GT.0.AND.IKNEW.GE.0) RETURN IHNEW=-I IKNEW=-X IF (IHNEW.GT.0.AND.IKNEW.GE.0) RETURN IHNEW=-Y IKNEW=-I RETURN C C -6 C 26 ILNEW=ABS(ILNEW) GO TO 17 C C 6/M C 27 ILNEW=ABS(ILNEW) GO TO 25 C C 622 C 28 IF (IHNEW.EQ.0.OR.IKNEW.EQ.0.OR.ABS(IHNEW).EQ.ABS(IKNEW).OR. & ABS(2*IHNEW).EQ.ABS(IKNEW).OR. & ABS(IHNEW).EQ.ABS(2*IKNEW)) ILNEW=ABS(ILNEW) 528 IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN X=IHNEW Y=IKNEW I=-IHNEW-IKNEW IHNEW=I IKNEW=X IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=Y IKNEW=I IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=-X IKNEW=-Y IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=-I IKNEW=-X IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=-Y IKNEW=-I IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=Y IKNEW=X ILNEW=-ILNEW GO TO 528 C C 6MM C 29 IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN X=IHNEW Y=IKNEW I=-IHNEW-IKNEW IHNEW=I IKNEW=X IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=Y IKNEW=I IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=-X IKNEW=-Y IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=-I IKNEW=-X IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=-Y IKNEW=-I IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.0) RETURN IHNEW=Y IKNEW=X GO TO 29 C C -6M2 C 30 ILNEW=ABS(ILNEW) IF (IHNEW.EQ.0.AND.IKNEW.EQ.0) RETURN 530 IF (IHNEW.GT.0.AND.IKNEW.GE.0) RETURN X=IHNEW Y=IKNEW I=-IHNEW-IKNEW IHNEW=I IKNEW=X IF (IHNEW.GT.0.AND.IKNEW.GE.0) RETURN IHNEW=Y IKNEW=I IF (IHNEW.GT.0.AND.IKNEW.GE.0) RETURN IHNEW=-Y IKNEW=-X GO TO 530 C C -62M C 31 ILNEW=ABS(ILNEW) IF (IHNEW.EQ.0.AND.IKNEW.EQ.0) RETURN 531 IF (IHNEW.GT.0.AND.-IHNEW/2.LE.IKNEW.AND.IKNEW.LE.IHNEW) RETURN X=IHNEW Y=IKNEW I=-IHNEW-IKNEW IHNEW=I IKNEW=X IF (IHNEW.GT.0.AND.-IHNEW/2.LE.IKNEW.AND.IKNEW.LE.IHNEW) RETURN IHNEW=Y IKNEW=I IF (IHNEW.GT.0.AND.-IHNEW/2.LE.IKNEW.AND.IKNEW.LE.IHNEW) RETURN IHNEW=Y IKNEW=X GO TO 531 C C 6/MMM C 32 ILNEW=ABS(ILNEW) GO TO 29 C C R3 C 33 STOP 'RE-INDEX ON HEXAGONAL AXES' C C R-3 C 34 GO TO 33 C C R32 C 35 GO TO 33 C C R3M C 36 GO TO 33 C C R-3M C 37 GO TO 33 C C 23 C 38 IF (ABS(IHNEW).EQ.ABS(IKNEW).AND.ABS(IKNEW).EQ.ABS(ILNEW)) THEN IHNEW=ABS(IHNEW) IKNEW=ABS(IKNEW) ILNEW=ABS(ILNEW)*(IHNEW*IKNEW*ILNEW)/ABS(IHNEW*IKNEW*ILNEW) RETURN END IF 538 IF (IHNEW.GT.ABS(ILNEW).AND.IKNEW.GE.ABS(ILNEW)) RETURN X=IHNEW Y=IKNEW Z=ILNEW IHNEW=-X IKNEW=-Y ILNEW=Z IF (IHNEW.GT.ABS(ILNEW).AND.IKNEW.GE.ABS(ILNEW)) RETURN IHNEW=-X IKNEW=Y ILNEW=-Z IF (IHNEW.GT.ABS(ILNEW).AND.IKNEW.GE.ABS(ILNEW)) RETURN IHNEW=X IKNEW=-Y ILNEW=-Z IF (IHNEW.GT.ABS(ILNEW).AND.IKNEW.GE.ABS(ILNEW)) RETURN IHNEW=Z IKNEW=X ILNEW=Y GO TO 538 C C M3 C 39 IHNEW=ABS(IHNEW) IKNEW=ABS(IKNEW) ILNEW=ABS(ILNEW) IF (IHNEW.EQ.IKNEW.AND.IKNEW.EQ.ILNEW) RETURN 539 IF (IHNEW.GT.ILNEW.AND.IKNEW.GE.ILNEW) RETURN X=IHNEW Y=IKNEW Z=ILNEW IHNEW=Z IKNEW=X ILNEW=Y IF (IHNEW.GT.ILNEW.AND.IKNEW.GE.ILNEW) RETURN IHNEW=Y IKNEW=Z ILNEW=X GO TO 539 C C 432 C 40 IF (ABS(IHNEW).EQ.ABS(IKNEW).AND.ABS(IKNEW).EQ.ABS(ILNEW)) THEN IHNEW=ABS(IHNEW) IKNEW=ABS(IKNEW) ILNEW=ABS(ILNEW) RETURN END IF 540 IF (IHNEW.GT.ILNEW.AND.IKNEW.GE.ILNEW.AND.ILNEW.GE.0) RETURN X=IHNEW Y=IKNEW Z=ILNEW IHNEW=Z IKNEW=X ILNEW=Y IF (IHNEW.GT.ILNEW.AND.IKNEW.GE.ILNEW.AND.ILNEW.GE.0) RETURN IHNEW=Y IKNEW=Z ILNEW=X IF (IHNEW.GT.ILNEW.AND.IKNEW.GE.ILNEW.AND.ILNEW.GE.0) RETURN IHNEW=-X IKNEW=-Y ILNEW=Z IF (IHNEW.GT.ILNEW.AND.IKNEW.GE.ILNEW.AND.ILNEW.GE.0) RETURN IHNEW=Z IKNEW=-X ILNEW=-Y IF (IHNEW.GT.ILNEW.AND.IKNEW.GE.ILNEW.AND.ILNEW.GE.0) RETURN IHNEW=-Y IKNEW=Z ILNEW=-X IF (IHNEW.GT.ILNEW.AND.IKNEW.GE.ILNEW.AND.ILNEW.GE.0) RETURN IHNEW=-X IKNEW=Y ILNEW=-Z IF (IHNEW.GT.ILNEW.AND.IKNEW.GE.ILNEW.AND.ILNEW.GE.0) RETURN IHNEW=-Z IKNEW=-X ILNEW=Y IF (IHNEW.GT.ILNEW.AND.IKNEW.GE.ILNEW.AND.ILNEW.GE.0) RETURN IHNEW=Y IKNEW=-Z ILNEW=-X IF (IHNEW.GT.ILNEW.AND.IKNEW.GE.ILNEW.AND.ILNEW.GE.0) RETURN IHNEW=X IKNEW=-Y ILNEW=-Z IF (IHNEW.GT.ILNEW.AND.IKNEW.GE.ILNEW.AND.ILNEW.GE.0) RETURN IHNEW=-Z IKNEW=X ILNEW=-Y IF (IHNEW.GT.ILNEW.AND.IKNEW.GE.ILNEW.AND.ILNEW.GE.0) RETURN IHNEW=-Y IKNEW=-Z ILNEW=X IF (IHNEW.GT.ILNEW.AND.IKNEW.GE.ILNEW.AND.ILNEW.GE.0) RETURN IHNEW=Y IKNEW=X ILNEW=-Z GO TO 540 C C -43M C 41 IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ABS(ILNEW)) RETURN X=IHNEW Y=IKNEW Z=ILNEW IHNEW=Z IKNEW=X ILNEW=Y IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ABS(ILNEW)) RETURN IHNEW=Y IKNEW=Z ILNEW=X IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ABS(ILNEW)) RETURN IHNEW=-X IKNEW=-Y ILNEW=Z IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ABS(ILNEW)) RETURN IHNEW=Z IKNEW=-X ILNEW=-Y IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ABS(ILNEW)) RETURN IHNEW=-Y IKNEW=Z ILNEW=-X IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ABS(ILNEW)) RETURN IHNEW=-X IKNEW=Y ILNEW=-Z IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ABS(ILNEW)) RETURN IHNEW=-Z IKNEW=-X ILNEW=Y IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ABS(ILNEW)) RETURN IHNEW=Y IKNEW=-Z ILNEW=-X IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ABS(ILNEW)) RETURN IHNEW=X IKNEW=-Y ILNEW=-Z IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ABS(ILNEW)) RETURN IHNEW=-Z IKNEW=X ILNEW=-Y IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ABS(ILNEW)) RETURN IHNEW=-Y IKNEW=-Z ILNEW=X IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ABS(ILNEW)) RETURN IHNEW=Y IKNEW=X ILNEW=Z GO TO 41 C C M3M C 42 IHNEW=ABS(IHNEW) IKNEW=ABS(IKNEW) ILNEW=ABS(ILNEW) IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ILNEW) RETURN X=IHNEW Y=IKNEW Z=ILNEW IHNEW=Z IKNEW=X ILNEW=Y IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ILNEW) RETURN IHNEW=Y IKNEW=Z ILNEW=X IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ILNEW) RETURN IHNEW=Z IKNEW=Y ILNEW=X IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ILNEW) RETURN IHNEW=X IKNEW=Z ILNEW=Y IF (IHNEW.GE.IKNEW.AND.IKNEW.GE.ILNEW) RETURN IHNEW=Y IKNEW=X ILNEW=Z RETURN END SUBROUTINE LSORT(H_LAUE,K_LAUE,L_LAUE,FOBS,SIGF,NHKL) PARAMETER (NREF=100000) INTEGER H_LAUE(NREF),K_LAUE(NREF),L_LAUE(NREF) REAL FOBS(NREF),SIGF(NREF) LL=1 LR=NHKL CALL SORTREFL(3,H_LAUE,K_LAUE,L_LAUE,FOBS,SIGF,LL,LR) RETURN END SUBROUTINE KSORT(H_LAUE,K_LAUE,L_LAUE,FOBS,SIGF,NHKL) PARAMETER (NREF=100000) INTEGER H_LAUE(NREF),K_LAUE(NREF),L_LAUE(NREF) REAL FOBS(NREF),SIGF(NREF) ISTART=1 DO I=2,NHKL IF (L_LAUE(I).NE.L_LAUE(I-1).OR.(I.EQ.NHKL)) THEN LL=ISTART IF (I.NE.NHKL) THEN LR=I-1 ELSE IF (L_LAUE(I).NE.L_LAUE(I-1)) THEN LR=I-1 ELSE LR=NHKL ENDIF IF (LL.NE.LR) + CALL SORTREFL(2,H_LAUE,K_LAUE,L_LAUE,FOBS,SIGF,LL,LR) ISTART=I ENDIF ENDDO RETURN END SUBROUTINE HSORT(H_LAUE,K_LAUE,L_LAUE,FOBS,SIGF,NHKL) PARAMETER (NREF=100000) INTEGER H_LAUE(NREF),K_LAUE(NREF),L_LAUE(NREF) REAL FOBS(NREF),SIGF(NREF) ISTART=1 DO I=2,NHKL IF ( (L_LAUE(I).NE.L_LAUE(I-1)).OR. + (K_LAUE(I).NE.K_LAUE(I-1)).OR. + (I.EQ.NHKL)) THEN LL=ISTART IF (I.NE.NHKL) THEN LR=I-1 ELSE IF ((L_LAUE(I).NE.L_LAUE(I-1)).OR. + (K_LAUE(I).NE.K_LAUE(I-1))) THEN LR=I-1 ELSE LR=NHKL ENDIF IF (LL.NE.LR) + CALL SORTREFL(1,H_LAUE,K_LAUE,L_LAUE,FOBS,SIGF,LL,LR) ISTART=I ENDIF ENDDO RETURN END SUBROUTINE SORTREFL(ICRIT,H_LAUE,K_LAUE,L_LAUE,FOBS,SIGF,LL,LR) C C Quicksort algorithm adapted from C Nikolaus Wirth: Algorithmen und Datenstrukturen, B.G. Teubner, Stuttgart C (1983) C C LL: left C LR: right C LX: medium-value C PARAMETER (NREF=100000) INTEGER H_LAUE(NREF),K_LAUE(NREF),L_LAUE(NREF) REAL FOBS(NREF),SIGF(NREF) INTEGER STACKL(NREF),STACKR(NREF),LL,LR,LS INTEGER*2 N1,N2,N3 REAL*4 F1,F2 LS = 1 STACKL(1) = LL STACKR(1) = LR 10 LL = STACKL(LS) LR = STACKR(LS) LS = LS-1 20 I = LL J = LR LT = INT((LL+LR)/2) IF (ICRIT.EQ.1) THEN LX = H_LAUE(LT) ELSE IF (ICRIT.EQ.2) THEN LX = K_LAUE(LT) ELSE IF (ICRIT.EQ.3) THEN LX = L_LAUE(LT) ENDIF 25 IF (ICRIT.EQ.1) THEN 30 IF (H_LAUE(I).LT.LX) THEN I=I+1 GOTO 30 ENDIF 40 IF (LX.LT.H_LAUE(J)) THEN J=J-1 GOTO 40 ENDIF ELSE IF (ICRIT.EQ.2) THEN 31 IF (K_LAUE(I).LT.LX) THEN I=I+1 GOTO 31 ENDIF 41 IF (LX.LT.K_LAUE(J)) THEN J=J-1 GOTO 41 ENDIF ELSE IF (ICRIT.EQ.3) THEN 32 IF (L_LAUE(I).LT.LX) THEN I=I+1 GOTO 32 ENDIF 42 IF (LX.LT.L_LAUE(J)) THEN J=J-1 GOTO 42 ENDIF ENDIF IF (I.LE.J) THEN N1 = H_LAUE(I) N2 = K_LAUE(I) N3 = L_LAUE(I) F1 = FOBS(I) F2 = SIGF(I) H_LAUE(I) = H_LAUE(J) K_LAUE(I) = K_LAUE(J) L_LAUE(I) = L_LAUE(J) FOBS(I) = FOBS(J) SIGF(I) = SIGF(J) H_LAUE(J) = N1 K_LAUE(J) = N2 L_LAUE(J) = N3 FOBS(J) = F1 SIGF(J) = F2 I = I+1 J = J-1 ENDIF IF (I.LE.J) GOTO 25 IF (I.LT.LR) THEN LS = LS+1 STACKL(LS) = I STACKR(LS) = LR ENDIF LR = J IF (LL.LE.LR) GOTO 20 IF (LS.NE.0) GOTO 10 RETURN END SUBROUTINE SPGRINFO(ISPGR,NPOINT,ABSCOND) INTEGER PGTABLE(230) LOGICAL ABSCOND(46) DATA PGTABLE + /1,2,3,3,3,4,4,4,4,5,5,5,5,5,5,6,6,6,6,6,6,6,6,6,7,7,7,7, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,8,8,8,8,8,8,8,8,8,8, + 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,9,9,9,9,9,9,10,10,11, + 11,11,11,11,11,12,12,12,12,12,12,12,12,12,12,13,13,13,13, + 13,13,13,13,13,13,13,13,14,14,14,14,15,15,15,15,15,15,14, + 14,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16, + 16,16,17,17,17,17,18,18,19,20,19,20,19,20,20,22,21,22,21, + 22,22,23,23,24,24,24,24,25,25,25,25,25,25,26,27,27,28,28, + 28,28,28,28,29,29,29,29,30,30,31,31,32,32,32,32,38,38,38, + 38,38,39,39,39,39,39,39,39,40,40,40,40,40,40,40,40,41,41, + 41,41,41,41,42,42,42,42,42,42,42,42,42,42 / NPOINT=PGTABLE(ISPGR) DO I=1,46 ABSCOND(I)= .FALSE. ENDDO GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22, + 23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41, + 42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60, + 61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79, + 80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98, + 99,100,101,102,103,104,105,106,107,108,109,110,111,112, + 113,114,115,116,117,118,119,120,121,122,123,124,125,126, + 127,128,129,130,131,132,133,134,135,136,137,138,139,140, + 141,142,143,144,145,146,147,148,149,150,151,152,153,154, + 155,156,157,158,159,160,161,162,163,164,165,166,167,168, + 169,170,171,172,173,174,175,176,177,178,179,180,181,182, + 183,184,185,186,187,188,189,190,191,192,193,194,195,196, + 197,198,199,200,201,202,203,204,205,206,207,208,209,210, + 211,212,213,214,215,216,217,218,219,220,221,222,223,224, + 225,226,227,228,229,230) ISPGR C P1 1 RETURN C P-1 2 RETURN C P2 3 RETURN C P21 4 ABSCOND(32)=.TRUE. !0K0,K=2N RETURN C C2 5 ABSCOND(1)=.TRUE. !HKL,H+K=2N RETURN C Pm 6 RETURN C Pc 7 ABSCOND(17)=.TRUE. !H0L,L=2N RETURN C Cm 8 ABSCOND(1)=.TRUE. !HKL,H+K=2N RETURN C Cc 9 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N RETURN C P2/m 10 RETURN C P21/m 11 ABSCOND(32)=.TRUE. !0K0,K=2N RETURN C C2/m 12 ABSCOND(1)=.TRUE. !HKL,H+K=2N RETURN C P2/c 13 ABSCOND(17)=.TRUE. !H0L,L=2N RETURN C P21/c 14 ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(32)=.TRUE. !0K0,K=2N RETURN C C2/c 15 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N RETURN C P222 16 RETURN C P2221 17 ABSCOND(34)=.TRUE. !00L,L=2N RETURN C P21212 18 ABSCOND(30)=.TRUE. !H00,H=2N ABSCOND(32)=.TRUE. !0K0,K=2N RETURN C P212121 19 ABSCOND(30)=.TRUE. !H00,H=2N ABSCOND(32)=.TRUE. !0K0,K=2N ABSCOND(34)=.TRUE. !00L,L=2N RETURN C C2221 20 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(34)=.TRUE. !00L,L=2N RETURN C C222 21 ABSCOND(1)=.TRUE. !HKL,H+K=2N RETURN C F222 22 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N RETURN C I222 23 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C I212121 24 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C Pmm2 25 RETURN C Pmc21 26 ABSCOND(17)=.TRUE. !H0L,L=2N RETURN C Pcc2 27 ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C Pma2 28 ABSCOND(18)=.TRUE. !H0L,H=2N RETURN C Pca21 29 ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C Pnc2 30 ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C Pmn21 31 ABSCOND(19)=.TRUE. !H0L,H+L=2N RETURN C Pba2 32 ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C Pna21 33 ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C Pnn2 34 ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C Cmm2 35 ABSCOND(1)=.TRUE. !HKL,H+K=2N RETURN C Cmc21 36 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N RETURN C Ccc2 37 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C Amm2 38 ABSCOND(2)=.TRUE. !HKL,K+L=2N RETURN C Abm2 39 ABSCOND(2)=.TRUE. !HKL,K+L=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C Ama2 40 ABSCOND(2)=.TRUE. !HKL,K+L=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N RETURN C Aba2 41 ABSCOND(2)=.TRUE. !HKL,K+L=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C Fmm2 42 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N RETURN C Fdd2 43 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N ABSCOND(20)=.TRUE. !H0L,H+L=4N ABSCOND(16)=.TRUE. !0KL,K+L=4N RETURN C Imm2 44 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C Iba2 45 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C Ima2 46 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(18)=.TRUE. !H0L,H=2N RETURN C Pmmm 47 RETURN C Pnnn 48 ABSCOND(11)=.TRUE. !HK0,H+K=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C Pccm 49 ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C Pban 50 ABSCOND(11)=.TRUE. !HK0,H+K=2N ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C Pmma 51 ABSCOND(9)=.TRUE. !HK0,H=2N RETURN C Pnna 52 ABSCOND(9)=.TRUE. !HK0,H=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C Pmna 53 ABSCOND(9)=.TRUE. !HK0,H=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N RETURN C Pcca 54 ABSCOND(9)=.TRUE. !HK0,H=2N ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C Pbam 55 ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C Pccn 56 ABSCOND(11)=.TRUE. !HK0,H+K=2N ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C Pbcm 57 ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C Pnnm 58 ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C Pmmn 59 ABSCOND(11)=.TRUE. !HK0,H+K=2N RETURN C Pbcn 60 ABSCOND(11)=.TRUE. !HK0,H+K=2N ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C Pbca 61 ABSCOND(9)=.TRUE. !HK0,H=2N ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C Pnma 62 ABSCOND(9)=.TRUE. !HK0,H=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C Cmcm 63 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N RETURN C Cmca 64 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(9)=.TRUE. !HK0,H=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N RETURN C Cmmm 65 ABSCOND(1)=.TRUE. !HKL,H+K=2N RETURN C Cccm 66 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C Cmma 67 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(9)=.TRUE. !HK0,H=2N RETURN C Ccca 68 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(9)=.TRUE. !HK0,H=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C Fmmm 69 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N RETURN C Fddd 70 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N ABSCOND(12)=.TRUE. !HK0,H+K=4N ABSCOND(20)=.TRUE. !H0L,H+L=4N ABSCOND(16)=.TRUE. !0KL,K+L=4N RETURN C Immm 71 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C Ibam 72 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C Ibca 73 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(9)=.TRUE. !HK0,H=2N ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C Imma 74 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(9)=.TRUE. !HK0,H=2N RETURN C P4 75 RETURN C P41 76 ABSCOND(35)=.TRUE. !00L,L=4N RETURN C P42 77 ABSCOND(34)=.TRUE. !00L,L=2N RETURN C P43 78 ABSCOND(35)=.TRUE. !00L,L=4N RETURN C I4 79 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C I41 80 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(35)=.TRUE. !00L,L=4N RETURN C P-4 81 RETURN C I-4 82 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C P4/m 83 RETURN C P42/m 84 ABSCOND(34)=.TRUE. !00L,L=2N RETURN C P4/n 85 ABSCOND(11)=.TRUE. !HK0,H+K=2N RETURN C P42/n 86 ABSCOND(11)=.TRUE. !HK0,H+K=2N ABSCOND(34)=.TRUE. !00L,L=2N RETURN C I4/m 87 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C I41/a 88 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(9)=.TRUE. !HK0,H=2N ABSCOND(35)=.TRUE. !00L,L=4N RETURN C P422 89 RETURN C P4212 90 ABSCOND(30)=.TRUE. !H00,H=2N ABSCOND(32)=.TRUE. !0K0,K=2N RETURN C P4122 91 ABSCOND(35)=.TRUE. !00L,L=4N RETURN C P41212 92 ABSCOND(30)=.TRUE. !H00,H=2N ABSCOND(32)=.TRUE. !0K0,K=2N ABSCOND(35)=.TRUE. !00L,L=4N RETURN C P4222 93 ABSCOND(34)=.TRUE. !00L,L=2N RETURN C P42212 94 ABSCOND(30)=.TRUE. !H00,H=2N ABSCOND(32)=.TRUE. !0K0,K=2N ABSCOND(34)=.TRUE. !00L,L=2N RETURN C P4322 95 ABSCOND(35)=.TRUE. !00L,L=4N RETURN C P43212 96 ABSCOND(30)=.TRUE. !H00,H=2N ABSCOND(32)=.TRUE. !0K0,K=2N ABSCOND(35)=.TRUE. !00L,L=4N RETURN C I422 97 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C I4122 98 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(35)=.TRUE. !00L,L=4N RETURN C P4mm 99 RETURN C P4bm 100 ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C P42cm 101 ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C P42nm 102 ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C P4cc 103 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C P4nc 104 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C P42mc 105 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N RETURN C P42bc 106 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C I4mm 107 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C I4cm 108 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C I41md 109 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(27)=.TRUE. !HHL,2H+L=4N ABSCOND(23)=.TRUE. !H-HL,2H-L=4N RETURN C I41cd 110 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(27)=.TRUE. !HHL,2H+L=4N ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(40)=.TRUE. !H-HL,2H+L=4N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C P-42m 111 RETURN C P-42c 112 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N RETURN C P-421m 113 ABSCOND(30)=.TRUE. !H00,H=2N ABSCOND(32)=.TRUE. !0K0,K=2N RETURN C P-421c 114 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(30)=.TRUE. !H00,H=2N ABSCOND(32)=.TRUE. !0K0,K=2N RETURN C P-4m2 115 RETURN C P-4c2 116 ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C P-4b2 117 ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C P-4n2 118 ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C I-4m2 119 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C I-4c2 120 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C I-42m 121 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C I-42d 122 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(27)=.TRUE. !HHL,2H+L=4N ABSCOND(23)=.TRUE. !H-HL,2H-L=4N RETURN C P4/mmm 123 RETURN C P4/mcc 124 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C P4/nbm 125 ABSCOND(11)=.TRUE. !HK0,H+K=2N ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C P4/nnc 126 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(11)=.TRUE. !HK0,H+K=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C P4/mbm 127 ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C P4/mnc 128 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C P4/nmm 129 ABSCOND(11)=.TRUE. !HK0,H+K=2N RETURN C P4/ncc 130 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(11)=.TRUE. !HK0,H+K=2N ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C P42/mmc 131 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N RETURN C P42/mcm 132 ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C P42/nbc 133 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(11)=.TRUE. !HK0,H+K=2N ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C P42/nnm 134 ABSCOND(11)=.TRUE. !HK0,H+K=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C P42/mbc 135 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C P42/mnm 136 ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C P42/nmc 137 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(11)=.TRUE. !HK0,H+K=2N ABSCOND(22)=.TRUE. !H-HL,L=2N RETURN C P42/ncm 138 ABSCOND(11)=.TRUE. !HK0,H+K=2N ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C I4/mmm 139 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C I4/mcm 140 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C I41/amd 141 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(27)=.TRUE. !HHL,2H+L=4N ABSCOND(9)=.TRUE. !HK0,H=2N ABSCOND(23)=.TRUE. !H-HL,2H-L=4N RETURN C I41/acd 142 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(27)=.TRUE. !HHL,2H+L=4N ABSCOND(9)=.TRUE. !HK0,H=2N ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(40)=.TRUE. !H-HL,2H+L=4N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C P3 143 RETURN C P31 144 ABSCOND(37)=.TRUE. !00L,L=3N RETURN C P32 145 ABSCOND(37)=.TRUE. !00L,L=3N RETURN C R3 146 ABSCOND(6)=.TRUE. !HKL,-H+K+L=3N RETURN C P-3 147 RETURN C R-3 148 ABSCOND(6)=.TRUE. !HKL,-H+K+L=3N RETURN C P312 149 RETURN C P321 150 RETURN C P3112 151 ABSCOND(37)=.TRUE. !00L,L=3N RETURN C P3121 152 ABSCOND(37)=.TRUE. !00L,L=3N RETURN C P3212 153 ABSCOND(37)=.TRUE. !00L,L=3N RETURN C P3221 154 ABSCOND(37)=.TRUE. !00L,L=3N RETURN C R32 155 ABSCOND(6)=.TRUE. !HKL,-H+K+L=3N RETURN C P3m1 156 RETURN C P31m 157 RETURN C P3c1 158 ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C P31c 159 ABSCOND(21)=.TRUE. !2H-HL,L=2N ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(41)=.TRUE. !H-2HL,L=2N RETURN C R3m 160 ABSCOND(6)=.TRUE. !HKL,-H+K+L=3N RETURN C R3c 161 ABSCOND(6)=.TRUE. !HKL,-H+K+L=3N ABSCOND(42)=.TRUE. !H0L,2H+L=6N ABSCOND(43)=.TRUE. !H-HL,2H-L=6N ABSCOND(44)=.TRUE. !0KL,2K-L=6N RETURN C P-31m 162 RETURN C P-31c 163 ABSCOND(21)=.TRUE. !2H-HL,L=2N ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(41)=.TRUE. !H-2HL,L=2N RETURN C P-3m1 164 RETURN C P-3c1 165 ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C R-3m 166 ABSCOND(6)=.TRUE. !HKL,-H+K+L=3N RETURN C R-3c 167 ABSCOND(6)=.TRUE. !HKL,-H+K+L=3N ABSCOND(42)=.TRUE. !H0L,2H+L=6N ABSCOND(43)=.TRUE. !H-HL,2H-L=6N ABSCOND(44)=.TRUE. !0KL,2K-L=6N RETURN C P6 168 RETURN C P61 169 ABSCOND(38)=.TRUE. !00L,L=6N RETURN C P65 170 ABSCOND(38)=.TRUE. !00L,L=6N RETURN C P62 171 ABSCOND(37)=.TRUE. !00L,L=3N RETURN C P64 172 ABSCOND(37)=.TRUE. !00L,L=3N RETURN C P63 173 ABSCOND(34)=.TRUE. !00L,L=2N RETURN C P-6 174 RETURN C P6/m 175 RETURN C P63/m 176 ABSCOND(34)=.TRUE. !00L,L=2N RETURN C P622 177 RETURN C P6122 178 ABSCOND(38)=.TRUE. !00L,L=6N RETURN C P6522 179 ABSCOND(38)=.TRUE. !00L,L=6N RETURN C P6222 180 ABSCOND(37)=.TRUE. !00L,L=3N RETURN C P6422 181 ABSCOND(37)=.TRUE. !00L,L=3N RETURN C P6322 182 ABSCOND(34)=.TRUE. !00L,L=2N RETURN C P6mm 183 RETURN C P6cc 184 ABSCOND(21)=.TRUE. !2H-HL,L=2N ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(41)=.TRUE. !H-2HL,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C P63cm 185 ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C P63mc 186 ABSCOND(21)=.TRUE. !2H-HL,L=2N ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(41)=.TRUE. !H-2HL,L=2N RETURN C P-6m2 187 RETURN C P-6c2 188 ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C P-62m 189 RETURN C P-62c 190 ABSCOND(21)=.TRUE. !2H-HL,L=2N ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(41)=.TRUE. !H-2HL,L=2N RETURN C P6/mmm 191 RETURN C P6/mcc 192 ABSCOND(21)=.TRUE. !2H-HL,L=2N ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(41)=.TRUE. !H-2HL,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C P63/mcm 193 ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(14)=.TRUE. !0KL,L=2N RETURN C P63/mmc 194 ABSCOND(21)=.TRUE. !2H-HL,L=2N ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(41)=.TRUE. !H-2HL,L=2N RETURN C P23 195 RETURN C F23 196 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N RETURN C I23 197 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C P213 198 ABSCOND(30)=.TRUE. !H00,H=2N ABSCOND(32)=.TRUE. !0K0,K=2N ABSCOND(34)=.TRUE. !00L,L=2N RETURN C I213 199 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C Pm-3 200 RETURN C Pn-3 201 ABSCOND(11)=.TRUE. !HK0,H+K=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C Fm-3 202 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N RETURN C Fd-3 203 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N ABSCOND(12)=.TRUE. !HK0,H+K=4N ABSCOND(20)=.TRUE. !H0L,H+L=4N ABSCOND(16)=.TRUE. !0KL,K+L=4N RETURN C Im-3 204 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C Pa-3 205 ABSCOND(9)=.TRUE. !HK0,H=2N ABSCOND(17)=.TRUE. !H0L,L=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C Ia-3 206 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(9)=.TRUE. !HK0,H=2N ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN C P432 207 RETURN C P4232 208 ABSCOND(30)=.TRUE. !H00,H=2N ABSCOND(32)=.TRUE. !0K0,K=2N ABSCOND(34)=.TRUE. !00L,L=2N RETURN C F432 209 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N RETURN C F4132 210 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N ABSCOND(31)=.TRUE. !H00,H=4N ABSCOND(33)=.TRUE. !0K0,K=4N ABSCOND(35)=.TRUE. !00L,L=4N RETURN C I432 211 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C P4332 212 ABSCOND(31)=.TRUE. !H00,H=4N ABSCOND(33)=.TRUE. !0K0,K=4N ABSCOND(35)=.TRUE. !00L,L=4N RETURN C P4132 213 ABSCOND(31)=.TRUE. !H00,H=4N ABSCOND(33)=.TRUE. !0K0,K=4N ABSCOND(35)=.TRUE. !00L,L=4N RETURN C I4132 214 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(31)=.TRUE. !H00,H=4N ABSCOND(33)=.TRUE. !0K0,K=4N ABSCOND(35)=.TRUE. !00L,L=4N RETURN C P-43m 215 RETURN C F-43m 216 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N RETURN C I-43m 217 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C P-43n 218 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(25)=.TRUE. !HKH,K=2N ABSCOND(26)=.TRUE. !HKK,H=2N ABSCOND(45)=.TRUE. !HK-K,H=2N ABSCOND(46)=.TRUE. !HK-H,K=2N ABSCOND(22)=.TRUE. !H-HL,L=2N RETURN C F-43c 219 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N ABSCOND(4)=.TRUE. !HHL,H=2N ABSCOND(7)=.TRUE. !HKH,H=2N ABSCOND(26)=.TRUE. !HKK,H=2N ABSCOND(45)=.TRUE. !HK-K,H=2N ABSCOND(8)=.TRUE. !HK-H,H=2N ABSCOND(10)=.TRUE. !H-HL,H=2N RETURN C I-43d 220 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(27)=.TRUE. !HHL,2H+L=4N ABSCOND(28)=.TRUE. !HKH,2H+K=4N ABSCOND(29)=.TRUE. !HKK,2K+H=4N ABSCOND(39)=.TRUE. !HK-K,H-2K=4N ABSCOND(36)=.TRUE. !HK-H,2H+K=4N ABSCOND(23)=.TRUE. !H-HL,2H-L=4N RETURN C Pm-3m 221 RETURN C Pn-3n 222 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(25)=.TRUE. !HKH,K=2N ABSCOND(26)=.TRUE. !HKK,H=2N ABSCOND(11)=.TRUE. !HK0,H+K=2N ABSCOND(45)=.TRUE. !HK-K,H=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(46)=.TRUE. !HK-H,K=2N ABSCOND(22)=.TRUE. !H-HL,L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C Pm-3n 223 ABSCOND(24)=.TRUE. !HHL,L=2N ABSCOND(25)=.TRUE. !HKH,K=2N ABSCOND(26)=.TRUE. !HKK,H=2N ABSCOND(45)=.TRUE. !HK-K,H=2N ABSCOND(46)=.TRUE. !HK-H,K=2N ABSCOND(22)=.TRUE. !H-HL,L=2N RETURN C Pn-3m 224 ABSCOND(11)=.TRUE. !HK0,H+K=2N ABSCOND(19)=.TRUE. !H0L,H+L=2N ABSCOND(15)=.TRUE. !0KL,K+L=2N RETURN C Fm-3m 225 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N RETURN C Fm-3c 226 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N ABSCOND(4)=.TRUE. !HHL,H=2N ABSCOND(7)=.TRUE. !HKH,H=2N ABSCOND(26)=.TRUE. !HKK,H=2N ABSCOND(45)=.TRUE. !HK-K,H=2N ABSCOND(8)=.TRUE. !HK-H,H=2N ABSCOND(10)=.TRUE. !H-HL,H=2N RETURN C Fd-3m 227 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N ABSCOND(12)=.TRUE. !HK0,H+K=4N ABSCOND(20)=.TRUE. !H0L,H+L=4N ABSCOND(16)=.TRUE. !0KL,K+L=4N RETURN C Fd-3c 228 ABSCOND(1)=.TRUE. !HKL,H+K=2N ABSCOND(3)=.TRUE. !HKL,H+L=2N ABSCOND(4)=.TRUE. !HHL,H=2N ABSCOND(7)=.TRUE. !HKH,H=2N ABSCOND(26)=.TRUE. !HKK,H=2N ABSCOND(12)=.TRUE. !HK0,H+K=4N ABSCOND(45)=.TRUE. !HK-K,H=2N ABSCOND(20)=.TRUE. !H0L,H+L=4N ABSCOND(8)=.TRUE. !HK-H,H=2N ABSCOND(10)=.TRUE. !H-HL,H=2N ABSCOND(16)=.TRUE. !0KL,K+L=4N RETURN C Im-3m 229 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N RETURN C Ia-3d 230 ABSCOND(5)=.TRUE. !HKL,H+K+L=2N ABSCOND(27)=.TRUE. !HHL,2H+L=4N ABSCOND(28)=.TRUE. !HKH,2H+K=4N ABSCOND(29)=.TRUE. !HKK,2K+H=4N ABSCOND(9)=.TRUE. !HK0,H=2N ABSCOND(39)=.TRUE. !HK-K,H-2K=4N ABSCOND(18)=.TRUE. !H0L,H=2N ABSCOND(36)=.TRUE. !HK-H,2H+K=4N ABSCOND(23)=.TRUE. !H-HL,2H-L=4N ABSCOND(13)=.TRUE. !0KL,K=2N RETURN END SUBROUTINE CHECKABSENT(IH,IK,IL,ABSCOND,REJECT) LOGICAL ABSCOND(49) LOGICAL REJECT REJECT=.FALSE. C HKL,H+K=2N IF (ABSCOND(1)) THEN IF ((MOD(IH+IK,2).NE.0)) REJECT=.TRUE. ENDIF C HKL,K+L=2N IF (ABSCOND(2)) THEN IF ((MOD(IK+IL,2).NE.0)) REJECT=.TRUE. ENDIF C HKL,H+L=2N IF (ABSCOND(3)) THEN IF ((MOD(IH+IL,2).NE.0)) REJECT=.TRUE. ENDIF C HHL,H=2N IF (ABSCOND(4)) THEN IF (IH.EQ.IK .AND. MOD(IH,2).NE.0) REJECT=.TRUE. ENDIF C HKL,H+K+L=2N IF (ABSCOND(5)) THEN IF ((MOD(IH+IK+IL,2).NE.0)) REJECT=.TRUE. ENDIF C HKL,-H+K+L=3N IF (ABSCOND(6)) THEN IF ((MOD(-IH+IK+IL,3).NE.0)) REJECT=.TRUE. ENDIF C HKH,H=2N IF (ABSCOND(7)) THEN IF (IH.EQ.IL .AND. MOD(IH,2).NE.0) REJECT=.TRUE. ENDIF C HK-H,H=2N IF (ABSCOND(8)) THEN IF (IL.EQ.-IH .AND. MOD(IH,2).NE.0) REJECT=.TRUE. ENDIF C HK0,H=2N IF (ABSCOND(9)) THEN IF ((IL.EQ.0).AND.(MOD(IH,2).NE.0)) REJECT=.TRUE. ENDIF C H-HL,H=2N IF (ABSCOND(10)) THEN IF (IK.EQ.-IH .AND. MOD(IH,2).NE.0) REJECT=.TRUE. ENDIF C HK0,H+K=2N IF (ABSCOND(11)) THEN IF ((IL.EQ.0).AND.(MOD(IH+IK,2).NE.0)) REJECT=.TRUE. ENDIF C HK0,H+K=4N IF (ABSCOND(12)) THEN IF ((IL.EQ.0).AND.(MOD(IH+IK,4).NE.0)) REJECT=.TRUE. ENDIF C 0KL,K=2N IF (ABSCOND(13)) THEN IF ((IH.EQ.0).AND.(MOD(IK,2).NE.0)) REJECT=.TRUE. ENDIF C 0KL,L=2N IF (ABSCOND(14)) THEN IF ((IH.EQ.0).AND.(MOD(IL,2).NE.0)) REJECT=.TRUE. ENDIF C 0KL,K+L=2N IF (ABSCOND(15)) THEN IF ((IH.EQ.0).AND.(MOD(IK+IL,2).NE.0)) REJECT=.TRUE. ENDIF C 0KL,K+L=4N IF (ABSCOND(16)) THEN IF ((IH.EQ.0).AND.(MOD(IK+IL,4).NE.0)) REJECT=.TRUE. ENDIF C H0L,L=2N IF (ABSCOND(17)) THEN IF ((IK.EQ.0).AND.(MOD(IL,2).NE.0)) REJECT=.TRUE. ENDIF C H0L,H=2N IF (ABSCOND(18)) THEN IF ((IK.EQ.0).AND.(MOD(IH,2).NE.0)) REJECT=.TRUE. ENDIF C H0L,H+L=2N IF (ABSCOND(19)) THEN IF ((IK.EQ.0).AND.(MOD(IH+IL,2).NE.0)) REJECT=.TRUE. ENDIF C H0L,H+L=4N IF (ABSCOND(20)) THEN IF ((IK.EQ.0).AND.(MOD(IH+IL,4).NE.0)) REJECT=.TRUE. ENDIF C 2H-HL,L=2N IF (ABSCOND(21)) THEN IF ((IH.EQ.-2*IK).AND.(MOD(IL,2).NE.0)) REJECT=.TRUE. ENDIF C H-HL,L=2N IF (ABSCOND(22)) THEN IF ((IK.EQ.-IH).AND.(MOD(IL,2).NE.0)) REJECT=.TRUE. ENDIF C H-HL,2H-L=4N IF (ABSCOND(23)) THEN IF ((IK.EQ.-IH).AND.(MOD(2*IH-IL,4).NE.0)) REJECT=.TRUE. ENDIF C HHL,L=2N IF (ABSCOND(24)) THEN IF ((IK.EQ.IH).AND.(MOD(IL,2).NE.0)) REJECT=.TRUE. ENDIF C HKH,K=2N IF (ABSCOND(25)) THEN IF ((IL.EQ.IH).AND.(MOD(IK,2).NE.0)) REJECT=.TRUE. ENDIF C HKK,H=2N IF (ABSCOND(26)) THEN IF ((IL.EQ.IK).AND.(MOD(IH,2).NE.0)) REJECT=.TRUE. ENDIF C HHL,2H+L=4N IF (ABSCOND(27)) THEN IF ((IH.EQ.IK).AND.(MOD(2*IH+IL,4).NE.0)) REJECT=.TRUE. ENDIF C HKH,2H+K=4N IF (ABSCOND(28)) THEN IF ((IH.EQ.IL).AND.(MOD(2*IH+IK,4).NE.0)) REJECT=.TRUE. ENDIF C HKK,2K+H=4N IF (ABSCOND(29)) THEN IF ((IK.EQ.IL).AND.(MOD(2*IK+IH,4).NE.0)) REJECT=.TRUE. ENDIF C H00,H=2N IF (ABSCOND(30)) THEN IF ((IK.EQ.0).AND.(IL.EQ.0).AND.(MOD(IH,2).NE.0)) + REJECT=.TRUE. ENDIF C H00,H=4N IF (ABSCOND(31)) THEN IF ((IK.EQ.0).AND.(IL.EQ.0).AND.(MOD(IH,4).NE.0)) + REJECT=.TRUE. ENDIF C 0K0,K=2N IF (ABSCOND(32)) THEN IF ((IH.EQ.0).AND.(IL.EQ.0).AND.(MOD(IK,2).NE.0)) + REJECT=.TRUE. ENDIF C 0K0,K=4N IF (ABSCOND(33)) THEN IF ((IH.EQ.0).AND.(IL.EQ.0).AND.(MOD(IK,4).NE.0)) + REJECT=.TRUE. ENDIF C 00L,L=2N IF (ABSCOND(34)) THEN IF ((IH.EQ.0).AND.(IK.EQ.0).AND.(MOD(IL,2).NE.0)) + REJECT=.TRUE. ENDIF C 00L,L=4N IF (ABSCOND(35)) THEN IF ((IH.EQ.0).AND.(IK.EQ.0).AND.(MOD(IL,4).NE.0)) + REJECT=.TRUE. ENDIF C HK-H,2H+K=4N IF (ABSCOND(36)) THEN IF ((IL.EQ.-IH).AND.(MOD(2*IH+IK,4).NE.0)) REJECT=.TRUE. ENDIF C 00L,L=3N IF (ABSCOND(37)) THEN IF ((IH.EQ.0).AND.(IK.EQ.0).AND.(MOD(IL,3).NE.0)) + REJECT=.TRUE. ENDIF C 00L,L=6N IF (ABSCOND(38)) THEN IF ((IH.EQ.0).AND.(IK.EQ.0).AND.(MOD(IL,6).NE.0)) + REJECT=.TRUE. ENDIF C HK-K,H-2K=4N IF (ABSCOND(39)) THEN IF ((IL.EQ.-IK).AND.(MOD(IH-2*IK,4).NE.0)) REJECT=.TRUE. ENDIF C H-HL,2H+L=4N IF (ABSCOND(40)) THEN IF ((IK.EQ.-IH).AND.(MOD(2*IH+IL,4).NE.0)) REJECT=.TRUE. ENDIF C H-2HL,L=2N IF (ABSCOND(41)) THEN IF ((IK.EQ.-2*IH).AND.(MOD(IL,2).NE.0)) REJECT=.TRUE. ENDIF C H0L,2H+L=6N IF (ABSCOND(42)) THEN IF ((IK.EQ.0).AND.(MOD(2*IH+IL,6).NE.0)) REJECT=.TRUE. ENDIF C H-HL,2H-L=6N IF (ABSCOND(43)) THEN IF ((IK.EQ.-IH).AND.(MOD(2*IH-IL,6).NE.0)) REJECT=.TRUE. ENDIF C 0KL,2K-L=6N IF (ABSCOND(44)) THEN IF ((IH.EQ.0).AND.(MOD(2*IK-IL,6).NE.0)) REJECT=.TRUE. ENDIF C HK-K,H=2N IF (ABSCOND(45)) THEN IF ((IL.EQ.-IK).AND.(MOD(IH,2).NE.0)) REJECT=.TRUE. ENDIF C HK-H,K=2N IF (ABSCOND(46)) THEN IF ((IL.EQ.-IH).AND.(MOD(IK,2).NE.0)) REJECT=.TRUE. ENDIF RETURN END