C 
C Program 'GRDCAL' (GRiD CALculator) to perform vectorial calculations
C with real-valued arrays stored in disk files.
C
C Version: 5.10
C Date: 1997, October 25
C
C Coded by: Ludek Klimes
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     E-mail: klimes@seis.karlov.mff.cuni.cz
C
C.......................................................................
C
C                                                    
C Description of the data files:
C
C The data are read in by the list directed input (free format).
C In the description of data files, each numbered paragraph indicates
C the beginning of a new input operation (new READ statement).
C If the symbolic name of the input variable is enclosed in apostrophes,
C the corresponding value in input data is of the type CHARACTER, i.e.
C it should be a character string enclosed in apostrophes.  If the first
C letter of the symbolic name is I-N, the corresponding value is of the
C type INTEGER.  Otherwise, the input parameter is of the type REAL and
C may or may not contain a decimal point.
C
C Input data read from the * external unit:
C     The interactive * external unit may also be redirected to the file
C     containing the relevant data.
C (1) 'SEP','CAL','GRD1','GRD2',...,'GRDn',/
C     'SEP'...String in apostrophes containing the name of the input
C             file with the data specifying grid dimensions.
C             Description of file SEP
C     'CAL'...String in apostrophes containing the name of the input
C             file containing the commands to be carried out at each
C             gridpoint.
C             Description of file CAL
C     'GRD1','GRD2',...,'GRDn'... Strings in apostrophes containing the
C             names of the input/output ASCII files with the grid
C             values.
C     /...    Input data line must be terminated by a slash.
C     Default: 'SEP'='grd.h', 'CAL'=' ', 'GRD1'=' ', ..., 'GRDn'=' '.
C
C                                                     
C Data file SEP has the form of the SEP (Stanford Exploration Project)
C parameter file:
C     All the data are specified in the form of PARAMETER=VALUE, e.g.
C     N1=50, with PARAMETER directly preceding = without intervening
C     spaces and with VALUE directly following = without intervening
C     spaces.  The PARAMETER=VALUE couple must be delimited by a space
C     or comma from both sides.
C     The PARAMETER string is not case-sensitive.
C     PARAMETER= followed by a space resets the default parameter value.
C     All other text in the input files is ignored.  The file thus may
C     contain unused data or comments without leading comment character.
C     Everything between comment character # and the end of the
C     respective line is ignored, too.
C     The PARAMETER=VALUE couples may be specified in any order.
C     The last appearance takes precedence.
C Data specifying grid dimensions:
C     N1=positive integer... Number of gridpoints along the X1 axis.
C             Default: N1=1
C     N2=positive integer... Number of gridpoints along the X2 axis.
C             Default: N2=1
C     N3=positive integer... Number of gridpoints along the X3 axis.
C             Default: N3=1
C
C                                                     
C File CAL containing, in each line, a command to be performed at each
C gridpoint:
C     The lines are read character-by-character.  The commands thus
C     should not be enclosed in parentheses.  The commands have the
C     structure like:
C       $3=$1+$2
C       C=A-B
C       C=$1-$2
C       $3=ABS(C)
C     etc.
C     Here $i corresponds to the i-th input/output file GRDi,
C     FUN(.) represents function FUN of a single argument,
C     FUN(.,.) represents function FUN of two arguments,
C     other names represent temporary variables.
C     Letter case is not distinguished.
C     A single line may contain a single operation.
C     Allowed operators:
C       A=B+C
C       A=B-C
C       A=B*C
C       A=B/C
C       A=B**C
C     Allowed functions (= sign means equivalent function names):
C       abs(.)
C       aint(.)=int(.)
C       anint(.)=nint(.)
C       amod(.)=mod(.)
C       sign(.)
C       dim(.)
C       amax1(.,.)=amax(.,.)=max(.,.)
C       amin1(.,.)=amin(.,.)=min(.,.)
C       sqrt(.)
C       exp(.)
C       alog(.)=log(.)=ln(.)
C       alog10(.)=log10(.)
C       sin(.)
C       cos(.)
C       tan(.)
C       asin(.)
C       acos(.)
C       atan(.)
C       atan2(.,.)
C       sinh(.)
C       cosh(.)
C       tanh(.)
C
C=======================================================================
C
C Common block /RAMC/:
      INCLUDE 'ram.inc'
