model/src/seawater.F

C $Header: /u/gcmpack/MITgcm/model/src/seawater.F,v 1.10 2015/02/15 16:47:32 mlosch Exp $
C $Name:  $

#include "CPP_OPTIONS.h"

C--  File seawater.F: routines that compute quantities related to seawater.
C--   Contents
C     Seawater (SW) librabry routines
C--   o SW_PTMP: function to compute potential temperature
C--   o SW_TEMP: function to compute in-situ temperature from pot. temp.
C--   o SW_ADTG: function to compute adiabatic temperature gradient
C--              (used by both SW_PTMP & SW_TEMP)

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

CBOP
C     !ROUTINE: SW_PTMP
C     !INTERFACE:
      _RL FUNCTION SW_PTMP  (S,T,P,PR)

C     !DESCRIPTION: \bv
C     *=============================================================*
C     | S/R  SW_PTMP
C     | o compute potential temperature as per UNESCO 1983 report.
C     *=============================================================*
C
C     started:
C              Armin Koehl akoehl@ucsd.edu
C
C     ==================================================================
C     SUBROUTINE SW_PTMP
C     ==================================================================
C     S  :: salinity    [psu      (PSS-78) ]
C     T  :: temperature [degree C (IPTS-68)]
C     P  :: pressure    [db]
C     PR :: Reference pressure  [db]
C     \ev

C     !USES:
      IMPLICIT NONE

C     !INPUT/OUTPUT PARAMETERS:
      _RL S,T,P,PR

C     !FUNCTIONS:
      _RL sw_adtg
      EXTERNAL sw_adtg

C     !LOCAL VARIABLES
      _RL del_P ,del_th, th, q
      _RL onehalf, two, three
      PARAMETER ( onehalf = 0.5 _d 0, two = 2. _d 0, three = 3. _d 0 )
CEOP

C theta1
      del_P  = PR - P
      del_th = del_P*sw_adtg(S,T,P)
      th     = T + onehalf*del_th
      q      = del_th
C theta2
      del_th = del_P*sw_adtg(S,th,P+onehalf*del_P)

      th     = th + (1 - 1/sqrt(two))*(del_th - q)
      q      = (two-sqrt(two))*del_th + (-two+three/sqrt(two))*q

C theta3
      del_th = del_P*sw_adtg(S,th,P+onehalf*del_P)
      th     = th + (1 + 1/sqrt(two))*(del_th - q)
      q      = (two + sqrt(two))*del_th + (-two-three/sqrt(two))*q

C theta4
      del_th = del_P*sw_adtg(S,th,P+del_P)
      SW_PTMP     = th + (del_th - two*q)/(two*three)

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

CBOP
C     !ROUTINE: SW_TEMP
C     !INTERFACE:
      _RL FUNCTION SW_TEMP( S, T, P, PR )
C     !DESCRIPTION: \bv
C     *=============================================================*
C     | S/R  SW_TEMP
C     | o compute in-situ temperature from potential temperature
C     *=============================================================*
C
C     REFERENCES:
C     Fofonoff, P. and Millard, R.C. Jr
C     Unesco 1983. Algorithms for computation of fundamental properties of
C     seawater, 1983. _Unesco Tech. Pap. in Mar. Sci._, No. 44, 53 pp.
C     Eqn.(31) p.39
C
C     Bryden, H. 1973.
C     New Polynomials for thermal expansion, adiabatic temperature gradient
C     and potential temperature of sea water.
C     DEEP-SEA RES., 1973, Vol20,401-408.
C     \ev

C     !USES:
      IMPLICIT NONE
C     === Global variables ===

C     !INPUT/OUTPUT PARAMETERS:
C     === Routine arguments ===
C     S      :: salinity
C     T      :: potential temperature
C     P      :: pressure
C     PR     :: reference pressure
      _RL  S, T, P, PR
CEOP

C     !FUNCTIONS:
      _RL sw_ptmp
      EXTERNAL sw_ptmp

      SW_temp = SW_PTMP (S,T,PR,P)

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

CBOP
C     !ROUTINE: SW_ADTG
C     !INTERFACE:
      _RL FUNCTION SW_ADTG  (S,T,P)

C     !DESCRIPTION: \bv
C     *=============================================================*
C     | S/R  SW_ADTG
C     | o compute adiabatic temperature gradient as per UNESCO 1983 routines.
C     *=============================================================*
C
C     started:
C              Armin Koehl akoehl@ucsd.edu
C     \ev

