C23456789012345678901234567890123456789012345678901234567890123456789012 C C Programm RMERGE, MSW 05/96 Version 2 C C C calculates R(merge) C R(rim) = redundancy independent merging R-factor C R(pim) = precision indicating merging R-factor C C C references : Weiss & Hilgenfeld (1997). J. Appl. Cryst. 30, 203-205. C Diederichs & Karplus (1997). Nature Struct. Biol. 4, 269-275. C Weiss et al. (1998). FEBS Lett. 423, 291-296. C C C Version 0 : 05/95 : im wesentlichen Berechnung von R(rim) und R(pim) C Version 1 : 05/96 : Analyse in Abhaengigkeit von Aufloesung, und C weitere R-Faktoren, R(m) und R(sqm) C Version 2 : 12/98 : allgemeinere Version, sollte keine Anpassung C der Arrays mehr erfordern C 01/99 : different input filetypes added C 10/99 : should compile ok on IRIX 6.2 C and on Digital UNIX V4.0D c Version 3 : 11/09 : K.D. : implement XDS/XSCALE files; various bugfixes c (e.g. uninitialized variables); define all variables C C C input : 1) SCALEPACK output (scaled data, option NO MERGE, C ORIGINAL INDEX) C C 2) SCALA output (scaled data, option UNMERGED REDUCED) C converted to ASCII format using MTZ2VARIOUS (Format : C 3I4,2F10.2) C C C C output : Total number of reflections C Number of unique reflections C Average redundancy C No. of reflections as a function of redundancy C No. of reflections per resolution bin (after averaging) C Average redundancy overall and per resolution bin C Average intensity overall and per resolution bin (after C averaging) C Average standard deviations overall and per resolution bin C Merging R-factor overall and per resolution bin C R(rim) and R(pim) overall and per resolution bin C C C output written to file rmerge.data (unit 12) C C C integer nhkl,nuni,nbx,nrd,iin,iout,iline,iopt,i,ix PARAMETER (NHKL=3600000,NUNI=500000,NBX=50,NRD=50) CHARACTER*80 FNAM c double precision definition to make calculation of res very accurate - required c for identifying symmetry-related reflections if iopt=3 . Please note that c this results in calls with both REAL and DOUBLE PRECISION arguments to c the non-standard function COSD . In other words, if you have to implement c COSD (e.g. in case of gfortran) then you have to provide both versions. c KD 11/2009 double precision CELL(6),CELLS(6) REAL*4 F2(NHKL),S2(NHKL),F2MEAN(NUNI),S2MEAN(NUNI) REAL*4 RXZ(NBX),RXN(NBX),RXM(NBX),RXRIM(NBX),RXPIM(NBX) REAL*4 RXZRIM(NBX),RXZPIM(NBX) REAL*4 SUMXZ(NBX),SUMXN(NBX),SUM2XZ(NBX),SUM2XN(NBX) REAL*4 R2XZ(NBX),R2XN(NBX),R2XM(NBX),RXAVE(NBX) REAL*4 F2XM(NBX),S2XM(NBX) REAL*4 SUMXF2OS2(NBX) INTEGER*4 IH,IK,IL,NREF,NCNT INTEGER*4 HMIN,KMIN,LMIN,HMAX,KMAX,LMAX INTEGER*4 NBIN(NUNI),NRED(NUNI) INTEGER*4 NX(NBX),NTOT(NBX),NUMRED(NRD),NRDMAX real reshi,reslo,temp,oldres,resmin,resmax,res integer ihold,ikold,ilold DATA HMIN,KMIN,LMIN,HMAX,KMAX,LMAX/3*999,3*-999/ DATA IIN,IOUT/1,12/ data oldres/-1./ data nrdmax/0/ data ihold/0/,ikold/0/,ilold/0/ C C-- Step 0: open files, etc. C WRITE(6,10) NHKL 10 FORMAT(/,' Programm RMERGE : ',/, . ' ***************** ',/, . ' Calculation of various R-factors ',/, . ' Version 3, MSW 12/98 and later ',//, . ' (the current version can handle up to ',I8, . ' reflections.)',/) C WRITE(6,15) 15 FORMAT(/,' Data file format : [1] SCALEPACK ',/, . ' [2] SCALA --> ASCII ',/, . ' [3] XDS or XSCALE ',//) READ(5,*) IOPT IF(IOPT.LT.1.or.IOPT.GT.3) STOP' wrong option' IF(IOPT.EQ.1) THEN WRITE(6,21) 21 FORMAT(/,' SCALEPACK output reflection (.SCA) file ',/, .' (option NO MERGE ORIGINAL INDEX) ',/) READ(5,30) FNAM ELSEIF(IOPT.EQ.2) THEN WRITE(6,22) 22 FORMAT(/,' SCALA output reflection file converted to ASCII ', .'format ',/,' (option UNMERGED REDUCED) ',/) READ(5,30) FNAM ELSEIF(IOPT.EQ.3) THEN WRITE(6,23) 23 FORMAT(/,' XDS_ASCII.HKL format file ',/) READ(5,30) FNAM ENDIF 30 FORMAT(A) C OPEN(IIN,FILE=FNAM,STATUS='OLD') C OPEN(IOUT,FILE='rmerge.data',STATUS='UNKNOWN') C WRITE(IOUT,32) FNAM 32 FORMAT(/,' Program RMERGE, Version 2, (MSW 12/98)',//, . ' Calculating data statistics for file ',A,//) C C-- Step 1: get cell, resolution, etc. C WRITE(6,35) 35 FORMAT(/,' Cell dimensions : ',/) READ(5,*) (CELL(I),I=1,6) WRITE(6,50) (CELL(I),CELL(I+3),I=1,3) WRITE(IOUT,50) (CELL(I),CELL(I+3),I=1,3) 50 FORMAT(/,' Cell dimensions :', .' a = ',F8.2,' A, alpha = ',F8.2,' deg',/, .18X,' b = ',F8.2,' A, beta = ',F8.2,' deg',/, .18X,' c = ',F8.2,' A, gamma = ',F8.2,' deg',//) cell(4)=cell(4)/57.29577951308232d0 cell(5)=cell(5)/57.29577951308232d0 cell(6)=cell(6)/57.29577951308232d0 CALL RECIPR(CELL,CELLS) C WRITE(6,60) 60 FORMAT(/,' Resolution limits for analysis ',/) READ(5,*) RESHI,RESLO IF(RESHI.GT.RESLO) THEN TEMP = RESLO RESLO = RESHI RESHI = TEMP ENDIF C C--Step 2: determine minimum and maximum hkl from reflection file C WRITE(6,84) 84 FORMAT(/,' Getting maximum h,k,l from reflection file ... ',/) IF(IOPT.EQ.1) THEN READ(IIN,'(I5)') ILINE DO I=1,ILINE READ(IIN,'(/)') ENDDO ENDIF NCNT = 0 NREF = 0 RESMIN = 0.0001 RESMAX = 9999.9 DO I = 1,1000000 IF(IOPT.EQ.1) THEN READ(IIN,'(12X,3I4)',END=179) IH,IK,IL ELSEIF(IOPT.EQ.2) THEN READ(IIN,'(3I4)',END=179) IH,IK,IL elseif (iopt.eq.3) then 985 continue read(iin,*,END=179,err=985) IH,IK,IL c XDS_ASCII.HKL has symmetry-related reflections grouped together. Evidently c these all have exactly the same d-spacing. Of course this is not water-tight. CALL RESOL(CELLS,IH,IK,IL,RES) if (res.eq.oldres) then ih=ihold ik=ikold il=ilold else oldres=res ihold=ih ikold=ik ilold=il endif ENDIF NREF = NREF + 1 IF(MOD(NREF,10000).EQ.0) WRITE(6,105) NREF if (iopt.ne.3) CALL RESOL(CELLS,IH,IK,IL,RES) IF(RES.GT.RESMIN) RESMIN = RES IF(RES.LT.RESMAX) RESMAX = RES IF(RES.GE.RESHI.AND.RES.LE.RESLO) THEN NCNT = NCNT + 1 HMIN = MIN(IH,HMIN) KMIN = MIN(IK,KMIN) LMIN = MIN(IL,LMIN) HMAX = MAX(IH,HMAX) KMAX = MAX(IK,KMAX) LMAX = MAX(IL,LMAX) ENDIF 105 FORMAT(' Reading reflection no. ',I10) ENDDO 179 REWIND(IIN) WRITE(6,65) NREF,NCNT,HMIN,HMAX,KMIN,KMAX,LMIN,LMAX,RESMIN, . RESMAX,RESLO,RESHI WRITE(IOUT,65) NREF,NCNT,HMIN,HMAX,KMIN,KMAX,LMIN,LMAX,RESMIN, . RESMAX,RESLO,RESHI 65 FORMAT(/,' Total number of reflections : ',I8,//, .' Number of reflections used : ',I8,//, .' Minimum and maximum (hkl) found :', .' H from ',I4,' to ',I4,/, .34X,' K from ',I4,' to ',I4,/, .34X,' L from ',I4,' to ',I4,//, .' Resolution range in reflection file :', .' d from ',F6.2,' to ',F6.2,' A ',//, .' Resolution range for analysis :', .' d from ',F6.2,' to ',F6.2,' A ',//) IF((HMAX-HMIN+1)*(KMAX-KMIN+1)*(LMAX-LMIN+1).GT.NUNI) THEN WRITE(6,76) 76 FORMAT(/,' W A R N I N G ! ! ! ',//, .' Reflection array too small, change parameter NUNI and ', .'recompile program. ',/) STOP' parameter NUNI ' ENDIF C C--Step 3: determine maximum redundancy C WRITE(6,85) 85 FORMAT(/,' Getting maximum redundancy from reflection file ... ', . /) IF(IOPT.EQ.1) THEN READ(IIN,'(I5)') ILINE DO I=1,ILINE READ(IIN,'(/)') ENDDO ENDIF NREF = 0 DO I = 1,1000000 IF(IOPT.EQ.1) THEN READ(IIN,'(12X,3I4)',END=189) IH,IK,IL ELSEIF(IOPT.EQ.2) THEN READ(IIN,'(3I4)',END=189) IH,IK,IL elseif (iopt.eq.3) then 986 continue read(iin,*,END=189,err=986) IH,IK,IL c XDS_ASCII.HKL has symmetry-related reflections grouped together. Evidently c these all have exactly the same d-spacing. Of course this is not water-tight. CALL RESOL(CELLS,IH,IK,IL,RES) if (res.eq.oldres) then ih=ihold ik=ikold il=ilold else oldres=res ihold=ih ikold=ik ilold=il endif ENDIF NREF = NREF + 1 IF(MOD(NREF,10000).EQ.0) WRITE(6,105) NREF IF(IH.GE.HMIN.AND.IH.LE.HMAX.AND.IK.GE.KMIN.AND.IK.LE.KMAX. . AND.IL.GE.LMIN.AND.IL.LE.LMAX) THEN CALL GETRED(HMIN,HMAX,KMIN,KMAX,LMIN,LMAX,IH,IK,IL,NRED,NRDMAX) ENDIF ENDDO 189 REWIND(IIN) WRITE(6,66) NRDMAX WRITE(IOUT,66) NRDMAX 66 FORMAT(/,' Maximum redundancy observed : ',I4,//) IF(NRDMAX.GT.NRD) THEN WRITE(6,74) NRDMAX 74 FORMAT(/,' W A R N I N G ! ! ! ',//, .' Redundancy array too small, increase Parameter NRD and ', .'recompile program.',/) STOP' parameter NRD ' ENDIF IF((HMAX-HMIN+1)*(KMAX-KMIN+1)*(LMAX-LMIN+1)*NRDMAX.GT.NHKL) THEN WRITE(6,75) 75 FORMAT(/,' W A R N I N G ! ! ! ',//, .' Reflection array too small, change parameter NHKL and ', .'recompile program. ',/) STOP' parameter NHKL ' ENDIF C C-- Step 4: Number of resolution bins for analysis C WRITE(6,70) 70 FORMAT(/,' Number of resolution bins ',/) READ(5,*) IX IF(IX.GT.NBX) STOP' too many bins' C C-- Step 5: reading the reflections and calculating R-factors C WRITE(6,86) 86 FORMAT(/,' Analysing reflection file ... ',/) CALL ANALYSIS(IIN,IOUT,IOPT,CELL,HMIN,HMAX,KMIN,KMAX,LMIN,LMAX, .NRDMAX,IX,RESLO,RESHI,NRED,F2,S2,NBIN,NX,RXZ,RXN,R2XZ,R2XN, .F2XM,S2XM,NUMRED,F2MEAN,S2MEAN,SUMXZ,SUMXN,SUM2XZ,SUM2XN, .NTOT,SUMXF2OS2,RXZRIM,RXZPIM,RXM,R2XM,RXRIM,RXPIM,RXAVE) WRITE(6,95) 95 FORMAT(/,' Program RMERGE finished successfully',/) STOP END C C----------------------------------------------------------------------- C SUBROUTINE ANALYSIS(IIN,IOUT,IOPT,CELL,HMIN,HMAX,KMIN,KMAX,LMIN, .LMAX,NRDMAX,IX,RESLO,RESHI,NRED,F2,S2,NBIN,NX,RXZ,RXN,R2XZ,R2XN, .F2XM,S2XM,NUMRED,F2MEAN,S2MEAN,SUMXZ,SUMXN,SUM2XZ,SUM2XN, .NTOT,SUMXF2OS2,RXZRIM,RXZPIM,RXM,R2XM,RXRIM,RXPIM,RXAVE) CHARACTER*80 LINE INTEGER*4 HMIN,KMIN,LMIN,HMAX,KMAX,LMAX,ix,i,j,k,nrdmax,iline integer nover,nuni,nmer REAL*4 RESLO,RESHI,RES,xd3hi,xd3lo,xstep,xd3,rz,rn,r2z,f2m real s2m,rzrim,rzpim,f2sum,s2sum,f2s2,sumz,sumn,sum2z,sum2n,fac1 real fac2,rave,rm,rrim,rpim,r2m,dlo,dhi,r2n double precision CELL(6),CELLS(6) REAL*4 F2NAT,SIGNAT REAL*4 F2(HMIN:HMAX,KMIN:KMAX,LMIN:LMAX,NRDMAX) REAL*4 S2(HMIN:HMAX,KMIN:KMAX,LMIN:LMAX,NRDMAX) REAL*4 F2MEAN(HMIN:HMAX,KMIN:KMAX,LMIN:LMAX) REAL*4 S2MEAN(HMIN:HMAX,KMIN:KMAX,LMIN:LMAX) REAL*4 RXZ(IX),RXN(IX),RXM(IX),RXRIM(IX),RXPIM(IX) REAL*4 RXZRIM(IX),RXZPIM(IX),RXAVE(IX) REAL*4 SUMXZ(IX),SUMXN(IX),SUM2XZ(IX),SUM2XN(IX) REAL*4 R2XZ(IX),R2XN(IX),R2XM(IX) REAL*4 F2XM(IX),S2XM(IX) REAL*4 SUMF2OS2,SUMXF2OS2(IX) INTEGER*4 IIN,IOUT,IOPT,IH,IK,IL,NREF,NSKIP,NR,NB INTEGER*4 NBIN(HMIN:HMAX,KMIN:KMAX,LMIN:LMAX) INTEGER*4 NRED(HMIN:HMAX,KMIN:KMAX,LMIN:LMAX) INTEGER*4 NX(IX),NTOT(IX),NUMRED(NRDMAX) integer ihold,ikold,ilold real oldres data oldres/-1./ data ihold/0/,ikold/0/,ilold/0/ XD3HI = 1. / (RESHI**3) XD3LO = 1. / (RESLO**3) XSTEP = (XD3HI - XD3LO) / FLOAT(IX) DO I = HMIN,HMAX DO J = KMIN,KMAX DO K = LMIN,LMAX NRED(I,J,K) = 0 ENDDO ENDDO ENDDO DO I = 1,NRDMAX NUMRED(I) = 0 ENDDO CALL RECIPR(CELL,CELLS) IF(IOPT.EQ.1) THEN READ(IIN,'(I5)') ILINE DO I=1,ILINE READ(IIN,'(/)') ENDDO ENDIF NREF = 0 NSKIP = 0 NOVER = 0 C DO I = 1,1000000 IF(IOPT.EQ.1) THEN READ(IIN,'(A)',END=199) LINE IF(LINE(34:34).NE.'*'.AND.LINE(42:42).NE.'*') . READ(LINE,100) IH,IK,IL,F2NAT,SIGNAT IF(LINE(34:34).EQ.'*'.OR.LINE(42:42).EQ.'*') NOVER=NOVER+1 ELSEIF(IOPT.EQ.2) THEN READ(IIN,'(3I4,2F10.2)',END=199) IH,IK,IL,F2NAT,SIGNAT elseif (iopt.eq.3) then 987 continue read(iin,*,END=199,err=987) IH,IK,IL,F2NAT,SIGNAT if (signat.lt.0.) goto 987 ! outlier c XDS_ASCII.HKL has symmetry-related reflections grouped together. Evidently c these all have exactly the same d-spacing. Of course this is not water-tight. CALL RESOL(CELLS,IH,IK,IL,RES) if (res.eq.oldres) then c same unique indices ih=ihold ik=ikold il=ilold else oldres=res ihold=ih ikold=ik ilold=il endif ENDIF NREF = NREF + 1 IF(MOD(NREF,10000).EQ.0) WRITE(6,105) NREF if (iopt.ne.3) CALL RESOL(CELLS,IH,IK,IL,RES) IF(RES.LT.RESHI.OR.RES.GT.RESLO) THEN NSKIP = NSKIP + 1 ELSE NRED(IH,IK,IL) = NRED(IH,IK,IL) + 1 NR = NRED(IH,IK,IL) F2(IH,IK,IL,NR) = F2NAT S2(IH,IK,IL,NR) = SIGNAT XD3 = 1. / (RES**3) NBIN(IH,IK,IL) = NINT(0.5 + ((XD3 - XD3LO) / XSTEP) ) ENDIF 100 FORMAT(12X,3I4,13X,2F8.0) 105 FORMAT(' Reading reflection no. ',I10) ENDDO C 199 WRITE(6,110)NREF,NREF-NSKIP,NSKIP,NOVER WRITE(IOUT,110)NREF,NREF-NSKIP,NSKIP,NOVER 110 FORMAT(/,I10,' reflections read, ',/, . I10,' reflections inside resolution limits, ',/, . I10,' reflections outside resolution limits, ',/, . I10,' overloaded reflections.',//) CLOSE(IIN) IF(NOVER.GE.1) WRITE(6,115) NOVER IF(NOVER.GE.1) WRITE(IOUT,115) NOVER 115 FORMAT(/,' W A R N I N G ! ! ! ',//,I6,' reflections appear ', .'overloaded in reflection file.',/,' Re-run ', .'SCALEPACK with a smaller scale factor!',/) C C-- computing average intensities, standard deviations and C-- various R-factors in resolution bins and overall C-- exclude all single measurements from sums except Fmean, C-- Smean C NUNI = 0 NMER = 0 RZ = 0. RN = 0. R2Z = 0. R2N = 0. F2M = 0. S2M = 0. rzrim = 0. rzpim = 0. C DO I = 1,IX NX(I) = 0 NTOT(I) = 0 RXAVE(I) = 0.0 RXZ(I) = 0. RXN(I) = 0. R2XZ(I) = 0. R2XN(I) = 0. F2XM(I) = 0. S2XM(I) = 0. rxzrim(i) = 0. rxzpim(i) = 0. ENDDO DO IH = HMIN,HMAX DO IK = KMIN,KMAX DO IL = LMIN,LMAX NB = NBIN(IH,IK,IL) NR = NRED(IH,IK,IL) if (nr.eq.0) cycle NX(NB) = NX(NB) + 1 NTOT(NB) = NTOT(NB) + NR NUNI = NUNI + 1 NUMRED(NR) = NUMRED(NR) + 1 IF(NR.EQ.1) THEN F2MEAN(IH,IK,IL) = F2(IH,IK,IL,NR) S2MEAN(IH,IK,IL) = S2(IH,IK,IL,NR) ELSEIF(NR.GT.1) THEN NMER = NMER + 1 F2SUM = 0 S2SUM = 0 DO I = 1,NR F2SUM = F2SUM + F2(IH,IK,IL,I) S2SUM = S2SUM + S2(IH,IK,IL,I) ENDDO F2MEAN(IH,IK,IL) = F2SUM / FLOAT(NR) S2MEAN(IH,IK,IL) = S2SUM / FLOAT(NR) ! mean sigma from input F2S2 = 0 DO I = 1,NR F2S2 = F2S2 + (F2(IH,IK,IL,I)-F2MEAN(IH,IK,IL))**2 ENDDO C F2SIG = SQRT(F2S2 / FLOAT(NR-1) ) C S2MEAN(IH,IK,IL) = F2SIG ! mean sigma from merging SUMZ = 0. SUMN = 0. SUM2Z = 0. SUM2N = 0. SUMF2OS2 = 0. DO I = 1,IX SUMXZ(I) = 0. SUMXN(I) = 0. SUM2XZ(I) = 0. SUM2XN(I) = 0. SUMXF2OS2(I) = 0. ENDDO DO I = 1,NR SUMZ = SUMZ + ABS(F2(IH,IK,IL,I) - F2MEAN(IH,IK,IL)) SUMN = SUMN + F2(IH,IK,IL,I) SUMXZ(NB) = SUMXZ(NB) + . ABS(F2(IH,IK,IL,I)-F2MEAN(IH,IK,IL)) SUMXN(NB) = SUMXN(NB) + F2(IH,IK,IL,I) SUM2Z = SUM2Z + (F2(IH,IK,IL,I) - F2MEAN(IH,IK,IL))**2 SUM2N = SUM2N + F2(IH,IK,IL,I)**2 SUM2XZ(NB) = SUM2XZ(NB) + . (F2(IH,IK,IL,I) - F2MEAN(IH,IK,IL))**2 SUM2XN(NB) = SUM2XN(NB) + F2(IH,IK,IL,I)**2 SUMF2OS2 = SUMF2OS2 + . ( (F2(IH,IK,IL,I) - F2MEAN(IH,IK,IL))**2 . / S2(IH,IK,IL,I)**2 ) SUMXF2OS2(NB) = SUMXF2OS2(NB) + . ( (F2(IH,IK,IL,I) - F2MEAN(IH,IK,IL))**2 . / S2(IH,IK,IL,I)**2 ) ENDDO RZ = RZ + SUMZ RN = RN + SUMN R2Z = R2Z + SQRT(SUM2Z) R2N = R2N + SQRT(SUM2N) RXZ(NB) = RXZ(NB) + SUMXZ(NB) RXN(NB) = RXN(NB) + SUMXN(NB) R2XZ(NB) = R2XZ(NB) + SQRT(SUM2XZ(NB)) R2XN(NB) = R2XN(NB) + SQRT(SUM2XN(NB)) FAC1 = (FLOAT(NR) / (FLOAT(NR) - 1.)) FAC2 = (1. / (FLOAT(NR) - 1.)) RZRIM = RZRIM + SUMZ * SQRT(FAC1) RXZRIM(NB) = RXZRIM(NB) + SUMXZ(NB) * SQRT(FAC1) RZPIM = RZPIM + SUMZ * SQRT(FAC2) RXZPIM(NB) = RXZPIM(NB) + SUMXZ(NB) * SQRT(FAC2) ENDIF F2M = F2M + F2MEAN(IH,IK,IL) S2M = S2M + S2MEAN(IH,IK,IL) F2XM(NB) = F2XM(NB) + F2MEAN(IH,IK,IL) S2XM(NB) = S2XM(NB) + S2MEAN(IH,IK,IL) ENDDO ENDDO ENDDO DO I = 1,IX IF(NX(I).NE.0) THEN RXAVE(I) = FLOAT(NTOT(I)) / FLOAT(NX(I)) F2XM(I) = F2XM(I) / FLOAT(NX(I)) S2XM(I) = S2XM(I) / FLOAT(NX(I)) ELSE RXAVE(I) = 0.0 F2XM(I) = 0.0 S2XM(I) = 0.0 ENDIF ENDDO IF(NUNI.NE.0) THEN RAVE = FLOAT(NREF-NSKIP)/FLOAT(NUNI) F2M = F2M / FLOAT(NUNI) S2M = S2M / FLOAT(NUNI) ELSE RAVE = 0.0 F2M = 0.0 S2M = 0.0 ENDIF IF(RN.NE.0.0) THEN RM = RZ / RN RRIM = RZRIM / RN RPIM = RZPIM / RN ELSE RM = 0.0 RRIM = 0.0 RPIM = 0.0 ENDIF IF(R2N.NE.0.0) THEN R2M = R2Z / R2N ELSE R2M = 0.0 ENDIF DO I = 1,IX IF(RXN(I).NE.0.0) THEN RXM(I) = RXZ(I) / RXN(I) RXRIM(I) = RXZRIM(I) / RXN(I) RXPIM(I) = RXZPIM(I) / RXN(I) ELSE RXM(I) = 0.0 RXRIM(I) = 0.0 RXPIM(I) = 0.0 ENDIF IF(R2XN(I).NE.0.0) THEN R2XM(I) = (R2XZ(I) / R2XN(I)) ELSE R2XM(I) = 0.0 ENDIF ENDDO WRITE(6,210) NREF,NREF-NSKIP,NUNI,RAVE,(I,I=1,NRDMAX) WRITE(IOUT,210) NREF,NREF-NSKIP,NUNI,RAVE,(I,I=1,NRDMAX) WRITE(6,211) (NUMRED(I),I=1,NRDMAX) WRITE(IOUT,211) (NUMRED(I),I=1,NRDMAX) 210 FORMAT(/,6X,' Reflection summary ',/, . 6X,' ****************** ',//, . ' Total number of reflections : ',I8,/, . ' Number of reflections used : ',I8,/, . ' Number of unique reflections : ',I8,/, . ' Average redundancy : ',F8.2,//, .' No. of reflections as a function of redundancy : ',//, .' Red. ',50I6) 211 FORMAT(' No. ',50I6,//) WRITE(6,220) WRITE(IOUT,220) 220 FORMAT(//,6X,' Summary of various R-factors by shells',/, . 6X,' **************************************',//, .' (in all sums except Imean and Smean single measurements', .' are excluded.)',//, .' Resolution bins # of Average Average Average Rm Rsqm ', .' Rrim Rpim',/, .' Lower Upper refs Red. I err ') DO I = 1,IX DLO = 1. / ( (XD3LO + (I-1)*XSTEP)**(1./3.) ) DHI = 1. / ( (XD3LO + I*XSTEP)**(1./3.) ) WRITE(6,230) DLO,DHI,NX(I),RXAVE(I),F2XM(I),S2XM(I), . RXM(I),R2XM(I),RXRIM(I),RXPIM(I) WRITE(IOUT,230) DLO,DHI,NX(I),RXAVE(I),F2XM(I),S2XM(I), . RXM(I),R2XM(I),RXRIM(I),RXPIM(I) 230 FORMAT(2X,2F7.2,I7,1X,F7.2,1X,2F8.1,4F7.3) ENDDO WRITE(6,240) NUNI,RAVE,F2M,S2M,RM,R2M,RRIM,RPIM WRITE(IOUT,240) NUNI,RAVE,F2M,S2M,RM,R2M,RRIM,RPIM 240 FORMAT('All reflections ',I7,1X,F7.2,1X,2F8.1,4F7.3,//) WRITE(6,250) WRITE(IOUT,250) 250 FORMAT(/,' P L E A S E N O T E ! The standard deviations ', .'listed in the table',/,' are not the same as the SCALEPACK ', .'or SCALA standard deviations.',/,' They are merely averaged ', .'experimental standard deviations and do not ',/, .' contain the inflation factors of the various scaling programs.' .,//) RETURN END C C----------------------------------------------------------------------- C C Berechnet reziproke Zelldimensionen aus realen Achsen und Winklen, C Formeln siehe Buerger, S.84-85 C C SUBROUTINE RECIPR(CELL,CELLS) double precision CELL(6),CELLS(6),VOL VOL = CELL(1) * CELL(2) * CELL(3) * SQRT( 1 - cos(CELL(4))**2 . - cos(CELL(5))**2 - cos(CELL(6))**2 + 2 * cos(CELL(4)) . * cos(CELL(5)) * cos(CELL(6)) ) CELLS(1) = CELL(2) * CELL(3) * sin(CELL(4)) / VOL CELLS(2) = CELL(1) * CELL(3) * sin(CELL(5)) / VOL CELLS(3) = CELL(1) * CELL(2) * sin(CELL(6)) / VOL CELLS(4) = ACOS(( cos(CELL(5)) * cos(CELL(6)) - cos(CELL(4))) . / ( sin(CELL(5)) * sin(CELL(6)) ) ) CELLS(5) = ACOS(( cos(CELL(4)) * cos(CELL(6)) - cos(CELL(5))) . / ( sin(CELL(4)) * sin(CELL(6)) ) ) CELLS(6) = ACOS(( cos(CELL(4)) * cos(CELL(5)) - cos(CELL(6))) . / ( sin(CELL(4)) * sin(CELL(5)) ) ) RETURN END C C---------------------------------------------------------------------- C C Berechnet Aufloesung aus (hkl) und reziproken Zelldimensionen C SUBROUTINE RESOL(CELLS,IH,IK,IL,RES) double precision CELLS(6) integer ih,ik,il real res RES = 1 / SQRT( ( IH * CELLS(1) )**2 + . ( IK * CELLS(2) )**2 + . ( IL * CELLS(3) )**2 + . 2 * IH * IK * CELLS(1) * CELLS(2) * COS(CELLS(6)) + . 2 * IH * IL * CELLS(1) * CELLS(3) * COS(CELLS(5)) + . 2 * IK * IL * CELLS(2) * CELLS(3) * COS(CELLS(4)) ) RETURN END C C---------------------------------------------------------------------- C SUBROUTINE GETRED(HMIN,HMAX,KMIN,KMAX,LMIN,LMAX,IH,IK,IL,NRED, .NRDMAX) INTEGER*4 HMIN,HMAX,KMIN,KMAX,LMIN,LMAX,IH,IK,IL INTEGER*4 NRED(HMIN:HMAX,KMIN:KMAX,LMIN:LMAX),NRDMAX NRED(IH,IK,IL) = NRED(IH,IK,IL) + 1 NRDMAX = MAX(NRDMAX,NRED(IH,IK,IL)) RETURN END C C-----------------------------------------------------------------------