C     ram.inc
C
C     Allocation of working array:
      INTEGER MGRID
      PARAMETER (MGRID=MRAM)
      REAL GRID(MGRID)
      EQUIVALENCE (GRID,RAM)
C
C.......................................................................
C
      INTEGER MFILE,MNAME,MKOM
C     
      PARAMETER (MFILE=9,MNAME=MFILE+20,MKOM=100,LU=1)
      CHARACTER*80 FGRD,FKOM,FILE(MFILE)
      INTEGER KGRID0(MFILE),KGRID1(MFILE)
      CHARACTER*6 NAME(MNAME)
      REAL RNAME(MNAME)
      INTEGER KOM0(MKOM),KOM1(MKOM),KOM2(MKOM),KOM3(MKOM)
C
      CHARACTER*255 LINE
      CHARACTER*7 FORMAT
      LOGICAL LUNDEF
      INTEGER NNAME,NKOM
C
C     NKOM... Number of commands
C
C.......................................................................
C
C     Main input data:
C     Default:
      FGRD='grd.h'
      FKOM=' '
      DO 10 IFILE=1,MFILE
        FILE(IFILE)=' '
        NAME(IFILE)='$'
        NAME(IFILE)(2:2)=CHAR(ICHAR('0')+IFILE)
   10 CONTINUE
C     Reading main input data:
      WRITE (*,'(2A)')
     .  ' Enter filenames of Grid header + Commands + In/Out grids, /: '
      READ (*,*) FGRD,FKOM,FILE
C     Default extension of FKOM is '.cal':
      IF(INDEX(FKOM,'.').EQ.0) THEN
        FKOM(LENGTH(FKOM)+1:LENGTH(FKOM)+4)='.cal'
      END IF
C
C     Reading all the data from file FGRD to the memory
C     (SEP parameter file form):
      CALL RSEP1(LU,FGRD)

C     Recalling the data specifying grid dimensions
C     (arguments: Name of value in input data, Variable, Default):
      CALL RSEP3I('N1',N1,1)
      CALL RSEP3I('N2',N2,1)
      CALL RSEP3I('N3',N3,1)
C
C.......................................................................
C
C     Reading the command file FKOM:
C
      NKOM=0
      NNAME=MFILE
      OPEN(LU,FILE=FKOM,STATUS='OLD')
C
C     Loop over input lines
   11 CONTINUE
        READ(LU,'(A)',END=19) LINE
        KEQ=INDEX(LINE,'=')
        IF(KEQ.NE.0) THEN
C
C         The line contains a new command
          NKOM=NKOM+1
          IF(NKOM.GT.MKOM) THEN
C           GRDCAL-01
            PAUSE 'Error GRDCAL-01: Insufficient memory for commands'
            STOP
C           Maximum number MKOM of the commands read from the command
C           file should probably be increased.  MKOM is declared by the
C           PARAMETER statement.
          END IF
          CALL LOWER(LINE)
C
C         Name of the result must precede '=':
          DO 12 K=KEQ-1,1,-1
            IF(LINE(K:K).EQ.' ') THEN
              GO TO 13
            END IF
   12     CONTINUE
   13     CONTINUE
          IF(K.GE.KEQ-1) THEN
C           GRDCAL-02
            PAUSE 'Error GRDCAL-02: Missing identifier of the result'
            STOP
          END IF
C         Registration of the name
          CALL REGNAM(LINE(K+1:KEQ-1),NAME,MNAME,NNAME,KOM0(NKOM))
C
C         End of the command:
          KEND=INDEX(LINE(KEQ+1:),' ')
          IF(KEND.EQ.0) THEN
C           GRDCAL-03
            PAUSE 'Error GRDCAL-03: Too long command line'
            STOP
          END IF
          KEND=KEQ+KEND-1
C
C         Search for left parenthesis:
          K=INDEX(LINE(KEQ+1:KEND),'(')
          IF(K.EQ.0) THEN
