source: branches/UKMO/r6232_tracer_advection/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv_functions.h90 @ 9295

Last change on this file since 9295 was 9295, checked in by jcastill, 3 years ago

Remove svn keywords

File size: 11.3 KB
Line 
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
Note: See TracBrowser for help on using the repository browser.