Ignore:
Timestamp:
2007-10-10T10:14:32+02:00 (12 years ago)
Author:
smasson
Message:

code modifications associated with the new routines, see ticket:4

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/eosbn2.F90

    r699 r703  
    55   !!                                               - Brunt-Vaisala frequency  
    66   !!============================================================================== 
     7   !! History :       !  89-03  (O. Marti)  Original code 
     8   !!            6.0  !  94-07  (G. Madec, M. Imbard)  add bn2 
     9   !!            6.0  !  94-08  (G. Madec)  Add Jackett & McDougall eos 
     10   !!            7.0  !  96-01  (G. Madec)  statement function for e3 
     11   !!            8.1  !  97-07  (G. Madec)  introduction of neos, OPA8.1 
     12   !!            8.1  !  97-07  (G. Madec)  density instead of volumic mass 
     13   !!                 !  99-02  (G. Madec, N. Grima) semi-implicit pressure gradient 
     14   !!                 !  01-09  (M. Ben Jelloul)  bugfix onlinear eos 
     15   !!            8.5  !  02-10  (G. Madec)  add eos_init 
     16   !!            8.5  !  02-11  (G. Madec, A. Bozec)  partial step, eos_insitu_2d 
     17   !!            9.0  !  03-08  (G. Madec)  F90, free form 
     18   !!            9.0  !  06-08  (G. Madec)  add tfreez function 
     19   !!---------------------------------------------------------------------- 
    720 
    821   !!---------------------------------------------------------------------- 
     
    1326   !!   eos_insitu_2d  : Compute the in situ density for 2d fields 
    1427   !!   eos_bn2        : Compute the Brunt-Vaisala frequency 
     28   !!   tfreez         : Compute the surface freezing temperature 
    1529   !!   eos_init       : set eos parameters (namelist) 
    1630   !!---------------------------------------------------------------------- 
    17    !! * Modules used 
    1831   USE dom_oce         ! ocean space and time domain 
    1932   USE phycst          ! physical constants 
     
    3346   END INTERFACE  
    3447 
    35    !! * Routine accessibility 
    36    PUBLIC eos        ! called by step.F90, inidtr.F90, tranpc.F90 and intgrd.F90 
    37    PUBLIC bn2        ! called by step.F90 
    38    PUBLIC eos_init   ! called by step.F90 
    39  
    40    !! * Share module variables 
    41    INTEGER , PUBLIC ::   &  !: nameos : ocean physical parameters 
    42       neos      = 0,     &  !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
    43       neos_init = 0         !: control flag for initialization 
    44  
    45    REAL(wp), PUBLIC ::   &  !: nameos : ocean physical parameters 
    46       ralpha = 2.0e-4,   &  !: thermal expension coeff. (linear equation of state) 
    47       rbeta  = 7.7e-4       !: saline  expension coeff. (linear equation of state) 
     48   PUBLIC   eos        ! called by step, istate, tranpc and zpsgrd modules 
     49   PUBLIC   bn2        ! called by step module 
     50   PUBLIC   tfreez     ! called by sbcice_... modules 
     51 
     52   !!* Namelist (nameos) 
     53   INTEGER , PUBLIC ::   neos   = 0        !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
     54   REAL(wp), PUBLIC ::   ralpha = 2.0e-4   !: thermal expension coeff. (linear equation of state) 
     55   REAL(wp), PUBLIC ::   rbeta  = 7.7e-4   !: saline  expension coeff. (linear equation of state) 
     56   NAMELIST/nameos/ neos, ralpha, rbeta 
    4857    
     58   INTEGER ::   neos_init = 0         !: control flag for initialization 
     59 
    4960   !! * Substitutions 
    5061#  include "domzgr_substitute.h90" 
    5162#  include "vectopt_loop_substitute.h90" 
    5263   !!---------------------------------------------------------------------- 
    53    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     64   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    5465   !! $Id$ 
    55    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     66   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5667   !!---------------------------------------------------------------------- 
    5768 
    5869CONTAINS 
    5970 
    60    SUBROUTINE eos_insitu ( ptem, psal, prd ) 
     71   SUBROUTINE eos_insitu( ptem, psal, prd ) 
    6172      !!---------------------------------------------------------------------- 
    6273      !!                   ***  ROUTINE eos_insitu  *** 
     
    92103      !! ** Action  :   compute prd , the in situ density (no units) 
    93104      !! 
    94       !! References : 
    95       !!      Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994 
    96       !! 
    97       !! History : 
    98       !!        !  89-03 (o. Marti)  Original code 
    99       !!        ! 94-08 (G. Madec) 
    100       !!        !  96-01 (G. Madec) statement function for e3 
    101       !!        !  97-07 (G. Madec) introduction of neos, OPA8.1 
    102       !!        !  97-07 (G. Madec) density instead of volumic mass 
    103       !!        !  99-02 (G. Madec, N. Grima) semi-implicit pressure gradient 
    104       !!        !  01-09 (M. Ben Jelloul) bugfix    
    105       !!---------------------------------------------------------------------- 
    106       !! * Arguments 
    107       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   & 
    108          ptem,                 &  ! potential temperature 
    109          psal                     ! salinity 
    110       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   & 
    111          prd                      ! potential density (surface referenced) 
    112  
    113       !! * Local declarations 
     105      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
     106      !!---------------------------------------------------------------------- 
     107      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptem   ! potential temperature  [Celcius] 
     108      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   psal   ! salinity               [psu] 
     109      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   prd    ! in situ density  
     110      !! 
    114111      INTEGER ::  ji, jj, jk      ! dummy loop indices 
    115112      REAL(wp) ::   &           
     
    119116         zd , zc , zaw, za ,   &  !    "         " 
    120117         zb1, za1, zkw, zk0       !    "         " 
    121       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    122          zws                      ! temporary workspace 
    123       !!---------------------------------------------------------------------- 
    124  
    125  
    126       ! initialization (in not already done) 
    127       IF( neos_init == 0 ) CALL eos_init 
    128  
     118      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zws   ! temporary workspace 
     119      !!---------------------------------------------------------------------- 
     120 
     121      IF( neos_init == 0 ) CALL eos_init      ! initialization (in not already done) 
    129122 
    130123      SELECT CASE ( neos ) 
    131  
     124      ! 
    132125      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    133  
     126         ! 
    134127!CDIR NOVERRCHK 
    135128         zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) ) 
    136  
    137129         !                                                ! =============== 
    138130         DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    181173         END DO                                           !   End of slab 
    182174         !                                                ! =============== 
    183  
    184  
     175         ! 
    185176      CASE ( 1 )               ! Linear formulation function of temperature only 
    186  
     177         ! 
    187178         !                                                ! =============== 
    188179         DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    199190         END DO                                           !   End of slab 
    200191         !                                                ! =============== 
    201  
    202  
     192         ! 
    203193      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    204  
     194         ! 
    205195         !                                                ! =============== 
    206196         DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    217207         END DO                                           !   End of slab 
    218208         !                                                ! =============== 
    219  
     209         ! 
    220210      CASE DEFAULT 
    221  
     211         ! 
    222212         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    223213         CALL ctl_stop( ctmp1 ) 
    224  
     214         ! 
    225215      END SELECT 
    226  
    227       IF(ln_ctl)   THEN 
    228          CALL prt_ctl(tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk) 
    229       ENDIF 
    230  
     216      ! 
     217      IF(ln_ctl)   CALL prt_ctl(tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk) 
     218      ! 
    231219   END SUBROUTINE eos_insitu 
    232220 
    233221 
    234    SUBROUTINE eos_insitu_pot ( ptem, psal, prd, prhop) 
     222   SUBROUTINE eos_insitu_pot( ptem, psal, prd, prhop ) 
    235223      !!---------------------------------------------------------------------- 
    236224      !!                  ***  ROUTINE eos_insitu_pot  *** 
     
    275263      !!              - prhop, the potential volumic mass (Kg/m3) 
    276264      !! 
    277       !! References : 
    278       !!      Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994 
    279       !!      Brown, J. A. and K. A. Campana. Mon. Weather Rev., 1978 
    280       !! 
    281       !! History : 
    282       !!   4.0  !  89-03  (O. Marti) 
    283       !!        !  94-08  (G. Madec) 
    284       !!        !  96-01  (G. Madec) statement function for e3 
    285       !!        !  97-07  (G. Madec) introduction of neos, OPA8.1 
    286       !!        !  97-07  (G. Madec) density instead of volumic mass 
    287       !!        !  99-02  (G. Madec, N. Grima) semi-implicit pressure gradient 
    288       !!        !  01-09  (M. Ben Jelloul) bugfix    
    289       !!   9.0  !  03-08  (G. Madec)  F90, free form 
    290       !!---------------------------------------------------------------------- 
    291       !! * Arguments 
    292       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   & 
    293          ptem,   &  ! potential temperature 
    294          psal       ! salinity 
    295       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   & 
    296          prd,    &  ! potential density (surface referenced) 
    297          prhop      ! potential density (surface referenced) 
    298  
    299       !! * Local declarations 
     265      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
     266      !!                Brown and Campana, Mon. Weather Rev., 1978 
     267      !!---------------------------------------------------------------------- 
     268      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptem   ! potential temperature  [Celcius] 
     269      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   psal   ! salinity               [psu] 
     270      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   prd    ! in situ density  
     271      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     272 
    300273      INTEGER  ::  ji, jj, jk                ! dummy loop indices 
    301274      REAL(wp) ::   &             ! temporary scalars 
    302275         zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw,   & 
    303276         zb, zd, zc, zaw, za, zb1, za1, zkw, zk0 
    304       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zws 
    305       !!---------------------------------------------------------------------- 
    306  
    307       ! initialization (in not already done) 
    308       IF( neos_init == 0 ) CALL eos_init 
    309  
     277      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zws 
     278      !!---------------------------------------------------------------------- 
     279 
     280      IF( neos_init == 0 ) CALL eos_init      ! initialization (in not already done) 
    310281 
    311282      SELECT CASE ( neos ) 
    312  
     283      ! 
    313284      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    314  
     285         ! 
    315286!CDIR NOVERRCHK 
    316287         zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) ) 
    317  
    318288         !                                                ! =============== 
    319289         DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    326296                  zh = fsdept(ji,jj,jk) 
    327297                  ! square root salinity 
    328 !!Edmee           zsr= SQRT( ABS( zs ) ) 
    329298                  zsr= zws(ji,jj,jk) 
    330299                  ! compute volumic mass pure water at atm pressure 
     
    366335         END DO                                           !   End of slab 
    367336         !                                                ! =============== 
    368  
    369  
     337         ! 
    370338      CASE ( 1 )               ! Linear formulation function of temperature only 
    371  
     339         ! 
    372340         !                                                ! =============== 
    373341         DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    385353         END DO                                           !   End of slab 
    386354         !                                                ! =============== 
    387  
    388  
     355         ! 
    389356      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    390  
     357         ! 
    391358         !                                                ! =============== 
    392359         DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    404371         END DO                                           !   End of slab 
    405372         !                                                ! =============== 
    406  
     373         ! 
    407374      CASE DEFAULT 
    408  
     375         ! 
    409376         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    410377         CALL ctl_stop( ctmp1 ) 
    411  
     378         ! 
    412379      END SELECT 
    413  
    414       IF(ln_ctl)   THEN 
    415          CALL prt_ctl(tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk) 
    416       ENDIF 
    417  
     380      ! 
     381      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
     382      ! 
    418383   END SUBROUTINE eos_insitu_pot 
    419384 
    420    SUBROUTINE eos_insitu_2d ( ptem, psal, pdep, prd ) 
     385 
     386   SUBROUTINE eos_insitu_2d( ptem, psal, pdep, prd ) 
    421387      !!---------------------------------------------------------------------- 
    422388      !!                  ***  ROUTINE eos_insitu_2d  *** 
     
    452418      !! ** Action  : - prd , the in situ density (no units) 
    453419      !! 
    454       !! References : 
    455       !!      Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994 
    456       !! 
    457       !! History : 
    458       !!   8.5  !  02-11  (G. Madec, A. Bozec)  partial step 
    459       !!---------------------------------------------------------------------- 
    460       !! * Arguments 
    461       REAL(wp), DIMENSION(jpi,jpj), INTENT( in ) ::   & 
    462          ptem,                           &  ! potential temperature 
    463          psal,                           &  ! salinity 
    464          pdep                               ! depth 
    465       REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::   & 
    466          prd                                ! potential density (surface referenced) 
    467  
    468       !! * Local declarations 
    469       INTEGER ::  ji, jj                    ! dummy loop indices 
     420      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
     421      !!---------------------------------------------------------------------- 
     422      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ptem   ! potential temperature  [Celcius] 
     423      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity               [psu] 
     424      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pdep   ! depth                  [m] 
     425      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   prd    ! in situ density  
     426      !! 
     427      INTEGER  ::  ji, jj                    ! dummy loop indices 
    470428      REAL(wp) ::   &             ! temporary scalars 
    471429         zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw,   & 
    472430         zb, zd, zc, zaw, za, zb1, za1, zkw, zk0,               & 
    473431         zmask 
    474       REAL(wp), DIMENSION(jpi,jpj) :: zws 
    475       !!---------------------------------------------------------------------- 
    476  
    477  
    478       ! initialization (in not already done) 
    479       IF( neos_init == 0 ) CALL eos_init 
     432      REAL(wp), DIMENSION(jpi,jpj) ::   zws 
     433      !!---------------------------------------------------------------------- 
     434 
     435      IF( neos_init == 0 ) CALL eos_init      ! initialization (in not already done) 
    480436 
    481437      prd(:,:) = 0.e0 
    482438 
    483439      SELECT CASE ( neos ) 
    484  
     440      ! 
    485441      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    486  
     442      ! 
    487443!CDIR NOVERRCHK 
    488444         DO jj = 1, jpjm1 
     
    496452            END DO 
    497453         END DO 
    498  
    499454         !                                                ! =============== 
    500455         DO jj = 1, jpjm1                                 ! Horizontal slab 
     
    505460            DO ji = 1, fs_jpim1   ! vector opt. 
    506461#endif 
    507  
    508462               zmask = tmask(ji,jj,1)      ! land/sea bottom mask = surf. mask 
    509463 
     
    543497               ! masked in situ density anomaly 
    544498               prd(ji,jj) = ( zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 )   & 
    545                           / rau0 * zmask 
    546             END DO 
    547             !                                             ! =============== 
    548          END DO                                           !   End of slab 
    549          !                                                ! =============== 
    550  
    551  
     499                  &       / rau0 * zmask 
     500            END DO 
     501            !                                             ! =============== 
     502         END DO                                           !   End of slab 
     503         !                                                ! =============== 
     504         ! 
    552505      CASE ( 1 )               ! Linear formulation function of temperature only 
    553  
     506         ! 
    554507         !                                                ! =============== 
    555508         DO jj = 1, jpjm1                                 ! Horizontal slab 
     
    565518         END DO                                           !   End of slab 
    566519         !                                                ! =============== 
    567  
    568  
     520         ! 
    569521      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    570  
     522         ! 
    571523         !                                                ! =============== 
    572524         DO jj = 1, jpjm1                                 ! Horizontal slab 
     
    582534         END DO                                           !   End of slab 
    583535         !                                                ! =============== 
    584  
     536         ! 
    585537      CASE DEFAULT 
    586  
     538         ! 
    587539         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    588540         CALL ctl_stop( ctmp1 ) 
    589  
     541         ! 
    590542      END SELECT 
    591543 
    592       IF(ln_ctl)   CALL prt_ctl(tab2d_1=prd, clinfo1=' eos2d: ') 
    593  
     544      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
     545      ! 
    594546   END SUBROUTINE eos_insitu_2d 
    595547 
     
    623575      !! ** Action  : - pn2 : the brunt-vaisala frequency 
    624576      !! 
    625       !! References : 
    626       !!      McDougall, T. J., J. Phys. Oceanogr., 17, 1950-1964, 1987. 
    627       !! 
    628       !! History : 
    629       !!   6.0  !  94-07  (G. Madec, M. Imbard)  Original code 
    630       !!   8.0  !  97-07  (G. Madec) introduction of statement functions 
    631       !!   8.5  !  02-07  (G. Madec) Free form, F90 
    632       !!   8.5  !  02-08  (G. Madec) introduction of arguments 
    633       !!---------------------------------------------------------------------- 
    634       !! * Arguments 
    635       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   & 
    636          ptem,                           &  ! potential temperature 
    637          psal                               ! salinity 
    638       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   & 
    639          pn2                               ! Brunt-Vaisala frequency 
    640  
    641       !! * Local declarations 
     577      !! References :   McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987. 
     578      !!---------------------------------------------------------------------- 
     579      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptem   ! potential temperature   [Celcius] 
     580      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   psal   ! salinity                [psu] 
     581      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pn2    ! Brunt-Vaisala frequency [s-1] 
     582 
    642583      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    643       REAL(wp) ::   & 
    644          zgde3w, zt, zs, zh,  &  ! temporary scalars  
    645          zalbet, zbeta           !    "         " 
     584      REAL(wp) ::   zgde3w, zt, zs, zh,  &  ! temporary scalars  
     585         &          zalbet, zbeta           !    "         " 
    646586#if defined key_zdfddm 
    647587      REAL(wp) ::   zds          ! temporary scalars 
    648588#endif 
    649589      !!---------------------------------------------------------------------- 
    650       !!  OPA8.5, LODYC-IPSL (2002) 
    651       !!---------------------------------------------------------------------- 
    652590 
    653591      ! pn2 : first and last levels 
     
    660598 
    661599      SELECT CASE ( neos ) 
    662  
     600      ! 
    663601      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    664  
     602         ! 
    665603         !                                                ! =============== 
    666604         DO jk = 2, jpkm1                                 ! Horizontal slab 
     
    712650         END DO                                           !   End of slab 
    713651         !                                                ! =============== 
    714  
    715  
     652         ! 
    716653      CASE ( 1 )               ! Linear formulation function of temperature only 
    717  
     654         ! 
    718655         !                                                ! =============== 
    719656         DO jk = 2, jpkm1                                 ! Horizontal slab 
     
    728665         END DO                                           !   End of slab 
    729666         !                                                ! =============== 
    730  
    731  
     667         ! 
    732668      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    733  
     669         ! 
    734670         !                                                ! =============== 
    735671         DO jk = 2, jpkm1                                 ! Horizontal slab 
     
    756692         END DO                                           !   End of slab 
    757693         !                                                ! =============== 
    758  
     694         ! 
    759695      CASE DEFAULT 
    760  
     696         ! 
    761697         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    762698         CALL ctl_stop( ctmp1 ) 
    763  
     699         ! 
    764700      END SELECT 
    765701 
    766       IF(ln_ctl)   THEN 
    767          CALL prt_ctl(tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk) 
     702      IF(ln_ctl)   CALL prt_ctl(tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk) 
    768703#if defined key_zdfddm 
    769          CALL prt_ctl(tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk) 
     704      IF(ln_ctl)   CALL prt_ctl(tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk) 
    770705#endif 
    771       ENDIF 
    772  
     706      ! 
    773707   END SUBROUTINE eos_bn2 
    774708 
    775709 
     710   FUNCTION tfreez( psal ) RESULT( ptf ) 
     711      !!---------------------------------------------------------------------- 
     712      !!                 ***  ROUTINE eos_init  *** 
     713      !! 
     714      !! ** Purpose :   Compute the sea surface freezing temperature [Celcius] 
     715      !! 
     716      !! ** Method  :   UNESCO freezing point at the surface (pressure = 0???) 
     717      !!       freezing point [Celcius]=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p 
     718      !!       checkvalue: tf= -2.588567 Celsius for s=40.0psu, p=500. decibars 
     719      !! 
     720      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978 
     721      !!---------------------------------------------------------------------- 
     722      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu] 
     723      REAL(wp), DIMENSION(jpi,jpj)                ::   ptf    ! freezing temperature [Celcius] 
     724      !!---------------------------------------------------------------------- 
     725      ptf(:,:) = ( - 0.0575 + 1.710523e-3 * SQRT( psal(:,:) )   & 
     726         &                  - 2.154996e-4 *       psal(:,:)   ) * psal(:,:) 
     727   END FUNCTION tfreez 
     728 
     729 
    776730   SUBROUTINE eos_init 
    777731      !!---------------------------------------------------------------------- 
     
    780734      !! ** Purpose :   initializations for the equation of state 
    781735      !! 
    782       !! ** Method  :   Read the namelist nameos 
    783       !! 
    784       !! ** Action  :   blahblah.... 
    785       !! 
    786       !! History : 
    787       !!   8.5  !  02-10  (G. Madec)  Original code 
    788       !!---------------------------------------------------------------------- 
    789       NAMELIST/nameos/ neos, ralpha, rbeta 
    790       !!---------------------------------------------------------------------- 
    791       !!  OPA 8.5, LODYC-IPSL (2002) 
    792       !!---------------------------------------------------------------------- 
    793  
    794       ! set the initialization flag to 1 
    795       neos_init = 1           ! indicate that the initialization has been done 
    796  
    797       ! namelist nameos : ocean physical parameters 
    798  
    799       ! Read Namelist nameos : equation of state 
    800       REWIND( numnam ) 
     736      !! ** Method  :   Read the namelist nameos and control the parameters 
     737      !!---------------------------------------------------------------------- 
     738 
     739      neos_init = 1               ! indicate that the initialization has been done 
     740 
     741      REWIND( numnam )            ! Read Namelist nameos : equation of state 
    801742      READ  ( numnam, nameos ) 
    802743 
     
    807748         WRITE(numout,*) '~~~~~~~~' 
    808749         WRITE(numout,*) '          Namelist nameos : set eos parameters' 
    809          WRITE(numout,*) 
    810750         WRITE(numout,*) '             flag for eq. of state and N^2  neos   = ', neos 
    811751         WRITE(numout,*) '             thermal exp. coef. (linear)    ralpha = ', ralpha 
    812752         WRITE(numout,*) '             saline  exp. coef. (linear)    rbeta  = ', rbeta 
    813          WRITE(numout,*) 
    814753      ENDIF 
    815754 
     
    817756 
    818757      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    819  
     758         IF(lwp) WRITE(numout,*) 
    820759         IF(lwp) WRITE(numout,*) '          use of Jackett & McDougall (1994) equation of state and' 
    821760         IF(lwp) WRITE(numout,*) '                 McDougall (1987) Brunt-Vaisala frequency' 
    822  
     761         ! 
    823762      CASE ( 1 )               ! Linear formulation function of temperature only 
    824  
     763         IF(lwp) WRITE(numout,*) 
    825764         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - ralpha * T )' 
    826765         IF( lk_zdfddm ) CALL ctl_stop( '          double diffusive mixing parameterization requires',   & 
    827766              &                         ' that T and S are used as state variables' ) 
    828  
     767         ! 
    829768      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    830  
     769         IF(lwp) WRITE(numout,*) 
    831770         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )' 
    832  
    833       CASE DEFAULT 
    834  
     771         ! 
     772      CASE DEFAULT             ! E R R O R in neos  
    835773         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    836774         CALL ctl_stop( ctmp1 ) 
    837  
    838775      END SELECT 
    839776 
Note: See TracChangeset for help on using the changeset viewer.