C     !USES:
      IMPLICIT NONE

C     !INPUT/OUTPUT PARAMETERS:
      _RL S,T,P

C     !LOCAL VARIABLES:
      _RL a0,a1,a2,a3,b0,b1,c0,c1,c2,c3,d0,d1,e0,e1,e2
      _RL sref
CEOP

      sref = 35. _d 0
      a0 =  3.5803 _d -5
      a1 = +8.5258 _d -6
      a2 = -6.836 _d -8
      a3 =  6.6228 _d -10

      b0 = +1.8932 _d -6
      b1 = -4.2393 _d -8

      c0 = +1.8741 _d -8
      c1 = -6.7795 _d -10
      c2 = +8.733 _d -12
      c3 = -5.4481 _d -14

      d0 = -1.1351 _d -10
      d1 =  2.7759 _d -12

      e0 = -4.6206 _d -13
      e1 = +1.8676 _d -14
      e2 = -2.1687 _d -16

      SW_ADTG =      a0 + (a1 + (a2 + a3*T)*T)*T
     &     + (b0 + b1*T)*(S-sref)
     &     + ( (c0 + (c1 + (c2 + c3*T)*T)*T) + (d0 + d1*T)*(S-sref) )*P
     &     + (  e0 + (e1 + e2*T)*T )*P*P

      RETURN
      END
