C 
C Subroutine file 'var.for' to store in the memory variations of the
C functions describing the model, with respect to their coefficients.
C
C Date: 1996, September 30
C Coded by Ludek Klimes
C
C.......................................................................
C
C This file consists of the following subroutine and its entries:
C     VAR1... Subroutine designed to initialize (i.e. to clear) the
C             memory storage locations.  After invocation of this
C             subroutine no variations are in the memory, thus the
C             variations at a new point in the model may be started to
C             be stored (see entry VAR2).
C             This subroutine contains entries VAR2, VAR3, VAR4, VAR5
C             and VAR6 listed below.
C             VAR1
C     VAR2... Entry of the subroutine VAR1, designed to store variations
C             of the functions describing the model in the memory.
C             One new variation is stored by one invocation, being added
C             into the register no. 0.  Note that one variation consists
C             of the variation of the functional value and its three
C             first derivatives.
C             VAR2
C     VAR3... Entry of the subroutine VAR1, designed to replace the
C             relative indices of the function coefficients by the
C             absolute ones in the register 0.  It should be called
C             after the register 0 is filled by the proper number of
C             invocations of the subroutine VAR2.
C             VAR3
C     VAR4... Entry of the subroutine VAR1, designed to define and/or
C             rebuild the 4*4 transformation matrix which may be applied
C             to the stored variations in order to modify them.
C             VAR4
C     VAR5... Entry of the subroutine VAR1, designed to modify the
C             stored variations by means of a linear transformation,
C             and to eventually append them to the registers
C             corresponding to the individual functions describing the
C             model.  The linear transformation is defined by
C             invocation(s) of the above entry VAR4.
C             VAR5
C     VAR6... Entry of the subroutine VAR1, designed to recall the
C             stored variations corresponding to a given function
C             describing the model.
C             VAR6
C
C.......................................................................
C
C Attention:
C (A) When linking this subroutine file with the file 'val.for',
C     subroutines CURVB1 and CURVBD of the file 'fit.for', instead of
C     CURVN1 and CURV2D, must be called from the 'val.for' file.  This
C     is the default in the distributed source code.  See also the
C     comment lines with '*' in the first column in the file 'val.for'.
C (B) In the basic version of C.R.T. routines, subroutines VAR* are
C     called from the following subroutine files:
C             'model.for' 7 times (in subroutines VELOC and POWER),
C             'parm.for'  7 times (in subroutine PARM2),
C             'val.for'  21 times (in subroutine VAL2),
C             'fit.for'   3 times (in subrs. CURVBD, SURFBD and VAL3BD).
C     Note that the corresponding call statements contain the substring
C             '     CALL VAR', and are denoted by '*V' in the first two
C             columns of the basic versions of the distributed source
C             code.
C     Each '*V' in the first two columns of the above mentioned files
C     has to be replaced by '  ' (2 blanks) if linking with 'var.for'.
C
C Relative CPU-time usage for the demo data:
C     CURVN1, CURV2D, no call VAR*:   1.00
C     CURVN1, CURV2D, 'VARNUL':       1.16
C     CURVB1, CURVBD, no call VAR*:   1.04
C     CURVB1, CURVBD, 'VARNUL':       1.22
C     CURVB1, CURVBD, 'VAR':          1.88
C
C-----------------------------------------------------------------------
C
C     
C
      SUBROUTINE VAR1()
C     dummy arguments of all entries:
      INTEGER IBI,IBB,IVAL,IVAL0,II,NBI
      REAL B0I,B1I,B2I,B3I,BBI
C
C This subroutine is designed to initialize (i.e.  to clear) the memory
C storage locations.  After invocation of this subroutine no variations
C are in the memory, thus the variations at a new point in the model may
C be started to be stored (see entry VAR2).
C
C No input.
C
C No output.
C
C No subroutines and external functions required.
C
C.......................................................................
C
C     Storage locations (common to all entries):
C
      INTEGER MFUNCT,MB
      PARAMETER (MFUNCT=48,MB=3072)
      INTEGER NB(0:MFUNCT),IB(MB), IAUX,I,J,JB,JB0,JVAL,JVAL0
      REAL B0(MB),B1(MB),B2(MB),B3(MB),BB(16), AUX0,AUX1,AUX2,AUX3
      SAVE NB,IB,B0,B1,B2,B3,BB
