ADAS Subroutine e5spln
SUBROUTINE E5SPLN( NTRDIM , NTDDIM , & ITRA , ITDA , ITVAL , & AMSRA , AMSDA , RMASS , DMASS , & TFRA , TFDA , TREVA , TDEVA , & QFTCXA , QTCXA , & LTRRNG , LTDRNG & ) C----------------------------------------------------------------------- C C ****************** FORTRAN77 SUBROUTINE: E5SPLN ********************* C C PURPOSE: C PERFORMS CUBIC SPLINE ON LOG(TEMP.) VERSUS LOG(RATE-COEFT) C INPUT DATA FOR A GIVEN DONOR/RECEIVER DATA-BLOCK. C C USING TWO-WAY SPLINES IT CALCULATES THE RATE-COEFFICIENTS C FOR 'ITVAL' PAIRS OF RECEIVER/DONOR TEMPERATURES FROM THE C TWO-DIMENSIONAL TABLE OF RECEIVER/DONOR TEMPERATURES READ C IN FROM THE INPUT FILE. IF A VALUE CANNOT BE INTERPOLATED C USING SPLINES IT IS EXPLICITLY EXTRAPOLATED. C C CALLING PROGRAM: ADAS505/SQTCX C C C SUBROUTINE: C C INPUT : (I*4) NTRDIM = MAX NUMBER OF RECEIVER TEMPERATURES ALLOWED C INPUT : (I*4) NTDDIM = MAX NUMBER OF DONOR TEMPERATURES ALLOWED C C INPUT : (I*4) ITRA = INPUT DATA FILE: NUMBER OF RECEIVER TEMPERA- C TURES READ FOR THE DATA-BLOCK BEING ASSESSED C INPUT : (I*4) ITDA = INPUT DATA FILE: NUMBER OF DONOR TEMPERA- C TURES READ FOR THE DATA-BLOCK BEING ASSESSED C INPUT : (I*4) ITVAL = NUMBER OF ISPF ENTERED RECEIVER/DONOR TEMP- C ERATURE PAIRS FOR WHICH RATE-COEFFICIENTS C ARE REQUIRED FOR TABULAR/GRAPHICAL OUTPUT. C C INPUT : (R*8) AMSRA = INPUT DATA FILE: RECEIVER ATOMIC MASS FOR C THE DATA-BLOCK BEING ASSESSED. C INPUT : (R*8) AMSDA = INPUT DATA FILE: DONOR ATOMIC MASS FOR C THE DATA-BLOCK BEING ASSESSED. C INPUT : (R*8) RMASS = USER ENTERED: RECEIVER ISOTOPIC ATOMIC MASS C INPUT : (R*8) DMASS = USER ENTERED: DONOR ISOTOPIC ATOMIC MASS C C INPUT : (R*8) TFRA() = INPUT DATA FILE: RECEIVER TEMPERATURES (EV) C FOR THE DATA-BLOCK BEING ASSESSED. C DIMENSION: RECEIVER TEMPERATURE INDEX C INPUT : (R*8) TFDA() = INPUT DATA FILE: DONOR TEMPERATURES (EV) C FOR THE DATA-BLOCK BEING ASSESSED. C DIMENSION: DONOR TEMPERATURE INDEX C INPUT : (R*8) TREVA() = USER ENTERED: RECEIVER TEMPERATURES (EV) C DIMENSION: RECEIVER/DONOR TEMP. PAIR INDEX C INPUT : (R*8) TDEVA() = USER ENTERED: DONOR TEMPERATURES (EV) C DIMENSION: RECEIVER/DONOR TEMP. PAIR INDEX C C C INPUT : (R*8) QFTCXA(,)=INPUT DATA FILE: FULL SET OF RATE-COEFFTS. C (UNITS: CM**3/SEC) FOR THE DATA-BLOCK BEING C ANALYSED. C 1ST DIMENSION: DONOR TEMPERATURE INDEX C 2ND DIMENSION: RECEIVER TEMPERATURE INDEX C OUTPUT: (R*8) QTCXA() = SPLINE INTERPOLATED OR EXTRAPOLATED RATE- C COEFFICIENTS FOR THE USER ENTERED RECEIVER/ C DONOR TEMPERATURE PAIRS (UNITS: CM**3/SEC) C DIMENSION: RECEIVER/DONOR TEMP. PAIR INDEX C C OUTPUT: (L*4) LTRRNG()= .TRUE. => OUTPUT 'QTCXA()' VALUE WAS INTER- C POLATED FOR THE USER ENTERED C RECEIVER TEMPERATURE 'TREVA()'. C .FALSE. => OUTPUT 'QTCXA()' VALUE WAS EXTRA- C POLATED FOR THE USER ENTERED C RECEIVER TEMPERATURE 'TREVA()'. C DIMENSION: RECEIVER/DONOR TEMP. PAIR INDEX C C OUTPUT: (L*4) LTDRNG()= .TRUE. => OUTPUT 'QTCXA()' VALUE WAS INTER- C POLATED FOR THE USER ENTERED C DONOR TEMPERATURE 'TDEVA()'. C .FALSE. => OUTPUT 'QTCXA()' VALUE WAS EXTRA- C POLATED FOR THE USER ENTERED C DONOR TEMPERATURE 'TDEVA()'. C C (I*4) NIN = PARAMETER = MAX. NO. OF INPUT TEMPERATURE C VALUES. MUST BE >= 'ITRA'&'ITDA' C (I*4) NOUT = PARAMETER = MAX. NO. OF OUTPUT TEMPERATURE C PAIRS. MUST BE >= 'ITVAL' C (I*4) L1 = PARAMETER = 1 C C (I*4) ITD = ARRAY SUBSCRIPT USED INPUT FILE DONOR C TEMPERATURES. C (I*4) ITR = ARRAY SUBSCRIPT USED INPUT FILE RECEIVER C TEMPERATURES. C (I*4) IT = ARRAY SUBSCRIPT USED FOR USER ENTERED C TEMPERATURE PAIRS . C (I*4) IOPT = DEFINES THE BOUNDARY DERIVATIVES FOR THE C SPLINE ROUTINE 'XXSPLE', SEE 'XXSPLE'. C (VALID VALUES = <0, 0, 1, 2, 3, 4) C C (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 (VALUE SET TO .FALSE. BY 'XXSPLE') C C (R*8) R8FUN1 = FUNCTION - (SEE ROUTINES SECTION BELOW) C (R*8) LOGSFR = LOG( SCALING FACTOR FOR DATA FILE RECEIVER C TEMPERATURES ) C (R*8) LOGSFD = LOG( SCALING FACTOR FOR DATA FILE DONOR C TEMPERATURES ) C (R*8) RMR = RECIPROCAL OF 'RMASS' - USED IN EXTRAPOLATN. C (R*8) DMD = RECIPROCAL OF 'DMASS' - USED IN EXTRAPOLATN. C (R*8) AMR = RECIPROCAL OF 'AMSRA' - USED IN EXTRAPOLATN. C (R*8) AMD = RECIPROCAL OF 'AMSDA' - USED IN EXTRAPOLATN. C (R*8) RDMIN = FACTOR USED IN EXTRAPOLATION OF DONOR C TEMPERATURES BELOW THE MINIMUM DATA VALUE. C (R*8) RDMAX = FACTOR USED IN EXTRAPOLATION OF DONOR C TEMPERATURES ABOVE THE MAXIMUM DATA VALUE. C (R*8) RRMIN = FACTOR USED IN EXTRAPOLATION OF RECEIVER C TEMPERATURES BELOW THE MINIMUM DATA VALUE. C (R*8) RRMAX = FACTOR USED IN EXTRAPOLATION OF RECEIVER C TEMPERATURES ABOVE THE MAXIMUM DATA VALUE. C (R*8) VAL1 = VALUE USED IN EXTRAPOLATION. C (R*8) VAL2 = VALUE USED IN EXTRAPOLATION. C (R*8) COEF1 = COEFFICIENT USED TO CALC. EXTRAPOLTED VALUE C (R*8) COEF2 = COEFFICIENT USED TO CALC. EXTRAPOLTED VALUE C C (R*8) XIN() = 1) LOG( DATA FILE DONOR TEMPERATURES ) C 2) LOG( DATA FILE RECEIVER TEMPERATURES ) C (R*8) YIN() = LOG( DATA FILE RATE-COEFFICIENTS ) C (R*8) XOUT() = 1) LOG( SCALED USER ENTERED DONOR TEMPS.) C 2) LOG( SCALED USER ENTERED RECEIVER TEMPS.) C (R*8) YOUT() = LOG( OUTPUT GENERATED RATE COEFFICIENTS ) C (R*8) YPASS(,)= LOG( RATE COEFFICIENTS ) INTERMEDIATE ARRAY C WHICH STORES INTERPOLATED/EXTRAPOLATED RATE C COEFFICIENT VALUES BEWTEEN THE TWO SPLINE C SECTIONS. C (R*8) DF() = SPLINE INTERPOLATED DERIVATIVES C C C NOTE: C C ROUTINES: C ROUTINE SOURCE BRIEF DESCRIPTION C ------------------------------------------------------------ C XXSPLE ADAS SPLINE SUBROUTINE (EXTENDED DIAGNOSTICS) C R8FUN1 ADAS REAL*8 FUNCTION: ( X -> X ) C C AUTHOR: PAUL E. BRIDEN (TESSELLA SUPPORT SERVICES PLC) C K1/0/81 C JET EXT. 4569 C C DATE: 21/02/91 C C UNIX-IDL PORT: C C AUTHOR: WILLIAM OSBORN (TESSELLA SUPPORT SERVICES PLC) C C DATE: 22TH MARCH 1996 C C VERSION: 1.1 DATE: 22-03-96 C MODIFIED: WILLIAM OSBORN C - FIRST VERSION C C VERSION: 1.2 DATE: 02-03-96 C MODIFIED: WILLIAM OSBORN C PROPER HEADER INFORMATION ADDED C C VERSION: 1.3 DATE: 7-11-97 C MODIFIED: Martin O'Mullane C increased NOUT to 24 C C----------------------------------------------------------------------- C C----------------------------------------------------------------------- INTEGER ITDA, ITRA, ITVAL, NTDDIM INTEGER NTRDIM LOGICAL LTDRNG(ITVAL), LTRRNG(ITVAL) REAL*8 AMSDA, AMSRA, DMASS REAL*8 QFTCXA(NTDDIM,NTRDIM), QTCXA(ITVAL) REAL*8 RMASS, TDEVA(ITVAL) REAL*8 TFDA(ITDA), TFRA(ITRA), TREVA(ITVAL)