New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

obs_conv_functions.h90 in branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS – NEMO

Context Navigation

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv_functions.h90 @ 2281

Last change on this file since 2281 was 2281, checked in by smasson, 14 years ago
set proper svn properties to all files...
Property svn:keywords set to `Id`
File size: 11.0 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format