1 | !!---------------------------------------------------------------------- |
---|
2 | !! NEMO/OPA 3.3 , NEMO Consortium (2010) |
---|
3 | !! $Id$ |
---|
4 | !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) |
---|
5 | !!---------------------------------------------------------------------- |
---|
6 | |
---|
7 | REAL(KIND=wp) FUNCTION potemp( ps, pt, pp, ppr ) |
---|
8 | !!---------------------------------------------------------------------- |
---|
9 | !! *** FUNCTION potemp *** |
---|
10 | !! |
---|
11 | !! ** Purpose : Compute potential temperature |
---|
12 | !! |
---|
13 | !! ** Method : A regression formula is used. |
---|
14 | !! |
---|
15 | !! ** Action : The code is kept as close to the F77 code as possible |
---|
16 | !! Check value: potemp(35,20,2000,0) = 19.621967 |
---|
17 | !! |
---|
18 | !! References : T. J. Mcdougall, D. R. Jackett, D. G. Wright |
---|
19 | !! and R. Feistel |
---|
20 | !! Accurate and computationally efficient algoritms for |
---|
21 | !! potential temperatures and density of seawater |
---|
22 | !! Journal of atmospheric and oceanic technology |
---|
23 | !! Vol 20, 2003, pp 730-741 |
---|
24 | !! |
---|
25 | !! |
---|
26 | !! History : |
---|
27 | !! ! 07-05 (K. Mogensen) Original code |
---|
28 | !!---------------------------------------------------------------------- |
---|
29 | |
---|
30 | !! * Arguments |
---|
31 | |
---|
32 | REAL(KIND=wp), INTENT(IN) :: ps |
---|
33 | REAL(KIND=wp), INTENT(IN) :: pt |
---|
34 | REAL(KIND=wp), INTENT(IN) :: pp |
---|
35 | REAL(KIND=wp), INTENT(IN) :: ppr |
---|
36 | |
---|
37 | !! * Local declarations |
---|
38 | REAL(KIND=wp) :: zpol |
---|
39 | REAL(KIND=wp), PARAMETER :: a1 = 1.067610e-05 |
---|
40 | REAL(KIND=wp), PARAMETER :: a2 = -1.434297e-06 |
---|
41 | REAL(KIND=wp), PARAMETER :: a3 = -7.566349e-09 |
---|
42 | REAL(KIND=wp), PARAMETER :: a4 = -8.535585e-06 |
---|
43 | REAL(KIND=wp), PARAMETER :: a5 = 3.074672e-08 |
---|
44 | REAL(KIND=wp), PARAMETER :: a6 = 1.918639e-08 |
---|
45 | REAL(KIND=wp), PARAMETER :: a7 = 1.788718e-10 |
---|
46 | |
---|
47 | zpol = a1 + a2 * ps + a3 * ( pp + ppr ) + a4 * pt & |
---|
48 | & + a5 * ps * pt + a6 * pt * pt + a7 * pt * ( pp + ppr ) |
---|
49 | |
---|
50 | potemp = pt + ( pp - ppr ) * zpol |
---|
51 | |
---|
52 | END FUNCTION potemp |
---|
53 | |
---|
54 | REAL(KIND=wp) FUNCTION fspott( pft, pfs, pfp ) |
---|
55 | !!---------------------------------------------------------------------- |
---|
56 | !! *** FUNCTION fspott *** |
---|
57 | !! |
---|
58 | !! ** Purpose : Compute potential temperature |
---|
59 | !! |
---|
60 | !! ** Method : A regression formula is used. |
---|
61 | !! |
---|
62 | !! ** Action : Check value: fspott(10,25,1000) = 8.4678516 |
---|
63 | !! |
---|
64 | !! References : A. E. Gill |
---|
65 | !! Atmosphere-Ocean Dynamics |
---|
66 | !! Volume 30 (International Geophysics) |
---|
67 | !! |
---|
68 | !! History : |
---|
69 | !! ! 07-05 (K. Mogensen) NEMO adopting of OPAVAR code. |
---|
70 | !!---------------------------------------------------------------------- |
---|
71 | |
---|
72 | !! * Arguments |
---|
73 | REAL(KIND=wp) :: pft ! in situ temperature in degrees celcius |
---|
74 | REAL(KIND=wp) :: pfs ! salinity in psu |
---|
75 | REAL(KIND=wp) :: pfp ! pressure in bars |
---|
76 | |
---|
77 | fspott = & |
---|
78 | & pft - pfp * ( ( 3.6504e-4 & |
---|
79 | & + pft * ( 8.3198e-5 & |
---|
80 | & + pft * ( -5.4065e-7 & |
---|
81 | & + pft * 4.0274e-9 ) ) ) & |
---|
82 | & + ( pfs - 35.0 ) * ( 1.7439e-5 & |
---|
83 | & - pft * 2.9778e-7 ) & |
---|
84 | & + pfp * ( 8.9309e-7 & |
---|
85 | & + pft * ( -3.1628e-8 & |
---|
86 | & + pft * 2.1987e-10 ) & |
---|
87 | & - ( pfs - 35.0 ) * 4.1057e-9 & |
---|
88 | & + pfp * ( -1.6056e-10 & |
---|
89 | & + pft * 5.0484e-12 ) ) ) |
---|
90 | |
---|
91 | END FUNCTION fspott |
---|
92 | |
---|
93 | REAL(KIND=wp) FUNCTION atg( p_s, p_t, p_p ) |
---|
94 | !!---------------------------------------------------------------------- |
---|
95 | !! *** FUNCTION atg *** |
---|
96 | !! |
---|
97 | !! ** Purpose : Compute adiabatic temperature gradient deg c per decibar |
---|
98 | !! |
---|
99 | !! ** Method : A regression formula is used |
---|
100 | !! |
---|
101 | !! ** Action : The code is kept as close to the F77 code as possible |
---|
102 | !! Check value: atg(40,40,10000) = 3.255974e-4 |
---|
103 | !! |
---|
104 | !! References : N. P. Fotonoff and R.C. Millard jr., |
---|
105 | !! Algoritms for computation of fundamental |
---|
106 | !! properties of seawater |
---|
107 | !! Unesco technical papers in marine science 44 |
---|
108 | !! Unesco 1983 |
---|
109 | !! |
---|
110 | !! History : |
---|
111 | !! ! 07-05 (K. Mogensen) Original code based on the F77 code. |
---|
112 | !!---------------------------------------------------------------------- |
---|
113 | |
---|
114 | !! * Arguments |
---|
115 | |
---|
116 | REAL(KIND=wp), INTENT(IN) :: p_s ! Salinity in PSU |
---|
117 | REAL(KIND=wp), INTENT(IN) :: p_t ! Temperature in centigrades |
---|
118 | REAL(KIND=wp), INTENT(IN) :: p_p ! Pressure in decibars. |
---|
119 | |
---|
120 | !! * Local declarations |
---|
121 | |
---|
122 | REAL(KIND=wp) :: z_ds |
---|
123 | |
---|
124 | z_ds = p_s - 35.0 |
---|
125 | atg = ((( -2.1687e-16 * p_t + 1.8676e-14 ) * p_t - 4.6206e-13 ) * p_p & |
---|
126 | & + (( 2.7759e-12 * p_t - 1.1351e-10 ) * z_ds + (( - 5.4481e-14 * p_t & |
---|
127 | & + 8.733e-12 ) * p_t - 6.7795e-10 ) * p_t + 1.8741e-8)) * p_p & |
---|
128 | & + ( -4.2393e-8 * p_t + 1.8932e-6 ) * z_ds & |
---|
129 | & + (( 6.6228e-10 * p_t - 6.836e-8 ) * p_t + 8.5258e-6 ) * p_t + 3.5803e-5 |
---|
130 | |
---|
131 | END FUNCTION atg |
---|
132 | |
---|
133 | REAL(KIND=wp) FUNCTION theta( p_s, p_t0, p_p0, p_pr ) |
---|
134 | !!---------------------------------------------------------------------- |
---|
135 | !! *** FUNCTION theta *** |
---|
136 | !! |
---|
137 | !! ** Purpose : Compute potential temperature |
---|
138 | !! |
---|
139 | !! ** Method : A regression formula is used. |
---|
140 | !! |
---|
141 | !! ** Action : The code is kept as close to the F77 code as possible |
---|
142 | !! Check value: theta(40,40,10000,0) = 36.89073 |
---|
143 | !! |
---|
144 | !! References : N. P. Fotonoff and R.C. Millard jr., |
---|
145 | !! Algoritms for computation of fundamental |
---|
146 | !! properties of seawater |
---|
147 | !! Unesco technical papers in marine science 44 |
---|
148 | !! Unesco 1983 |
---|
149 | !! |
---|
150 | !! History : |
---|
151 | !! ! 07-05 (K. Mogensen) Original code based on the F77 code. |
---|
152 | !!---------------------------------------------------------------------- |
---|
153 | |
---|
154 | !! * Arguments |
---|
155 | REAL(KIND=wp), INTENT(IN) :: p_s |
---|
156 | REAL(KIND=wp), INTENT(IN) :: p_t0 |
---|
157 | REAL(KIND=wp), INTENT(IN) :: p_p0 |
---|
158 | REAL(KIND=wp), INTENT(IN) :: p_pr |
---|
159 | |
---|
160 | !! * Local declarations |
---|
161 | REAL(KIND=wp) :: z_p |
---|
162 | REAL(KIND=wp) :: z_t |
---|
163 | REAL(KIND=wp) :: z_h |
---|
164 | REAL(KIND=wp) :: z_xk |
---|
165 | REAL(KIND=wp) :: z_q |
---|
166 | |
---|
167 | z_p = p_p0 |
---|
168 | z_t = p_t0 |
---|
169 | z_h = p_pr - z_p |
---|
170 | z_xk = z_h * atg( p_s, z_t, z_p ) |
---|
171 | Z_t = z_t + 0.5 * z_xk |
---|
172 | z_q = z_xk |
---|
173 | z_p = z_p + 0.5 * z_h |
---|
174 | z_xk = z_h * atg( p_s, z_t, z_p ) |
---|
175 | z_t = z_t + 0.29289322 * ( z_xk - z_q ) |
---|
176 | z_q = 0.58578644 * z_xk + 0.121320344 * z_q |
---|
177 | z_xk = z_h * atg( p_s, z_t, z_p ) |
---|
178 | z_t = z_t + 1.707106781 * ( z_xk - z_q ) |
---|
179 | z_q = 3.414213562 * z_xk - 4.121320244 * z_q |
---|
180 | z_p = z_p + 0.5 * z_h |
---|
181 | z_xk = z_h * atg( p_s, z_t, z_p ) |
---|
182 | theta = z_t + ( z_xk - 2.0 * z_q ) / 6.0 |
---|
183 | |
---|
184 | END FUNCTION theta |
---|
185 | |
---|
186 | REAL(KIND=wp) FUNCTION depth( p_p, p_lat ) |
---|
187 | !!---------------------------------------------------------------------- |
---|
188 | !! *** FUNCTION depth *** |
---|
189 | !! |
---|
190 | !! ** Purpose : Compute depth from pressure and latitudes |
---|
191 | !! |
---|
192 | !! ** Method : A regression formula is used. |
---|
193 | !! |
---|
194 | !! ** Action : The code is kept as close to the F77 code as possible |
---|
195 | !! Check value: depth(10000,30) = 9712.653 |
---|
196 | !! |
---|
197 | !! References : N. P. Fotonoff and R.C. Millard jr., |
---|
198 | !! Algoritms for computation of fundamental |
---|
199 | !! properties of seawater |
---|
200 | !! Unesco technical papers in marine science 44 |
---|
201 | !! Unesco 1983 |
---|
202 | !! |
---|
203 | !! History : |
---|
204 | !! ! 07-05 (K. Mogensen) Original code based on the F77 code. |
---|
205 | !!---------------------------------------------------------------------- |
---|
206 | |
---|
207 | !! * Arguments |
---|
208 | REAL(KIND=wp), INTENT(IN) :: p_p ! Pressure in decibars |
---|
209 | REAL(KIND=wp), INTENT(IN) :: p_lat ! Latitude in degrees |
---|
210 | |
---|
211 | !! * Local declarations |
---|
212 | REAL(KIND=wp) :: z_x |
---|
213 | REAL(KIND=wp) :: z_gr |
---|
214 | |
---|
215 | z_x = SIN( p_lat / 57.29578 ) |
---|
216 | z_x = z_x * z_x |
---|
217 | z_gr = 9.780318 * ( 1.0 + ( 5.2788e-3 + 2.36e-5 * z_x ) * z_x ) + 1.092e-6 * p_p |
---|
218 | depth = ((( -1.82e-15 * p_p + 2.279e-10 ) * p_p - 2.2512e-5 ) * p_p + 9.72659 ) * p_p |
---|
219 | depth = depth / z_gr |
---|
220 | |
---|
221 | END FUNCTION depth |
---|
222 | |
---|
223 | REAL(KIND=wp) FUNCTION p_to_dep( p_p, p_lat ) |
---|
224 | !!---------------------------------------------------------------------- |
---|
225 | !! *** FUNCTION p_to_dep *** |
---|
226 | !! |
---|
227 | !! ** Purpose : Compute depth from pressure and latitudes |
---|
228 | !! |
---|
229 | !! ** Method : A regression formula is used. This version is less |
---|
230 | !! accurate the "depth" but invertible. |
---|
231 | !! |
---|
232 | !! ** Action : |
---|
233 | !! |
---|
234 | !! References : P.M Saunders |
---|
235 | !! Pratical conversion of pressure to depth |
---|
236 | !! Journal of physical oceanography Vol 11, 1981, pp 573-574 |
---|
237 | !! |
---|
238 | !! History : |
---|
239 | !! ! 07-05 (K. Mogensen) Original code |
---|
240 | !!---------------------------------------------------------------------- |
---|
241 | |
---|
242 | !! * Arguments |
---|
243 | REAL(KIND=wp), INTENT(IN) :: p_p ! Pressure in decibars |
---|
244 | REAL(KIND=wp), INTENT(IN) :: p_lat ! Latitude in degrees |
---|
245 | |
---|
246 | !! * Local declarations |
---|
247 | REAL(KIND=wp) :: z_x |
---|
248 | REAL(KIND=wp) :: z_c1 |
---|
249 | REAL(KIND=wp) :: z_c2 |
---|
250 | |
---|
251 | z_x = SIN( p_lat / 57.29578 ) |
---|
252 | z_x = z_x * z_x |
---|
253 | z_c1 = ( 5.92 + 5.25 * z_x ) * 1e-3 |
---|
254 | z_c2 = 2.21e-6 |
---|
255 | p_to_dep = (1 - z_c1) * p_p - z_c2 * p_p * p_p |
---|
256 | |
---|
257 | END FUNCTION p_to_dep |
---|
258 | |
---|
259 | REAL(KIND=wp) FUNCTION dep_to_p( p_dep, p_lat ) |
---|
260 | !!---------------------------------------------------------------------- |
---|
261 | !! *** FUNCTION dep_to_p *** |
---|
262 | !! |
---|
263 | !! ** Purpose : Compute depth from pressure and latitudes |
---|
264 | !! |
---|
265 | !! ** Method : The expression used in p_to_dep is inverted. |
---|
266 | !! |
---|
267 | !! ** Action : |
---|
268 | !! |
---|
269 | !! References : P.M Saunders |
---|
270 | !! Pratical conversion of pressure to depth |
---|
271 | !! Journal of physical oceanography Vol 11, 1981, pp 573-574 |
---|
272 | !! |
---|
273 | !! History : |
---|
274 | !! ! 07-05 (K. Mogensen) Original code |
---|
275 | !!---------------------------------------------------------------------- |
---|
276 | |
---|
277 | !! * Arguments |
---|
278 | REAL(KIND=wp), INTENT(IN) :: p_dep ! Depth in meters |
---|
279 | REAL(KIND=wp), INTENT(IN) :: p_lat ! Latitude in degrees |
---|
280 | |
---|
281 | !! * Local declarations |
---|
282 | REAL(KIND=wp) :: z_x |
---|
283 | REAL(KIND=wp) :: z_c1 |
---|
284 | REAL(KIND=wp) :: z_c2 |
---|
285 | REAL(KIND=wp) :: z_d |
---|
286 | |
---|
287 | z_x = SIN( p_lat / 57.29578 ) |
---|
288 | z_x = z_x * z_x |
---|
289 | z_c1 = ( 5.92 + 5.25 * z_x ) * 1e-3 |
---|
290 | z_c2 = 2.21e-6 |
---|
291 | z_d = ( z_c1 - 1 ) * ( z_c1 - 1 ) - 4 * z_c2 * p_dep |
---|
292 | dep_to_p = (( 1 - z_c1 ) - SQRT( z_d )) / ( 2 * z_c2 ) |
---|
293 | |
---|
294 | END FUNCTION dep_to_p |
---|