[2287] | 1 | !!---------------------------------------------------------------------- |
---|
[9598] | 2 | !! NEMO/OCE 4.0 , NEMO Consortium (2018) |
---|
[2287] | 3 | !! $Id$ |
---|
[10068] | 4 | !! Software governed by the CeCILL license (see ./LICENSE) |
---|
[2287] | 5 | !!---------------------------------------------------------------------- |
---|
| 6 | |
---|
| 7 | REAL(KIND=wp) FUNCTION potemp( ps, pt, pp, ppr ) |
---|
[2202] | 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 |
---|
[7646] | 73 | REAL(KIND=wp) :: pft ! in situ temperature in degrees Celsius |
---|
[2202] | 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 |
---|