*IF DEF,OCEAN @DYALLOC.4440
C ******************************COPYRIGHT****************************** GTS2F400.3079
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.3080
C GTS2F400.3081
C Use, duplication or disclosure of this code is subject to the GTS2F400.3082
C restrictions as set forth in the contract. GTS2F400.3083
C GTS2F400.3084
C Meteorological Office GTS2F400.3085
C London Road GTS2F400.3086
C BRACKNELL GTS2F400.3087
C Berkshire UK GTS2F400.3088
C RG12 2SZ GTS2F400.3089
C GTS2F400.3090
C If no contract has been raised with this copy of the code, the use, GTS2F400.3091
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.3092
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.3093
C Modelling at the above address. GTS2F400.3094
C ******************************COPYRIGHT****************************** GTS2F400.3095
C GTS2F400.3096
CLL======== FUNCTION fnztop =================================== FNZTOP.2
CLL CODED BY : OSCAR ALVES 22/2/93 FNZTOP.3
CLL REVIEWED BY: FNZTOP.4
CLL FNZTOP.5
CLL FUNCTION TO CALCULATE PRESSURE IN DECIBARS FROM DEPTH IN METRES FNZTOP.6
CLL USING AN ITERATIVE INVERSE OF SAUNDERS ALGORITHM (FUNCTION FNZTOP.7
CLL fnztop). ITERATES UNTIL THE ERROR IS ZERO, A LIMIT CYCLE IS FNZTOP.8
CLL DETECTED OR 'MLOOP' ITERATIONS REACHED. FNZTOP.9
CLL ERRROR EXIT IF ERROR > EPS. FNZTOP.10
CLL ARRAy PA USED TO DETECT A LIMIT CYCLE FNZTOP.11
CLL FNZTOP.12
CLL CHECK VALUE: fnztop= 10302.423165 -- CRAY 64 BIT FNZTOP.13
CLL = 10302.4231650052 - IEEE 63 BIT FNZTOP.14
CLL FOR Z=10000.0M,XLAT=30.0 FNZTOP.15
CLL ORH0F400.1
CLL Model Modification history ORH0F400.2
CLL version Date ORH0F400.3
CLL 4.0 05/08/94: N Farnon: Reduce the tightness of the convergence (EPS ORH0F400.4
CLL WARNING! Changing EPS, affects bit comparison!!!! ORH0F400.5
CLL 4.2 15/11/96: S Ineson: Initialise EP (value not important, OSI1F402.1
CLL prevents failure on T3E) OSI1F402.2
CLL ORH0F400.6
CLLEND FNZTOP.16
C*L FNZTOP.17
REAL FUNCTION fnztop(Z,XLAT) 1,1FNZTOP.18
FNZTOP.19
IMPLICIT NONE FNZTOP.20
FNZTOP.21
INTEGER FNZTOP.22
& MLOOP ! MAXIMUM NUMBER OF ITERATONS FNZTOP.23
& ,MCONV ! DIMENSION FNZTOP.24
FNZTOP.25
REAL FNZTOP.26
& EPS ! MAX ERROR ALLOWED FNZTOP.27
FNZTOP.28
PARAMETER (MLOOP=200,MCONV=5,EPS=1.0E-1) ORH0F400.7
FNZTOP.30
C--DEFINE ARGUMENTS FNZTOP.31
REAL FNZTOP.32
& Z ! DEPTH (METRES) FNZTOP.33
& ,XLAT ! LATITUDE (DEGREES) FNZTOP.34
FNZTOP.35
C-- DEFINE LOCAL VARIABLES FNZTOP.36
REAL FNZTOP.37
& P ! PRESSURE FNZTOP.38
& ,ZZ ! DEPTH FNZTOP.39
& ,EE ! TEMPORARY VARIABLE FNZTOP.40
& ,EA ! TEMPORARY VARIABLE FNZTOP.41
& ,EP ! TEMPORARY VARIABLE FNZTOP.42
& ,PA ! TEMPORARY VARIABLE FNZTOP.43
FNZTOP.44
INTEGER FNZTOP.45
& IA ! COUNTER FNZTOP.46
& ,I ! LOOP INDEX FNZTOP.47
& ,J ! LOOP INDEX FNZTOP.48
& ,K ! LOOP INDEX FNZTOP.49
FNZTOP.50
REAL fnptoz ! FUNCTION TO CALCULATE DEPTH AS FUNCTION OF PRESSUR FNZTOP.51
EXTERNAL fnptoz FNZTOP.52
C FNZTOP.53
C FNZTOP.54
C CHECK VALUE fnztop = 10302.423165 - CRAY 64-BIT FNZTOP.55
C = 10302.4231650052 - IEEE 64 BIT FNZTOP.56
C FOR Z=10000M, XLAT=30.0 FNZTOP.57
C FNZTOP.58
DIMENSION PA(MCONV) FNZTOP.59
FNZTOP.60
P = Z FNZTOP.61
IA=0 FNZTOP.62
EP=0.0 OSI1F402.3
FNZTOP.63
DO I=1,MLOOP ORH0F400.8
FNZTOP.65
ZZ=fnptoz
(P,XLAT) FNZTOP.66
FNZTOP.67
C-- ZERRO ERROR FNZTOP.68
FNZTOP.69
IF (Z.EQ.ZZ) GOTO 50 FNZTOP.70
FNZTOP.71
EE = Z - ZZ FNZTOP.72
EA = ABS(EE) FNZTOP.73
FNZTOP.74
C-- SAVE NEW BEST VALUE FNZTOP.75
IF (IA.EQ.0.OR.EA.LT.EP) THEN FNZTOP.76
FNZTOP.77
IA = 1 FNZTOP.78
EP = EA FNZTOP.79
PA(IA) = P FNZTOP.80
FNZTOP.81
C-- LOOP FOR LIMIT CYCLE FNZTOP.82
ELSE IF (EA.EQ.EP) THEN FNZTOP.83
FNZTOP.84
DO J=1,IA FNZTOP.85
IF (P.EQ.PA(J)) GOTO 50 FNZTOP.86
END DO FNZTOP.87
FNZTOP.88
IF (IA.LT.MCONV) THEN FNZTOP.89
IA = IA + 1 FNZTOP.90
PA(IA) = P FNZTOP.91
END IF FNZTOP.92
FNZTOP.93
END IF FNZTOP.94
FNZTOP.95
C CORRECT P AND LOOP FNZTOP.96
FNZTOP.97
P = P+EE FNZTOP.98
FNZTOP.99
END DO FNZTOP.100
FNZTOP.101
IF (EA.GT.EPS) THEN FNZTOP.102
FNZTOP.103
WRITE(6,*)'SUBR fnztop. ITERATION HAS NOT CONVERGED AFTER', GIE0F403.247
& MLOOP,' ITERATIONS' FNZTOP.105
WRITE(6,*)'OBJECT DEPTH =',Z GIE0F403.248
WRITE(6,*)'LATEST P = ',P,' CORRESPONDING Z = ',ZZ GIE0F403.249
WRITE(6,*)'MINIMUM ERROR = ',EA GIE0F403.250
WRITE(6,*)'NUMBER OF CORRESPONDING PS =',IA GIE0F403.251
WRITE(6,*)'PA ARRAY',(PA(K),K=1,IA) GIE0F403.252
STOP FNZTOP.111
FNZTOP.112
END IF FNZTOP.113
FNZTOP.114
P = PA(IA) FNZTOP.115
FNZTOP.116
50 fnztop = P FNZTOP.117
FNZTOP.118
RETURN FNZTOP.119
END FNZTOP.120
*ENDIF @DYALLOC.4441