C  Adapted from mtzmnf.f

C   This program reads a basic MTZ file, calculates a couple of new
C   columns based on the input data, and writes out a new file.

C   It should be run as:
C
C   mtz_rw HKLIN foo1.mtz HKLOUT foo2.mtz <<eof
C   LABI F=filelabel SIGF=filelabel
C   LABO I=filelabel SIGI=filelabel
C   END
C   eof

      PROGRAM MTZRW

C     .. Parameters ..
      INTEGER MAXPAR
      PARAMETER (MAXPAR=200)
      INTEGER MCOLS
      PARAMETER (MCOLS=200)
      INTEGER MAXSYM
      PARAMETER (MAXSYM=96)

      INTEGER MINDX,MTZPRT,MTZERR,LOOKUP(MCOLS),NLPRGI,JDO40,
     +    LENSTR,NLPRGO,IAPPND,NCOLX
      REAL ADATA(MCOLS),BDATA(MCOLS),S
      LOGICAL MTZEOF,LOGMSS(MCOLS)
      CHARACTER CTPRGI(MCOLS)*1,CTPRGO(MCOLS)*1,LSPRGI(MCOLS)*30,
     +    LSPRGO(MCOLS)*30

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/'H','K','L','F','SIGF',195*' '/
      DATA CTPRGI/'H','H','H','F','Q',195*' '/
      DATA LOOKUP/-1,-1,-1,-1,-1,195*0/
      DATA NLPRGO/2/
      DATA LSPRGO/'I','SIGI',198*' '/
      DATA CTPRGO/'J','Q',198*' '/

C CCP4 initialisations
      call ccpfyp
C MTZ-specific initialisations
      call mtzini

C Open input and output files on same index
      MINDX = 1
      MTZprt = 1
      MTZERR = 0
      CALL LROPEN(MINDX,'HKLIN',MTZPRT,MTZERR)
      CALL LWOPEN(MINDX,'HKLOUT')

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(MINDX,LSPRGI,NLPRGI,NTOK,LINE,IBEG,IEND)

      ELSEIF (KEY.EQ.'LABO') THEN

C Parse LABOUT line
        CALL LKYOUT(MINDX,LSPRGO,NLPRGO,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 Return no. of columns in input file
      CALL LRNCOL(MINDX,NCOLX)
C Assign input labels
      CALL LRASSN(MINDX,LSPRGI,NLPRGI,LOOKUP,CTPRGI)
C Assign output labels, appended to input labels
      IAPPND = 1
      CALL LWASSN(MINDX,LSPRGO,NLPRGO,CTPRGO,IAPPND)

C---- Loop for reflections-----------
C
 100  CONTINUE

C Read reflection data in file order
      CALL LRREFL(MINDX,S,ADATA,MTZEOF)
      IF (MTZEOF) GO TO 200

C Check for Missing Number Flags
      CALL LRREFM(MINDX,LOGMSS)

C     default is to leave columns unchanged
      DO 40 JDO40 = 1,MCOLS
         BDATA(JDO40) = ADATA(JDO40)
 40   CONTINUE   

C If either F or SIGF columns missing, mark new columns as missing
      IF (LOGMSS(LOOKUP(4)) .OR. LOGMSS(LOOKUP(5))) THEN
        CALL EQUAL_MAGIC(MINDX,BDATA(NCOLX+1),2)
C Else, write out new columns
      ELSE
        BDATA(NCOLX+1) = ADATA(LOOKUP(4))**2
        BDATA(NCOLX+2) = (2.*ADATA(LOOKUP(5))*ADATA(LOOKUP(4)) +
     +                       ADATA(LOOKUP(5))*ADATA(LOOKUP(5)))
      ENDIF
 
      CALL LWREFL(MINDX,BDATA)

C     ...Return for next reflection
      GOTO 100

 200  CONTINUE
      CALL LRCLOS(MINDX)
      CALL LWCLOS(MINDX,MTZPRT)

      CALL CCPERR(0,'Normal termination')
      END