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 By Ludek Klimes
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 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 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 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 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 VAR6... Entry of the subroutine VAR1, designed to recall the
C stored variations corresponding to a given function
C describing the model.
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 Date: 1996, September 30
C Coded by Ludek Klimes
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
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 Error messages:
C 362... Error in VAR2: Array index out of range:
C Dimension MB of arrays iB, B0, B1, B2 and B3 should be
C increased.
C
C.......................................................................
C
I=NB(MFUNCT)+1
IF(I.GT.MB) THEN
PAUSE 'Error 362 in VAR2: Array index out of range.'
STOP
END IF
NB(MFUNCT)=I
IB(I)=IBI
B0(I)=B0I
B1(I)=B1I
B2(I)=B2I
B3(I)=B3I
RETURN
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
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
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 Error messages:
C 365... Error in VAR5: array index out of range:
C Dimension MB of arrays IB, B0, B1, B2 and B3 should be
C increased.
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
PAUSE 'Error 365 in VAR5: Array index out of range.'
STOP
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
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