C
C.......................................................................
C
      DO 11 I=0,MFUNCT
        NB(I)=0
   11 CONTINUE
      RETURN
C
C-----------------------------------------------------------------------
C
C     
C
      ENTRY VAR2(IBI,B0I,B1I,B2I,B3I)
C     INTEGER IBI
C     REAL B0I,B1I,B2I,B3I
C
C This entry is designed to store variations of the functions describing
C the model in the memory.  One new variation is stored by one
C invocation, being added into the register no.  0.  Note that one
C variation consists of the variation of the functional value and its
C three first derivatives.
C
C Input:
C     IBI...  Index of the function coefficient, relative to the
C             beginning of the function.
C     B0I,B1I,B2I,B3I... Variation of the functional value and the three
C             first derivatives, with respect to the IBI-th coefficient
C             of the function.
C The input parameters are not altered.
C
C No output.
C
C.......................................................................
C
      I=NB(MFUNCT)+1
      IF(I.GT.MB) THEN
C       362
        CALL ERROR('362 in VAR2: Array index out of range.')
C       Dimension MB of arrays IB, B0, B1, B2 and B3 should be
C       increased.
      END IF
      NB(MFUNCT)=I
      IB(I)=IBI
      B0(I)=B0I
      B1(I)=B1I
      B2(I)=B2I
      B3(I)=B3I
      RETURN
C
C-----------------------------------------------------------------------
C
C     
C
      ENTRY VAR3(IBI)
C     INTEGER IBI
C
C This entry is designed to replace the relative indices of the function
C coefficients by the absolute ones in the register 0.  It should be
C called after the register 0 is filled by the proper number of
C invocations of the subroutine VAR2.
C
C Input:
C     IBI...  Shift added to the index of the function coefficient.
C             It should equal the difference between the absolute (see
C             entry VAR6) and relative (see entry VAR2) indices of the
C             corresponding function.
C The input parameter is not altered.
C
C No output.
C
C.......................................................................
C
      DO 31 I=NB(MFUNCT-1)+1,NB(MFUNCT)
        IB(I)=IB(I)+IBI
   31 CONTINUE
      RETURN
C
C-----------------------------------------------------------------------
C
C     
C
      ENTRY VAR4(IBB,BBI)
C     INTEGER IBB
C     REAL BBI
C
C This entry is designed to define and/or rebuild the 4*4 transformation
C matrix which may be applied to the stored variations in order to
C modify them.
C
C Input:
C     IBB...  IBB=0: 4*4 transformation matrix is set to the identity
C               matrix multiplied by BBI.
C             IBB=1,2,...,16: BBI is added to the IBB-th element of the
C               transformation matrix.
C     BBI...  Given real value.
C The input parameters are not altered.
C
C No output.
C
C.......................................................................
C
      IF(IBB.LE.0) THEN
        DO 41 I=2,15
          BB(I)=0.
   41   CONTINUE
        DO 42 I=1,16,5
          BB(I)=BBI
   42   CONTINUE
      ELSE
        BB(IBB)=BB(IBB)+BBI
      END IF
      RETURN
C
C-----------------------------------------------------------------------
C
C     
C
      ENTRY VAR5(IVAL,IVAL0)
