C Bits cut out of wilson.f C 5/3/2004: Updated to show reading of crystals and datasets C This program reads a basic MTZ file. Nothing is done C with the data read in. C It should be run as: C C mtz_read HKLIN foo.mtz <<eof C LABI F=filelabel SIGF=filelabel C END C eof PROGRAM READMTZ C .. Parameters .. INTEGER MAXPAR PARAMETER (MAXPAR=200) INTEGER MCOLS PARAMETER (MCOLS=200) INTEGER MAXSETS PARAMETER (MAXSETS=20) INTEGER MAXSYM PARAMETER (MAXSYM=96) INTEGER I,LENTIT,MTZERR,MTZIN,MTZPRT,NLPRGI,LENSTR,NUMCOL, + NREFLX,NSPGRP,NSYM,NSYMP,NDATASETS, + INHKL(3),MTZLOK(MCOLS),ISETS(MAXSETS) REAL S,FA,SA,RSYM(4,4,MAXSYM),CELMTZ(6),RNGMTZ(2,MCOLS), + RECIN(MCOLS),SMINWL,SMAXWL, + DATCELL(6,MAXSETS),DATWAVE(MAXSETS) LOGICAL MTZEOF,LOGMSS(MCOLS) CHARACTER LATTYP*1,NAMSPG*10,PGNAME*10,VERSNX*10, + CTPRGI(MCOLS)*1,LSPRGI(MCOLS)*30,TITIN*80, + PNAME(MAXSETS)*64,XNAME(MAXSETS)*64,DNAME(MAXSETS)*64 C Parser variables REAL FVALUE(MAXPAR) INTEGER IBEG(MAXPAR),IDEC(MAXPAR),IEND(MAXPAR),ITYP(MAXPAR), + NTOK LOGICAL LEND CHARACTER KEY*4,LINE*400,CVALUE(MAXPAR)*4 DATA NLPRGI /5/ DATA (LSPRGI(J),J=1,200) /'H','K','L','F','SIGF',195*' '/ DATA (CTPRGI(J),J=1,200) /'H','H','H','F','Q',195*' '/ DATA MTZLOK/5*-1,195*0/ C CCP4 initialisations call ccpfyp C MTZ-specific initialisations call mtzini C Open input file mtzin = 1 MTZprt = 0 MTZERR = 0 CALL LROPEN(MTZIN,'HKLIN',MTZPRT,MTZERR) C Parse keyworded input 10 CONTINUE LINE = ' ' KEY = ' ' NTOK = MAXPAR C C *********************************************************** CALL PARSER(KEY,LINE,IBEG,IEND,ITYP,FVALUE,CVALUE,IDEC,NTOK,LEND, + .TRUE.) C *********************************************************** C End of file? IF (LEND) GO TO 50 IF (KEY.EQ.'LABI') THEN C Parse LABIN line CALL LKYIN(MTZIN,LSPRGI,NLPRGI,NTOK,LINE,IBEG,IEND) ELSE IF (KEY.EQ.'END') THEN GO TO 50 ELSE WRITE (6,FMT=6022) LINE(1:LENSTR(LINE)) 6022 FORMAT (' Error: Key_Word line NOT Understood:-',/' ',A) GO TO 10 END IF GO TO 10 C End of keyworded input 50 CONTINUE C Get header info NUMCOL = MCOLS CALL LRINFO(MTZIN,VERSNX,NUMCOL,NREFLX,RNGMTZ) CALL LRTITL(MTZIN,TITIN,LENTIT) CALL LRCELL(MTZIN,CELMTZ) CALL LRRSOL(MTZIN,SMINWL,SMAXWL) CALL LRSYMI(MTZIN,NSYMP,LATTYP,NSPGRP,NAMSPG,PGNAME) IF (NSPGRP.GT.0) THEN CALL LRSYMM(MTZIN,NSYM,RSYM) END IF C Set up column assignments based on LABIN CALL LRASSN(MTZIN,LSPRGI,NLPRGI,MTZLOK,CTPRGI) C *** For CCP4 5.0 libraries C Read in the crystal, project, dataset and set id C information, plus the cell parameters and wavelengths, C associated with each dataset NDATASETS = MaxSets CALL LRIDX(MTZIN,PNAME,XNAME,DNAME,ISETS, + DATCELL,DATWAVE,NDATASETS) C Alternatively: C *** For CCP4 4.2 (and earlier) C Read in the project, dataset and set id C information, plus the cell parameters and wavelengths, C associated with each dataset C NDATASETS = MaxSets C CALL LRIDC(MTZIN,PNAME,DNAME,ISETS, C + DATCELL,DATWAVE,NDATASETS) C Loop over reflections. C LRREFL returns columns in file order 110 CALL LRREFL(MTZIN,S,RECIN,MTZEOF) IF (MTZEOF) GO TO 230 C Check for Missing Number Flags CALL LRREFM(MTZIN,LOGMSS) IF( LOGMSS(MTZLOK(4)) .OR. LOGMSS(MTZLOK(5))) GO TO 110 C Check resolution limits IF (S.LT.SMINWL .OR. S.GT.SMAXWL) GO TO 110 C Read data DO 120, I=1,3 INHKL(I) = NINT(RECIN(I)) 120 CONTINUE FA = RECIN(MTZLOK(4)) SA = RECIN(MTZLOK(5)) GO TO 110 C End of file 230 CONTINUE C Close file CALL LRCLOS(MTZIN) CALL CCPERR(0,'Normal termination') END