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.
eosbn2.F90 in branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90 @ 2371

Last change on this file since 2371 was 2371, checked in by acc, 13 years ago

nemo_v3_3_beta. Improvement of the Griffies operator code (#680). Some aspects are still undergoing scientific assessment but the code structure is ready for release. Dynamical allocation of the large triad arrays has been introduced to reduce memory when the new operator is not in use.

  • Property svn:keywords set to Id
File size: 38.2 KB
Line 
1MODULE eosbn2
2   !!==============================================================================
3   !!                       ***  MODULE  eosbn2  ***
4   !! Ocean diagnostic variable : equation of state - in situ and potential density
5   !!                                               - Brunt-Vaisala frequency
6   !!==============================================================================
7   !! History :  OPA  ! 1989-03  (O. Marti)  Original code
8   !!            6.0  ! 1994-07  (G. Madec, M. Imbard)  add bn2
9   !!            6.0  ! 1994-08  (G. Madec)  Add Jackett & McDougall eos
10   !!            7.0  ! 1996-01  (G. Madec)  statement function for e3
11   !!            8.1  ! 1997-07  (G. Madec)  density instead of volumic mass
12   !!             -   ! 1999-02  (G. Madec, N. Grima) semi-implicit pressure gradient
13   !!            8.2  ! 2001-09  (M. Ben Jelloul)  bugfix on linear eos
14   !!   NEMO     1.0  ! 2002-10  (G. Madec)  add eos_init
15   !!             -   ! 2002-11  (G. Madec, A. Bozec)  partial step, eos_insitu_2d
16   !!             -   ! 2003-08  (G. Madec)  F90, free form
17   !!            3.0  ! 2006-08  (G. Madec)  add tfreez function
18   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
19   !!             -   ! 2010-10  (G. Nurser, G. Madec)  add eos_alpbet used in ldfslp
20   !!----------------------------------------------------------------------
21
22   !!----------------------------------------------------------------------
23   !!   eos            : generic interface of the equation of state
24   !!   eos_insitu     : Compute the in situ density
25   !!   eos_insitu_pot : Compute the insitu and surface referenced potential
26   !!                    volumic mass
27   !!   eos_insitu_2d  : Compute the in situ density for 2d fields
28   !!   eos_bn2        : Compute the Brunt-Vaisala frequency
29   !!   eos_alpbet     : calculates the in situ thermal and haline expansion coeff.
30   !!   tfreez         : Compute the surface freezing temperature
31   !!   eos_init       : set eos parameters (namelist)
32   !!----------------------------------------------------------------------
33   USE dom_oce         ! ocean space and time domain
34   USE phycst          ! physical constants
35   USE in_out_manager  ! I/O manager
36   USE zdfddm          ! vertical physics: double diffusion
37   USE prtctl          ! Print control
38
39   IMPLICIT NONE
40   PRIVATE
41
42   !                   !! * Interface
43   INTERFACE eos
44      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d
45   END INTERFACE
46   INTERFACE bn2
47      MODULE PROCEDURE eos_bn2
48   END INTERFACE
49
50   PUBLIC   eos        ! called by step, istate, tranpc and zpsgrd modules
51   PUBLIC   eos_init   ! called by istate module
52   PUBLIC   bn2        ! called by step module
53   PUBLIC   eos_alpbet ! called by ldfslp module
54   PUBLIC   tfreez     ! called by sbcice_... modules
55
56   !                                          !!* Namelist (nameos) *
57   INTEGER , PUBLIC ::   nn_eos   = 0         !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
58   REAL(wp), PUBLIC ::   rn_alpha = 2.0e-4_wp !: thermal expension coeff. (linear equation of state)
59   REAL(wp), PUBLIC ::   rn_beta  = 7.7e-4_wp !: saline  expension coeff. (linear equation of state)
60
61   REAL(wp), PUBLIC ::   ralpbet              !: alpha / beta ratio
62   
63   !! * Substitutions
64#  include "domzgr_substitute.h90"
65#  include "vectopt_loop_substitute.h90"
66   !!----------------------------------------------------------------------
67   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
68   !! $Id$
69   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
70   !!----------------------------------------------------------------------
71CONTAINS
72
73   SUBROUTINE eos_insitu( pts, prd )
74      !!----------------------------------------------------------------------
75      !!                   ***  ROUTINE eos_insitu  ***
76      !!
77      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
78      !!       potential temperature and salinity using an equation of state
79      !!       defined through the namelist parameter nn_eos.
80      !!
81      !! ** Method  :   3 cases:
82      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state.
83      !!         the in situ density is computed directly as a function of
84      !!         potential temperature relative to the surface (the opa t
85      !!         variable), salt and pressure (assuming no pressure variation
86      !!         along geopotential surfaces, i.e. the pressure p in decibars
87      !!         is approximated by the depth in meters.
88      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
89      !!         with pressure                      p        decibars
90      !!              potential temperature         t        deg celsius
91      !!              salinity                      s        psu
92      !!              reference volumic mass        rau0     kg/m**3
93      !!              in situ volumic mass          rho      kg/m**3
94      !!              in situ density anomalie      prd      no units
95      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
96      !!          t = 40 deg celcius, s=40 psu
97      !!      nn_eos = 1 : linear equation of state function of temperature only
98      !!              prd(t) = 0.0285 - rn_alpha * t
99      !!      nn_eos = 2 : linear equation of state function of temperature and
100      !!               salinity
101      !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1.
102      !!      Note that no boundary condition problem occurs in this routine
103      !!      as pts are defined over the whole domain.
104      !!
105      !! ** Action  :   compute prd , the in situ density (no units)
106      !!
107      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
108      !!----------------------------------------------------------------------
109      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
110      !                                                               ! 2 : salinity               [psu]
111      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   prd   ! in situ density
112      !!
113      INTEGER  ::   ji, jj, jk           ! dummy loop indices
114      REAL(wp) ::   zt , zs , zh , zsr   ! temporary scalars
115      REAL(wp) ::   zr1, zr2, zr3, zr4   !    -         -
116      REAL(wp) ::   zrhop, ze, zbw, zb   !    -         -
117      REAL(wp) ::   zd , zc , zaw, za    !    -         -
118      REAL(wp) ::   zb1, za1, zkw, zk0   !    -         -
119      REAL(wp) ::   zrau0r               !    -         -
120      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zws   ! temporary workspace
121      !!----------------------------------------------------------------------
122
123      SELECT CASE( nn_eos )
124      !
125      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
126         zrau0r = 1.e0 / rau0
127!CDIR NOVERRCHK
128         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
129         
130         DO jk = 1, jpkm1
131            DO jj = 1, jpj
132               DO ji = 1, jpi
133                  zt = pts   (ji,jj,jk,jp_tem)
134                  zs = pts   (ji,jj,jk,jp_sal)
135                  zh = fsdept(ji,jj,jk)        ! depth
136                  zsr= zws   (ji,jj,jk)        ! square root salinity
137                  !
138                  ! compute volumic mass pure water at atm pressure
139                  zr1= ( ( ( ( 6.536332e-9_wp  *zt - 1.120083e-6_wp )*zt + 1.001685e-4_wp )*zt   &
140                     &        -9.095290e-3_wp )*zt + 6.793952e-2_wp )*zt +  999.842594_wp
141                  ! seawater volumic mass atm pressure
142                  zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt        &
143                     &                      -4.0899e-3_wp ) *zt+0.824493_wp
144                  zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp
145                  zr4= 4.8314e-4_wp
146                  !
147                  ! potential volumic mass (reference to the surface)
148                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
149                  !
150                  ! add the compression terms
151                  ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
152                  zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
153                  zb = zbw + ze * zs
154                  !
155                  zd = -2.042967e-2_wp
156                  zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
157                  zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp
158                  za = ( zd*zsr + zc ) *zs + zaw
159                  !
160                  zb1=   (-0.1909078_wp*zt+7.390729_wp )        *zt-55.87545_wp
161                  za1= ( ( 2.326469e-3_wp*zt+1.553190_wp)       *zt-65.00517_wp ) *zt+1044.077_wp
162                  zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp
163                  zk0= ( zb1*zsr + za1 )*zs + zkw
164                  !
165                  ! masked in situ density anomaly
166                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
167                     &             - rau0  ) * zrau0r * tmask(ji,jj,jk)
168               END DO
169            END DO
170         END DO
171         !
172      CASE( 1 )                !==  Linear formulation function of temperature only  ==!
173         DO jk = 1, jpkm1
174            prd(:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk)
175         END DO
176         !
177      CASE( 2 )                !==  Linear formulation function of temperature and salinity  ==!
178         DO jk = 1, jpkm1
179            prd(:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk)
180         END DO
181         !
182      END SELECT
183      !
184      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk )
185      !
186   END SUBROUTINE eos_insitu
187
188
189   SUBROUTINE eos_insitu_pot( pts, prd, prhop )
190      !!----------------------------------------------------------------------
191      !!                  ***  ROUTINE eos_insitu_pot  ***
192      !!           
193      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) and the
194      !!      potential volumic mass (Kg/m3) from potential temperature and
195      !!      salinity fields using an equation of state defined through the
196      !!     namelist parameter nn_eos.
197      !!
198      !! ** Method  :
199      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state.
200      !!         the in situ density is computed directly as a function of
201      !!         potential temperature relative to the surface (the opa t
202      !!         variable), salt and pressure (assuming no pressure variation
203      !!         along geopotential surfaces, i.e. the pressure p in decibars
204      !!         is approximated by the depth in meters.
205      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
206      !!              rhop(t,s)  = rho(t,s,0)
207      !!         with pressure                      p        decibars
208      !!              potential temperature         t        deg celsius
209      !!              salinity                      s        psu
210      !!              reference volumic mass        rau0     kg/m**3
211      !!              in situ volumic mass          rho      kg/m**3
212      !!              in situ density anomalie      prd      no units
213      !!
214      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
215      !!          t = 40 deg celcius, s=40 psu
216      !!
217      !!      nn_eos = 1 : linear equation of state function of temperature only
218      !!              prd(t) = ( rho(t) - rau0 ) / rau0 = 0.028 - rn_alpha * t
219      !!              rhop(t,s)  = rho(t,s)
220      !!
221      !!      nn_eos = 2 : linear equation of state function of temperature and
222      !!               salinity
223      !!              prd(t,s) = ( rho(t,s) - rau0 ) / rau0
224      !!                       = rn_beta * s - rn_alpha * tn - 1.
225      !!              rhop(t,s)  = rho(t,s)
226      !!      Note that no boundary condition problem occurs in this routine
227      !!      as (tn,sn) or (ta,sa) are defined over the whole domain.
228      !!
229      !! ** Action  : - prd  , the in situ density (no units)
230      !!              - prhop, the potential volumic mass (Kg/m3)
231      !!
232      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
233      !!                Brown and Campana, Mon. Weather Rev., 1978
234      !!----------------------------------------------------------------------
235      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
236      !                                                               ! 2 : salinity               [psu]
237      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density
238      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
239
240      INTEGER  ::   ji, jj, jk   ! dummy loop indices
241      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! temporary scalars
242      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r       !    -         -
243      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zws   ! 3D workspace
244      !!----------------------------------------------------------------------
245
246      SELECT CASE ( nn_eos )
247      !
248      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
249         zrau0r = 1.e0 / rau0
250!CDIR NOVERRCHK
251         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
252         
253         DO jk = 1, jpkm1
254            DO jj = 1, jpj
255               DO ji = 1, jpi
256                  zt = pts   (ji,jj,jk,jp_tem)
257                  zs = pts   (ji,jj,jk,jp_sal)
258                  zh = fsdept(ji,jj,jk)        ! depth
259                  zsr= zws   (ji,jj,jk)        ! square root salinity
260                  !
261                  ! compute volumic mass pure water at atm pressure
262                  zr1= ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   &
263                     &                          -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp
264                  ! seawater volumic mass atm pressure
265                  zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt   &
266                     &                                         -4.0899e-3_wp ) *zt+0.824493_wp
267                  zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp
268                  zr4= 4.8314e-4_wp
269                  !
270                  ! potential volumic mass (reference to the surface)
271                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
272                  !
273                  ! save potential volumic mass
274                  prhop(ji,jj,jk) = zrhop * tmask(ji,jj,jk)
275                  !
276                  ! add the compression terms
277                  ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
278                  zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
279                  zb = zbw + ze * zs
280                  !
281                  zd = -2.042967e-2_wp
282                  zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
283                  zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp
284                  za = ( zd*zsr + zc ) *zs + zaw
285                  !
286                  zb1=   (  -0.1909078_wp  *zt+7.390729_wp    ) *zt-55.87545_wp
287                  za1= ( (   2.326469e-3_wp*zt+1.553190_wp    ) *zt-65.00517_wp ) *zt + 1044.077_wp
288                  zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp
289                  zk0= ( zb1*zsr + za1 )*zs + zkw
290                  !
291                  ! masked in situ density anomaly
292                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
293                     &             - rau0  ) * zrau0r * tmask(ji,jj,jk)
294               END DO
295            END DO
296         END DO
297         !
298      CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
299         DO jk = 1, jpkm1
300            prd  (:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_sal) )        * tmask(:,:,jk)
301            prhop(:,:,jk) = ( 1.e0_wp   +            prd (:,:,jk)       ) * rau0 * tmask(:,:,jk)
302         END DO
303         !
304      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
305         DO jk = 1, jpkm1
306            prd  (:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask(:,:,jk)
307            prhop(:,:,jk) = ( 1.e0_wp  + prd (:,:,jk) )                                       * rau0 * tmask(:,:,jk)
308         END DO
309         !
310      END SELECT
311      !
312      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk )
313      !
314   END SUBROUTINE eos_insitu_pot
315
316
317   SUBROUTINE eos_insitu_2d( pts, pdep, prd )
318      !!----------------------------------------------------------------------
319      !!                  ***  ROUTINE eos_insitu_2d  ***
320      !!
321      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
322      !!      potential temperature and salinity using an equation of state
323      !!      defined through the namelist parameter nn_eos. * 2D field case
324      !!
325      !! ** Method :
326      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state.
327      !!         the in situ density is computed directly as a function of
328      !!         potential temperature relative to the surface (the opa t
329      !!         variable), salt and pressure (assuming no pressure variation
330      !!         along geopotential surfaces, i.e. the pressure p in decibars
331      !!         is approximated by the depth in meters.
332      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
333      !!         with pressure                      p        decibars
334      !!              potential temperature         t        deg celsius
335      !!              salinity                      s        psu
336      !!              reference volumic mass        rau0     kg/m**3
337      !!              in situ volumic mass          rho      kg/m**3
338      !!              in situ density anomalie      prd      no units
339      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
340      !!          t = 40 deg celcius, s=40 psu
341      !!      nn_eos = 1 : linear equation of state function of temperature only
342      !!              prd(t) = 0.0285 - rn_alpha * t
343      !!      nn_eos = 2 : linear equation of state function of temperature and
344      !!               salinity
345      !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1.
346      !!      Note that no boundary condition problem occurs in this routine
347      !!      as pts are defined over the whole domain.
348      !!
349      !! ** Action  : - prd , the in situ density (no units)
350      !!
351      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
352      !!----------------------------------------------------------------------
353      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
354      !                                                           ! 2 : salinity               [psu]
355      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                  [m]
356      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density
357      !!
358      INTEGER  ::   ji, jj                    ! dummy loop indices
359      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! temporary scalars
360      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zmask        !    -         -
361      REAL(wp), DIMENSION(jpi,jpj) ::   zws   ! 2D workspace
362      !!----------------------------------------------------------------------
363
364      prd(:,:) = 0.e0
365
366      SELECT CASE( nn_eos )
367      !
368      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
369      !
370!CDIR NOVERRCHK
371         DO jj = 1, jpjm1
372!CDIR NOVERRCHK
373            DO ji = 1, fs_jpim1   ! vector opt.
374               zws(ji,jj) = SQRT( ABS( pts(ji,jj,jp_sal) ) )
375            END DO
376         END DO
377         DO jj = 1, jpjm1
378            DO ji = 1, fs_jpim1   ! vector opt.
379               zmask = tmask(ji,jj,1)          ! land/sea bottom mask = surf. mask
380               zt    = pts  (ji,jj,jp_tem)            ! interpolated T
381               zs    = pts  (ji,jj,jp_sal)            ! interpolated S
382               zsr   = zws  (ji,jj)            ! square root of interpolated S
383               zh    = pdep (ji,jj)            ! depth at the partial step level
384               !
385               ! compute volumic mass pure water at atm pressure
386               zr1 = ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   &
387                  &                        -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp
388               ! seawater volumic mass atm pressure
389               zr2 = ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp )*zt+7.6438e-5_wp ) *zt   &
390                  &                                   -4.0899e-3_wp ) *zt+0.824493_wp
391               zr3 = ( -1.6546e-6_wp*zt+1.0227e-4_wp ) *zt-5.72466e-3_wp
392               zr4 = 4.8314e-4_wp
393               !
394               ! potential volumic mass (reference to the surface)
395               zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
396               !
397               ! add the compression terms
398               ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
399               zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
400               zb = zbw + ze * zs
401               !
402               zd =    -2.042967e-2_wp
403               zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
404               zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt -4.721788_wp
405               za = ( zd*zsr + zc ) *zs + zaw
406               !
407               zb1=     (-0.1909078_wp  *zt+7.390729_wp      ) *zt-55.87545_wp
408               za1=   ( ( 2.326469e-3_wp*zt+1.553190_wp      ) *zt-65.00517_wp ) *zt+1044.077_wp
409               zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp   ) *zt-30.41638_wp ) *zt   &
410                  &                             +2098.925_wp ) *zt+190925.6_wp
411               zk0= ( zb1*zsr + za1 )*zs + zkw
412               !
413               ! masked in situ density anomaly
414               prd(ji,jj) = ( zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 ) / rau0 * zmask
415            END DO
416         END DO
417         !
418      CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
419         DO jj = 1, jpjm1
420            DO ji = 1, fs_jpim1   ! vector opt.
421               prd(ji,jj) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1)
422            END DO
423         END DO
424         !
425      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
426         DO jj = 1, jpjm1
427            DO ji = 1, fs_jpim1   ! vector opt.
428               prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1) 
429            END DO
430         END DO
431         !
432      END SELECT
433
434      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )
435      !
436   END SUBROUTINE eos_insitu_2d
437
438
439   SUBROUTINE eos_bn2( pts, pn2 )
440      !!----------------------------------------------------------------------
441      !!                  ***  ROUTINE eos_bn2  ***
442      !!
443      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the time-
444      !!      step of the input arguments
445      !!     
446      !! ** Method :
447      !!       * nn_eos = 0  : UNESCO sea water properties
448      !!         The brunt-vaisala frequency is computed using the polynomial
449      !!      polynomial expression of McDougall (1987):
450      !!            N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
451      !!      If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is
452      !!      computed and used in zdfddm module :
453      !!              Rrau = alpha/beta * ( dk[ t ] / dk[ s ] )
454      !!       * nn_eos = 1  : linear equation of state (temperature only)
455      !!            N^2 = grav * rn_alpha * dk[ t ]/e3w
456      !!       * nn_eos = 2  : linear equation of state (temperature & salinity)
457      !!            N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w
458      !!      The use of potential density to compute N^2 introduces e r r o r
459      !!      in the sign of N^2 at great depths. We recommand the use of
460      !!      nn_eos = 0, except for academical studies.
461      !!        Macro-tasked on horizontal slab (jk-loop)
462      !!      N.B. N^2 is set to zero at the first level (JK=1) in inidtr
463      !!      and is never used at this level.
464      !!
465      !! ** Action  : - pn2 : the brunt-vaisala frequency
466      !!
467      !! References :   McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987.
468      !!----------------------------------------------------------------------
469      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
470      !                                                               ! 2 : salinity               [psu]
471      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pn2    ! Brunt-Vaisala frequency [s-1]
472      !!
473      INTEGER  ::   ji, jj, jk   ! dummy loop indices
474      REAL(wp) ::   zgde3w, zt, zs, zh, zalbet, zbeta   ! temporary scalars
475#if defined key_zdfddm
476      REAL(wp) ::   zds   ! temporary scalars
477#endif
478      !!----------------------------------------------------------------------
479
480      ! pn2 : interior points only (2=< jk =< jpkm1 )
481      ! --------------------------
482      !
483      SELECT CASE( nn_eos )
484      !
485      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
486         DO jk = 2, jpkm1
487            DO jj = 1, jpj
488               DO ji = 1, jpi
489                  zgde3w = grav / fse3w(ji,jj,jk)
490                  zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) )          ! potential temperature at w-point
491                  zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0   ! salinity anomaly (s-35) at w-point
492                  zh = fsdepw(ji,jj,jk)                                     ! depth in meters  at w-point
493                  !
494                  zalbet = ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &   ! ratio alpha/beta
495                     &                                  - 0.203814e-03_wp ) * zt   &
496                     &                                  + 0.170907e-01_wp ) * zt   &
497                     &   +         0.665157e-01_wp                                 &
498                     &   +     ( - 0.678662e-05_wp * zs                            &
499                     &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   &
500                     &   +   ( ( - 0.302285e-13_wp * zh                            &
501                     &           - 0.251520e-11_wp * zs                            &
502                     &           + 0.512857e-12_wp * zt * zt              ) * zh   &
503                     &           - 0.164759e-06_wp * zs                            &
504                     &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   &
505                     &                                  + 0.380374e-04_wp ) * zh
506                     !
507                  zbeta  = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt      &   ! beta
508                     &                               - 0.301985e-05_wp ) * zt      &
509                     &   +       0.785567e-03_wp                                   &
510                     &   + (     0.515032e-08_wp * zs                              &
511                     &         + 0.788212e-08_wp * zt - 0.356603e-06_wp ) * zs     &
512                     &   + ( (   0.121551e-17_wp * zh                              &
513                     &         - 0.602281e-15_wp * zs                              &
514                     &         - 0.175379e-14_wp * zt + 0.176621e-12_wp ) * zh     &
515                     &                                + 0.408195e-10_wp   * zs     &
516                     &     + ( - 0.213127e-11_wp * zt + 0.192867e-09_wp ) * zt     &
517                     &                                - 0.121555e-07_wp ) * zh
518                     !
519                  pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk)           &   ! N^2
520                     &          * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )   &
521                     &                     - ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) )
522#if defined key_zdfddm
523                  !                                                         !!bug **** caution a traiter zds=dk[S]= 0 !!!!
524                  zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )                    ! Rrau = (alpha / beta) (dk[t] / dk[s])
525                  IF ( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp
526                  rrau(ji,jj,jk) = zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds
527#endif
528               END DO
529            END DO
530         END DO
531         !
532      CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
533         DO jk = 2, jpkm1
534            pn2(:,:,jk) = grav * rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk)
535         END DO
536         !
537      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
538         DO jk = 2, jpkm1
539            pn2(:,:,jk) = grav * (  rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) )      &
540               &                  - rn_beta  * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) )  )   &
541               &               / fse3w(:,:,jk) * tmask(:,:,jk)
542         END DO 
543#if defined key_zdfddm
544         DO jk = 2, jpkm1                                 ! Rrau = (alpha / beta) (dk[t] / dk[s])
545            DO jj = 1, jpj
546               DO ji = 1, jpi
547                  zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) 
548                  IF ( ABS( zds ) <= 1.e-20_wp ) zds = 1.e-20_wp
549                  rrau(ji,jj,jk) = ralpbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds
550               END DO
551            END DO
552         END DO
553#endif
554      END SELECT
555
556      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk )
557#if defined key_zdfddm
558      IF(ln_ctl)   CALL prt_ctl( tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk )
559#endif
560      !
561   END SUBROUTINE eos_bn2
562
563
564   SUBROUTINE eos_alpbet( pts, palph, pbeta )
565      !!----------------------------------------------------------------------
566      !!                 ***  ROUTINE ldf_slp_grif  ***
567      !!
568      !! ** Purpose :   Calculates the thermal and haline expansion coefficients at T-points.
569      !!
570      !! ** Method  :   calculates alpha and beta at T-points
571      !!       * nn_eos = 0  : UNESCO sea water properties
572      !!         The brunt-vaisala frequency is computed using the polynomial
573      !!      polynomial expression of McDougall (1987):
574      !!            N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
575      !!      If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is
576      !!      computed and used in zdfddm module :
577      !!              Rrau = alpha/beta * ( dk[ t ] / dk[ s ] )
578      !!       * nn_eos = 1  : linear equation of state (temperature only)
579      !!            N^2 = grav * rn_alpha * dk[ t ]/e3w
580      !!       * nn_eos = 2  : linear equation of state (temperature & salinity)
581      !!            N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w
582      !!       * nn_eos = 3  : Jackett JAOT 2003 ???
583      !!
584      !! ** Action  : - palph, pbeta : thermal and haline expansion coeff. at T-point
585      !!----------------------------------------------------------------------
586      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts            ! pot. temperature & salinity
587      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   palph, pbeta   ! thermal & haline expansion coeff.
588      !!
589      INTEGER  ::   ji, jj, jk   ! dummy loop indices
590      REAL(wp) ::   zt, zs, zh   ! local scalars
591      !!----------------------------------------------------------------------
592      !
593      SELECT CASE ( nn_eos )
594      !
595      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
596         DO jk = 1, jpk
597            DO jj = 1, jpj
598               DO ji = 1, jpi
599                  zt = pts(ji,jj,jk,jp_tem)           ! potential temperature
600                  zs = pts(ji,jj,jk,jp_sal) - 35._wp  ! salinity anomaly (s-35)
601                  zh = fsdept(ji,jj,jk)              ! depth in meters
602                  !
603                  pbeta(ji,jj,jk) = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt   &
604                     &                                        - 0.301985e-05_wp ) * zt   &
605                     &           + 0.785567e-03_wp                                       &
606                     &           + (     0.515032e-08_wp * zs                            &
607                     &                 + 0.788212e-08_wp * zt - 0.356603e-06_wp ) * zs   &
608                     &           + ( (   0.121551e-17_wp * zh                            &
609                     &                 - 0.602281e-15_wp * zs                            &
610                     &                 - 0.175379e-14_wp * zt + 0.176621e-12_wp ) * zh   &
611                     &                                        + 0.408195e-10_wp   * zs   &
612                     &             + ( - 0.213127e-11_wp * zt + 0.192867e-09_wp ) * zt   &
613                     &                                        - 0.121555e-07_wp ) * zh
614                     !
615                  palph(ji,jj,jk) = - pbeta(ji,jj,jk) *                             &
616                      &     ((( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &
617                      &                                  - 0.203814e-03_wp ) * zt   &
618                      &                                  + 0.170907e-01_wp ) * zt   &
619                      &   + 0.665157e-01_wp                                         &
620                      &   +     ( - 0.678662e-05_wp * zs                            &
621                      &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   &
622                      &   +   ( ( - 0.302285e-13_wp * zh                            &
623                      &           - 0.251520e-11_wp * zs                            &
624                      &           + 0.512857e-12_wp * zt * zt              ) * zh   &
625                      &           - 0.164759e-06_wp * zs                            &
626                      &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   &
627                      &                                  + 0.380374e-04_wp ) * zh)
628               END DO
629            END DO
630         END DO
631         !
632      CASE ( 1 )
633         palph(:,:,:) = - rn_alpha
634         pbeta(:,:,:) =   0._wp
635         !
636      CASE ( 2 )
637         palph(:,:,:) = - rn_alpha
638         pbeta(:,:,:) =   rn_beta
639         !
640      CASE DEFAULT
641         IF(lwp) WRITE(numout,cform_err)
642         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos
643         nstop = nstop + 1
644         !
645      END SELECT
646      !
647   END SUBROUTINE eos_alpbet
648
649
650   FUNCTION tfreez( psal ) RESULT( ptf )
651      !!----------------------------------------------------------------------
652      !!                 ***  ROUTINE eos_init  ***
653      !!
654      !! ** Purpose :   Compute the sea surface freezing temperature [Celcius]
655      !!
656      !! ** Method  :   UNESCO freezing point at the surface (pressure = 0???)
657      !!       freezing point [Celcius]=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p
658      !!       checkvalue: tf= -2.588567 Celsius for s=40.0psu, p=500. decibars
659      !!
660      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978
661      !!----------------------------------------------------------------------
662      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu]
663      REAL(wp), DIMENSION(jpi,jpj)                ::   ptf    ! freezing temperature [Celcius]
664      !!----------------------------------------------------------------------
665      !
666      ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   &
667         &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:)
668      !
669   END FUNCTION tfreez
670
671
672   SUBROUTINE eos_init
673      !!----------------------------------------------------------------------
674      !!                 ***  ROUTINE eos_init  ***
675      !!
676      !! ** Purpose :   initializations for the equation of state
677      !!
678      !! ** Method  :   Read the namelist nameos and control the parameters
679      !!----------------------------------------------------------------------
680      NAMELIST/nameos/ nn_eos, rn_alpha, rn_beta
681      !!----------------------------------------------------------------------
682      !
683      REWIND( numnam )            ! Read Namelist nameos : equation of state
684      READ  ( numnam, nameos )
685      !
686      IF(lwp) THEN                ! Control print
687         WRITE(numout,*)
688         WRITE(numout,*) 'eos_init : equation of state'
689         WRITE(numout,*) '~~~~~~~~'
690         WRITE(numout,*) '          Namelist nameos : set eos parameters'
691         WRITE(numout,*) '             flag for eq. of state and N^2  nn_eos   = ', nn_eos
692         WRITE(numout,*) '             thermal exp. coef. (linear)    rn_alpha = ', rn_alpha
693         WRITE(numout,*) '             saline  exp. coef. (linear)    rn_beta  = ', rn_beta
694      ENDIF
695      !
696      SELECT CASE( nn_eos )         ! check option
697      !
698      CASE( 0 )                        !==  Jackett and McDougall (1994) formulation  ==!
699         IF(lwp) WRITE(numout,*)
700         IF(lwp) WRITE(numout,*) '          use of Jackett & McDougall (1994) equation of state and'
701         IF(lwp) WRITE(numout,*) '                 McDougall (1987) Brunt-Vaisala frequency'
702         !
703      CASE( 1 )                        !==  Linear formulation = F( temperature )  ==!
704         IF(lwp) WRITE(numout,*)
705         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - rn_alpha * T )'
706         IF( lk_zdfddm ) CALL ctl_stop( '          double diffusive mixing parameterization requires',   &
707              &                         ' that T and S are used as state variables' )
708         !
709      CASE( 2 )                        !==  Linear formulation = F( temperature , salinity )  ==!
710         ralpbet = rn_alpha / rn_beta
711         IF(lwp) WRITE(numout,*)
712         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rn_beta * S - rn_alpha * T )'
713         !
714      CASE DEFAULT                     !==  ERROR in nn_eos  ==!
715         WRITE(ctmp1,*) '          bad flag value for nn_eos = ', nn_eos
716         CALL ctl_stop( ctmp1 )
717         !
718      END SELECT
719      !
720   END SUBROUTINE eos_init
721
722   !!======================================================================
723END MODULE eosbn2 
Note: See TracBrowser for help on using the repository browser.