C
C           No left parenthesis - search for binary operators:
            K=INDEX(LINE(KEQ+1:KEND),'**')
            IF(K.NE.0) THEN
C             Two-letter binary operator **:
              KOM3(NKOM)=5
C             Registration of the name of the second operand
              K=KEQ+K
              CALL REGNAM(LINE(K+2:KEND-1),NAME,MNAME,NNAME,KOM2(NKOM))
            ELSE
C             Search for a one-letter binary operator:
              K=INDEX(LINE(KEQ+2:KEND),'+')
              IF(K.NE.0) THEN
                K=K+1
                KOM3(NKOM)=1
              ELSE
                K=INDEX(LINE(KEQ+2:KEND),'-')
                IF(K.NE.0) THEN
                  K=K+1
                  KOM3(NKOM)=2
                ELSE
                  K=INDEX(LINE(KEQ+1:KEND),'*')
                  IF(K.NE.0) THEN
                    KOM3(NKOM)=3
                IF(K.EQ.1) THEN
                  K=0
                  KOM3(NKOM)=0
                END IF
                  ELSE
                    K=INDEX(LINE(KEQ+1:KEND),'/')
                    IF(K.NE.0) THEN
                      KOM3(NKOM)=4
                    ELSE
C                     No binary operator:
                      KOM3(NKOM)=0
                    END IF
                  END IF
                END IF
              END IF
              K=KEQ+K
              IF(KOM3(NKOM).NE.0) THEN
C               Registration of the name of the second operand
                CALL REGNAM
     *                    (LINE(K+1:KEND),NAME,MNAME,NNAME,KOM2(NKOM))
                IF(K+1.GT.KEND) THEN
C                 
C                 GRDCAL-04
                  WRITE(*,'(2A)') '                 ',LINE(KEQ:KEND)
                  PAUSE 'Error GRDCAL-04: Missing second operand'
                  STOP
                END IF
              END IF
            END IF
            IF(KOM3(NKOM).NE.0) THEN
C             Registration of the name of the first operand
              IF(KEQ+1.GT.K-1) THEN
C               GRDCAL-05
                WRITE(*,'(2A)') '                 ',LINE(KEQ:KEND)
                PAUSE 'Error GRDCAL-05: Missing first operand'
                STOP
              END IF
              CALL REGNAM(LINE(KEQ+1:K-1),NAME,MNAME,NNAME,KOM1(NKOM))
            ELSE
C             Registration of the name of the single operand
              IF(KEQ+1.GT.KEND) THEN
C               GRDCAL-06
                WRITE(*,'(2A)') '                 ',LINE(KEQ:KEND)
                PAUSE 'Error GRDCAL-06: Missing operand'
                STOP
              END IF
              CALL REGNAM
     *                  (LINE(KEQ+1:KEND),NAME,MNAME,NNAME,KOM1(NKOM))
              KOM2(NKOM)=0
            END IF
C
          ELSE
C
C           Operator has the form of Fortran 77 intrinsic function
            K=KEQ+K
            IF(LINE(KEND:KEND).NE.')') THEN
C             GRDCAL-07
              WRITE(*,'(2A)') '                 ',LINE(KEQ:KEND)
              PAUSE 'Error GRDCAL-07: Missing closing parenthesis'
              STOP
            END IF
C           Search for comma delimiting the arguments
            I=INDEX(LINE(K+1:KEND-1),',')
C           Registration of the arguments
            IF(I.EQ.0) THEN
C             Single argument:
              IF(K+1.GT.KEND-1) THEN
C               GRDCAL-08
                WRITE(*,'(2A)') '                 ',LINE(KEQ:KEND)
                PAUSE 'Error GRDCAL-08: Missing argument'
                STOP
              END IF
              CALL REGNAM(LINE(K+1:KEND-1),NAME,MNAME,NNAME,KOM1(NKOM))
              KOM2(NKOM)=0
            ELSE
C             Two arguments:
              I=K+I
              IF(K+1.GT.I-1) THEN
