1 |
C $Header: /u/gcmpack/MITgcm/pkg/cost/Attic/sw_ptmp.F,v 1.1.2.1 2002/04/04 10:58:59 heimbach Exp $ |
2 |
|
3 |
#include "CPP_OPTIONS.h" |
4 |
|
5 |
|
6 |
_RL function SW_PTMP (S,T,P,PR) |
7 |
|
8 |
c ================================================================== |
9 |
c SUBROUTINE SW_PTMP |
10 |
c ================================================================== |
11 |
c |
12 |
c o Calculates potential temperature as per UNESCO 1983 report. |
13 |
c |
14 |
c started: |
15 |
c |
16 |
c Armin Koehl akoehl@ucsd.edu |
17 |
c |
18 |
c ================================================================== |
19 |
c SUBROUTINE SW_PTMP |
20 |
c ================================================================== |
21 |
C S = salinity [psu (PSS-78) ] |
22 |
C T = temperature [degree C (IPTS-68)] |
23 |
C P = pressure [db] |
24 |
C PR = Reference pressure [db] |
25 |
|
26 |
implicit none |
27 |
|
28 |
c routine arguments |
29 |
_RL S,T,P,PR |
30 |
|
31 |
c local arguments |
32 |
_RL del_P ,del_th, th, q |
33 |
_RL onehalf, two, three |
34 |
parameter ( onehalf = 0.5 _d 0, two = 2. _d 0, three = 3. _d 0 ) |
35 |
|
36 |
c externals |
37 |
_RL sw_adtg |
38 |
external sw_adtg |
39 |
c theta1 |
40 |
del_P = PR - P |
41 |
del_th = del_P*sw_adtg(S,T,P) |
42 |
th = T + onehalf*del_th |
43 |
q = del_th |
44 |
c theta2 |
45 |
del_th = del_P*sw_adtg(S,th,P+onehalf*del_P) |
46 |
|
47 |
th = th + (1 - 1/sqrt(two))*(del_th - q) |
48 |
q = (two-sqrt(two))*del_th + (-two+three/sqrt(two))*q |
49 |
|
50 |
c theta3 |
51 |
del_th = del_P*sw_adtg(S,th,P+onehalf*del_P) |
52 |
th = th + (1 + 1/sqrt(two))*(del_th - q) |
53 |
q = (two + sqrt(two))*del_th + (-two-three/sqrt(two))*q |
54 |
|
55 |
c theta4 |
56 |
del_th = del_P*sw_adtg(S,th,P+del_P) |
57 |
SW_PTMP = th + (del_th - two*q)/(two*three) |
58 |
return |
59 |
end |