ADAS Subroutine xxsplf
SUBROUTINE XXSPLF( LSETX , LSETY , IOPT , FINTX ,
& NIN , XIN , YIN ,
& NOUT , XOUT , YOUT ,
& X , DY ,
& Q , D1 , D2 , D3 ,
& LINTRP
& )
C-----------------------------------------------------------------------
C
C ****************** FORTRAN77 SUBROUTINE: XXSPLF *********************
C
C PURPOSE: TO INTERPOLATE/EXTRAPOLATE USING CUBIC SPLINES
C
C (IF IOPT < 0 NO EXTRAPOLATION TAKES PLACE = VALUES
C SET TO ZERO).- LOGICAL ARRAY 'LINTRP()' SPECIFIES
C WHETHER OUTPUT SPLINE IS INTERPOLATED '.TRUE.' OR
C EXTRAPOLATED '.FALSE.'.
C
C (AS FOR 'XXSPLN' EXCEPT 'LINTRP' ARGUMENT ADDED).
C (AS FOR 'XXSPLE' EXCEPT WITH OPTION TO USE
C PREVIOUSLY CALCULATED SPLINE DERIVATIVES)
C
C CALLING PROGRAMS: GENERAL USE
C
C SUBROUTINE:
C
C I/O : (L*4) LSETX = .TRUE. => SET UP SPLINE PARAMETERS RELATING
C TO 'XIN' AXIS.
C .FALSE. => DO NOT SET UP SPLINE PARAMETERS
C RELATING TO 'XIN' AXIS.
C (I.E. THEY WERE SET IN A PREVIOUS
C CALL )
C ( 'LSETX' IS ALWAYS RETURN AS '.FALSE.' ON
C RETURN FROM THE SUBROUTINE ).
C ** IMPORTANT: SEE NOTES BELOW ON 'LSETX' **
C I/O : (L*4) LSETY = .TRUE. => CALCULATE SPLINE DERIVATIVES
C RELATING TO 'YIN' AXIS.
C .FALSE. => DO NOT SET UP SPLINE DERIVATIVES
C RELATING TO 'YIN' AXIS.
C (I.E. THEY WERE SET IN A PREVIOUS
C CALL )
C ( 'LSETY' IS ALWAYS RETURN AS '.FALSE.' ON
C RETURN FROM THE SUBROUTINE ).
C ** IMPORTANT: SEE NOTES BELOW ON 'LSETY' **
C INPUT : (I*4) IOPT = SPLINE END CONDITIONS/EXTRAPOLATION CONTROL
C SWITCH - SEE NOTES BELOW
C I.E. DEFINES THE BOUNDARY DERIVATIVES.
C (VALID VALUES = 0, 1, 2, 3, 4)
C IF IOPT < 0 THEN NO EXTRAPOLATION TAKES
C - ANY VALUES REQUIRING EXTRAPOLATION WILL BE
C SET TO ZERO (END CONDITIONS AS FOR IOPT=0)
C INPUT : (R*8) FINTX = INTERPOLATING X-COORDINATE TRANSFORMATION.
C EXTERNAL FUNCTION (SEE ROUTINES BELOW)
C
C INPUT : (I*4) NIN = NUMBER OF KNOTS
C INPUT : (R*8) XIN() = X-VALUES OF KNOTS
C INPUT : (R*8) YIN() = Y-VALUES OF KNOTS
C
C INPUT : (I*4) NOUT = NUMBER OF OUTPUT VALUES TO BE INTERPOLATED
C EXTRAPOLATED.
C INPUT : (R*8) XOUT() = X-VALUES AT WHICH INTERPOLATION/EXTRAPOLA-
C TION REQUIRED
C OUTPUT: (R*8) YOUT() = INTERPOLATED/EXTRAPOLATED Y-VALUES FOR
C REQUESTED 'XOUT()' VALUES.
C
C I/O : (R*8) X() = TRANSFORMED VALUES OF 'XIN()'. (ARRAY SIZE:
C NIN) REQUIRED INPUT IF LSETX IS .FALSE.
C I/O : (R*8) DY() = DERIVATIVES AT INPUT KNOTS. REQUIRED INPUT
C IF LSETY IS .FALSE.
C I/O : (R*8) Q() = SECOND DERIVATIVE FOR KNOT. REQUIRED INPUT
C IF LSETX IS .FALSE. AND LSETY IS .TRUE.
C I/O : (R*8) D1() = MULTIPLICATION FACTOR USED IN CALCULATING
C 'U()'. REQUIRED INPUT IF LSETX IS .FALSE.
C AND LSETY IS .TRUE.
C I/O : (R*8) D2() = MULTIPLICATION FACTOR USED IN CALCULATING
C 'U()'. REQUIRED INPUT IF LSETX IS .FALSE.
C AND LSETY IS .TRUE.
C I/O : (R*8) D3() = MULTIPLICATION FACTOR USED IN CALCULATING
C 'U()'. REQUIRED INPUT IF LSETX IS .FALSE.
C AND LSETY IS .TRUE.
C
C OUTPUT: (L*4) LINTRP()= .TRUE. => 'YOUT()' VALUE INTERPOLATED.
C .FALSE. => 'YOUT()' VALUE EXTRAPOLATED.
C (ARRAY SIZE: NOUT)
C
C (I*4) NKNOTS = PARAMETER = MAXIMUM NUMBER OF KNOTS ALLOWED
C (I*4) NIOPT = PARAMETER = MAXIMUM VALUE OF IOPT ALLOWED
C
C (I*4) I = GENERAL ARRAY USE
C (I*4) K = INDEX OF 'XOUT()' VALUE FOR INTERPOLATION/
C EXTRAPOLATION.
C (I*4) NIN0 = 'NIN' - 1
C (I*4) INTER = INDEX OF CLOSEST/NEXT HIGHEST VALUE OF
C 'XIN()' TO THE VALUE OF 'XOUT()' BEING
C INTERPOLATED/EXTRAPOLATED. WHEN LOOPING
C OVER MULTIPLE YOUT EVALUATIONS, THE INDEX
C OF THE LAST EVALUATION IS USED AS THE
C INITIAL GUESS FOR THE NEXT.
C (I*4) NOPT = VALUE OF 'IOPT' USED IN CALCULATING END-
C CONDITIONS FOR STORED 'X-VALUE' SPLINE
C PARAMETERS. (NOTE: IF 'IOPT < 0', THEN
C 'NOPT = 0'.) - I.E. 'NOPT = MAX( 0, IOPT )'.
C
C (R*8) XK = VALUE OF 'XOUT(K)' BEING INTERPOLATED/
C EXTRAPOLATED
C (R*8) XKK = TRANSFORMED VALUE OF 'XOUT(K)' BEING
C INTERPOLATED/EXTRAPOLATED.
C (R*8) T1 = INVERSE OF SEPARATION OF KNOTS EITHER
C SIDE OF CURRENT KNOT.
C (R*8) T2 = (CURRENT KNOT POSITION TO NEXT HIGHEST KNOT
C POSITION) DIVIDED BY 'T1'
C (R*8) T3 = (CURRENT KNOT POSITION TO NEXT LOWEST KNOT
C POSITION) DIVIDED BY 'T1'
C (R*8) T4 = INTERPOLATION FACTOR FOR CURRENT KNOT
C (R*8) DL1 = (REQUESTED 'XOUT()' VALUE TO NEXT HIGHEST
C KNOT POSITION) DIVIDED BY SEPARATION OF
C KNOTS EITHER SIDE OF 'XOUT(K)'.
C (R*8) DL2 = (REQUESTED 'XOUT()' VALUE TO NEXT LOWEST
C KNOT POSITION) DIVIDED BY SEPARATION OF
C KNOTS EITHER SIDE OF 'XOUT(K)'.
C (R*8) DL2 = (REQUESTED 'XOUT()' VALUE TO NEXT LOWEST
C (R*8) DL3 = SEPARATION OF KNOTS EITHER SIDE OF
C 'XOUT(K)' * 'DL1' * 'DL2'.
C
C (L*4) LEXTRP = .TRUE. => 'EXTRAPOLATION SWITCHED ON'.
C .FALSE. => 'EXTRAPOLATION SWITCHED OFF'.
C
C (R*8) QVAL() = VALUE OF 'Q(1)' : FUNCTION OF 'NOPT'
C (R*8) D2VAL() = VALUE OF 'D2(1)' : FUNCTION OF 'NOPT'
C (R*8) D3VAL() = VALUE OF 'D3(1)' : FUNCTION OF 'NOPT'
C (R*8) UVAL() = VALUE OF 'U(NIN)' : FUNCTION OF 'NOPT'
C (R*8) AGRL() = POLYNOMIAL CONSTANTS FOR CUBIC SPLINE FOR
C GIVEN 'XOUT(K)' VALUE.
C (R*8) H() = SEPARATION, ALONG X-AXIS, OF KNOT FROM NEXT
C HIGHEST KNOT.
C (R*8) HINTER = SEPARATION, ALONG X-AXIS, IN INTERVAL FOR
C INTERPOLATION
C (R*8) U() = TEMPORARY STORAGE OF DECOMPOSED FACTORS
C (R*8) DELY() = SEPARATION, ALONG Y-AXIS, OF KNOT FROM NEXT
C HIGHEST KNOT.
C
C (L*4) LUVAL()= .TRUE. => VALUE OF 'UVAL()' REFERS TO RATE
C OF CHANGE OF SLOPE AT FINAL POINT.
C .FALSE.=> VALUE OF 'UVAL()' REFERS TO FINAL
C SLOPE
C FUNCTION OF 'NOPT'
C
C NOTES: 'LSETX': SET TO .TRUE. ON ENTRY IF A NEW 'XIN' ARRAY IS BEING
C USED. IF THE 'XIN' AXIS IS THE SAME FOR A NUMBER OF
C CALLS THEN DO NOT RESET 'LSETX' - THIS SUBROUTINE
C SETS IT TO .FALSE. FOR YOU. IF THE VALUE OF 'NOPT'
C IS CHANGED BETWEEN CALLS THEN THE VALUE OF 'LSETX'
C ON ENTRY IS TAKEN AS BEING EQUAL TO .TRUE. NOPT IS
C INITIALISED TO -1 SO THAT LSETX WILL BE SET .TRUE.
C ON THE FIRST CALL OF THIS SUBROUTINE.
C
C THEREFORE 'LSETX' NEED ONLY BE SET TO .TRUE. ON ENTRY
C IF ANY ONE OF THE FOLLOWING VALUES HAS CHANGED:
C
C 'NIN' , 'FINTX' , 'XIN(I), I=1,NIN'
C
C 'LSETY': SET TO .TRUE. ON ENTRY IF A NEW 'YIN' ARRAY IS BEING
C USED. IF THE 'YIN' AXIS IS THE SAME FOR A NUMBER OF
C CALLS THEN DO NOT RESET 'LSETY' - THIS SUBROUTINE
C SETS IT TO .FALSE. FOR YOU. IF LSETX IS .TRUE.,
C EITHER ON ENTRY OR BECAUSE THE ROUTINE RESETS IT
C (SEE ABOVE) THEN LSETY IS ALSO SET TO .TRUE.
C
C THEREFORE 'LSETY' NEED ONLY BE SET TO .TRUE. ON ENTRY
C IF YIN HAS CHANGED WHILE THE 'X' VALUES HAVE NOT.
C
C CARE: VARIABLES MUST BE USED FOR 'LSETX' AND 'LSETY',
C A CONSTANT, I.E. .TRUE. , CANNOT BE DIRECTLY
C TYPED AS AN ARGUMENT BECAUSE IT WILL BE CHANGED
C TO .FALSE. ON RETURN.
C
C SPLINE END CONDITIONS AND EXTRAPOLATION DEPEND ON 'IOPT' AS
C FOLLOWS:
C
C --------------------------------------------------------------
C | IOPT | NOPT | DY(1) DDY(1) | DY(N) DDY(N) |EXTRAP'N|
C |-------|------|-----------------|------------------|--------|
C | < 0 | 0 | - 0.0 | - 0.0 | NO |
C | 0 | 0 | - 0.0 | - 0.0 | YES |
C | 1 | 1 | - 0.0 | -1.5 - | YES |
C | 2 | 2 | 0.0 - | 1.0 - | YES |
C | 3 | 3 | -0.5 - | -1.5 - | YES |
C | 4 | 4 | 0.0 - | - 0.0 | YES |
C | 5 | 5 | -4.5 - | -1.5 - | YES |
C | 6 | 6 | +0.5 - | - 0.0 | YES |
C | 7 | 7 | -3.5 - | - 0.0 | YES |
C --------------------------------------------------------------
C
C NB. OPTIONS TO BE EXTENDED FOR POWER AND CX APPLICATION
C
C -------------------------------------------------------------
C IF ( IOPT.LT.0 ) - NO EXTRAPOLATION TAKES PLACE VALUES SET
C TO ZERO (CARE IF LOG OF OUTPUT IS NEEDED).
C IF ( IOPT.GT.7 ) PROGRAM STOPS
C -------------------------------------------------------------
C
C THIS SUBROUTINE IS AN AMENDED AND STRUCTURED VERSION OF THE
C SUBROUTINE 'ESPLINE' WRITTEN BY H.P. SUMMERS, JET 26TH
C OCTOBER 1989. IT REMOVES THE COMMON BLOCK /IONSPL/ , THE
C SWITCHES 'ISW & ISW2' AND ALSO THE CASE FOR THE INTERPOLATION
C OF CHARGE STATE VALUES. IT INTRODUCES THE FEATURE THAT AN
C ARRAY OF INPUT 'X-VALUES' CAN BE INTERPOLATED/EXTRAPOLATED
C IN ONE CALL.
C
C ROUTINES:
C ROUTINE SOURCE BRIEF DESCRIPTION
C ------------------------------------------------------------
C FINTX ------ EXTERNAL REAL*8 FUNCTION, USED TO
C TRANSFORM X-COORDINATES.
C XXHUNT ------ SEARCH ROUTINE FOR FINDING INTERVAL
C CONTAINING A PRESCRIBED VALUE IN A
C MONOTONIC VECTOR. INITIAL GUESSES ARE
C USED TO SPEED THE SEARCH.
C
C
C AUTHOR: LORNE D. HORTON (IPP GARCHING)
C L5.213
C IPP EXT. 1635
C DATE: 18/03/03
C
C-----------------------------------------------------------------------
C Notes: AS FOR 'XXSPLE' BUT WITH 'LSETY' ADDED TO ALLOW
C EXTERNAL SAVING OF SPLINE COEFFICIENTS (FOR
C EXAMPLE, WHEN IT IS NECESSARY TO HOLD MORE THAN
C ONE SPLINE RESULT AT A TIME). IN ADDDITION, A
C HUNT ALGORITHM 'XXHUNT' FOR SPEEDING EVALUATION
C HAS BEEN ADDED.
C
C
C XXSPLE COMMENTS
C
C AUTHOR: PAUL E. BRIDEN (TESSELLA SUPPORT SERVICES PLC)
C K1/0/81
C JET EXT. 4569
C
C DATE: 14/01/91 - ADAS91: AS FOR 'XXSPLN' BUT WITH 'LINTRP()' ADDED
C
C VERSION: 1.2
C
C MODIFIED: LORNE HORTON (JET) DATE: 25/10/97
C - ADDED IOPT CHOICES 5, 6 AND 7
C
C VERSION: 1.3
C
C MODIFIED: Martin O'Mullane (JET) DATE: 2/6/99
C - SAVE nin0 and inter variables also. All compilers, ie
C especially g77, do not automatically save (or initialise
C variables to zero).
C
C-----------------------------------------------------------------------
C
C VERSION : 1.1
C DATE : 18-03-2003
C MODIFIED : Lorne Horton
C - First version.
C
C VERSION : 1.2
C DATE : 10-04-2007
C MODIFIED : Allan Whiteford
C - Modified documentation as part of automated
C subroutine documentation preparation.
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C
C-----------------------------------------------------------------------
INTEGER IOPT, NIN, NOUT
LOGICAL LINTRP(NOUT), LSETX, LSETY
REAL*8 D1(NIN), D2(NIN), D3(NIN), DY(NIN)
REAL*8 Q(NIN), X(NIN), XIN(NIN)
REAL*8 XOUT(NOUT), YIN(NIN), YOUT(NOUT)