C               GRDCAL-09
                WRITE(*,'(2A)') '                 ',LINE(KEQ:KEND)
                PAUSE 'Error GRDCAL-09: Missing first argument'
                STOP
              END IF
              CALL REGNAM(LINE(K+1:I-1),NAME,MNAME,NNAME,KOM1(NKOM))
              IF(I+1.GT.KEND-1) THEN
C               GRDCAL-10
                WRITE(*,'(2A)') '                 ',LINE(KEQ:KEND)
                PAUSE 'Error GRDCAL-10: Missing second argument'
                STOP
              END IF
              CALL REGNAM(LINE(I+1:KEND-1),NAME,MNAME,NNAME,KOM2(NKOM))
            END IF
C           Registration of the function
            IF(LINE(KEQ+1:K-1).EQ.'abs') THEN
              KOM3(NKOM)= 6
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-11
                PAUSE 'Error GRDCAL-11: Redundant argument in ABS'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'aint'
     *          .OR.LINE(KEQ+1:K-1).EQ.'int') THEN
              KOM3(NKOM)= 7
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-12
                PAUSE 'Error GRDCAL-12: Redundant argument in AINT'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'anint'
     *          .OR.LINE(KEQ+1:K-1).EQ.'nint') THEN
              KOM3(NKOM)= 8
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-13
                PAUSE 'Error GRDCAL-13: Redundant argument in ANINT'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'amod'
     *          .OR.LINE(KEQ+1:K-1).EQ.'mod') THEN
              KOM3(NKOM)= 9
              IF(KOM2(NKOM).EQ.0) THEN
C               GRDCAL-14
                PAUSE 'Error GRDCAL-14: Missing second argument of AMOD'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'sign') THEN
              KOM3(NKOM)=10
              IF(KOM2(NKOM).EQ.0) THEN
C               GRDCAL-15
                PAUSE 'Error GRDCAL-15: Missing second argument of SIGN'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'dim') THEN
              KOM3(NKOM)=11
              IF(KOM2(NKOM).EQ.0) THEN
C               GRDCAL-16
                PAUSE 'Error GRDCAL-16: Missing second argument of DIM'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'amax1'
     *          .OR.LINE(KEQ+1:K-1).EQ.'amax'
     *          .OR.LINE(KEQ+1:K-1).EQ.'max') THEN
              KOM3(NKOM)=12
              IF(KOM2(NKOM).EQ.0) THEN
C               GRDCAL-17
                PAUSE'Error GRDCAL-17: Missing second argument of AMAX1'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'amin1'
     *          .OR.LINE(KEQ+1:K-1).EQ.'amin'
     *          .OR.LINE(KEQ+1:K-1).EQ.'min') THEN
              KOM3(NKOM)=13
              IF(KOM2(NKOM).EQ.0) THEN
C               GRDCAL-18
                PAUSE'Error GRDCAL-18: Missing second argument of AMIN1'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'sqrt') THEN
              KOM3(NKOM)=14
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-19
                PAUSE 'Error GRDCAL-19: Redundant argument in SQRT'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'exp') THEN
              KOM3(NKOM)=15
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-20
                PAUSE 'Error GRDCAL-20: Redundant argument in EXP'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'alog'
     *          .OR.LINE(KEQ+1:K-1).EQ.'log'
     *          .OR.LINE(KEQ+1:K-1).EQ.'ln') THEN
              KOM3(NKOM)=16
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-21
                PAUSE 'Error GRDCAL-21: Redundant argument in ALOG'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'alog10'
     *          .OR.LINE(KEQ+1:K-1).EQ.'log10') THEN
              KOM3(NKOM)=17
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-22
                PAUSE 'Error GRDCAL-22: Redundant argument in ALOG10'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'sin') THEN
              KOM3(NKOM)=18
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-23
                PAUSE 'Error GRDCAL-23: Redundant argument in SIN'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'cos') THEN
              KOM3(NKOM)=19
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-24
                PAUSE 'Error GRDCAL-24: Redundant argument in COS'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'tan') THEN
              KOM3(NKOM)=20
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-25
                PAUSE 'Error GRDCAL-25: Redundant argument in TAN'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'asin') THEN
              KOM3(NKOM)=21
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-26
                PAUSE 'Error GRDCAL-26: Redundant argument in ASIN'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'acos') THEN
              KOM3(NKOM)=22
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-27
                PAUSE 'Error GRDCAL-27: Redundant argument in ACOS'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'atan') THEN
              KOM3(NKOM)=23
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-28
                PAUSE 'Error GRDCAL-28: Redundant argument in ATAN'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'atan2') THEN
              KOM3(NKOM)=24
              IF(KOM2(NKOM).EQ.0) THEN
