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