*IF DEF,OCEAN @DYALLOC.4444
C ******************************COPYRIGHT****************************** GTS2F400.7381
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.7382
C GTS2F400.7383
C Use, duplication or disclosure of this code is subject to the GTS2F400.7384
C restrictions as set forth in the contract. GTS2F400.7385
C GTS2F400.7386
C Meteorological Office GTS2F400.7387
C London Road GTS2F400.7388
C BRACKNELL GTS2F400.7389
C Berkshire UK GTS2F400.7390
C RG12 2SZ GTS2F400.7391
C GTS2F400.7392
C If no contract has been raised with this copy of the code, the use, GTS2F400.7393
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.7394
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.7395
C Modelling at the above address. GTS2F400.7396
C ******************************COPYRIGHT****************************** GTS2F400.7397
C GTS2F400.7398
CLL======== FUNCTION POTTEM ================================= POTTEM.2
CLL CODED BY : OSCAR ALVES 22/2/93 POTTEM.3
CLL REVIEWED BY: POTTEM.4
CLL POTTEM.5
CLL SUBROUTINE TO CALCULATE THE FINAL TEMPERATURE OF WATER MOVED POTTEM.6
CLL ADIABATICALLY FROM AN INITIAL TEMPERATURE TT, SALINITY SS AND POTTEM.7
CLL PRESSURE P0, TO A FINAL PRESSURE P1. POTTEM.8
CLL POTTEM.9
CLL THE INTEGRAL EQUATION IS SOLVED BY DIRECT INTEGRATION WITH A POTTEM.10
CLL PRESSURE INCREMENT DPP - USING BRYDEN EQUATION FOR THE POTTEM.11
CLL ADIABATIC LAPSE RATE (SUBROUTINE ATG). POTTEM.12
CLL POTTEM.13
CLL T=INITIAL TEMPERATURE IN DEG C (IPTS-68) POTTEM.14
CLL S=SALINITY IN NSU POTTEM.15
CLL P0=INITIAL PRESSURE IN DECIBARS POTTEM.16
CLL P1=FINAL PRESSURE IN DECIBARS POTTEM.17
CLL DPP=PRESSURE STEP POTTEM.18
CLL POTTEM=FINAL TEMPERATURE IN DEG C POTTEM.19
CLL POTTEM.20
CLL PRESSURES ARE "OCEANOGRAPHIC" PRESSURES, EQUAL TO ABSOLUTE POTTEM.21
CLL PRESSURE MINUS ONE ATMOSPHERE POTTEM.22
CLL POTTEM.23
CLL TESTS WITH DPP VALUES RANGING FROM 1 TO 128 DECIBARS SHOWED POTTEM.24
CLL THE MOST ACCURATE RESULTS WERE OBTAINED WITH DPP EQUAL TO 1 POTTEM.25
CLL POTTEM.26
CLL CHECK VALUE: POTTEM = 43.26663196648 - CARY 64 BIT POTTEM.27
CLL = 43.266631967051 - IEEE 64 BIT POTTEM.28
CLL FOR: T=40.0, S=40.0, P0=0.0, P1=10000.0, DPP=1.0 POTTEM.29
CLLEND POTTEM.30
C*L POTTEM.31
REAL FUNCTION POTTEM (TT,SS,P0,P1,DPP) 1,2POTTEM.32
POTTEM.33
IMPLICIT NONE POTTEM.34
POTTEM.35
C-- DEFINE ARGUMENTS POTTEM.36
REAL POTTEM.37
& TT ! TEMPERATURE (DEG C) POTTEM.38
& ,SS ! SALINITY (PSU) POTTEM.39
& ,P0 ! INITIAL PRESSURE (DECIBARS) POTTEM.40
& ,P1 ! FINAL PRESSURE (DECIBARS) POTTEM.41
& ,DPP ! PRESSURE STEP FROM P0 TO P1 (DECIBARS) POTTEM.42
POTTEM.43
C-- DEFINE LOCAL VARIABLES POTTEM.44
REAL POTTEM.45
& P ! PRESSURE POTTEM.46
& ,T ! TEMPERATURE POTTEM.47
& ,TB ! TEMPORARY VARIABLE POTTEM.48
& ,TA ! TEMPORARY VARIABLE POTTEM.49
& ,TEST ! ERROR TESTER POTTEM.50
& ,DP ! PRESSURE STEP POTTEM.51
POTTEM.52
REAL ATG !FUNCTION FOR ADIABATIC LAPSE RATE POTTEM.53
EXTERNAL ATG POTTEM.54
C POTTEM.55
POTTEM.56
IF (P0.LT.0.0E0.OR.P0.GT.20000.0E0 POTTEM.57
& .OR.P1.LT.0.0E0.OR.P1.GT.20000.0E0) THEN POTTEM.58
POTTEM.59
WRITE(6,*)'SUBROUTINE POTTEM STOPPING - PRESSURE OUT OF RANGE' GIE0F403.474
WRITE(6,*)'PRESSURES P0 AND P1 = ',P0,P1 GIE0F403.475
WRITE(6,*)'ALLOWED RANGE IS 0.0 - 20,000' GIE0F403.476
STOP POTTEM.63
END IF POTTEM.64
POTTEM.65
DP=SIGN(DPP,P1-P0) POTTEM.66
P=P0 POTTEM.67
T=TT POTTEM.68
TB=T-ATG
(P0,T,SS)*DP POTTEM.69
POTTEM.70
10 TA=TB+2.0E0*ATG(P,T,SS)*DP POTTEM.71
P= P+DP POTTEM.72
TB=T POTTEM.73
T=TA POTTEM.74
TEST=(P-P1)*(P-DP-P1) POTTEM.75
POTTEM.76
IF (TEST.GT.0.0) GOTO 10 POTTEM.77
POTTEM.78
POTTEM = ((P1-P+DP)*T+(P-P1)*TB)/DP POTTEM.79
POTTEM.80
RETURN POTTEM.81
END POTTEM.82
*ENDIF @DYALLOC.4445