C               GRDCAL-29
                PAUSE'Error GRDCAL-29: Missing second argument of ATAN2'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'sinh') THEN
              KOM3(NKOM)=25
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-30
                PAUSE 'Error GRDCAL-30: Redundant argument in SINH'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'cosh') THEN
              KOM3(NKOM)=26
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-31
                PAUSE 'Error GRDCAL-31: Redundant argument in COSH'
                STOP
              END IF
            ELSE IF(LINE(KEQ+1:K-1).EQ.'tanh') THEN
              KOM3(NKOM)=27
              IF(KOM2(NKOM).NE.0) THEN
C               GRDCAL-32
                PAUSE 'Error GRDCAL-32: Redundant argument in TANH'
                STOP
              END IF
            ELSE
C             GRDCAL-33
              WRITE(*,'(2A)') '                 ',LINE(KEQ:KEND)
              PAUSE           'Error GRDCAL-33: Unknown function'
              STOP
            END IF
C
          END IF
        END IF
      GO TO 11
   19 CONTINUE
      CLOSE(LU)
C
C     Interpreting the constants:
      FORMAT='(F00.0)'
      DO 20 I=1,NNAME
        IF(('0'.LE.NAME(I)(1:1).AND.NAME(I)(1:1).LE.'9').OR.
     *       NAME(I)(1:1).EQ.'+'.OR.NAME(I)(1:1).EQ.'-'.OR.
     *       NAME(I)(1:1).EQ.'.') THEN
          L=LENGTH(NAME(I))
          FORMAT(3:3)=CHAR(ICHAR('0')+L/10)
          FORMAT(4:4)=CHAR(ICHAR('0')+MOD(L,10))
          READ(NAME(I),FORMAT) RNAME(I)
        ELSE
          RNAME(I)=0.
        END IF
   20 CONTINUE
C
C.......................................................................
C
C     Reading input grid values:
      IGRID=0
      DO 29 IFILE=1,MFILE
        DO 22 IKOM=1,NKOM
          IF(KOM1(IKOM).EQ.IFILE.OR.KOM2(IKOM).EQ.IFILE) THEN
C           File appears at the R.H.S. of the command:
            IF(IGRID+N1*N2*N3.GT.MGRID) THEN
C             GRDCAL-34
              PAUSE
     *           'Error GRDCAL-34: Insufficient memory for input grids'
C             Dimension MRAM of array RAM in include file
C             ram.inc should probably be increased
C             to accommodate all input grids.
              STOP
            END IF
            IF(FILE(IFILE).EQ.' ') THEN
C             GRDCAL-35
              PAUSE 'Error GRDCAL-35: Blank filename of input grid'
              STOP
            END IF
            CALL RARRAY(LU,FILE(IFILE),'FORMATTED',.TRUE.,-999999.,
     *                  N1*N2*N3,GRID(IGRID+1))
            KGRID1(IFILE)=IGRID
            IGRID=IGRID+N1*N2*N3
            GO TO 23
          END IF
   22   CONTINUE
   23   CONTINUE
   29 CONTINUE
C
C     Determining storage for output grid values:
      IGRID=0
      DO 39 IFILE=1,MFILE
        DO 32 IKOM=1,NKOM
          IF(KOM0(IKOM).EQ.IFILE) THEN
C           File appears at the L.H.S. of the command:
            IF(IGRID+N1*N2*N3.GT.MGRID) THEN
C             GRDCAL-36
              PAUSE
     *          'Error GRDCAL-36: Insufficient memory for output grids'
              STOP
