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