1 |
C $Header: /u/gcmpack/MITgcm/pkg/cost/Attic/sw_adtg.F,v 1.1.2.1 2002/04/04 10:58:59 heimbach Exp $ |
2 |
|
3 |
#include "CPP_OPTIONS.h" |
4 |
|
5 |
_RL function SW_ADTG (S,T,P) |
6 |
|
7 |
c ================================================================== |
8 |
c SUBROUTINE SW_ADTG |
9 |
c ================================================================== |
10 |
c |
11 |
c o Calculates adiabatic temperature gradient as per UNESCO 1983 routines. |
12 |
c |
13 |
c started: |
14 |
c |
15 |
c Armin Koehl akoehl@ucsd.edu |
16 |
c |
17 |
c ================================================================== |
18 |
c SUBROUTINE SW_ADTG |
19 |
c ================================================================== |
20 |
|
21 |
implicit none |
22 |
_RL a0,a1,a2,a3,b0,b1,c0,c1,c2,c3,d0,d1,e0,e1,e2 |
23 |
_RL S,T,P |
24 |
_RL sref |
25 |
|
26 |
sref = 35. _d 0 |
27 |
a0 = 3.5803 _d -5 |
28 |
a1 = +8.5258 _d -6 |
29 |
a2 = -6.836 _d -8 |
30 |
a3 = 6.6228 _d -10 |
31 |
|
32 |
b0 = +1.8932 _d -6 |
33 |
b1 = -4.2393 _d -8 |
34 |
|
35 |
c0 = +1.8741 _d -8 |
36 |
c1 = -6.7795 _d -10 |
37 |
c2 = +8.733 _d -12 |
38 |
c3 = -5.4481 _d -14 |
39 |
|
40 |
d0 = -1.1351 _d -10 |
41 |
d1 = 2.7759 _d -12 |
42 |
|
43 |
e0 = -4.6206 _d -13 |
44 |
e1 = +1.8676 _d -14 |
45 |
e2 = -2.1687 _d -16 |
46 |
|
47 |
SW_ADTG = a0 + (a1 + (a2 + a3*T)*T)*T |
48 |
& + (b0 + b1*T)*(S-sref) |
49 |
& + ( (c0 + (c1 + (c2 + c3*T)*T)*T) + (d0 + d1*T)*(S-sref) )*P |
50 |
& + ( e0 + (e1 + e2*T)*T )*P*P |
51 |
end |