C             Dimension MRAM of array RAM in include file
C             ram.inc should probably be increased
C             to accommodate all output grids.
            END IF
            IF(FILE(IFILE).EQ.' ') THEN
C             GRDCAL-37
              PAUSE 'Error GRDCAL-37: Blank filename of output grid'
              STOP
            END IF
            KGRID0(IFILE)=IGRID
            IGRID=IGRID+N1*N2*N3
            GO TO 33
          END IF
   32   CONTINUE
   33   CONTINUE
   39 CONTINUE
C
C.......................................................................
C
C     Performing grid calculations:
C
C     Loop for gridpoints:
      DO 202 IGRID=1,N1*N2*N3
C
C       Loop for individual commands:
        DO 201 IKOM=1,NKOM
          I0=KOM0(IKOM)
          I1=KOM1(IKOM)
          I2=KOM2(IKOM)
          LUNDEF=.FALSE.
          IF(I1.LE.MFILE) THEN
            RNAME(I1)=GRID(KGRID1(I1)+IGRID)
          END IF
          IF(RNAME(I1).LT.-999998.) THEN
            LUNDEF=.TRUE.
          END IF
          IF(I2.GT.0) THEN
            IF(I2.LE.MFILE) THEN
              RNAME(I2)=GRID(KGRID1(I2)+IGRID)
            END IF
            IF(RNAME(I2).LT.-999998.) THEN
              LUNDEF=.TRUE.
            END IF
          END IF
          IF(LUNDEF) THEN
            RNAME(I0)=-999999.
          ELSE
C
            GO TO (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) KOM3(IKOM)
              RNAME(I0)=RNAME(I1)
              GO TO 199
  101       CONTINUE
              RNAME(I0)=RNAME(I1)+RNAME(I2)
              GO TO 199
  102       CONTINUE
              RNAME(I0)=RNAME(I1)-RNAME(I2)
              GO TO 199
  103       CONTINUE
              RNAME(I0)=RNAME(I1)*RNAME(I2)
              GO TO 199
  104       CONTINUE
              IF(RNAME(I2).EQ.0.) THEN
                IF(RNAME(I1).EQ.0.) THEN
                  RNAME(I0)=0.
                ELSE
                  RNAME(I0)=-999999.
                END IF
              ELSE
                RNAME(I0)=RNAME(I1)/RNAME(I2)
              END IF
              GO TO 199
  105       CONTINUE
              IF(RNAME(I1).LT.0.) THEN
                RNAME(I0)=-999999.
              ELSE
                RNAME(I0)=RNAME(I1)**RNAME(I2)
              END IF
              GO TO 199
  106       CONTINUE
              RNAME(I0)=ABS(RNAME(I1))
              GO TO 199
  107       CONTINUE
              RNAME(I0)=AINT(RNAME(I1))
              GO TO 199
  108       CONTINUE
              RNAME(I0)=ANINT(RNAME(I1))
              GO TO 199
  109       CONTINUE
              IF(RNAME(I2).EQ.0.) THEN
                RNAME(I0)=-999999.
              ELSE
                RNAME(I0)=AMOD(RNAME(I1),RNAME(I2))
              END IF
              GO TO 199
  110       CONTINUE
              RNAME(I0)=SIGN(RNAME(I1),RNAME(I2))
              GO TO 199
  111       CONTINUE
              RNAME(I0)=DIM(RNAME(I1),RNAME(I2))
              GO TO 199
  112       CONTINUE
              RNAME(I0)=AMAX1(RNAME(I1),RNAME(I2))
              GO TO 199
  113       CONTINUE
              RNAME(I0)=AMIN1(RNAME(I1),RNAME(I2))
              GO TO 199
  114       CONTINUE
              IF(RNAME(I1).LT.0.) THEN
                RNAME(I0)=-999999.
              ELSE
                RNAME(I0)=SQRT(RNAME(I1))
              END IF
              GO TO 199
  115       CONTINUE
              RNAME(I0)=EXP(RNAME(I1))
              GO TO 199
  116       CONTINUE
              IF(RNAME(I1).LE.0.) THEN
                RNAME(I0)=-999999.
              ELSE
                RNAME(I0)=ALOG(RNAME(I1))
              END IF
              GO TO 199
  117       CONTINUE
              IF(RNAME(I1).LE.0.) THEN
                RNAME(I0)=-999999.
              ELSE
                RNAME(I0)=ALOG10(RNAME(I1))
              END IF
              GO TO 199
  118       CONTINUE
              RNAME(I0)=SIN(RNAME(I1))
              GO TO 199
  119       CONTINUE
              RNAME(I0)=COS(RNAME(I1))
              GO TO 199
  120       CONTINUE
              RNAME(I0)=TAN(RNAME(I1))
              GO TO 199
  121       CONTINUE
              IF(ABS(RNAME(I1)).GT.1.) THEN
                RNAME(I0)=-999999.
              ELSE
                RNAME(I0)=ASIN(RNAME(I1))
              END IF
              GO TO 199
  122       CONTINUE
              IF(ABS(RNAME(I1)).GT.1.) THEN
                RNAME(I0)=-999999.
              ELSE
                RNAME(I0)=ACOS(RNAME(I1))
              END IF
              GO TO 199
  123       CONTINUE
              IF(ABS(RNAME(I1)).GT.1.) THEN
                RNAME(I0)=-999999.
              ELSE
                RNAME(I0)=ATAN(RNAME(I1))
              END IF
              GO TO 199
  124       CONTINUE
              IF(RNAME(I1).EQ.0..AND.RNAME(I2).EQ.0.) THEN
                RNAME(I0)=-999999.
              ELSE
                RNAME(I0)=ATAN2(RNAME(I1),RNAME(I2))
              END IF
              GO TO 199
  125       CONTINUE
              RNAME(I0)=SINH(RNAME(I1))
              GO TO 199
  126       CONTINUE
              RNAME(I0)=COSH(RNAME(I1))
              GO TO 199
  127       CONTINUE
              RNAME(I0)=TANH(RNAME(I1))
              GO TO 199
  199       CONTINUE
          END IF