1	mlosch	1.11	C $Header: /u/gcmpack/MITgcm/model/src/seawater.F,v 1.10 2015/02/15 16:47:32 mlosch Exp $
2	ce107	1.4	C $Name: $
3	mlosch	1.1
4			#include "CPP_OPTIONS.h"
5	jmc	1.2
6			C-- File seawater.F: routines that compute quantities related to seawater.
7			C-- Contents
8	mlosch	1.11	C Seawater (SW) librabry routines
9	jmc	1.2	C-- o SW_PTMP: function to compute potential temperature
10	jmc	1.5	C-- o SW_TEMP: function to compute in-situ temperature from pot. temp.
11			C-- o SW_ADTG: function to compute adiabatic temperature gradient
12			C-- (used by both SW_PTMP & SW_TEMP)
13
14			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
15
16			CBOP
17			C !ROUTINE: SW_PTMP
18			C !INTERFACE:
19			_RL FUNCTION SW_PTMP (S,T,P,PR)
20	mlosch	1.1
21			C !DESCRIPTION: \bv
22	jmc	1.5	C =============================================================
23			C \| S/R SW_PTMP
24			C \| o compute potential temperature as per UNESCO 1983 report.
25			C =============================================================
26			C
27			C started:
28			C Armin Koehl akoehl@ucsd.edu
29			C
30			C ==================================================================
31			C SUBROUTINE SW_PTMP
32			C ==================================================================
33			C S :: salinity [psu (PSS-78) ]
34			C T :: temperature [degree C (IPTS-68)]
35			C P :: pressure [db]
36			C PR :: Reference pressure [db]
37	mlosch	1.11	C \ev
38	mlosch	1.1
39			C !USES:
40			IMPLICIT NONE
41
42			C !INPUT/OUTPUT PARAMETERS:
43	jmc	1.5	_RL S,T,P,PR
44	mlosch	1.1
45	jmc	1.5	C !FUNCTIONS:
46			_RL sw_adtg
47			EXTERNAL sw_adtg
48	mlosch	1.1
49	jmc	1.5	C !LOCAL VARIABLES
50	mlosch	1.1	_RL del_P ,del_th, th, q
51			_RL onehalf, two, three
52	jmc	1.5	PARAMETER ( onehalf = 0.5 _d 0, two = 2. _d 0, three = 3. _d 0 )
53			CEOP
54	mlosch	1.1
55	jmc	1.5	C theta1
56	mlosch	1.1	del_P = PR - P
57			del_th = del_P*sw_adtg(S,T,P)
58			th = T + onehalf*del_th
59			q = del_th
60	jmc	1.5	C theta2
61	mlosch	1.1	del_th = del_Psw_adtg(S,th,P+onehalfdel_P)
62
63			th = th + (1 - 1/sqrt(two))*(del_th - q)
64			q = (two-sqrt(two))del_th + (-two+three/sqrt(two))q
65
66	jmc	1.5	C theta3
67	mlosch	1.1	del_th = del_Psw_adtg(S,th,P+onehalfdel_P)
68			th = th + (1 + 1/sqrt(two))*(del_th - q)
69			q = (two + sqrt(two))del_th + (-two-three/sqrt(two))q
70
71	jmc	1.5	C theta4
72	mlosch	1.1	del_th = del_P*sw_adtg(S,th,P+del_P)
73			SW_PTMP = th + (del_th - twoq)/(twothree)
74
75	jmc	1.5	RETURN
76			END
77
78			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
79	mlosch	1.1
80			CBOP
81			C !ROUTINE: SW_TEMP
82			C !INTERFACE:
83	jmc	1.5	_RL FUNCTION SW_TEMP( S, T, P, PR )
84	mlosch	1.1	C !DESCRIPTION: \bv
85			C =============================================================
86			C \| S/R SW_TEMP
87	jmc	1.2	C \| o compute in-situ temperature from potential temperature
88	mlosch	1.1	C =============================================================
89			C
90			C REFERENCES:
91			C Fofonoff, P. and Millard, R.C. Jr
92			C Unesco 1983. Algorithms for computation of fundamental properties of
93			C seawater, 1983. _Unesco Tech. Pap. in Mar. Sci._, No. 44, 53 pp.
94			C Eqn.(31) p.39
95	jmc	1.2	C
96	mlosch	1.1	C Bryden, H. 1973.
97	jmc	1.6	C New Polynomials for thermal expansion, adiabatic temperature gradient
98			C and potential temperature of sea water.
99	mlosch	1.1	C DEEP-SEA RES., 1973, Vol20,401-408.
100	mlosch	1.11	C \ev
101	mlosch	1.1
102			C !USES:
103			IMPLICIT NONE
104			C === Global variables ===
105	jmc	1.2
106	mlosch	1.1	C !INPUT/OUTPUT PARAMETERS:
107			C === Routine arguments ===
108	jmc	1.5	C S :: salinity
109			C T :: potential temperature
110			C P :: pressure
111			C PR :: reference pressure
112			_RL S, T, P, PR
113	mlosch	1.1	CEOP
114
115	jmc	1.5	C !FUNCTIONS:
116	mlosch	1.10	_RL sw_ptmp
117			EXTERNAL sw_ptmp
118	mlosch	1.1
119	mlosch	1.10	SW_temp = SW_PTMP (S,T,PR,P)
120	mlosch	1.1
121			RETURN
122			END
123
124	jmc	1.5	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
125	mlosch	1.1
126	jmc	1.5	CBOP
127			C !ROUTINE: SW_ADTG
128			C !INTERFACE:
129	jmc	1.2	_RL FUNCTION SW_ADTG (S,T,P)
130	mlosch	1.1
131	jmc	1.5	C !DESCRIPTION: \bv
132			C =============================================================
133			C \| S/R SW_ADTG
134			C \| o compute adiabatic temperature gradient as per UNESCO 1983 routines.
135			C =============================================================
136			C
137			C started:
138			C Armin Koehl akoehl@ucsd.edu
139	mlosch	1.11	C \ev
140	jmc	1.5
141			C !USES:
142			IMPLICIT NONE
143
144			C !INPUT/OUTPUT PARAMETERS:
145			_RL S,T,P
146	mlosch	1.1
147	jmc	1.5	C !LOCAL VARIABLES:
148	mlosch	1.1	_RL a0,a1,a2,a3,b0,b1,c0,c1,c2,c3,d0,d1,e0,e1,e2
149			_RL sref
150	jmc	1.5	CEOP
151	mlosch	1.1
152			sref = 35. _d 0
153			a0 = 3.5803 _d -5
154			a1 = +8.5258 _d -6
155			a2 = -6.836 _d -8
156			a3 = 6.6228 _d -10
157
158			b0 = +1.8932 _d -6
159			b1 = -4.2393 _d -8
160
161			c0 = +1.8741 _d -8
162			c1 = -6.7795 _d -10
163			c2 = +8.733 _d -12
164			c3 = -5.4481 _d -14
165
166			d0 = -1.1351 _d -10
167			d1 = 2.7759 _d -12
168
169			e0 = -4.6206 _d -13
170			e1 = +1.8676 _d -14
171			e2 = -2.1687 _d -16
172
173			SW_ADTG = a0 + (a1 + (a2 + a3T)T)*T
174			& + (b0 + b1T)(S-sref)
175			& + ( (c0 + (c1 + (c2 + c3T)T)T) + (d0 + d1T)(S-sref) )P
176			& + ( e0 + (e1 + e2T)T )PP
177	jmc	1.5
178			RETURN
179			END