C     INTEGER IVAL,IVAL0
C
C This entry is designed to modify the stored variations by means of a
C linear transformation, and to eventually append them to the registers
C corresponding to the individual functions describing the model.  The
C linear transformation is defined by invocation(s) of the entry VAR4.
C
C Input:
C     IVAL,IVAL0... The variations from the register IVAL0 are
C             transformed by means of the matrix defined through the
C             entry VAR4, and then copied to the register IVAL.
C             The transformed variations are appended to ones already
C             stored in the IVAL-th register.
C             If IVAL=IVAL0 or IVAL0=0, the original variations are
C             deleted from the IVAL0-th register, otherwise the original
C             variations are retained.
C The input parameters are not altered.
C
C No output.
C
C.......................................................................
C
      IF(IVAL.LE.0) THEN
        JVAL=MFUNCT
        JB=NB(JVAL-1)
      ELSE
        JVAL=IVAL
        IF(IVAL.EQ.IVAL0) THEN
          JB=NB(JVAL-1)
        ELSE
          JB=NB(JVAL)
        END IF
      END IF
      IF(IVAL0.LE.0) THEN
        JVAL0=MFUNCT
      ELSE
        JVAL0=IVAL0
      END IF
C
      DO 58 J=1,NB(JVAL0)-NB(JVAL0-1)
        JB=JB+1
        IF(JVAL.EQ.MFUNCT.OR.JVAL0.LT.MFUNCT) THEN
          JB0=NB(JVAL0-1)+J
        ELSE
          JB0=NB(JVAL0-1)+1
        END IF
        IAUX=IB(JB0)
        AUX0=B0(JB0)
        AUX1=B1(JB0)
        AUX2=B2(JB0)
        AUX3=B3(JB0)
        IF(JVAL.NE.JVAL0) THEN
          DO 51 I=JVAL,MFUNCT-1
            NB(I)=NB(I)+1
   51     CONTINUE
          IF(JVAL0.LT.MFUNCT) THEN
C           original variations are not deleted
            JB0=NB(MFUNCT)+1
            NB(MFUNCT)=JB0
          END IF
        END IF
        IF(JB0.GT.MB) THEN
C         365
          CALL ERROR('365 in VAR5: Array index out of range.')
C         Dimension MB of arrays IB, B0, B1, B2 and B3 should be
C         increased.
        END IF
        DO 52 I=JB0-1,JB,-1
          IB(I+1)=IB(I)
          B0(I+1)=B0(I)
          B1(I+1)=B1(I)
          B2(I+1)=B2(I)
          B3(I+1)=B3(I)
   52   CONTINUE
        IB(JB)=IAUX
        B0(JB)=BB(1)*AUX0+BB(5)*AUX1+BB( 9)*AUX2+BB(13)*AUX3
        B1(JB)=BB(2)*AUX0+BB(6)*AUX1+BB(10)*AUX2+BB(14)*AUX3
        B2(JB)=BB(3)*AUX0+BB(7)*AUX1+BB(11)*AUX2+BB(15)*AUX3
        B3(JB)=BB(4)*AUX0+BB(8)*AUX1+BB(12)*AUX2+BB(16)*AUX3
   58 CONTINUE
      RETURN
C
C-----------------------------------------------------------------------
C
C     
C
      ENTRY VAR6(IVAL,II,NBI,IBI,B0I,B1I,B2I,B3I)
C     INTEGER IVAL,II,NBI,IBI
C     REAL B0I,B1I,B2I,B3I
C
C This entry is designed to recall the stored variations corresponding
C to a given function describing the model.
C
C Input:
C     IVAL... Index of the function describing the model.  The output
C             variations are thus recalled from the IVAL-th register.
C     II...   Sequential number within the register of the required
C             variation of the IVAL-th function.
C The input parameters are not altered.
C
C Output:
C     NBI...  Number of the variations of the IVAL-th function stored in
C             the IVAL-th register.
C     IBI...  Absolute index of the function coefficient.  For II.GT.NBI
C             undefined.
C     B0I,B1I,B2I,B3I... Variation of the functional value and the three
C             first derivatives, with respect to the IBI-th coefficient
C             of the model.  For II.GT.NBI undefined.
C
C.......................................................................
C
      NBI=NB(IVAL)-NB(IVAL-1)
      IF(II.LE.NBI) THEN
        I=NB(IVAL-1)+II
        IBI=IB(I)
        B0I=B0(I)
        B1I=B1(I)
        B2I=B2(I)
        B3I=B3(I)
      END IF
      RETURN
      END
C
C=======================================================================
C