C
          IF(I0.LE.MFILE) THEN
            GRID(KGRID0(I0)+IGRID)=RNAME(I0)
          END IF
  201   CONTINUE
C
  202 CONTINUE
C
C.......................................................................
C
C     Writing output grid values:
      IGRID=0
      DO 339 IFILE=1,MFILE
        DO 332 IKOM=1,NKOM
          IF(KOM0(IKOM).EQ.IFILE) THEN
C           File appears at the L.H.S. of the command:
            CALL WARRAY(LU,FILE(IFILE),'FORMATTED',.TRUE.,-999998.,
     *                 .FALSE.,0.,N1*N2*N3,GRID(IGRID+1))
            IGRID=IGRID+N1*N2*N3
            GO TO 333
          END IF
  332   CONTINUE
  333   CONTINUE
  339 CONTINUE
C
      STOP
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE REGNAM(NAME0,NAME,MNAME,NNAME,KOM)
C
      INTEGER MNAME,NNAME,KOM
      CHARACTER*(*) NAME0,NAME(MNAME)
C
C-----------------------------------------------------------------------
C
      INTEGER INAME
C
      DO 10 INAME=1,NNAME
        IF(NAME(INAME).EQ.NAME0) THEN
          KOM=INAME
          GO TO 20
        END IF
   10 CONTINUE
      NNAME=NNAME+1
      IF(NNAME.GT.MNAME) THEN
C       GRDCAL-38
        PAUSE 'Error GRDCAL-38: Insufficient memory for variable names'
        STOP
C       Maximum number MNAME of variables used in the command file
C       should probably be increased.  MNAME is declared by the
C       PARAMETER statement.
      END IF
      NAME(NNAME)=NAME0
      KOM=NNAME
C
   20 CONTINUE
      RETURN
      END
C
C=======================================================================
C
      INCLUDE 'sep.for'
C     sep.for
      INCLUDE 'forms.for'
C     forms.for
      INCLUDE 'length.for'
C     length.for
C
C=======================================================================
C