*IF DEF,C93_1A,OR,DEF,C93_2A GNF0F402.22
C ******************************COPYRIGHT****************************** GTS2F400.9415
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9416
C GTS2F400.9417
C Use, duplication or disclosure of this code is subject to the GTS2F400.9418
C restrictions as set forth in the contract. GTS2F400.9419
C GTS2F400.9420
C Meteorological Office GTS2F400.9421
C London Road GTS2F400.9422
C BRACKNELL GTS2F400.9423
C Berkshire UK GTS2F400.9424
C RG12 2SZ GTS2F400.9425
C GTS2F400.9426
C If no contract has been raised with this copy of the code, the use, GTS2F400.9427
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9428
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9429
C Modelling at the above address. GTS2F400.9430
C ******************************COPYRIGHT****************************** GTS2F400.9431
C GTS2F400.9432
CLL SUBROUTINE SPLINE-------------------------------------------------- SPLINE1A.3
CLL SPLINE1A.4
CLL PURPOSE: To fit a cubic spline to vertical data profiles. SPLINE1A.5
CLL Outputs the second derivative at the input data points. SPLINE1A.6
CLL To evaluate the spline and its first two derivatives at SPLINE1A.7
CLL a particular point call subroutine EVAL_SP. SPLINE1A.8
CLL Tested under compiler CFT77 SPLINE1A.9
CLL Tested under OS version 5.1 SPLINE1A.10
CLL SPLINE1A.11
CLL Author J.T.Heming SPLINE1A.12
CLL SPLINE1A.13
CLL Model Modification history from model version 3.0: SPLINE1A.14
CLL version date SPLINE1A.15
CLL vn4.2 07/11/96:Allow this routine to be used in C93_2A (Farnon) GNF0F402.21
CLL SPLINE1A.16
CLL Logical components covered: D413 SPLINE1A.17
CLL SPLINE1A.18
CLL Project TASK: SPLINE1A.19
CLL SPLINE1A.20
CLL Programming standard: U M DOC Paper NO. 4, SPLINE1A.21
CLL SPLINE1A.22
CLL External documentation SPLINE1A.23
CLL SPLINE1A.24
CLLEND------------------------------------------------------------------ SPLINE1A.25
C SPLINE1A.26
C*L ARGUMENTS:--------------------------------------------------------- SPLINE1A.27
SUBROUTINE SPLINE( 3SPLINE1A.28
C data in SPLINE1A.29
& X,Y,H_POINTS,V_POINTS, SPLINE1A.30
C data out SPLINE1A.31
& AMU) SPLINE1A.32
C*L SPLINE1A.33
C----------------------------------------------------------------------- SPLINE1A.34
IMPLICIT NONE SPLINE1A.35
C*---------------------------------------------------------------------- SPLINE1A.36
INTEGER SPLINE1A.37
* H_POINTS ! The number of sets of data for which splines to be SPLINE1A.38
* ! calculated SPLINE1A.39
*,V_POINTS ! The number of points at which each spline is to be SPLINE1A.40
* ! evaluated SPLINE1A.41
C----------------------------------------------------------------------- SPLINE1A.42
REAL SPLINE1A.43
* X(V_POINTS) ! Indendent variable array - n.b. assumes that x- SPLINE1A.44
* ! profile is the same for all H_POINTS on a V_POINT SPLINE1A.45
*,Y(H_POINTS,V_POINTS) ! Dependent variable array SPLINE1A.46
*,AMU(H_POINTS,V_POINTS) ! Output array of second derivative SPLINE1A.47
C* SPLINE1A.48
C*L SPLINE1A.49
C----------------------------------------------------------------------- SPLINE1A.50
C Local Variables SPLINE1A.51
C----------------------------------------------------------------------- SPLINE1A.52
INTEGER SPLINE1A.53
* I,K ! Loop counters SPLINE1A.54
C----------------------------------------------------------------------- SPLINE1A.55
REAL SPLINE1A.56
* H(V_POINTS) SPLINE1A.57
*,RH(V_POINTS) SPLINE1A.58
*,A(V_POINTS) SPLINE1A.59
*,RB SPLINE1A.60
*,WORK1(H_POINTS) SPLINE1A.61
*,WORK2(H_POINTS) SPLINE1A.62
C----------------------------------------------------------------------- SPLINE1A.63
CL Initialise top and bottom values of AMU SPLINE1A.64
C----------------------------------------------------------------------- SPLINE1A.65
DO I=1,H_POINTS SPLINE1A.66
AMU(I,1)=0.0 SPLINE1A.67
AMU(I,V_POINTS)=0.0 SPLINE1A.68
ENDDO SPLINE1A.69
C----------------------------------------------------------------------- SPLINE1A.70
CL Calculate the difference between adjacent linear first derivatives SPLINE1A.71
C----------------------------------------------------------------------- SPLINE1A.72
DO K=1,V_POINTS-1 SPLINE1A.73
H(K)=X(K+1)-X(K) SPLINE1A.74
RH(K)=1.0/H(K) SPLINE1A.75
DO I=1,H_POINTS SPLINE1A.76
WORK1(I)=(Y(I,K+1)-Y(I,K))*6.0*RH(K) SPLINE1A.77
ENDDO SPLINE1A.78
IF(K.GT.1)THEN SPLINE1A.79
DO I=1,H_POINTS SPLINE1A.80
AMU(I,K)=WORK1(I)-WORK2(I) SPLINE1A.81
ENDDO SPLINE1A.82
ENDIF SPLINE1A.83
DO I=1,H_POINTS SPLINE1A.84
WORK2(I)=WORK1(I) SPLINE1A.85
ENDDO SPLINE1A.86
ENDDO SPLINE1A.87
C----------------------------------------------------------------------- SPLINE1A.88
H(V_POINTS)=0.0 SPLINE1A.89
RH(V_POINTS)=0.0 SPLINE1A.90
A(2)=0.5 SPLINE1A.91
DO K=2,V_POINTS SPLINE1A.92
IF(K.GT.2)THEN SPLINE1A.93
A(K)=H(K-1)*RB*RH(K-2) SPLINE1A.94
ENDIF SPLINE1A.95
RB=1.0/(2.0*(H(K-1)+H(K))*RH(K-1)-A(K)) SPLINE1A.96
DO I=1,H_POINTS SPLINE1A.97
AMU(I,K)=RH(K)*AMU(I,K) SPLINE1A.98
ENDDO SPLINE1A.99
DO I=1,H_POINTS SPLINE1A.100
AMU(I,K)=RB*(AMU(I,K)-AMU(I,K-1)) SPLINE1A.101
ENDDO SPLINE1A.102
ENDDO SPLINE1A.103
C----------------------------------------------------------------------- SPLINE1A.104
CL Calculate second derivatives at all but top level SPLINE1A.105
C----------------------------------------------------------------------- SPLINE1A.106
CL *** Following loop labelled to workaround fmp mistranslation SPLINE1A.107
C SPLINE1A.108
DO 100 K=1,V_POINTS-1 SPLINE1A.109
DO I=1,H_POINTS SPLINE1A.110
AMU(I,V_POINTS-K)=AMU(I,V_POINTS-K)-(A(V_POINTS-K+1)* SPLINE1A.111
* AMU(I,V_POINTS-K+1)) SPLINE1A.112
ENDDO SPLINE1A.113
100 CONTINUE SPLINE1A.114
C======================================================================= SPLINE1A.115
C END OF SUBROUTINE SPLINE SPLINE1A.116
C======================================================================= SPLINE1A.117
RETURN SPLINE1A.118
END SPLINE1A.119
C======================================================================= SPLINE1A.120
*ENDIF SPLINE1A.121