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.
Changeset 13710 for NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests – NEMO

Ignore:
Timestamp:
2020-11-02T10:56:42+01:00 (4 years ago)
Author:
emanuelaclementi
Message:

branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves: merge with trunk@13708, see #2155 and #2339

Location:
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves
Files:
2 deleted
119 edited
5 copied

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@13559        sette 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/BENCH/EXPREF/namelist_cfg_orca025_like

    r12530 r13710  
    1515&namusr_def    !   User defined :   BENCH configuration: Flat bottom, beta-plane 
    1616!----------------------------------------------------------------------- 
    17    nn_isize   =   1442     ! number of point in i-direction of global(local) domain if >0 (<0)   
    18    nn_jsize   =   1207  !!  1050    ! number of point in j-direction of global(local) domain if >0 (<0)   
     17   nn_isize   =   1440     ! number of point in i-direction of global(local) domain if >0 (<0)   
     18   nn_jsize   =   1206  !!  1049    ! number of point in j-direction of global(local) domain if >0 (<0)   
    1919   nn_ksize   =   75       ! total number of point in k-direction 
    2020   nn_perio   =   4        ! periodicity 
    … …  
    3030&namctl        !   Control prints                                       (default: OFF) 
    3131!----------------------------------------------------------------------- 
    32    nn_print    =    0      !  level of print (0 no extra print) 
    3332   ln_timing   = .false.   !  timing by routine write out in timing.output file 
    3433/ 
    … …  
    7877!!                                                                    !! 
    7978!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    80 !!   namdrg_top    top    friction                                      (ln_OFF =F & ln_isfcav=T) 
    81 !!   namdrg_bot    bottom friction                                      (ln_OFF =F) 
     79!!   namdrg_top    top    friction                                      (ln_drg_OFF =F & ln_isfcav=T) 
     80!!   namdrg_bot    bottom friction                                      (ln_drg_OFF =F) 
    8281!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    8382!!   nambbl        bottom boundary layer scheme                         (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/BENCH/EXPREF/namelist_cfg_orca12_like

    r12530 r13710  
    1515&namusr_def    !   User defined :   BENCH configuration: Flat bottom, beta-plane 
    1616!----------------------------------------------------------------------- 
    17    nn_isize   =   4322     ! number of point in i-direction of global(local) domain if >0 (<0)   
    18    nn_jsize   =   3147     ! number of point in j-direction of global(local) domain if >0 (<0)   
     17   nn_isize   =   4320     ! number of point in i-direction of global(local) domain if >0 (<0)   
     18   nn_jsize   =   3146     ! number of point in j-direction of global(local) domain if >0 (<0)   
    1919   nn_ksize   =   75       ! total number of point in k-direction 
    2020   nn_perio   =   4        ! periodicity 
    … …  
    3030&namctl        !   Control prints                                       (default: OFF) 
    3131!----------------------------------------------------------------------- 
    32    nn_print    =    0      !  level of print (0 no extra print) 
    3332   ln_timing   = .false.   !  timing by routine write out in timing.output file 
    3433/ 
    … …  
    7877!!                                                                    !! 
    7978!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    80 !!   namdrg_top    top    friction                                      (ln_OFF =F & ln_isfcav=T) 
    81 !!   namdrg_bot    bottom friction                                      (ln_OFF =F) 
     79!!   namdrg_top    top    friction                                      (ln_drg_OFF =F & ln_isfcav=T) 
     80!!   namdrg_bot    bottom friction                                      (ln_drg_OFF =F) 
    8281!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    8382!!   nambbl        bottom boundary layer scheme                         (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/BENCH/EXPREF/namelist_cfg_orca1_like

    r12530 r13710  
    1515&namusr_def    !   User defined :   BENCH configuration: Flat bottom, beta-plane 
    1616!----------------------------------------------------------------------- 
    17    nn_isize   =   362      ! number of point in i-direction of global(local) domain if >0 (<0)   
    18    nn_jsize   =   332      ! number of point in j-direction of global(local) domain if >0 (<0)   
     17   nn_isize   =   360      ! number of point in i-direction of global(local) domain if >0 (<0)   
     18   nn_jsize   =   331      ! number of point in j-direction of global(local) domain if >0 (<0)   
    1919   nn_ksize   =   75       ! total number of point in k-direction 
    2020   nn_perio   =   6        ! periodicity 
    … …  
    3030&namctl        !   Control prints                                       (default: OFF) 
    3131!----------------------------------------------------------------------- 
    32    nn_print    =    0      !  level of print (0 no extra print) 
    3332   ln_timing   = .false.   !  timing by routine write out in timing.output file 
    3433/ 
    … …  
    7877!!                                                                    !! 
    7978!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    80 !!   namdrg_top    top    friction                                      (ln_OFF =F & ln_isfcav=T) 
    81 !!   namdrg_bot    bottom friction                                      (ln_OFF =F) 
     79!!   namdrg_top    top    friction                                      (ln_drg_OFF =F & ln_isfcav=T) 
     80!!   namdrg_bot    bottom friction                                      (ln_drg_OFF =F) 
    8281!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    8382!!   nambbl        bottom boundary layer scheme                         (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/BENCH/MY_SRC/usrdef_hgr.F90

    r9762 r13710  
    2424   PUBLIC   usr_def_hgr   ! called by domhgr.F90 
    2525 
     26   !! * Substitutions 
     27#  include "do_loop_substitute.h90" 
    2628   !!---------------------------------------------------------------------- 
    2729   !! NEMO/OPA 4.0, NEMO Consortium (2016) 
    … …  
    5961      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2] 
    6062      ! 
    61       INTEGER  ::   ji, jj   ! dummy loop indices 
     63      INTEGER  ::   ji, jj         ! dummy loop indices 
    6264      REAL(wp) ::   zres, zf0 
    63       REAL(wp) ::   zti, zui, ztj, zvj   ! local scalars 
     65      REAL(wp) ::   zti, ztj       ! local scalars 
    6466      !!------------------------------------------------------------------------------- 
    6567      ! 
    … …  
    7072      IF(lwp) WRITE(numout,*) '          given by rn_dx and rn_dy'  
    7173      ! 
    72       !                           
    7374      ! Position coordinates (in grid points) 
    74       !                          ==========          
    75       DO jj = 1, jpj 
    76          DO ji = 1, jpi 
    77              
    78             zti = REAL( ji - 1 + nimpp - 1, wp )          ;  ztj = REAL( jj - 1 + njmpp - 1, wp ) 
    79             zui = REAL( ji - 1 + nimpp - 1, wp ) + 0.5_wp ;  zvj = REAL( jj - 1 + njmpp - 1, wp ) + 0.5_wp 
     75      !                          ========== 
     76      DO_2D( 1, 1, 1, 1 ) 
     77          
     78         zti = REAL( mig0_oldcmp(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
     79         ztj = REAL( mjg0_oldcmp(jj) - 1, wp )   ! start at j=0 in the global grid without halos 
     80          
     81         plamt(ji,jj) = zti 
     82         plamu(ji,jj) = zti + 0.5_wp 
     83         plamv(ji,jj) = zti 
     84         plamf(ji,jj) = zti + 0.5_wp 
     85          
     86         pphit(ji,jj) = ztj 
     87         pphiu(ji,jj) = ztj 
     88         pphiv(ji,jj) = ztj + 0.5_wp 
     89         pphif(ji,jj) = ztj + 0.5_wp 
    8090 
    81             plamt(ji,jj) = zti 
    82             plamu(ji,jj) = zui 
    83             plamv(ji,jj) = zti 
    84             plamf(ji,jj) = zui 
    85     
    86             pphit(ji,jj) = ztj 
    87             pphiv(ji,jj) = zvj 
    88             pphiu(ji,jj) = ztj 
    89             pphif(ji,jj) = zvj 
    90              
    91          END DO 
    92       END DO 
     91      END_2D 
    9392      !      
    9493      ! Horizontal scale factors (in meters) 
    … …  
    109108      kff = 1                       !  indicate not to compute Coriolis parameter afterward 
    110109      ! 
    111       zf0   = 2._wp * omega * SIN( rad * 45 )   ! constant coriolis factor corresponding to 45°N 
     110      zf0 = 2._wp * omega * SIN( rad * 45 )   ! constant coriolis factor corresponding to 45°N 
    112111      pff_f(:,:) = zf0 
    113112      pff_t(:,:) = zf0 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/BENCH/MY_SRC/usrdef_istate.F90

    r11536 r13710  
    2828   PUBLIC   usr_def_istate   ! called by istate.F90 
    2929 
     30   !! * Substitutions 
     31#  include "do_loop_substitute.h90" 
    3032   !!---------------------------------------------------------------------- 
    3133   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    … …  
    5557      REAL(wp) ::   zfact 
    5658      INTEGER  ::   ji, jj, jk 
     59      INTEGER  ::   igloi, igloj   ! to be removed in the future, see comment bellow 
    5760      !!---------------------------------------------------------------------- 
    5861      ! 
    … …  
    6164      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   ' 
    6265      ! 
    63       ! define unique value on each point. z2d ranging from 0.05 to -0.05 
    64       DO jj = 1, jpj 
    65          DO ji = 1, jpi 
    66             z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji) + mjg(jj) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) 
    67          ENDDO 
    68       ENDDO 
     66      ! define unique value on each point of the inner global domain. z2d ranging from 0.05 to -0.05 
     67      ! 
     68      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,  
     69      ! we must define z2d as bellow. 
     70      ! Once we decide to forget trunk compatibility, we must simply define z2d as: 
     71!!$      DO_2D( 0, 0, 0, 0 ) 
     72!!$         z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) ) 
     73!!$      END_2D 
     74      igloi = Ni0glo + 2 * COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 
     75      igloj = Nj0glo + 2 * COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) + 1 * COUNT( (/ jperio >= 4 .AND. jperio <= 6 /) ) 
     76      DO_2D( 0, 0, 0, 0 ) 
     77         z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * igloi, wp ) / REAL( igloi * igloj, wp ) ) 
     78      END_2D 
    6979      ! 
    7080      ! sea level: 
    7181      pssh(:,:) = z2d(:,:)                                                ! +/- 0.05 m 
    7282      ! 
    73       DO jk = 1, jpk 
     83      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    7484         zfact = REAL(jk-1,wp) / REAL(jpk-1,wp)   ! 0 to 1 to add a basic stratification 
    7585         ! temperature choosen to lead to ~50% ice at the beginning if rn_thres_sst = 0.5 
    … …  
    7888         pts(:,:,jk,jp_sal) = 30._wp + 1._wp * zfact + z2d(:,:)           ! 30 to 31 +/- 0.05 psu 
    7989         ! velocities: 
    80          pu(:,:,jk) = z2d(:,:) * 0.1_wp                                   ! +/- 0.005  m/s 
    81          pv(:,:,jk) = z2d(:,:) * 0.01_wp                                  ! +/- 0.0005 m/s 
    82       ENDDO 
     90         pu(:,:,jk) = z2d(:,:) *  0.1_wp * umask(:,:,jk)                  ! +/- 0.005  m/s 
     91         pv(:,:,jk) = z2d(:,:) * 0.01_wp * vmask(:,:,jk)                  ! +/- 0.0005 m/s 
     92      END_3D 
     93      pts(:,:,jpk,:) = 0._wp 
     94      pu( :,:,jpk  ) = 0._wp 
     95      pv( :,:,jpk  ) = 0._wp 
    8396      ! 
    8497      CALL lbc_lnk('usrdef_istate', pssh, 'T',  1. )            ! apply boundary conditions 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/BENCH/MY_SRC/usrdef_nam.F90

    r12563 r13710  
    5858      !! 
    5959      NAMELIST/namusr_def/ nn_isize, nn_jsize, nn_ksize, nn_perio 
    60       NAMELIST/nammpp/ jpni, jpnj, ln_nnogather, ln_listonly 
     60      NAMELIST/nammpp/ jpni, jpnj, nn_hls, ln_nnogather, ln_listonly 
    6161      !!----------------------------------------------------------------------      
    6262      ! 
    … …  
    7777902      IF( ios >  0 )   CALL ctl_nam ( ios , 'nammpp in configuration namelist' ) 
    7878 
    79          kpi = ( -nn_isize - 2*nn_hls ) * jpni + 2*nn_hls 
    80          kpj = ( -nn_jsize - 2*nn_hls ) * jpnj + 2*nn_hls 
     79         kpi = -nn_isize * jpni 
     80         kpj = -nn_jsize * jpnj 
    8181      ELSE 
    8282         kpi = nn_isize 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/BENCH/MY_SRC/usrdef_sbc.F90

    r12377 r13710  
    3434   PUBLIC   usrdef_sbc_ice_flx  ! routine called by sbcice_lim.F90 for ice thermo 
    3535 
     36   !! * Substitutions 
     37#  include "do_loop_substitute.h90" 
    3638   !!---------------------------------------------------------------------- 
    3739   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    … …  
    9799      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace 
    98100      INTEGER  ::   ji, jj 
     101      INTEGER  ::   igloi, igloj   ! to be removed in the future, see comment bellow 
    99102      !!--------------------------------------------------------------------- 
    100103#if defined key_si3 
    … …  
    102105      ! 
    103106      ! define unique value on each point. z2d ranging from 0.05 to -0.05 
    104       DO jj = 1, jpj 
    105          DO ji = 1, jpi 
    106             z2d(ji,jj) = 0.1 * ( 0.5 - REAL( nimpp + ji - 1 + ( njmpp + jj - 2 ) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) 
    107          ENDDO 
    108       ENDDO 
    109       utau_ice(:,:) = 0.1_wp +  z2d(:,:) 
    110       vtau_ice(:,:) = 0.1_wp +  z2d(:,:) 
     107      ! 
     108      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,  
     109      ! we must define z2d as bellow. 
     110      ! Once we decide to forget trunk compatibility, we must simply define z2d as: 
     111!!$      DO_2D( 0, 0, 0, 0 ) 
     112!!$         z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) ) 
     113!!$      END_2D 
     114      igloi = Ni0glo + 2 * COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 
     115      igloj = Nj0glo + 2 * COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) + 1 * COUNT( (/ jperio >= 4 .AND. jperio <= 6 /) ) 
     116      DO_2D( 0, 0, 0, 0 ) 
     117         z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * igloi, wp ) / REAL( igloi * igloj, wp ) ) 
     118      END_2D 
     119      utau_ice(:,:) = 0.1_wp + z2d(:,:) 
     120      vtau_ice(:,:) = 0.1_wp + z2d(:,:) 
    111121 
    112122      CALL lbc_lnk_multi( 'usrdef_sbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 
    … …  
    127137      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness 
    128138      !! 
    129       REAL(wp) ::   zfr1, zfr2                 ! local variables 
    130139      REAL(wp), DIMENSION(jpi,jpj) ::   zsnw   ! snw distribution after wind blowing 
    131140      !!--------------------------------------------------------------------- 
    … …  
    162171      qsr_tot (:,:) = at_i_b(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 
    163172 
    164       ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 
    165       zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            ! transmission when hi>10cm 
    166       zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1 
    167       ! 
    168       WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
    169          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    170       ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm 
    171          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 
    172       ELSEWHERE                                                         ! zero when hs>0 
    173          qtr_ice_top(:,:,:) = 0._wp  
    174       END WHERE 
     173      ! --- shortwave radiation transmitted thru the surface scattering layer (W/m2) --- ! 
     174      qtr_ice_top(:,:,:) = 0._wp 
     175 
    175176#endif 
    176177 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/BENCH/MY_SRC/usrdef_zgr.F90

    r12377 r13710  
    192192      z2d(:,:) = REAL( jpkm1 , wp )          ! flat bottom 
    193193      ! 
    194       IF( jperio == 3 .OR. jperio ==4 ) THEN   ! add a small island in the upper corners to avoid model instabilities... 
    195          z2d(mi0(       1):mi1(     3),mj0(jpjglo-2):mj1(jpjglo)) = 0. 
    196          z2d(mi0(jpiglo-2):mi1(jpiglo),mj0(jpjglo-2):mj1(jpjglo)) = 0. 
    197       ENDIF 
     194      ! 
     195      ! BENCH should work without these 2 small islands on the 2 poles of the folding... 
     196      !   -> Comment out these lines if instabilities are too large... 
     197      ! 
     198       
     199!!$      IF( jperio == 3 .OR. jperio == 4 ) THEN   ! add a small island in the upper corners to avoid model instabilities... 
     200!!$         z2d(mi0(       nn_hls):mi1(                  nn_hls+2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0. 
     201!!$         z2d(mi0(jpiglo-nn_hls):mi1(MIN(jpiglo,jpiglo-nn_hls+2)),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0. 
     202!!$         z2d(mi0(jpiglo/2     ):mi1(           jpiglo/2     +2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0. 
     203!!$      ENDIF 
     204!!$      ! 
     205!!$      IF( jperio == 5 .OR. jperio == 6 ) THEN   ! add a small island in the upper corners to avoid model instabilities... 
     206!!$         z2d(mi0(       nn_hls):mi1(       nn_hls+1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls+1)) = 0. 
     207!!$         z2d(mi0(jpiglo-nn_hls):mi1(jpiglo-nn_hls+1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls+1)) = 0. 
     208!!$         z2d(mi0(jpiglo/2     ):mi1(jpiglo/2     +1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls+1)) = 0. 
     209!!$      ENDIF 
     210 
    198211      ! 
    199212      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/CANAL/EXPREF/context_nemo.xml

    r12276 r13710  
    1111       <variable id="ref_month" type="int"> 01 </variable> 
    1212       <variable id="ref_day"   type="int"> 01 </variable> 
    13        <variable id="rau0"      type="float" > 1026.0 </variable> 
     13       <variable id="rho0"      type="float" > 1026.0 </variable> 
    1414       <variable id="cpocean"   type="float" > 3991.86795711963 </variable> 
    1515       <variable id="convSpsu"  type="float" > 0.99530670233846  </variable> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/CANAL/EXPREF/file_def_nemo-oce.xml

    r9572 r13710  
    1515     <field field_ref="soce" />  
    1616     <field field_ref="ssh"  /> 
    17      <field field_ref="salgrad"  /> 
    18      <field field_ref="ke_zint"  /> 
     17     <field field_ref="socegrad"  /> 
     18     <field field_ref="eken_int"  /> 
    1919     <field field_ref="relvor"  /> 
    2020     <field field_ref="potvor"  /> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/CANAL/EXPREF/namelist_cfg

    r12489 r13710  
    2020&namusr_def    !   User defined :   CANAL configuration: Flat bottom, beta-plane 
    2121!----------------------------------------------------------------------- 
    22    rn_domszx   =   3600.   !  x horizontal size         [km] 
    23    rn_domszy   =   1800.   !  y horizontal size         [km] 
    24    rn_domszz   =   5000.   !  z vertical size            [m] 
    25    rn_dx       =     30.   !  x horizontal resolution   [km] 
    26    rn_dy       =     30.   !  y horizontal resolution   [km] 
    27    rn_dz       =    500.   !  z vertical resolution      [m] 
     22   rn_domszx   =   2000.   !  x horizontal size         [km] 
     23   rn_domszy   =   1000.   !  y horizontal size         [km] 
     24   rn_domszz   =   1000.   !  z vertical size            [m] 
     25   rn_dx       =     10.   !  x horizontal resolution   [km] 
     26   rn_dy       =     10.   !  y horizontal resolution   [km] 
     27   rn_dz       =   1000.   !  z vertical resolution      [m] 
    2828   rn_0xratio  =      0.5  !  x-domain ratio of the 0 
    2929   rn_0yratio  =      0.5  !  y-domain ratio of the 0 
    … …  
    3131   rn_ppgphi0  =    38.5   !  Reference latitude      [degrees] 
    3232   rn_u10      =      0.   !  10m wind speed              [m/s] 
    33      rn_windszx =   4000.   !  longitudinal wind extension   [km] 
    34      rn_windszy =   4000.   !  latitudinal wind extension    [km] 
    35      rn_uofac  =      0.   !  Uoce multiplicative factor (0.:absolute or 1.:relative winds) 
     33     rn_windszx =   90.    !  longitudinal wind extension   [km] 
     34     rn_windszy =   90.    !  latitudinal wind extension    [km] 
     35!!clem     rn_uofac  =     0.    !  Uoce multiplicative factor (0.:absolute or 1.:relative winds) 
    3636   rn_vtxmax   =      1.   !  initial vortex max current  [m/s] 
    3737   rn_uzonal   =      1.   !  initial zonal current       [m/s] 
    38      rn_ujetszx =   4000.   !  longitudinal jet extension   [km] 
    39      rn_ujetszy =   4000.   !  latitudinal jet extension    [km] 
     38     rn_ujetszx =   4000.  !  longitudinal jet extension   [km] 
     39     rn_ujetszy =   400.   !  latitudinal jet extension    [km] 
    4040   nn_botcase  =      0    !  bottom definition (0:flat, 1:bump) 
    41    nn_initcase =      1    !  initial condition case (0:rest, 1:zonal current, 2:current shear, 3: gaussian zonal current, 
    42       !                    !                          4: geostrophic zonal pulse, 5: vortex) 
    43    ln_sshnoise =  .false.  !  add random noise on initial ssh 
    44    rn_lambda   =     50.   ! gaussian lambda 
     41   nn_initcase =      1    !  initial condition case 
     42   !                       !          -1 : stratif at rest 
     43   !                       !           0 : rest 
     44   !                       !           1 : zonal current 
     45   !                       !           2 : current shear 
     46   !                       !           3 : gaussian zonal current 
     47   !                       !           4 : geostrophic zonal pulse 
     48   !                       !           5 : baroclinic vortex 
     49   ln_sshnoise =  .FALSE.  !  add random noise on initial ssh 
     50   rn_lambda   =     50.   !  gaussian lambda 
     51   nn_perio    = 1 
    4552/ 
    4653!----------------------------------------------------------------------- 
    … …  
    5966!----------------------------------------------------------------------- 
    6067   ln_linssh   =  .false.  !  =T  linear free surface  ==>>  model level are fixed in time 
    61    rn_Dt      =   1440.   !  time step for the dynamics (and tracer if nn_acc=0) 
    62    rn_atfp     =   0.05    !  asselin time filter parameter 
     68   rn_Dt      =   1200.    !  time step for the dynamics (and tracer if nn_acc=0) 
     69   rn_atfp     =   0.0     !  asselin time filter parameter 
     70/ 
     71!----------------------------------------------------------------------- 
     72&namcfg        !   parameters of the configuration                      (default: use namusr_def in namelist_cfg) 
     73!----------------------------------------------------------------------- 
     74   ln_write_cfg = .false.   !  (=T) create the domain configuration file 
     75      cn_domcfg_out = "domain_cfg" ! newly created domain configuration filename 
    6376/ 
    6477!!====================================================================== 
    … …  
    108121!!                                                                    !! 
    109122!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    110 !!   namdrg_top    top    friction                                      (ln_OFF =F & ln_isfcav=T) 
    111 !!   namdrg_bot    bottom friction                                      (ln_OFF =F) 
     123!!   namdrg_top    top    friction                                      (ln_drg_OFF =F & ln_isfcav=T) 
     124!!   namdrg_bot    bottom friction                                      (ln_drg_OFF =F) 
    112125!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    113126!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    117130&namdrg        !   top/bottom drag coefficient                          (default: NO selection) 
    118131!----------------------------------------------------------------------- 
    119    ln_OFF     = .true.    !  free-slip       : Cd = 0 
     132   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    120133/ 
    121134!!====================================================================== 
    … …  
    134147!----------------------------------------------------------------------- 
    135148   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    136    !                            !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     149   !                            !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    137150   rn_a0       =  0.28        !  thermal expension coefficient (for simplified equation of state) 
    138151   rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state) 
    … …  
    148161   ln_traadv_OFF = .false. !  No tracer advection 
    149162   ln_traadv_cen = .false. !  2nd order centered scheme 
    150       nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN 
    151       nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT 
     163      nn_cen_h   =  2            !  =2/4, horizontal 2nd order CEN / 4th order CEN 
     164      nn_cen_v   =  2            !  =2/4, vertical   2nd order CEN / 4th order COMPACT 
    152165   ln_traadv_fct = .false. !  FCT scheme 
    153       nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
     166      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order 
    154167      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
    155168   ln_traadv_mus = .false. !  MUSCL scheme 
    … …  
    162175&namtra_ldf    !   lateral diffusion scheme for tracers                 (default: NO selection) 
    163176!----------------------------------------------------------------------- 
    164    ln_traldf_OFF   =  .true.  !  No explicit diffusion 
     177   !                       !  Operator type: 
     178   ln_traldf_OFF   = .true.    !  No explicit diffusion 
     179   ln_traldf_lap   = .false.   !    laplacian operator 
     180   ln_traldf_blp   = .false.   !  bilaplacian operator 
     181   ! 
     182   !                       !  Direction of action: 
     183   ln_traldf_lev   = .false.   !  iso-level 
     184   ln_traldf_hor   = .true.    !  horizontal  (geopotential) 
     185   ln_traldf_iso   = .false.   !  iso-neutral (standard operator) 
     186   ln_traldf_triad = .false.   !  iso-neutral (triad    operator) 
     187   ! 
     188   !                             !  iso-neutral options: 
     189   ln_traldf_msc   = .false.   !  Method of Stabilizing Correction      (both operators) 
     190   rn_slpmax       =  0.01     !  slope limit                           (both operators) 
     191   ln_triad_iso    = .false.   !  pure horizontal mixing in ML              (triad only) 
     192   rn_sw_triad     = 1         !  =1 switching triad ; =0 all 4 triads used (triad only) 
     193   ln_botmix_triad = .false.   !  lateral mixing on bottom                  (triad only) 
     194   ! 
     195   !                       !  Coefficients: 
     196   nn_aht_ijk_t    = 31         !  space/time variation of eddy coefficient: 
     197      !                             !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file 
     198      !                             !   =  0           constant 
     199      !                             !   = 10 F(k)      =ldf_c1d 
     200      !                             !   = 20 F(i,j)    =ldf_c2d 
     201      !                             !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation 
     202      !                             !   = 30 F(i,j,k)  =ldf_c2d * ldf_c1d 
     203      !                             !   = 31 F(i,j,k,t)=F(local velocity and grid-spacing) 
     204      !                        !  time invariant coefficients:  aht0 = 1/2  Ud*Ld   (lap case) 
     205      !                             !                           or   = 1/12 Ud*Ld^3 (blp case) 
     206      rn_Ud        = 0.01           !  lateral diffusive velocity [m/s] (nn_aht_ijk_t= 0, 10, 20, 30) 
     207      rn_Ld        = 200.e+3        !  lateral diffusive length   [m]   (nn_aht_ijk_t= 0, 10) 
    165208/ 
    166209!!====================================================================== 
    … …  
    183226      nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction 
    184227   ln_dynadv_cen2 = .false. !  flux form - 2nd order centered scheme 
    185    ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme 
     228   ln_dynadv_ubs  = .true.  !  flux form - 3rd order UBS      scheme 
    186229/ 
    187230!----------------------------------------------------------------------- 
    188231&namdyn_vor    !   Vorticity / Coriolis scheme                          (default: NO selection) 
    189232!----------------------------------------------------------------------- 
    190    ln_dynvor_ene = .true.  !  energy conserving scheme 
    191    ln_dynvor_ens = .false. !  enstrophy conserving scheme 
    192    ln_dynvor_mix = .false. !  mixed scheme 
     233   ln_dynvor_ene = .false.  !  energy conserving scheme 
     234   ln_dynvor_ens = .false.  !  enstrophy conserving scheme 
     235   ln_dynvor_mix = .false.  !  mixed scheme 
    193236   ln_dynvor_een = .false.  !  energy & enstrophy scheme 
     237   ln_dynvor_enT = .false.  !  energy conserving scheme (T-point) 
     238   ln_dynvor_eeT = .true.   !  energy conserving scheme (een using e3t) 
    194239      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    195240/ 
    … …  
    210255         !                          !                     = 1 Boxcar over   nn_e sub-steps 
    211256         !                          !                     = 2 Boxcar over 2*nn_e  "    " 
    212       ln_bt_auto    = .false.    ! Number of sub-step defined from: 
     257      ln_bt_auto    = .true.    ! Number of sub-step defined from: 
    213258         nn_e      =  24         ! =F : the number of sub-step in rn_Dt seconds 
    214259/ 
    … …  
    222267   !                       !  Direction of action  : 
    223268   ln_dynldf_lev =  .false.    !  iso-level 
    224    ln_dynldf_hor =  .true.    !  horizontal (geopotential) 
     269   ln_dynldf_hor =  .false.    !  horizontal (geopotential) 
    225270   ln_dynldf_iso =  .false.    !  iso-neutral 
    226271   !                       !  Coefficient 
    227    nn_ahm_ijk_t  = 20           !  space/time variation of eddy coef 
     272   nn_ahm_ijk_t  = 31           !  space/time variation of eddy coef 
    228273      !                             !  =-30  read in eddy_viscosity_3D.nc file 
    229274      !                             !  =-20  read in eddy_viscosity_2D.nc file 
    … …  
    271316!!                                                                    !! 
    272317!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    273 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    274318!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    275319!!   namdiu       Cool skin and warm layer models                       (default: OFF) 
    276320!!   namdiu       Cool skin and warm layer models                       (default: OFF) 
     321<<<<<<< .working 
    277322!!   namflo       float parameters                                      (default: OFF) 
    278323!!   nam_diadct   transports through some sections                      (default: OFF) 
     324||||||| .merge-left.r13465 
     325!!   namflo       float parameters                                      (default: OFF) 
     326!!   nam_diaharm  Harmonic analysis of tidal constituents               (default: OFF) 
     327!!   nam_diadct   transports through some sections                      (default: OFF) 
     328======= 
     329!!   namflo       float parameters                                      ("key_float") 
     330!!   nam_diaharm  Harmonic analysis of tidal constituents               ("key_diaharm") 
     331!!   namdct       transports through some sections                      ("key_diadct") 
     332!!   nam_diatmb   Top Middle Bottom Output                              (default: OFF) 
     333>>>>>>> .merge-right.r13470 
    279334!!   nam_dia25h   25h Mean Output                                       (default: OFF) 
    280335!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4") 
    … …  
    285340!----------------------------------------------------------------------- 
    286341   ln_glo_trd  = .false.   ! (T) global domain averaged diag for T, T^2, KE, and PE 
    287    ln_dyn_trd  = .true.   ! (T) 3D momentum trend output 
     342   ln_dyn_trd  = .true.    ! (T) 3D momentum trend output 
    288343   ln_dyn_mxl  = .false.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet) 
    289344   ln_vor_trd  = .false.   ! (T) 2D barotropic vorticity trends (not coded yet) 
    … …  
    312367&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi") 
    313368!----------------------------------------------------------------------- 
     369!!   jpni        =   8       !  jpni   number of processors following i (set automatically if < 1) 
     370!!   jpnj        =   1       !  jpnj   number of processors following j (set automatically if < 1) 
    314371/ 
    315372!----------------------------------------------------------------------- 
    316373&namctl        !   Control prints                                       (default: OFF) 
    317374!----------------------------------------------------------------------- 
     375   ln_timing   = .true.   !  timing by routine write out in timing.output file 
     376!!   ln_diacfl   = .true.   !  CFL diagnostics write out in cfl_diagnostics.ascii 
    318377/ 
    319378!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/CANAL/MY_SRC/domvvl.F90

    r12489 r13710  
    99   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability 
    1010   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping 
     11   !!            4.x  ! 2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio 
    1112   !!---------------------------------------------------------------------- 
    1213 
    13    !!---------------------------------------------------------------------- 
    14    !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
    15    !!   dom_vvl_sf_nxt   : Compute next vertical scale factors 
    16    !!   dom_vvl_sf_update   : Swap vertical scale factors and update the vertical grid 
    17    !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 
    18    !!   dom_vvl_rst      : read/write restart file 
    19    !!   dom_vvl_ctl      : Check the vvl options 
    20    !!---------------------------------------------------------------------- 
    2114   USE oce             ! ocean dynamics and tracers 
    2215   USE phycst          ! physical constant 
    … …  
    3629   PRIVATE 
    3730 
    38    PUBLIC  dom_vvl_init       ! called by domain.F90 
    39    PUBLIC  dom_vvl_sf_nxt     ! called by step.F90 
    40    PUBLIC  dom_vvl_sf_update  ! called by step.F90 
    41    PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
    42  
    4331   !                                                      !!* Namelist nam_vvl 
    4432   LOGICAL , PUBLIC :: ln_vvl_zstar           = .FALSE.    ! zstar  vertical coordinate 
    … …  
    6250   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence 
    6351 
     52#if defined key_qco 
     53   !!---------------------------------------------------------------------- 
     54   !!   'key_qco'      EMPTY MODULE      Quasi-Eulerian vertical coordonate 
     55   !!---------------------------------------------------------------------- 
     56#else 
     57   !!---------------------------------------------------------------------- 
     58   !!   Default key      Old management of time varying vertical coordinate 
     59   !!---------------------------------------------------------------------- 
     60    
     61   !!---------------------------------------------------------------------- 
     62   !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
     63   !!   dom_vvl_sf_nxt   : Compute next vertical scale factors 
     64   !!   dom_vvl_sf_update   : Swap vertical scale factors and update the vertical grid 
     65   !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 
     66   !!   dom_vvl_rst      : read/write restart file 
     67   !!   dom_vvl_ctl      : Check the vvl options 
     68   !!---------------------------------------------------------------------- 
     69 
     70   PUBLIC  dom_vvl_init       ! called by domain.F90 
     71   PUBLIC  dom_vvl_zgr        ! called by isfcpl.F90 
     72   PUBLIC  dom_vvl_sf_nxt     ! called by step.F90 
     73   PUBLIC  dom_vvl_sf_update  ! called by step.F90 
     74   PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
     75    
     76   !! * Substitutions 
     77#  include "do_loop_substitute.h90" 
    6478   !!---------------------------------------------------------------------- 
    6579   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    116130      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 
    117131      ! 
     132      IF(lwp) WRITE(numout,*) 
     133      IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated' 
     134      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     135      ! 
     136      CALL dom_vvl_ctl     ! choose vertical coordinate (z_star, z_tilde or layer) 
     137      ! 
     138      !                    ! Allocate module arrays 
     139      IF( dom_vvl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' ) 
     140      ! 
     141      !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 
     142      CALL dom_vvl_rst( nit000, Kbb, Kmm, 'READ' ) 
     143      e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all 
     144      ! 
     145      CALL dom_vvl_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column 
     146      ! 
     147   END SUBROUTINE dom_vvl_init 
     148 
     149 
     150   SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa) 
     151      !!---------------------------------------------------------------------- 
     152      !!                ***  ROUTINE dom_vvl_init  *** 
     153      !!                    
     154      !! ** Purpose :  Interpolation of all scale factors,  
     155      !!               depths and water column heights 
     156      !! 
     157      !! ** Method  :  - interpolate scale factors 
     158      !! 
     159      !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b) 
     160      !!              - Regrid: e3(u/v)_n 
     161      !!                        e3(u/v)_b        
     162      !!                        e3w_n            
     163      !!                        e3(u/v)w_b       
     164      !!                        e3(u/v)w_n       
     165      !!                        gdept_n, gdepw_n and gde3w_n 
     166      !!              - h(t/u/v)_0 
     167      !!              - frq_rst_e3t and frq_rst_hdv 
     168      !! 
     169      !! Reference  : Leclair, M., and G. Madec, 2011, Ocean Modelling. 
     170      !!---------------------------------------------------------------------- 
     171      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 
     172      !!---------------------------------------------------------------------- 
    118173      INTEGER ::   ji, jj, jk 
    119174      INTEGER ::   ii0, ii1, ij0, ij1 
    120175      REAL(wp)::   zcoef 
    121176      !!---------------------------------------------------------------------- 
    122       ! 
    123       IF(lwp) WRITE(numout,*) 
    124       IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated' 
    125       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    126       ! 
    127       CALL dom_vvl_ctl     ! choose vertical coordinate (z_star, z_tilde or layer) 
    128       ! 
    129       !                    ! Allocate module arrays 
    130       IF( dom_vvl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' ) 
    131       ! 
    132       !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 
    133       CALL dom_vvl_rst( nit000, Kbb, Kmm, 'READ' ) 
    134       e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all 
    135177      ! 
    136178      !                    !== Set of all other vertical scale factors  ==!  (now and before) 
    … …  
    160202      gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 
    161203      gdepw(:,:,1,Kbb) = 0.0_wp 
    162       DO jk = 2, jpk                               ! vertical sum 
    163          DO jj = 1,jpj 
    164             DO ji = 1,jpi 
    165                !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    166                !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
    167                !                             ! 0.5 where jk = mikt      
     204      DO_3D( 1, 1, 1, 1, 2, jpk ) 
     205         !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
     206         !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
     207         !                             ! 0.5 where jk = mikt      
    168208!!gm ???????   BUG ?  gdept(:,:,:,Kmm) as well as gde3w  does not include the thickness of ISF ?? 
    169                zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 
    170                gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
    171                gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  & 
    172                   &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm))  
    173                gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
    174                gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 
    175                gdept(ji,jj,jk,Kbb) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb))  & 
    176                   &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb))  
    177             END DO 
    178          END DO 
    179       END DO 
     209         zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 
     210         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
     211         gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  & 
     212            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm))  
     213         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
     214         gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 
     215         gdept(ji,jj,jk,Kbb) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb))  & 
     216            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb))  
     217      END_3D 
    180218      ! 
    181219      !                    !==  thickness of the water column  !!   (ocean portion only) 
    … …  
    212250         ENDIF 
    213251         IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator 
    214             DO jj = 1, jpj 
    215                DO ji = 1, jpi 
     252            DO_2D( 1, 1, 1, 1 ) 
    216253!!gm  case |gphi| >= 6 degrees is useless   initialized just above by default 
    217                   IF( ABS(gphit(ji,jj)) >= 6.) THEN 
    218                      ! values outside the equatorial band and transition zone (ztilde) 
    219                      frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp ) 
    220                      frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 
    221                   ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star 
    222                      ! values inside the equatorial band (ztilde as zstar) 
    223                      frq_rst_e3t(ji,jj) =  0.0_wp 
    224                      frq_rst_hdv(ji,jj) =  1.0_wp / rn_Dt 
    225                   ELSE                                      ! transition band (2.5 to 6 degrees N/S) 
    226                      !                                      ! (linearly transition from z-tilde to z-star) 
    227                      frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   & 
    228                         &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  & 
    229                         &                                          * 180._wp / 3.5_wp ) ) 
    230                      frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt)                                & 
    231                         &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp   & 
    232                         &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  & 
    233                         &                                          * 180._wp / 3.5_wp ) ) 
    234                   ENDIF 
    235                END DO 
    236             END DO 
     254               IF( ABS(gphit(ji,jj)) >= 6.) THEN 
     255                  ! values outside the equatorial band and transition zone (ztilde) 
     256                  frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp ) 
     257                  frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 
     258               ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star 
     259                  ! values inside the equatorial band (ztilde as zstar) 
     260                  frq_rst_e3t(ji,jj) =  0.0_wp 
     261                  frq_rst_hdv(ji,jj) =  1.0_wp / rn_Dt 
     262               ELSE                                      ! transition band (2.5 to 6 degrees N/S) 
     263                  !                                      ! (linearly transition from z-tilde to z-star) 
     264                  frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   & 
     265                     &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  & 
     266                     &                                          * 180._wp / 3.5_wp ) ) 
     267                  frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt)                                & 
     268                     &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp   & 
     269                     &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  & 
     270                     &                                          * 180._wp / 3.5_wp ) ) 
     271               ENDIF 
     272            END_2D 
    237273            IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
    238274               IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
    239                   ii0 = 103   ;   ii1 = 111        
    240                   ij0 = 128   ;   ij1 = 135   ;    
     275                  ii0 = 103 + nn_hls - 1   ;   ii1 = 111 + nn_hls - 1       
     276                  ij0 = 128 + nn_hls       ;   ij1 = 135 + nn_hls 
    241277                  frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
    242278                  frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rn_Dt 
    … …  
    264300      ENDIF 
    265301      ! 
    266    END SUBROUTINE dom_vvl_init 
     302   END SUBROUTINE dom_vvl_zgr 
    267303 
    268304 
    … …  
    298334      LOGICAL                ::   ll_do_bclinic         ! local logical 
    299335      REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
    300       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t 
     336      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ze3t 
     337      LOGICAL , DIMENSION(:,:,:), ALLOCATABLE ::   llmsk 
    301338      !!---------------------------------------------------------------------- 
    302339      ! 
    … …  
    329366      END DO 
    330367      ! 
    331       IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate ! 
    332          !                                                            ! ------baroclinic part------ ! 
     368      IF( (ln_vvl_ztilde .OR. ln_vvl_layer) .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate ! 
     369         !                                                               ! ------baroclinic part------ ! 
    333370         ! I - initialization 
    334371         ! ================== 
    … …  
    383420         zwu(:,:) = 0._wp 
    384421         zwv(:,:) = 0._wp 
    385          DO jk = 1, jpkm1        ! a - first derivative: diffusive fluxes 
    386             DO jj = 1, jpjm1 
    387                DO ji = 1, fs_jpim1   ! vector opt. 
    388                   un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           & 
    389                      &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
    390                   vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           &  
    391                      &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) ) 
    392                   zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 
    393                   zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 
    394                END DO 
    395             END DO 
    396          END DO 
    397          DO jj = 1, jpj          ! b - correction for last oceanic u-v points 
    398             DO ji = 1, jpi 
    399                un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 
    400                vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 
    401             END DO 
    402          END DO 
    403          DO jk = 1, jpkm1        ! c - second derivative: divergence of diffusive fluxes 
    404             DO jj = 2, jpjm1 
    405                DO ji = fs_2, fs_jpim1   ! vector opt. 
    406                   tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    & 
    407                      &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    & 
    408                      &                                            ) * r1_e1e2t(ji,jj) 
    409                END DO 
    410             END DO 
    411          END DO 
     422         DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     423            un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           & 
     424               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
     425            vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           &  
     426               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) ) 
     427            zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 
     428            zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 
     429         END_3D 
     430         DO_2D( 1, 1, 1, 1 ) 
     431            un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 
     432            vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 
     433         END_2D 
     434         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     435            tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    & 
     436               &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    & 
     437               &                                            ) * r1_e1e2t(ji,jj) 
     438         END_3D 
    412439         !                       ! d - thickness diffusion transport: boundary conditions 
    413440         !                             (stored for tracer advction and continuity equation) 
    … …  
    416443         ! 4 - Time stepping of baroclinic scale factors 
    417444         ! --------------------------------------------- 
    418          ! Leapfrog time stepping 
    419          ! ~~~~~~~~~~~~~~~~~~~~~~ 
    420445         CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 
    421446         tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + rDt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 
    … …  
    423448         ! Maximum deformation control 
    424449         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    425          ze3t(:,:,jpk) = 0._wp 
    426          DO jk = 1, jpkm1 
    427             ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    428          END DO 
    429          z_tmax = MAXVAL( ze3t(:,:,:) ) 
    430          CALL mpp_max( 'domvvl', z_tmax )                 ! max over the global domain 
    431          z_tmin = MINVAL( ze3t(:,:,:) ) 
    432          CALL mpp_min( 'domvvl', z_tmin )                 ! min over the global domain 
     450         ALLOCATE( ze3t(jpi,jpj,jpk), llmsk(jpi,jpj,jpk) ) 
     451         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     452            ze3t(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) / e3t_0(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     453         END_3D 
     454         ! 
     455         llmsk(   1:Nis1,:,:) = .FALSE.   ! exclude halos from the checked region 
     456         llmsk(Nie1: jpi,:,:) = .FALSE. 
     457         llmsk(:,   1:Njs1,:) = .FALSE. 
     458         llmsk(:,Nje1: jpj,:) = .FALSE. 
     459         ! 
     460         llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp                  ! define only the inner domain 
     461         z_tmax = MAXVAL( ze3t(:,:,:), mask = llmsk )   ;   CALL mpp_max( 'domvvl', z_tmax )   ! max over the global domain 
     462         z_tmin = MINVAL( ze3t(:,:,:), mask = llmsk )   ;   CALL mpp_min( 'domvvl', z_tmin )   ! min over the global domain 
    433463         ! - ML - test: for the moment, stop simulation for too large e3_t variations 
    434464         IF( ( z_tmax >  rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 
    435             IF( lk_mpp ) THEN 
    436                CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 
    437                CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 
    438             ELSE 
    439                ijk_max = MAXLOC( ze3t(:,:,:) ) 
    440                ijk_max(1) = ijk_max(1) + nimpp - 1 
    441                ijk_max(2) = ijk_max(2) + njmpp - 1 
    442                ijk_min = MINLOC( ze3t(:,:,:) ) 
    443                ijk_min(1) = ijk_min(1) + nimpp - 1 
    444                ijk_min(2) = ijk_min(2) + njmpp - 1 
    445             ENDIF 
     465            CALL mpp_maxloc( 'domvvl', ze3t, llmsk, z_tmax, ijk_max ) 
     466            CALL mpp_minloc( 'domvvl', ze3t, llmsk, z_tmin, ijk_min ) 
    446467            IF (lwp) THEN 
    447468               WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax 
    … …  
    452473            ENDIF 
    453474         ENDIF 
     475         DEALLOCATE( ze3t, llmsk ) 
    454476         ! - ML - end test 
    455477         ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 
    … …  
    613635         tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) 
    614636      ENDIF 
    615       gdept(:,:,:,Kbb) = gdept(:,:,:,Kmm) 
    616       gdepw(:,:,:,Kbb) = gdepw(:,:,:,Kmm) 
    617  
    618       e3t(:,:,:,Kmm) = e3t(:,:,:,Kaa) 
    619       e3u(:,:,:,Kmm) = e3u(:,:,:,Kaa) 
    620       e3v(:,:,:,Kmm) = e3v(:,:,:,Kaa) 
    621637 
    622638      ! Compute all missing vertical scale factor and depths 
    … …  
    641657      gdepw(:,:,1,Kmm) = 0.0_wp 
    642658      gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 
    643       DO jk = 2, jpk 
    644          DO jj = 1,jpj 
    645             DO ji = 1,jpi 
    646               !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    647                                                                  ! 1 for jk = mikt 
    648                zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
    649                gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
    650                gdept(ji,jj,jk,Kmm) =    zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) )  & 
    651                    &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) )  
    652                gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
    653             END DO 
    654          END DO 
    655       END DO 
     659      DO_3D( 1, 1, 1, 1, 2, jpk ) 
     660        !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
     661                                                           ! 1 for jk = mikt 
     662         zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
     663         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
     664         gdept(ji,jj,jk,Kmm) =    zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) )  & 
     665             &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) )  
     666         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
     667      END_3D 
    656668 
    657669      ! Local depth and Inverse of the local depth of the water 
    … …  
    700712         ! 
    701713      CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean 
    702          DO jk = 1, jpk 
    703             DO jj = 1, jpjm1 
    704                DO ji = 1, fs_jpim1   ! vector opt. 
    705                   pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   & 
    706                      &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     & 
    707                      &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 
    708                END DO 
    709             END DO 
    710          END DO 
     714         DO_3D( 1, 0, 1, 0, 1, jpk ) 
     715            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   & 
     716               &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     & 
     717               &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 
     718         END_3D 
    711719         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp ) 
    712720         pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 
    713721         ! 
    714722      CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean 
    715          DO jk = 1, jpk 
    716             DO jj = 1, jpjm1 
    717                DO ji = 1, fs_jpim1   ! vector opt. 
    718                   pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   & 
    719                      &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     & 
    720                      &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 
    721                END DO 
    722             END DO 
    723          END DO 
     723         DO_3D( 1, 0, 1, 0, 1, jpk ) 
     724            pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   & 
     725               &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     & 
     726               &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 
     727         END_3D 
    724728         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp ) 
    725729         pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 
    726730         ! 
    727731      CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean 
    728          DO jk = 1, jpk 
    729             DO jj = 1, jpjm1 
    730                DO ji = 1, fs_jpim1   ! vector opt. 
    731                   pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 
    732                      &                       *    r1_e1e2f(ji,jj)                                                  & 
    733                      &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     & 
    734                      &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 
    735                END DO 
    736             END DO 
    737          END DO 
     732         DO_3D( 1, 0, 1, 0, 1, jpk ) 
     733            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 
     734               &                       *    r1_e1e2f(ji,jj)                                                  & 
     735               &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     & 
     736               &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 
     737         END_3D 
    738738         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp ) 
    739739         pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 
    … …  
    803803         IF( ln_rstart ) THEN                   !* Read the restart file 
    804804            CALL rst_read_open                  !  open the restart file if necessary 
    805             CALL iom_get( numror, jpdom_autoglo, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     805            CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
    806806            ! 
    807807            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    … …  
    810810            id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 
    811811            id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 
     812            ! 
    812813            !                             ! --------- ! 
    813814            !                             ! all cases ! 
    814815            !                             ! --------- ! 
     816            ! 
    815817            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    816                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    817                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     818               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     819               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
    818820               ! needed to restart if land processor not computed  
    819821               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    … …  
    828830               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files' 
    829831               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    830                IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.' 
    831                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     832               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
     833               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    832834               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    833835               l_1st_euler = .true. 
    … …  
    835837               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files' 
    836838               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    837                IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.' 
    838                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     839               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
     840               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
    839841               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    840842               l_1st_euler = .true. 
    … …  
    842844               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file' 
    843845               IF(lwp) write(numout,*) 'Compute scale factor from sshn' 
    844                IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.' 
     846               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    845847               DO jk = 1, jpk 
    846848                  e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 
    … …  
    861863               !                          ! ----------------------- ! 
    862864               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    863                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
    864                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
     865                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
     866                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
    865867               ELSE                            ! one at least array is missing 
    866868                  tilde_e3t_b(:,:,:) = 0.0_wp 
    … …  
    871873                  !                       ! ------------ ! 
    872874                  IF( id5 > 0 ) THEN  ! required array exists 
    873                      CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
     875                     CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
    874876                  ELSE                ! array is missing 
    875877                     hdiv_lf(:,:,:) = 0.0_wp 
    … …  
    895897                  ssh(:,:,Kbb) = -ssh_ref 
    896898 
    897                   DO jj = 1, jpj 
    898                      DO ji = 1, jpi 
    899                         IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth 
    900                            ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 
    901                            ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 
    902                         ENDIF 
    903                      ENDDO 
    904                   ENDDO 
     899                  DO_2D( 1, 1, 1, 1 ) 
     900                     IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth 
     901                        ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 
     902                        ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 
     903                     ENDIF 
     904                  END_2D 
    905905               ENDIF !If test case else 
    906906 
    … …  
    913913               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    914914 
    915                DO ji = 1, jpi 
    916                   DO jj = 1, jpj 
    917                      IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
    918                        CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 
    919                      ENDIF 
    920                   END DO  
    921                END DO  
     915               DO_2D( 1, 1, 1, 1 ) 
     916                  IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
     917                     CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 
     918                  ENDIF 
     919               END_2D 
    922920               ! 
    923921            ELSE 
    924922               ! 
    925                ! usr_def_istate called here only to get sshb, that is needed to initialize e3t(Kbb) and e3t(Kmm) 
    926                CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  ) 
    927                ! usr_def_istate will be called again in istate_init to initialize ts(bn), ssh(bn), u(bn) and v(bn) 
     923               ! usr_def_istate called here only to get ssh(Kbb) needed to initialize e3t(Kbb) and e3t(Kmm) 
     924               ! 
     925               CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )   
     926               ! 
     927               ! usr_def_istate will be called again in istate_init to initialize ts, ssh, u and v 
    928928               ! 
    929929               DO jk=1,jpk 
    930                   e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 
    931                     &                              / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
    932                     &              + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) )   ! make sure e3t_b != 0 on land points 
     930                  e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 
     931                    &                            / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
     932                    &            + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) )   ! make sure e3t(:,:,:,Kbb) != 0 on land points 
    933933               END DO 
    934934               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    935                ssh(:,:  ,Kmm) = ssh(:,:  ,Kbb)   ! needed later for gde3w 
     935               ssh(:,:,Kmm) = ssh(:,:,Kbb)                                     ! needed later for gde3w 
    936936               ! 
    937937            END IF           ! end of ll_wd edits 
    … …  
    10251025      ! 
    10261026      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' ) 
    1027       IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' ) 
    10281027      ! 
    10291028      IF(lwp) THEN                   ! Print the choice 
    … …  
    10411040   END SUBROUTINE dom_vvl_ctl 
    10421041 
     1042#endif 
     1043 
    10431044   !!====================================================================== 
    10441045END MODULE domvvl 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/CANAL/MY_SRC/stpctl.F90

    r12377 r13710  
    1919   USE dom_oce         ! ocean space and time domain variables  
    2020   USE c1d             ! 1D vertical configuration 
     21   USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables 
     22   USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy 
     23   !   
    2124   USE diawri          ! Standard run outputs       (dia_wri_state routine) 
    22    ! 
    2325   USE in_out_manager  ! I/O manager 
    2426   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2527   USE lib_mpp         ! distributed memory computing 
    26    USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables 
    27    USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy 
    28  
     28   ! 
    2929   USE netcdf          ! NetCDF library 
    3030   IMPLICIT NONE 
    … …  
    3333   PUBLIC stp_ctl           ! routine called by step.F90 
    3434 
    35    INTEGER  ::   idrun, idtime, idssh, idu, ids1, ids2, idt1, idt2, idc1, idw1, istatus 
    36    LOGICAL  ::   lsomeoce 
     35   INTEGER                ::   nrunid   ! netcdf file id 
     36   INTEGER, DIMENSION(8)  ::   nvarid   ! netcdf variable id 
    3737   !!---------------------------------------------------------------------- 
    3838   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    4242CONTAINS 
    4343 
    44    SUBROUTINE stp_ctl( kt, Kbb, Kmm, kindic ) 
     44   SUBROUTINE stp_ctl( kt, Kmm ) 
    4545      !!---------------------------------------------------------------------- 
    4646      !!                    ***  ROUTINE stp_ctl  *** 
    … …  
    4949      !! 
    5050      !! ** Method  : - Save the time step in numstp 
    51       !!              - Print it each 50 time steps 
    52       !!              - Stop the run IF problem encountered by setting indic=-3 
     51      !!              - Stop the run IF problem encountered by setting nstop > 0 
    5352      !!                Problems checked: |ssh| maximum larger than 10 m 
    5453      !!                                  |U|   maximum larger than 10 m/s  
    … …  
    5756      !! ** Actions :   "time.step" file = last ocean time-step 
    5857      !!                "run.stat"  file = run statistics 
    59       !!                nstop indicator sheared among all local domain (lk_mpp=T) 
     58      !!                 nstop indicator sheared among all local domain 
    6059      !!---------------------------------------------------------------------- 
    6160      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    62       INTEGER, INTENT(in   ) ::   Kbb, Kmm      ! ocean time level index 
    63       INTEGER, INTENT(inout) ::   kindic   ! error indicator 
    64       !! 
    65       INTEGER                ::   ji, jj, jk          ! dummy loop indices 
    66       INTEGER, DIMENSION(2)  ::   ih                  ! min/max loc indices 
    67       INTEGER, DIMENSION(3)  ::   iu, is1, is2        ! min/max loc indices 
    68       REAL(wp)               ::   zzz                 ! local real  
    69       REAL(wp), DIMENSION(9) ::   zmax 
    70       LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns 
    71       CHARACTER(len=20) :: clname 
    72       !!---------------------------------------------------------------------- 
    73       ! 
    74       ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
    75       ll_colruns = ll_wrtstp .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) 
    76       ll_wrtruns = ll_colruns .AND. lwm 
    77       IF( kt == nit000 .AND. lwp ) THEN 
    78          WRITE(numout,*) 
    79          WRITE(numout,*) 'stp_ctl : time-stepping control' 
    80          WRITE(numout,*) '~~~~~~~' 
    81          !                                ! open time.step file 
    82          IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    83          !                                ! open run.stat file(s) at start whatever 
    84          !                                ! the value of sn_cfctl%ptimincr 
    85          IF( lwm .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) ) THEN 
     61      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index 
     62      !! 
     63      INTEGER                         ::   ji                                    ! dummy loop indices 
     64      INTEGER                         ::   idtime, istatus 
     65      INTEGER , DIMENSION(9)          ::   iareasum, iareamin, iareamax 
     66      INTEGER , DIMENSION(3,4)        ::   iloc                                  ! min/max loc indices 
     67      REAL(wp)                        ::   zzz                                   ! local real  
     68      REAL(wp), DIMENSION(9)          ::   zmax, zmaxlocal 
     69      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce 
     70      LOGICAL, DIMENSION(jpi,jpj,jpk) ::   llmsk 
     71      CHARACTER(len=20)               ::   clname 
     72      !!---------------------------------------------------------------------- 
     73      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
     74      ! 
     75      ll_wrtstp  = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
     76      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1  
     77      ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 
     78      ! 
     79      IF( kt == nit000 ) THEN 
     80         ! 
     81         IF( lwp ) THEN 
     82            WRITE(numout,*) 
     83            WRITE(numout,*) 'stp_ctl : time-stepping control' 
     84            WRITE(numout,*) '~~~~~~~' 
     85         ENDIF 
     86         !                                ! open time.step    ascii file, done only by 1st subdomain 
     87         IF( lwm )   CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     88         ! 
     89         IF( ll_wrtruns ) THEN 
     90            !                             ! open run.stat     ascii file, done only by 1st subdomain 
    8691            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     92            !                             ! open run.stat.nc netcdf file, done only by 1st subdomain 
    8793            clname = 'run.stat.nc' 
    8894            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    89             istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun ) 
    90             istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 
    91             istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh ) 
    92             istatus = NF90_DEF_VAR( idrun,   'abs_u_max', NF90_DOUBLE, (/ idtime /), idu  ) 
    93             istatus = NF90_DEF_VAR( idrun,       's_min', NF90_DOUBLE, (/ idtime /), ids1 ) 
    94             istatus = NF90_DEF_VAR( idrun,       's_max', NF90_DOUBLE, (/ idtime /), ids2 ) 
    95             istatus = NF90_DEF_VAR( idrun,       't_min', NF90_DOUBLE, (/ idtime /), idt1 ) 
    96             istatus = NF90_DEF_VAR( idrun,       't_max', NF90_DOUBLE, (/ idtime /), idt2 ) 
     95            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 
     96            istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 
     97            istatus = NF90_DEF_VAR( nrunid, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), nvarid(1) ) 
     98            istatus = NF90_DEF_VAR( nrunid,   'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 
     99            istatus = NF90_DEF_VAR( nrunid,       's_min', NF90_DOUBLE, (/ idtime /), nvarid(3) ) 
     100            istatus = NF90_DEF_VAR( nrunid,       's_max', NF90_DOUBLE, (/ idtime /), nvarid(4) ) 
     101            istatus = NF90_DEF_VAR( nrunid,       't_min', NF90_DOUBLE, (/ idtime /), nvarid(5) ) 
     102            istatus = NF90_DEF_VAR( nrunid,       't_max', NF90_DOUBLE, (/ idtime /), nvarid(6) ) 
    97103            IF( ln_zad_Aimp ) THEN 
    98                istatus = NF90_DEF_VAR( idrun,   'abs_wi_max', NF90_DOUBLE, (/ idtime /), idw1 ) 
    99                istatus = NF90_DEF_VAR( idrun,       'Cu_max', NF90_DOUBLE, (/ idtime /), idc1 ) 
     104               istatus = NF90_DEF_VAR( nrunid,   'Cf_max', NF90_DOUBLE, (/ idtime /), nvarid(7) ) 
     105               istatus = NF90_DEF_VAR( nrunid,'abs_wi_max',NF90_DOUBLE, (/ idtime /), nvarid(8) ) 
    100106            ENDIF 
    101             istatus = NF90_ENDDEF(idrun) 
    102             zmax(8:9) = 0._wp    ! initialise to zero in case ln_zad_Aimp option is not in use 
    103          ENDIF 
    104       ENDIF 
    105       IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    106       ! 
    107       IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file) 
     107            istatus = NF90_ENDDEF(nrunid) 
     108         ENDIF 
     109         !     
     110      ENDIF 
     111      ! 
     112      !                                   !==              write current time step              ==! 
     113      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
     114      IF( lwm .AND. ll_wrtstp ) THEN 
    108115         WRITE ( numstp, '(1x, i8)' )   kt 
    109116         REWIND( numstp ) 
    110117      ENDIF 
    111       ! 
    112       !                                   !==  test of extrema  ==! 
     118      !                                   !==            test of local extrema           ==! 
     119      !                                   !==  done by all processes at every time step  ==! 
     120      ! 
     121      llmsk(   1:Nis1,:,:) = .FALSE.                                              ! exclude halos from the checked region 
     122      llmsk(Nie1: jpi,:,:) = .FALSE. 
     123      llmsk(:,   1:Njs1,:) = .FALSE. 
     124      llmsk(:,Nje1: jpj,:) = .FALSE. 
     125      ! 
     126      llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0) == 1._wp         ! define only the inner domain 
     127      ! 
     128      ll_0oce = .NOT. ANY( llmsk(:,:,1) )                                         ! no ocean point in the inner domain? 
     129      ! 
    113130      IF( ll_wd ) THEN 
    114          zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) + ssh_ref*tmask(:,:,1) )  )        ! ssh max  
     131         zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) )   ! ssh max 
    115132      ELSE 
    116          zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) )  )                               ! ssh max 
    117       ENDIF 
    118       zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) )  )                                  ! velocity max (zonal only) 
    119       zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus salinity max 
    120       zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       salinity max 
    121       zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus temperature max 
    122       zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       temperature max 
    123       zmax(7) = REAL( nstop , wp )                                            ! stop indicator 
    124       IF( ln_zad_Aimp ) THEN 
    125          zmax(8) = MAXVAL(  ABS( wi(:,:,:) ) , mask = wmask(:,:,:) == 1._wp ) ! implicit vertical vel. max 
    126          zmax(9) = MAXVAL(   Cu_adv(:,:,:)   , mask = tmask(:,:,:) == 1._wp ) !       cell Courant no. max 
    127       ENDIF 
    128       ! 
     133         zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm)           ), mask = llmsk(:,:,1) )   ! ssh max 
     134      ENDIF 
     135      llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     136      zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) ), mask = llmsk )                     ! velocity max (zonal only) 
     137      llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     138      zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     ! minus salinity max 
     139      zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     !       salinity max 
     140      IF( ll_colruns .OR. jpnij == 1 ) THEN     ! following variables are used only in the netcdf file 
     141         zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  ! minus temperature max 
     142         zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  !       temperature max 
     143         IF( ln_zad_Aimp ) THEN 
     144            zmax(7) = MAXVAL(   Cu_adv(:,:,:)   , mask = llmsk )                  ! partitioning coeff. max 
     145            llmsk(:,:,:) = wmask(:,:,:) == 1._wp 
     146            zmax(8) = MAXVAL(  ABS( wi(:,:,:) ) , mask = llmsk )                  ! implicit vertical vel. max 
     147         ELSE 
     148            zmax(7:8) = 0._wp 
     149         ENDIF 
     150      ELSE 
     151         zmax(5:8) = 0._wp 
     152      ENDIF 
     153      zmax(9) = REAL( nstop, wp )                                                 ! stop indicator 
     154      ! 
     155      !                                   !==               get global extrema             ==! 
     156      !                                   !==  done by all processes if writting run.stat  ==! 
    129157      IF( ll_colruns ) THEN 
    130          CALL mpp_max( "stpctl", zmax )          ! max over the global domain 
    131          nstop = NINT( zmax(7) )                 ! nstop indicator sheared among all local domains 
    132       ENDIF 
    133       !                                   !==  run statistics  ==!   ("run.stat" files) 
     158         zmaxlocal(:) = zmax(:) 
     159         CALL mpp_max( "stpctl", zmax )          ! max over the global domain: ok even of ll_0oce = .true.  
     160         nstop = NINT( zmax(9) )                 ! update nstop indicator (now sheared among all local domains) 
     161      ELSE 
     162         ! if no ocean point: MAXVAL returns -HUGE => we must overwrite this value to avoid error handling bellow. 
     163         IF( ll_0oce )   zmax(1:4) = (/ 0._wp, 0._wp, -1._wp, 1._wp /)   ! default "valid" values... 
     164      ENDIF 
     165      ! 
     166      zmax(3) = -zmax(3)                         ! move back from max(-zz) to min(zz) : easier to manage!  
     167      zmax(5) = -zmax(5)                         ! move back from max(-zz) to min(zz) : easier to manage! 
     168      IF( ll_colruns ) THEN 
     169         zmaxlocal(3) = -zmaxlocal(3)            ! move back from max(-zz) to min(zz) : easier to manage!  
     170         zmaxlocal(5) = -zmaxlocal(5)            ! move back from max(-zz) to min(zz) : easier to manage! 
     171      ENDIF 
     172      ! 
     173      !                                   !==              write "run.stat" files              ==! 
     174      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
    134175      IF( ll_wrtruns ) THEN 
    135          WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 
    136          istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 
    137          istatus = NF90_PUT_VAR( idrun,   idu, (/ zmax(2)/), (/kt/), (/1/) ) 
    138          istatus = NF90_PUT_VAR( idrun,  ids1, (/-zmax(3)/), (/kt/), (/1/) ) 
    139          istatus = NF90_PUT_VAR( idrun,  ids2, (/ zmax(4)/), (/kt/), (/1/) ) 
    140          istatus = NF90_PUT_VAR( idrun,  idt1, (/-zmax(5)/), (/kt/), (/1/) ) 
    141          istatus = NF90_PUT_VAR( idrun,  idt2, (/ zmax(6)/), (/kt/), (/1/) ) 
    142          IF( ln_zad_Aimp ) THEN 
    143             istatus = NF90_PUT_VAR( idrun,  idw1, (/ zmax(8)/), (/kt/), (/1/) ) 
    144             istatus = NF90_PUT_VAR( idrun,  idc1, (/ zmax(9)/), (/kt/), (/1/) ) 
    145          ENDIF 
    146          IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 
    147          IF( kt == nitend         ) istatus = NF90_CLOSE(idrun) 
     176         WRITE(numrun,9500) kt, zmax(1), zmax(2), zmax(3), zmax(4) 
     177         DO ji = 1, 6 + 2 * COUNT( (/ln_zad_Aimp/) ) 
     178            istatus = NF90_PUT_VAR( nrunid, nvarid(ji), (/zmax(ji)/), (/kt/), (/1/) ) 
     179         END DO 
     180         IF( kt == nitend )   istatus = NF90_CLOSE(nrunid) 
    148181      END IF 
    149       !                                   !==  error handling  ==! 
    150       IF( ( ln_ctl .OR. lsomeoce ) .AND. (   &             ! have use mpp_max (because ln_ctl=.T.) or contains some ocean points 
    151          &  zmax(1) >   20._wp .OR.   &                    ! too large sea surface height ( > 20 m ) 
    152          &  zmax(2) >   10._wp .OR.   &                    ! too large velocity ( > 10 m/s) 
    153 !!$      &  zmax(3) >=   0._wp .OR.   &                    ! negative or zero sea surface salinity 
    154 !!$      &  zmax(4) >= 100._wp .OR.   &                    ! too large sea surface salinity ( > 100 ) 
    155 !!$      &  zmax(4) <    0._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice) 
    156          &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN   ! NaN encounter in the tests 
    157          IF( lk_mpp .AND. ln_ctl ) THEN 
    158             CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,Kmm))        , ssmask(:,:)  , zzz, ih  ) 
    159             CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm))          , umask (:,:,:), zzz, iu  ) 
    160             CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is1 ) 
    161             CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is2 ) 
     182      !                                   !==               error handling               ==! 
     183      !                                   !==  done by all processes at every time step  ==! 
     184      ! 
     185      IF(  zmax(1) >   20._wp .OR.   &                   ! too large sea surface height ( > 20 m ) 
     186         & zmax(2) >   10._wp .OR.   &                   ! too large velocity ( > 10 m/s) 
     187!!$         & zmax(3) <=   0._wp .OR.   &                   ! negative or zero sea surface salinity 
     188!!$         & zmax(4) >= 100._wp .OR.   &                   ! too large sea surface salinity ( > 100 ) 
     189!!$         & zmax(4) <    0._wp .OR.   &                   ! too large sea surface salinity (keep this line for sea-ice) 
     190         & ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR.   &               ! NaN encounter in the tests 
     191         & ABS(   zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
     192         ! 
     193         iloc(:,:) = 0 
     194         IF( ll_colruns ) THEN   ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 
     195            ! first: close the netcdf file, so we can read it 
     196            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
     197            ! get global loc on the min/max 
     198            llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0 ) == 1._wp         ! define only the inner domain 
     199            CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,         Kmm)), llmsk(:,:,1), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     200            llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     201            CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:,       Kmm)), llmsk(:,:,:), zzz, iloc(1:3,2) ) 
     202            llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     203            CALL mpp_minloc( 'stpctl',      ts(:,:,:,jp_sal,Kmm) , llmsk(:,:,:), zzz, iloc(1:3,3) ) 
     204            CALL mpp_maxloc( 'stpctl',      ts(:,:,:,jp_sal,Kmm) , llmsk(:,:,:), zzz, iloc(1:3,4) ) 
     205            ! find which subdomain has the max. 
     206            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
     207            DO ji = 1, 9 
     208               IF( zmaxlocal(ji) == zmax(ji) ) THEN 
     209                  iareamin(ji) = narea   ;   iareamax(ji) = narea   ;   iareasum(ji) = 1 
     210               ENDIF 
     211            END DO 
     212            CALL mpp_min( "stpctl", iareamin )         ! min over the global domain 
     213            CALL mpp_max( "stpctl", iareamax )         ! max over the global domain 
     214            CALL mpp_sum( "stpctl", iareasum )         ! sum over the global domain 
     215         ELSE                    ! find local min and max locations: 
     216            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
     217            llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0 ) == 1._wp        ! define only the inner domain 
     218            iloc(1:2,1) = MAXLOC( ABS( ssh(:,:,         Kmm)), mask = llmsk(:,:,1) ) 
     219            llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     220            iloc(1:3,2) = MAXLOC( ABS(  uu(:,:,:,       Kmm)), mask = llmsk(:,:,:) ) 
     221            llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     222            iloc(1:3,3) = MINLOC(       ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) ) 
     223            iloc(1:3,4) = MAXLOC(       ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) ) 
     224            DO ji = 1, 4   ! local domain indices ==> global domain indices, excluding halos 
     225               iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 
     226            END DO 
     227            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
     228         ENDIF 
     229         ! 
     230         WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests' 
     231         CALL wrt_line( ctmp2, kt, '|ssh| max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
     232         CALL wrt_line( ctmp3, kt, '|U|   max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
     233         CALL wrt_line( ctmp4, kt, 'Sal   min', zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 
     234         CALL wrt_line( ctmp5, kt, 'Sal   max', zmax(4), iloc(:,4), iareasum(4), iareamin(4), iareamax(4) ) 
     235         IF( Agrif_Root() ) THEN 
     236            WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort* files' 
    162237         ELSE 
    163             ih(:)  = MAXLOC( ABS( ssh(:,:,Kmm)   )                              ) + (/ nimpp - 1, njmpp - 1    /) 
    164             iu(:)  = MAXLOC( ABS( uu  (:,:,:,Kmm) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    165             is1(:) = MINLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    166             is2(:) = MAXLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    167          ENDIF 
    168           
    169          WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests' 
    170          WRITE(ctmp2,9100) kt,   zmax(1), ih(1) , ih(2) 
    171          WRITE(ctmp3,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3) 
    172          WRITE(ctmp4,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 
    173          WRITE(ctmp5,9400) kt,   zmax(4), is2(1), is2(2), is2(3) 
    174          WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort.nc file' 
    175           
     238            WRITE(ctmp6,*) '      ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 
     239         ENDIF 
     240         ! 
    176241         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file 
    177           
    178          IF( .NOT. ln_ctl ) THEN 
    179             WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea 
    180             CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6 ) 
    181          ELSE 
    182             CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6, ' ' ) 
    183          ENDIF 
    184  
    185          kindic = -3 
    186          ! 
    187       ENDIF 
    188       ! 
    189 9100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5) 
    190 9200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5) 
    191 9300  FORMAT (' kt=',i8,'   S     min: ',1pg11.4,', at  i j k: ',3i5) 
    192 9400  FORMAT (' kt=',i8,'   S     max: ',1pg11.4,', at  i j k: ',3i5) 
     242         ! 
     243         IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
     244            IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     245            ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
     246            ENDIF 
     247         ELSE                                    ! only mpi subdomains with errors are here -> STOP now 
     248            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     249         ENDIF 
     250         ! 
     251      ENDIF 
     252      ! 
     253      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet... 
     254         ngrdstop = Agrif_Fixed()                                           ! store which grid got this error 
     255         IF( .NOT. ll_colruns .AND. jpnij > 1 )   CALL ctl_stop( 'STOP' )   ! we must abort here to avoid MPI deadlock 
     256      ENDIF 
     257      ! 
    1932589500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 
    194259      ! 
    195260   END SUBROUTINE stp_ctl 
     261 
     262 
     263   SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 
     264      !!---------------------------------------------------------------------- 
     265      !!                     ***  ROUTINE wrt_line  *** 
     266      !! 
     267      !! ** Purpose :   write information line 
     268      !! 
     269      !!---------------------------------------------------------------------- 
     270      CHARACTER(len=*),      INTENT(  out) ::   cdline 
     271      CHARACTER(len=*),      INTENT(in   ) ::   cdprefix 
     272      REAL(wp),              INTENT(in   ) ::   pval 
     273      INTEGER, DIMENSION(3), INTENT(in   ) ::   kloc 
     274      INTEGER,               INTENT(in   ) ::   kt, ksum, kmin, kmax 
     275      ! 
     276      CHARACTER(len=80) ::   clsuff 
     277      CHARACTER(len=9 ) ::   clkt, clsum, clmin, clmax 
     278      CHARACTER(len=9 ) ::   cli, clj, clk 
     279      CHARACTER(len=1 ) ::   clfmt 
     280      CHARACTER(len=4 ) ::   cl4   ! needed to be able to compile with Agrif, I don't know why 
     281      INTEGER           ::   ifmtk 
     282      !!---------------------------------------------------------------------- 
     283      WRITE(clkt , '(i9)') kt 
     284       
     285      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
     286      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
     287      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum 
     288      WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1    ! how many digits to we need to write ? (we decide max = 9) 
     289      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1 
     290                                   WRITE(clmax, cl4) kmax-1 
     291      ! 
     292      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1      ! how many digits to we need to write jpiglo? (we decide max = 9) 
     293      cl4 = '(i'//clfmt//')'   ;   WRITE(cli, cl4) kloc(1)      ! this is ok with AGRIF 
     294      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1      ! how many digits to we need to write jpjglo? (we decide max = 9) 
     295      cl4 = '(i'//clfmt//')'   ;   WRITE(clj, cl4) kloc(2)      ! this is ok with AGRIF 
     296      ! 
     297      IF( ksum == 1 ) THEN   ;   WRITE(clsuff,9100) TRIM(clmin) 
     298      ELSE                   ;   WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 
     299      ENDIF 
     300      IF(kloc(3) == 0) THEN 
     301         ifmtk = INT(LOG10(REAL(jpk,wp))) + 1                   ! how many digits to we need to write jpk? (we decide max = 9) 
     302         clk = REPEAT(' ', ifmtk)                               ! create the equivalent in blank string 
     303         WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 
     304      ELSE 
     305         WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1      ! how many digits to we need to write jpk? (we decide max = 9) 
     306         !!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF 
     307         cl4 = '(i'//clfmt//')'   ;   WRITE(clk, cl4) kloc(3)   ! this is ok with AGRIF 
     308         WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj),    TRIM(clk), TRIM(clsuff) 
     309      ENDIF 
     310      ! 
     3119100  FORMAT('MPI rank ', a) 
     3129200  FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 
     3139300  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j   ', a, ' ', a, ' ', a, ' ', a) 
     3149400  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 
     315      ! 
     316   END SUBROUTINE wrt_line 
     317 
    196318 
    197319   !!====================================================================== 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/CANAL/MY_SRC/trazdf.F90

    r12489 r13710  
    3535   PUBLIC   tra_zdf_imp   ! called by trczdf.F90 
    3636 
     37   !! * Substitutions 
     38#  include "do_loop_substitute.h90" 
    3739   !!---------------------------------------------------------------------- 
    3840   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7779      ! JMM avoid negative salinities near river outlet ! Ugly fix 
    7880      ! JMM : restore negative salinities to small salinities: 
    79 !!$   WHERE( pts(:,:,:,jp_sal,Kaa) < 0._wp )   pts(:,:,:,jp_sal,Kaa) = 0.1_wp 
     81!!$      WHERE( pts(:,:,:,jp_sal,Kaa) < 0._wp )   pts(:,:,:,jp_sal,Kaa) = 0.1_wp 
    8082!!gm 
    8183 
    … …  
    9597      ENDIF 
    9698      !                                          ! print mean trends (used for debugging) 
    97       IF(ln_ctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kaa), clinfo1=' zdf  - Ta: ', mask1=tmask,               & 
    98          &                       tab3d_2=pts(:,:,:,jp_sal,Kaa), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     99      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kaa), clinfo1=' zdf  - Ta: ', mask1=tmask,               & 
     100         &                                  tab3d_2=pts(:,:,:,jp_sal,Kaa), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    99101      ! 
    100102      IF( ln_timing )   CALL timing_stop('tra_zdf') 
    … …  
    154156            IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution  
    155157               IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator  
    156                   DO jk = 2, jpkm1 
    157                      DO jj = 2, jpjm1 
    158                         DO ji = fs_2, fs_jpim1   ! vector opt. 
    159                            zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)   
    160                         END DO 
    161                      END DO 
    162                   END DO 
     158                  DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     159                     zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)   
     160                  END_3D 
    163161               ELSE                          ! standard or triad iso-neutral operator 
    164                   DO jk = 2, jpkm1 
    165                      DO jj = 2, jpjm1 
    166                         DO ji = fs_2, fs_jpim1   ! vector opt. 
    167                            zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 
    168                         END DO 
    169                      END DO 
    170                   END DO 
     162                  DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     163                     zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 
     164                  END_3D 
    171165               ENDIF 
    172166            ENDIF 
    … …  
    174168            ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked) 
    175169            IF( ln_zad_Aimp ) THEN         ! Adaptive implicit vertical advection 
    176                DO jk = 1, jpkm1 
    177                   DO jj = 2, jpjm1 
    178                      DO ji = fs_2, fs_jpim1   ! vector opt. (ensure same order of calculation as below if wi=0.) 
    179                         zzwi = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk  ,Kmm) 
    180                         zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 
    181                         zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zzwi - zzws   & 
    182                            &                 + p2dt * ( MAX( wi(ji,jj,jk  ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) 
    183                         zwi(ji,jj,jk) = zzwi + p2dt *   MIN( wi(ji,jj,jk  ) , 0._wp ) 
    184                         zws(ji,jj,jk) = zzws - p2dt *   MAX( wi(ji,jj,jk+1) , 0._wp ) 
    185                     END DO 
    186                   END DO 
    187                END DO 
     170               DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     171                  zzwi = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk  ,Kmm) 
     172                  zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 
     173                  zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zzwi - zzws   & 
     174                     &                 + p2dt * ( MAX( wi(ji,jj,jk  ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) 
     175                  zwi(ji,jj,jk) = zzwi + p2dt *   MIN( wi(ji,jj,jk  ) , 0._wp ) 
     176                  zws(ji,jj,jk) = zzws - p2dt *   MAX( wi(ji,jj,jk+1) , 0._wp ) 
     177               END_3D 
    188178            ELSE 
    189                DO jk = 1, jpkm1 
    190                   DO jj = 2, jpjm1 
    191                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    192                         zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk,Kmm) 
    193                         zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 
    194                         zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zwi(ji,jj,jk) - zws(ji,jj,jk) 
    195                     END DO 
    196                   END DO 
    197                END DO 
     179               DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     180                  zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk,Kmm) 
     181                  zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 
     182                  zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zwi(ji,jj,jk) - zws(ji,jj,jk) 
     183               END_3D 
    198184            ENDIF 
    199185            ! 
    … …  
    217203            !   used as a work space array: its value is modified. 
    218204            ! 
    219             DO jj = 2, jpjm1        !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k) 
    220                DO ji = fs_2, fs_jpim1            ! done one for all passive tracers (so included in the IF instruction) 
    221                   zwt(ji,jj,1) = zwd(ji,jj,1) 
    222                END DO 
    223             END DO 
    224             DO jk = 2, jpkm1 
    225                DO jj = 2, jpjm1 
    226                   DO ji = fs_2, fs_jpim1 
    227                      zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1) 
    228                   END DO 
    229                END DO 
    230             END DO 
     205            DO_2D( 0, 0, 0, 0 ) 
     206               zwt(ji,jj,1) = zwd(ji,jj,1) 
     207            END_2D 
     208            DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     209               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1) 
     210            END_3D 
    231211            ! 
    232212         ENDIF  
    233213         !          
    234          DO jj = 2, jpjm1           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
    235             DO ji = fs_2, fs_jpim1 
    236                pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs) 
    237             END DO 
    238          END DO 
    239          DO jk = 2, jpkm1 
    240             DO jj = 2, jpjm1 
    241                DO ji = fs_2, fs_jpim1 
    242                   zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs)   ! zrhs=right hand side 
    243                   pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pt(ji,jj,jk-1,jn,Kaa) 
    244                END DO 
    245             END DO 
    246          END DO 
     214         DO_2D( 0, 0, 0, 0 ) 
     215            pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs) 
     216         END_2D 
     217         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     218            zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs)   ! zrhs=right hand side 
     219            pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pt(ji,jj,jk-1,jn,Kaa) 
     220         END_3D 
    247221         ! 
    248          DO jj = 2, jpjm1           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer) 
    249             DO ji = fs_2, fs_jpim1 
    250                pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 
    251             END DO 
    252          END DO 
    253          DO jk = jpk-2, 1, -1 
    254             DO jj = 2, jpjm1 
    255                DO ji = fs_2, fs_jpim1 
    256                   pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) )   & 
    257                      &             / zwt(ji,jj,jk) * tmask(ji,jj,jk) 
    258                END DO 
    259             END DO 
    260          END DO 
     222         DO_2D( 0, 0, 0, 0 ) 
     223            pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 
     224         END_2D 
     225         DO_3DS( 0, 0, 0, 0, jpk-2, 1, -1 ) 
     226            pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) )   & 
     227               &             / zwt(ji,jj,jk) * tmask(ji,jj,jk) 
     228         END_3D 
    261229         !                                            ! ================= ! 
    262230      END DO                                          !  end tracer loop  ! 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/CANAL/MY_SRC/usrdef_hgr.F90

    r10074 r13710  
    2626   PUBLIC   usr_def_hgr   ! called by domhgr.F90 
    2727 
     28   !! * Substitutions 
     29#  include "do_loop_substitute.h90" 
    2830   !!---------------------------------------------------------------------- 
    2931   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6163      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2] 
    6264      ! 
    63       INTEGER  ::   ji, jj   ! dummy loop indices 
     65      INTEGER  ::   ji, jj     ! dummy loop indices 
    6466      REAL(wp) ::   zphi0, zlam0, zbeta, zf0 
    65       REAL(wp) ::   zti, zui, ztj, zvj   ! local scalars 
     67      REAL(wp) ::   zti, ztj   ! local scalars 
    6668      !!------------------------------------------------------------------------------- 
    6769      ! 
    … …  
    7577      ! Position coordinates (in kilometers) 
    7678      !                          ========== 
    77       zlam0 = -REAL(NINT(jpiglo*rn_0xratio)-1, wp) * rn_dx 
    78       zphi0 = -REAL(NINT(jpjglo*rn_0yratio)-1, wp) * rn_dy  
     79      zlam0 = -REAL(NINT(Ni0glo*rn_0xratio)-1, wp) * rn_dx 
     80      zphi0 = -REAL(NINT(Nj0glo*rn_0yratio)-1, wp) * rn_dy  
    7981 
    8082#if defined key_agrif 
    … …  
    8890#endif 
    8991          
    90       DO jj = 1, jpj 
    91          DO ji = 1, jpi 
    92             zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) 
    93             zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 
    94  
    95             plamt(ji,jj) = zlam0 + rn_dx * zti 
    96             plamu(ji,jj) = zlam0 + rn_dx * zui 
    97             plamv(ji,jj) = plamt(ji,jj)  
    98             plamf(ji,jj) = plamu(ji,jj)  
    99     
    100             pphit(ji,jj) = zphi0 + rn_dy * ztj 
    101             pphiv(ji,jj) = zphi0 + rn_dy * zvj 
    102             pphiu(ji,jj) = pphit(ji,jj)  
    103             pphif(ji,jj) = pphiv(ji,jj)  
    104          END DO 
    105       END DO 
     92      DO_2D( 1, 1, 1, 1 )          
     93         zti = REAL( mig0_oldcmp(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
     94         ztj = REAL( mjg0_oldcmp(jj) - 1, wp )   ! start at j=0 in the global grid without halos 
     95          
     96         plamt(ji,jj) = zlam0 + rn_dx *   zti 
     97         plamu(ji,jj) = zlam0 + rn_dx * ( zti + 0.5_wp )  
     98         plamv(ji,jj) = plamt(ji,jj)  
     99         plamf(ji,jj) = plamu(ji,jj)  
     100          
     101         pphit(ji,jj) = zphi0 + rn_dy *   ztj 
     102         pphiv(ji,jj) = zphi0 + rn_dy * ( ztj + 0.5_wp )  
     103         pphiu(ji,jj) = pphit(ji,jj)  
     104         pphif(ji,jj) = pphiv(ji,jj)  
     105      END_2D 
    106106      !      
    107107      ! Horizontal scale factors (in meters) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/CANAL/MY_SRC/usrdef_istate.F90

    r12489 r13710  
    2828   PUBLIC   usr_def_istate   ! called by istate.F90 
    2929 
     30   !! * Substitutions 
     31#  include "do_loop_substitute.h90" 
    3032   !!---------------------------------------------------------------------- 
    3133   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6466      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   ' 
    6567      ! 
    66       IF (ln_sshnoise) CALL RANDOM_NUMBER(zrandom) 
    6768      zjetx = ABS(rn_ujetszx)/2. 
    6869      zjety = ABS(rn_ujetszy)/2. 
    6970      ! 
     71      zf0   = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 
     72      ! 
    7073      SELECT CASE(nn_initcase) 
     74 
     75      CASE(-1)    ! stratif at rest 
     76 
     77         ! sea level: 
     78         pssh(:,:) = 0. 
     79         ! temperature: 
     80         pts(:,:,1,jp_tem) = 25. !!30._wp 
     81         pts(:,:,2:jpk,jp_tem) = 22. !!24._wp 
     82         ! salinity:   
     83         pts(:,:,:,jp_sal) = 35._wp 
     84         ! velocities: 
     85         pu(:,:,:) = 0. 
     86         pv(:,:,:) = 0. 
     87 
    7188      CASE(0)    ! rest 
    7289          
    … …  
    96113            zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 
    97114            WHERE( ABS(gphit) <= zjety ) 
    98                pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
    99             ELSEWHERE 
    100                pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3   & 
     115               pssh(:,:) = - rn_uzonal / grav * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
     116            ELSEWHERE 
     117               pssh(:,:) = - rn_uzonal / grav * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3   & 
    101118                  &                             + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
    102119            END WHERE 
    … …  
    107124         pts(:,:,jpk,jp_sal) = 0. 
    108125         DO jk=1, jpkm1 
    109             pts(:,:,jk,jp_sal) = gphit(:,:) 
     126            WHERE( ABS(gphit) <= zjety ) 
     127!!$            WHERE( ABS(gphit) <= zjety*0.5 .AND. ABS(glamt) <= zjety*0.5 ) ! for a square of salt 
     128               pts(:,:,jk,jp_sal) = 35. 
     129            ELSEWHERE 
     130               pts(:,:,jk,jp_sal) = 30. 
     131            END WHERE                     
    110132         END DO 
    111133         ! velocities: 
    … …  
    132154            WHERE( ABS(gphit) <= zjety ) 
    133155               pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav   & 
    134                   &        * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
     156                  &        * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
    135157            ELSEWHERE 
    136158               pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav   & 
    137                   &        * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
     159                  &        * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
    138160            END WHERE 
    139161         END SELECT 
    … …  
    141163         pts(:,:,:,jp_tem) = 10._wp 
    142164         ! salinity:   
    143          pts(:,:,:,jp_sal) = 2. 
    144          DO jk=1, jpkm1 
    145             WHERE( ABS(gphiv) <= zjety ) pts(:,:,jk,jp_sal) = 2. + SIGN(1.,gphiv(:,:)) 
     165         pts(:,:,:,jp_sal) = 30. 
     166         DO jk=1, jpkm1 
     167            WHERE( ABS(gphiv) <= zjety ) pts(:,:,jk,jp_sal) = 30. + SIGN(1.,gphiv(:,:)) 
    146168         END DO 
    147169         ! velocities: 
    … …  
    164186         pssh(:,1) = - ff_t(:,1) / grav * pu(:,1,1) * e2t(:,1) 
    165187         DO jl=1, jpnj 
    166             DO jj=nldj, nlej 
    167                DO ji=nldi, nlei 
    168                   pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * pu(ji,jj,1) * e2t(ji,jj) 
    169                END DO 
    170             END DO 
     188            DO_2D( 0, 0, 0, 0 ) 
     189               pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * pu(ji,jj,1) * e2t(ji,jj) 
     190            END_2D 
    171191            CALL lbc_lnk( 'usrdef_istate', pssh, 'T',  1. ) 
    172192         END DO 
    … …  
    176196         ! salinity:   
    177197         DO jk=1, jpkm1 
    178             pts(:,:,jk,jp_sal) = gphit(:,:) 
     198            pts(:,:,jk,jp_sal) = pssh(:,:) 
    179199         END DO 
    180200         ! velocities: 
    … …  
    183203      CASE(4)    ! geostrophic zonal pulse 
    184204    
    185          DO jj=1, jpj 
    186             DO ji=1, jpi 
    187                IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN 
    188                   zdu = rn_uzonal 
    189                ELSEIF ( ABS(glamt(ji,jj)) <= zjetx + 100. ) THEN 
    190                   zdu = rn_uzonal * ( ( zjetx-ABS(glamt(ji,jj)) )/100. + 1. ) 
    191                ELSE 
    192                   zdu = 0. 
    193                END IF 
    194                IF ( ABS(gphit(ji,jj)) <= zjety ) THEN 
    195                   pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav 
    196                   pu(ji,jj,:) = zdu 
    197                   pts(ji,jj,:,jp_sal) = zdu / rn_uzonal + 1. 
    198                ELSE 
    199                   pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav  
    200                   pu(ji,jj,:) = 0. 
    201                   pts(ji,jj,:,jp_sal) = 1. 
    202                END IF 
    203             END DO 
    204          END DO 
     205         DO_2D( 1, 1, 1, 1 ) 
     206            IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN 
     207               zdu = rn_uzonal 
     208            ELSEIF ( ABS(glamt(ji,jj)) <= zjetx + 100. ) THEN 
     209               zdu = rn_uzonal * ( ( zjetx-ABS(glamt(ji,jj)) )/100. + 1. ) 
     210            ELSE 
     211               zdu = 0. 
     212            END IF 
     213            IF ( ABS(gphit(ji,jj)) <= zjety ) THEN 
     214               pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav 
     215               pu(ji,jj,:) = zdu 
     216               pts(ji,jj,:,jp_sal) = zdu / rn_uzonal + 1. 
     217            ELSE 
     218               pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav  
     219               pu(ji,jj,:) = 0. 
     220               pts(ji,jj,:,jp_sal) = 1. 
     221            END IF 
     222         END_2D 
    205223          
    206224         ! temperature: 
    207225         pts(:,:,:,jp_tem) = 10._wp * ptmask(:,:,:)         
    208226         pv(:,:,:) = 0. 
    209           
    210227          
    211228       CASE(5)    ! vortex 
    … …  
    213230         zf0   = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 
    214231         zumax = rn_vtxmax * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 
    215          zlambda = SQRT(2._wp)*rn_lambda       ! Horizontal scale in meters  
     232         zlambda = SQRT(2._wp)*rn_lambda*1.e3       ! Horizontal scale in meters  
    216233         zn2 = 3.e-3**2 
    217234         zH = 0.5_wp * 5000._wp 
    … …  
    220237         zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 
    221238         ! 
    222          DO jj=1, jpj 
    223             DO ji=1, jpi 
    224                zx = glamt(ji,jj) * 1.e3 
    225                zy = gphit(ji,jj) * 1.e3 
    226                ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y) 
    227                zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy 
    228                ! Sea level: 
    229                pssh(ji,jj) = 0. 
    230                DO jl=1,5 
    231                   zdt = pssh(ji,jj) 
    232                   zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH))   ! F'(z) 
    233                   zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav    ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 
    234                   pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1)   ! ssh = Psurf / (Rho*g) 
    235                END DO 
    236                ! temperature: 
    237                DO jk=1,jpk 
    238                   zdt =  pdept(ji,jj,jk)  
    239                   zrho1 = rho0 * (1._wp + zn2*zdt/grav) 
    240                   IF (zdt < zH) THEN 
    241                      zdzF = (1._wp-EXP(zdt-zH)) / (zH-1._wp + EXP(-zH))   ! F'(z) 
    242                      zrho1 = zrho1 - zdzF * zpsurf / grav    ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 
    243                   ENDIF 
    244                   !               pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 
    245                   pts(ji,jj,jk,jp_tem) = (10._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 
    246                END DO 
     239         DO_2D( 1, 1, 1, 1 ) 
     240            zx = glamt(ji,jj) * 1.e3 
     241            zy = gphit(ji,jj) * 1.e3 
     242            ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y) 
     243            zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy 
     244            ! Sea level: 
     245            pssh(ji,jj) = 0. 
     246            DO jl=1,5 
     247               zdt = pssh(ji,jj) 
     248               zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH))   ! F'(z) 
     249               zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav    ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 
     250               pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1)   ! ssh = Psurf / (Rho*g) 
    247251            END DO 
    248          END DO 
     252            ! temperature: 
     253            DO jk=1,jpk 
     254               zdt =  pdept(ji,jj,jk)  
     255               zrho1 = rho0 * (1._wp + zn2*zdt/grav) 
     256               IF (zdt < zH) THEN 
     257                  zdzF = (1._wp-EXP(zdt-zH)) / (zH-1._wp + EXP(-zH))   ! F'(z) 
     258                  zrho1 = zrho1 - zdzF * zpsurf / grav    ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 
     259               ENDIF 
     260               !               pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 
     261               pts(ji,jj,jk,jp_tem) = (10._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 
     262            END DO 
     263         END_2D 
    249264         ! 
    250265         ! salinity:   
    … …  
    253268         ! velocities: 
    254269         za = 2._wp * zP0 / zlambda**2 
    255          DO jj=1, jpj 
    256             DO ji=1, jpim1 
    257                zx = glamu(ji,jj) * 1.e3 
    258                zy = gphiu(ji,jj) * 1.e3 
    259                DO jk=1, jpk 
    260                   zdu = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji+1,jj,jk)) 
    261                   IF (zdu < zH) THEN 
    262                      zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH)) 
    263                      zdyPs = - za * zy * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal 
    264                      pu(ji,jj,jk) = - zf / ( rho0 * ff_t(ji,jj) ) * zdyPs * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk) 
    265                   ELSE 
    266                      pu(ji,jj,jk) = 0._wp 
    267                   ENDIF 
    268                END DO 
     270         DO_2D( 0, 0, 0, 0 ) 
     271            zx = glamu(ji,jj) * 1.e3 
     272            zy = gphiu(ji,jj) * 1.e3 
     273            DO jk=1, jpk 
     274               zdu = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji+1,jj,jk)) 
     275               IF (zdu < zH) THEN 
     276                  zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH)) 
     277                  zdyPs = - za * zy * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal 
     278                  pu(ji,jj,jk) = - zf / ( rho0 * ff_t(ji,jj) ) * zdyPs * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk) 
     279               ELSE 
     280                  pu(ji,jj,jk) = 0._wp 
     281               ENDIF 
    269282            END DO 
    270          END DO 
    271          ! 
    272          DO jj=1, jpjm1 
    273             DO ji=1, jpi 
    274                zx = glamv(ji,jj) * 1.e3 
    275                zy = gphiv(ji,jj) * 1.e3 
    276                DO jk=1, jpk 
    277                   zdv = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji,jj+1,jk)) 
    278                   IF (zdv < zH) THEN 
    279                      zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH)) 
    280                      zdxPs = - za * zx * EXP(-(zx**2+zy**2)*zr_lambda2) 
    281                      pv(ji,jj,jk) = zf / ( rho0 * ff_f(ji,jj) ) * zdxPs * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk) 
    282                   ELSE 
    283                      pv(ji,jj,jk) = 0._wp 
    284                   ENDIF 
    285                END DO 
     283         END_2D 
     284         ! 
     285         DO_2D( 0, 0, 0, 0 ) 
     286            zx = glamv(ji,jj) * 1.e3 
     287            zy = gphiv(ji,jj) * 1.e3 
     288            DO jk=1, jpk 
     289               zdv = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji,jj+1,jk)) 
     290               IF (zdv < zH) THEN 
     291                  zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH)) 
     292                  zdxPs = - za * zx * EXP(-(zx**2+zy**2)*zr_lambda2) 
     293                  pv(ji,jj,jk) = zf / ( rho0 * ff_f(ji,jj) ) * zdxPs * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk) 
     294               ELSE 
     295                  pv(ji,jj,jk) = 0._wp 
     296               ENDIF 
    286297            END DO 
    287          END DO 
     298         END_2D 
    288299         !             
    289300      END SELECT 
    290  
     301       
    291302      IF (ln_sshnoise) THEN 
     303         CALL RANDOM_SEED() 
    292304         CALL RANDOM_NUMBER(zrandom) 
    293305         pssh(:,:) = pssh(:,:) + ( 0.1  * zrandom(:,:) - 0.05 ) 
    294306      END IF 
    295307      CALL lbc_lnk( 'usrdef_istate', pssh, 'T',  1. ) 
    296       CALL lbc_lnk(  'usrdef_istate', pts, 'T',  1. ) 
    297       CALL lbc_lnk(   'usrdef_istate', pu, 'U', -1. ) 
    298       CALL lbc_lnk(   'usrdef_istate', pv, 'V', -1. ) 
     308      CALL lbc_lnk( 'usrdef_istate', pts , 'T',  1. ) 
     309      CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 
    299310 
    300311   END SUBROUTINE usr_def_istate 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/CANAL/MY_SRC/usrdef_nam.F90

    r12377 r13710  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
     16   USE dom_oce 
    1717   USE par_oce        ! ocean space and time domain 
    1818   USE phycst         ! physical constants 
    … …  
    5050   LOGICAL , PUBLIC ::   ln_sshnoise=.false. ! add random noise on initial ssh 
    5151   REAL(wp), PUBLIC ::   rn_lambda  = 50.    ! gaussian lambda 
     52   INTEGER , PUBLIC ::   nn_perio   =    0   ! periodicity of the channel (0=closed, 1=E-W) 
    5253 
    5354   !!---------------------------------------------------------------------- 
    … …  
    7980      !! 
    8081      NAMELIST/namusr_def/  rn_domszx, rn_domszy, rn_domszz, rn_dx, rn_dy, rn_dz, rn_0xratio, rn_0yratio   & 
    81          &                 , nn_fcase, rn_ppgphi0, rn_vtxmax, rn_uzonal, rn_ujetszx, rn_ujetszy   & 
    82          &                 , rn_u10, rn_windszx, rn_windszy, rn_uofac   & 
    83          &                 , nn_botcase, nn_initcase, ln_sshnoise, rn_lambda 
     82         &                 , nn_fcase, rn_ppgphi0, rn_u10, rn_windszx, rn_windszy & !!, rn_uofac   & 
     83         &                 , rn_vtxmax, rn_uzonal, rn_ujetszx, rn_ujetszy  & 
     84         &                 , nn_botcase, nn_initcase, ln_sshnoise, rn_lambda, nn_perio 
    8485      !!---------------------------------------------------------------------- 
    8586      ! 
    … …  
    106107      kk_cfg = INT( rn_dx ) 
    107108      ! 
    108       ! Global Domain size:  EW_CANAL global domain is  1800 km x 1800 Km x 5000 m 
    109       kpi = NINT( rn_domszx / rn_dx ) + 1 
    110       kpj = NINT( rn_domszy / rn_dy ) + 3 
    111       kpk = NINT( rn_domszz / rn_dz ) + 1 
    112 #if defined key_agrif 
    113       IF( .NOT. Agrif_Root() ) THEN 
    114          kpi  = nbcellsx + 2 + 2*nbghostcells 
    115          kpj  = nbcellsy + 2 + 2*nbghostcells 
     109      IF( Agrif_Root() ) THEN        ! Global Domain size:  EW_CANAL global domain is  1800 km x 1800 Km x 5000 m 
     110         kpi = NINT( rn_domszx / rn_dx ) + 1 
     111         kpj = NINT( rn_domszy / rn_dy ) + 3 
     112      ELSE                           ! Global Domain size: add nbghostcells + 1 "land" point on each side 
     113         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
     114         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
    116115      ENDIF 
    117 #endif 
     116      kpk = MAX( 2, NINT( rn_domszz / rn_dz ) + 1 ) 
    118117      ! 
    119118      zh  = (kpk-1)*rn_dz 
    … …  
    150149         WRITE(numout,*) '      add random noise on initial ssh   ln_sshnoise= ', ln_sshnoise 
    151150         WRITE(numout,*) '      Gaussian lambda parameter          rn_lambda = ', rn_lambda 
    152          WRITE(numout,*) '   ' 
    153          WRITE(numout,*) '   Lateral boundary condition of the global domain' 
    154          WRITE(numout,*) '      EW_CANAL : closed basin               jperio = ', kperio 
     151         WRITE(numout,*) '      Periodicity of the basin            nn_perio = ', nn_perio 
    155152      ENDIF 
     153      !                             ! Set the lateral boundary condition of the global domain 
     154      kperio = nn_perio                    ! EW_CANAL configuration : closed basin 
    156155      ! 
    157156   END SUBROUTINE usr_def_nam 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/CANAL/MY_SRC/usrdef_sbc.F90

    r12377 r13710  
    1717   USE sbc_oce         ! Surface boundary condition: ocean fields 
    1818   USE phycst          ! physical constants 
    19    USE usrdef_nam, ONLY : rn_u10, rn_uofac, rn_windszy  
     19   USE usrdef_nam, ONLY : rn_u10, rn_uofac, rn_windszy, rn_windszx  
    2020   ! 
    2121   USE in_out_manager  ! I/O manager 
    … …  
    3838CONTAINS 
    3939 
    40    SUBROUTINE usrdef_sbc_oce( kt, Kmm, Kbb ) 
     40   SUBROUTINE usrdef_sbc_oce( kt, Kbb ) 
    4141      !!--------------------------------------------------------------------- 
    4242      !!                    ***  ROUTINE usr_def_sbc  *** 
    … …  
    5353      !!---------------------------------------------------------------------- 
    5454      INTEGER, INTENT(in) ::   kt        ! ocean time step 
    55       INTEGER, INTENT(in) ::   Kbb, Kmm  ! ocean time index 
     55      INTEGER, INTENT(in) ::   Kbb       ! ocean time index 
    5656      INTEGER  ::   ji, jj               ! dummy loop indices 
    5757      REAL(wp) :: zrhoair = 1.22     ! approximate air density [Kg/m3] 
    … …  
    6969         ! 
    7070         utau(:,:) = 0._wp 
    71          IF( rn_u10 /= 0. .AND. rn_windszy > 0. ) THEN 
    72             WHERE( ABS(gphit) <= rn_windszy/2. ) utau(:,:) = zrhocd * rn_u10 * rn_u10 
    73          ENDIF 
    7471         vtau(:,:) = 0._wp 
    7572         taum(:,:) = 0._wp 
    … …  
    8380      ENDIF 
    8481 
     82      IF( rn_u10 /= 0. .AND. rn_windszy > 0. ) THEN 
     83         IF( nyear == 1 .AND. nmonth == 1 .AND. nday <= 10 ) THEN 
     84            WHERE( ABS(gphit) <= rn_windszy/2. .AND. ABS(glamt) <= rn_windszx/2. ) utau(:,:) = zrhocd * rn_u10 * rn_u10 
     85         ELSE 
     86            utau(:,:) = 0. 
     87         ENDIF 
     88      ENDIF 
     89 
    8590      IF( rn_uofac /= 0. ) THEN 
    8691          
    8792         WHERE( ABS(gphit) <= rn_windszy/2. ) 
    88             zwndrel(:,:) = rn_u10 - rn_uofac * uu(:,:,1,Kmm) 
     93            zwndrel(:,:) = rn_u10 - rn_uofac * uu(:,:,1,Kbb) 
    8994         ELSEWHERE 
    90             zwndrel(:,:) =        - rn_uofac * uu(:,:,1,Kmm) 
     95            zwndrel(:,:) =        - rn_uofac * uu(:,:,1,Kbb) 
    9196         END WHERE 
    9297         utau(:,:) = zrhocd * zwndrel(:,:) * zwndrel(:,:) 
    9398 
    94          zwndrel(:,:) = - rn_uofac * vv(:,:,1,Kmm) 
     99         zwndrel(:,:) = - rn_uofac * vv(:,:,1,Kbb) 
    95100         vtau(:,:) = zrhocd * zwndrel(:,:) * zwndrel(:,:) 
    96101 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/CANAL/MY_SRC/usrdef_zgr.F90

    r12377 r13710  
    197197         zmaxlam = MAXVAL(glamt) 
    198198         CALL mpp_max( 'usrdef_zgr', zmaxlam )                 ! max over the global domain 
    199          zscl = rpi / zmaxlam 
    200          z2d(:,:) = 0.5 * ( 1. - COS( glamt(:,:) * zscl ) ) 
    201          z2d(:,:) = REAL(jpkm1 - NINT( 0.75 * REAL(jpkm1,wp) * z2d(:,:) ), wp) 
     199         zscl = 0.5 * rpi / zmaxlam 
     200         z2d(:,:) = COS( glamt(:,:) * zscl ) 
     201         z2d(:,:) = REAL(jpkm1 - NINT( 0.5 * REAL(jpkm1,wp) * z2d(:,:) ), wp) 
    202202      END SELECT 
    203203      ! 
    204204      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
    205205      ! 
    206       k_bot(:,:) = INT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere 
     206      k_bot(:,:) = NINT( z2d(:,:) )          ! =jpkm1 over the ocean point, =0 elsewhere 
    207207      ! 
    208208      k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV1D/EXPREF/context_nemo.xml

    r12276 r13710  
    1111       <variable id="ref_month" type="int"> 01 </variable> 
    1212       <variable id="ref_day"   type="int"> 01 </variable> 
    13        <variable id="rau0"      type="float" > 1026.0 </variable> 
     13       <variable id="rho0"      type="float" > 1026.0 </variable> 
    1414       <variable id="cpocean"   type="float" > 3991.86795711963 </variable> 
    1515       <variable id="convSpsu"  type="float" > 0.99530670233846  </variable> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV1D/EXPREF/namelist_cfg

    r12489 r13710  
    106106!!                                                                    !! 
    107107!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    108 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    109 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     108!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     109!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    110110!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    111111!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    115115&namdrg        !   top/bottom drag coefficient                          (default: NO selection) 
    116116!----------------------------------------------------------------------- 
    117    ln_OFF     = .true.     !  free-slip       : Cd = 0                   
     117   ln_drg_OFF = .true.     !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    118118/ 
    119119!!====================================================================== 
    … …  
    197197!!                                                                    !! 
    198198!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    199 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    200199!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    201200!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV1D/EXPREF/namelist_cfg_120pts

    r12489 r13710  
    106106!!                                                                    !! 
    107107!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    108 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    109 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     108!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     109!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    110110!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    111111!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    115115&namdrg        !   top/bottom drag coefficient                          (default: NO selection) 
    116116!----------------------------------------------------------------------- 
    117    ln_OFF     = .true.     !  free-slip       : Cd = 0                   
     117   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    118118/ 
    119119!!====================================================================== 
    … …  
    197197!!                                                                    !! 
    198198!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    199 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    200199!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    201200!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV1D/EXPREF/namelist_cfg_240pts

    r12489 r13710  
    106106!!                                                                    !! 
    107107!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    108 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    109 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     108!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     109!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    110110!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    111111!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    115115&namdrg        !   top/bottom drag coefficient                          (default: NO selection) 
    116116!----------------------------------------------------------------------- 
    117    ln_OFF     = .true.     !  free-slip       : Cd = 0                   
     117   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    118118/ 
    119119!!====================================================================== 
    … …  
    197197!!                                                                    !! 
    198198!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    199 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    200199!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    201200!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV1D/EXPREF/namelist_cfg_60pts

    r12489 r13710  
    106106!!                                                                    !! 
    107107!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    108 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    109 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     108!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     109!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    110110!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    111111!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    115115&namdrg        !   top/bottom drag coefficient                          (default: NO selection) 
    116116!----------------------------------------------------------------------- 
    117    ln_OFF     = .true.     !  free-slip       : Cd = 0                   
     117   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    118118/ 
    119119!!====================================================================== 
    … …  
    197197!!                                                                    !! 
    198198!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    199 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    200199!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    201200!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg

    r10535 r13710  
    8888!------------------------------------------------------------------------------ 
    8989   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    90    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     90   nn_iceini_file   =  1              !  netcdf file provided for initialization 
    9191 
    9292   sn_hti = 'initice_60pts'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg_120pts

    r10431 r13710  
    8888!------------------------------------------------------------------------------ 
    8989   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    90    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     90   nn_iceini_file   =  1              !  netcdf file provided for initialization  
    9191 
    9292   sn_hti = 'initice_120pts'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg_240pts

    r10431 r13710  
    8888!------------------------------------------------------------------------------ 
    8989   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    90    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     90   nn_iceini_file   =  1              !  netcdf file provided for initialization  
    9191 
    9292   sn_hti = 'initice_240pts'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg_60pts

    r10431 r13710  
    8888!------------------------------------------------------------------------------ 
    8989   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    90    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     90   nn_iceini_file   =  1              !  netcdf file provided for initialization  
    9191 
    9292   sn_hti = 'initice_60pts'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90

    r10513 r13710  
    2626   PUBLIC   usr_def_hgr   ! called by domhgr.F90 
    2727 
     28   !! * Substitutions 
     29#  include "do_loop_substitute.h90" 
    2830   !!---------------------------------------------------------------------- 
    2931   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6264      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2] 
    6365      ! 
    64       INTEGER  ::   ji, jj   ! dummy loop indices 
     66      INTEGER  ::   ji, jj     ! dummy loop indices 
    6567      REAL(wp) ::   zphi0, zlam0, zbeta, zf0 
    66       REAL(wp) ::   zti, zui, ztj, zvj   ! local scalars 
     68      REAL(wp) ::   zti, ztj   ! local scalars 
    6769      !!------------------------------------------------------------------------------- 
    6870      ! 
    … …  
    7375 
    7476      !                          ========== 
    75       zlam0 = -(jpiglo-1)/2 * 1.e-3 * rn_dx 
    76       zphi0 = -(jpjglo-1)/2 * 1.e-3 * rn_dy 
     77      zlam0 = -REAL( (Ni0glo-2)/2, wp) * 1.e-3 * rn_dx 
     78      zphi0 = -REAL( (Nj0glo-2)/2, wp) * 1.e-3 * rn_dy 
    7779 
    78       DO jj = 1, jpj 
    79          DO ji = 1, jpi 
    80             zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) 
    81             zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 
    82  
    83             plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 
    84             plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 
    85             plamv(ji,jj) = plamt(ji,jj)  
    86             plamf(ji,jj) = plamu(ji,jj)  
    87     
    88             pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 
    89             pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 
    90             pphiu(ji,jj) = pphit(ji,jj)  
    91             pphif(ji,jj) = pphiv(ji,jj)  
    92          END DO 
    93       END DO 
     80      DO_2D( 1, 1, 1, 1 ) 
     81         zti = REAL( mig0_oldcmp(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
     82         ztj = REAL( mjg0_oldcmp(jj) - 1, wp )   ! start at j=0 in the global grid without halos 
     83          
     84         plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 *   zti 
     85         plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp ) 
     86         plamv(ji,jj) = plamt(ji,jj)  
     87         plamf(ji,jj) = plamu(ji,jj)  
     88          
     89         pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 *   ztj 
     90         pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * ( ztj + 0.5_wp ) 
     91         pphiu(ji,jj) = pphit(ji,jj)  
     92         pphif(ji,jj) = pphiv(ji,jj)  
     93      END_2D 
    9494          
    9595      ! constant scale factors 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV1D/MY_SRC/usrdef_nam.F90

    r12377 r13710  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
    1716   USE par_oce        ! ocean space and time domain 
    1817   USE phycst         ! physical constants 
    … …  
    9190         WRITE(numout,*) '         LX [km]: ', zlx 
    9291         WRITE(numout,*) '         LY [km]: ', zly 
    93          WRITE(numout,*) '         resulting global domain size :        jpiglo = ', kpi 
    94          WRITE(numout,*) '                                               jpjglo = ', kpj 
     92         WRITE(numout,*) '         resulting global domain size :        Ni0glo = ', kpi 
     93         WRITE(numout,*) '                                               Nj0glo = ', kpj 
    9594         WRITE(numout,*) '                                               jpkglo = ', kpk 
    9695         WRITE(numout,*) '         Coriolis:', ln_corio 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV1D/MY_SRC/usrdef_sbc.F90

    r12377 r13710  
    107107      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness 
    108108      !! 
     109      INTEGER  ::   jl 
    109110      REAL(wp) ::   zfr1, zfr2                 ! local variables 
    110111      REAL(wp), DIMENSION(jpi,jpj) ::   zsnw   ! snw distribution after wind blowing 
     112      REAL(wp), DIMENSION(jpi,jpj) ::   ztri 
    111113      !!--------------------------------------------------------------------- 
    112114      ! 
    … …  
    141143 
    142144      ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 
    143       zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            ! transmission when hi>10cm 
    144       zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1 
     145      cloud_fra(:,:) = pp_cldf 
     146      ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm 
    145147      ! 
    146       WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
    147          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    148       ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm 
    149          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 
    150       ELSEWHERE                                                         ! zero when hs>0 
    151          qtr_ice_top(:,:,:) = 0._wp  
    152       END WHERE 
    153            
     148      DO jl = 1, jpl 
     149         WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm   
     150            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
     151         ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm 
     152            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 
     153         ELSEWHERE                                                         ! zero when hs>0 
     154            qtr_ice_top(:,:,jl) = 0._wp 
     155         END WHERE 
     156      ENDDO 
     157          
     158  
    154159   END SUBROUTINE usrdef_sbc_ice_flx 
    155160 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV2D/EXPREF/context_nemo.xml

    r12276 r13710  
    1111       <variable id="ref_month" type="int"> 01 </variable> 
    1212       <variable id="ref_day"   type="int"> 01 </variable> 
    13        <variable id="rau0"      type="float" > 1026.0 </variable> 
     13       <variable id="rho0"      type="float" > 1026.0 </variable> 
    1414       <variable id="cpocean"   type="float" > 3991.86795711963 </variable> 
    1515       <variable id="convSpsu"  type="float" > 0.99530670233846  </variable> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV2D/EXPREF/file_def_nemo-ice.xml

    r10516 r13710  
    5555        <field field_ref="normstr"          name="normstr" /> 
    5656        <field field_ref="sheastr"          name="sheastr" /> 
    57         <field field_ref="isig1"            name="isig1"   /> 
    58         <field field_ref="isig2"            name="isig2"   /> 
    59         <field field_ref="isig3"            name="isig3"   /> 
     57       <field field_ref="sig1_pnorm"       name="sig1_pnorm"/> 
     58       <field field_ref="sig2_pnorm"       name="sig2_pnorm"/> 
    6059 
    6160        <!-- heat fluxes --> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV2D/EXPREF/namelist_cfg

    r12489 r13710  
    106106!!                                                                    !! 
    107107!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    108 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    109 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     108!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     109!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    110110!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    111111!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    115115&namdrg        !   top/bottom drag coefficient                          (default: NO selection) 
    116116!----------------------------------------------------------------------- 
    117    ln_OFF     = .true.     !  free-slip       : Cd = 0                   
     117   ln_drg_OFF = .true.     !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    118118/ 
    119119!!====================================================================== 
    … …  
    197197!!                                                                    !! 
    198198!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    199 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    200199!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    201200!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV2D/EXPREF/namelist_ice_cfg

    r10535 r13710  
    8686!------------------------------------------------------------------------------ 
    8787   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    88    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     88   nn_iceini_file   =  1              !  netcdf file provided for initialization  
    8989 
    9090   sn_hti = 'initice'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90

    r10515 r13710  
    2626   PUBLIC   usr_def_hgr   ! called by domhgr.F90 
    2727 
     28   !! * Substitutions 
     29#  include "do_loop_substitute.h90" 
    2830   !!---------------------------------------------------------------------- 
    2931   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6264      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2] 
    6365      ! 
    64       INTEGER  ::   ji, jj   ! dummy loop indices 
     66      INTEGER  ::   ji, jj     ! dummy loop indices 
    6567      REAL(wp) ::   zphi0, zlam0, zbeta, zf0 
    66       REAL(wp) ::   zti, zui, ztj, zvj   ! local scalars 
     68      REAL(wp) ::   zti, ztj   ! local scalars 
    6769      !!------------------------------------------------------------------------------- 
    6870      ! 
    … …  
    7476 
    7577      !                          ========== 
    76       zlam0 = -(jpiglo-1)/2 * 1.e-3 * rn_dx 
    77       zphi0 = -(jpjglo-1)/2 * 1.e-3 * rn_dy 
     78      zlam0 = -REAL( (Ni0glo-2)/2, wp) * 1.e-3 * rn_dx 
     79      zphi0 = -REAL( (Nj0glo-2)/2, wp) * 1.e-3 * rn_dy  
    7880 
    7981#if defined key_agrif  
    … …  
    8183!clem         zlam0  = Agrif_Parent(zlam0) + (Agrif_ix())*Agrif_Parent(rn_dx) * 1.e-5 
    8284!clem         zphi0  = Agrif_Parent(zphi0) + (Agrif_iy())*Agrif_Parent(rn_dy) * 1.e-5 
    83          zlam0 = ( 0.5_wp - ( Agrif_parent(jpiglo) - 1 ) / 2 ) * 1.e-3 * Agrif_irhox() * rn_dx  & 
     85         zlam0 = ( 0.5_wp - REAL( (Agrif_parent(Ni0glo) - 2 ) / 2, wp ) ) * 1.e-3 * Agrif_irhox() * rn_dx  & 
    8486            &  + ( Agrif_Ix() + nbghostcells - 1 ) * Agrif_irhox() * rn_dx * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dx * 1.e-3 
    85          zphi0 = ( 0.5_wp - ( Agrif_parent(jpjglo) - 1 ) / 2 ) * 1.e-3 * Agrif_irhoy() * rn_dy  & 
     87         zphi0 = ( 0.5_wp - REAL( (Agrif_parent(Nj0glo) - 2 ) / 2, wp ) ) * 1.e-3 * Agrif_irhoy() * rn_dy  & 
    8688            &  + ( Agrif_Iy() + nbghostcells - 1 ) * Agrif_irhoy() * rn_dy * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dy * 1.e-3 
    8789      ENDIF 
    8890#endif          
    8991 
    90       DO jj = 1, jpj 
    91          DO ji = 1, jpi 
    92             zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) 
    93             zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 
    94  
    95             plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 
    96             plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 
    97             plamv(ji,jj) = plamt(ji,jj)  
    98             plamf(ji,jj) = plamu(ji,jj)  
    99     
    100             pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 
    101             pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 
    102             pphiu(ji,jj) = pphit(ji,jj)  
    103             pphif(ji,jj) = pphiv(ji,jj)  
    104          END DO 
    105       END DO 
     92      DO_2D( 1, 1, 1, 1 ) 
     93         zti = REAL( mig0_oldcmp(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
     94         ztj = REAL( mjg0_oldcmp(jj) - 1, wp )   ! start at j=0 in the global grid without halos 
     95          
     96         plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 *   zti 
     97         plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp ) 
     98         plamv(ji,jj) = plamt(ji,jj)  
     99         plamf(ji,jj) = plamu(ji,jj)  
     100          
     101         pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 *   ztj 
     102         pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * ( ztj + 0.5_wp ) 
     103         pphiu(ji,jj) = pphit(ji,jj)  
     104         pphif(ji,jj) = pphiv(ji,jj)  
     105      END_2D 
    106106          
    107107         ! Horizontal scale factors (in meters) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV2D/MY_SRC/usrdef_nam.F90

    r12377 r13710  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
     16   USE dom_oce 
    1717   USE par_oce        ! ocean space and time domain 
    1818   USE phycst         ! physical constants 
    … …  
    8282      kk_cfg = NINT( rn_dx ) 
    8383      ! 
    84       IF( Agrif_Root() ) THEN        ! Global Domain size:  ICE_AGRIF domain is  300 km x 300 Km x 10 m 
     84      IF( Agrif_Root() ) THEN        ! Global Domain size: ICE_AGRIF domain is  300 km x 300 Km x 10 m 
    8585         kpi = NINT( 300.e3 / rn_dx ) - 1 
    8686         kpj = NINT( 300.e3 / rn_dy ) - 1 
    87       ELSE 
    88          kpi = nbcellsx + 2 + 2*nbghostcells 
    89          kpj = nbcellsy + 2 + 2*nbghostcells 
     87      ELSE                           ! Global Domain size: add nbghostcells + 1 "land" point on each side 
     88         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
     89         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
    9090      ENDIF 
    91       kpk = 1 
     91      kpk = 2 
    9292      ! 
    9393!!      zlx = (kpi-2)*rn_dx*1.e-3 
    … …  
    110110         WRITE(numout,*) '         LX [km]: ', zlx 
    111111         WRITE(numout,*) '         LY [km]: ', zly 
    112          WRITE(numout,*) '         resulting global domain size :        jpiglo = ', kpi 
    113          WRITE(numout,*) '                                               jpjglo = ', kpj 
     112         WRITE(numout,*) '         resulting global domain size :        Ni0glo = ', kpi 
     113         WRITE(numout,*) '                                               Nj0glo = ', kpj 
    114114         WRITE(numout,*) '                                               jpkglo = ', kpk 
    115115         WRITE(numout,*) '         Coriolis:', ln_corio 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV2D/MY_SRC/usrdef_sbc.F90

    r12377 r13710  
    107107      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   phi    ! ice thickness 
    108108      !! 
     109      INTEGER  ::   jl 
    109110      REAL(wp) ::   zfr1, zfr2                 ! local variables 
    110111      REAL(wp), DIMENSION(jpi,jpj) ::   zsnw   ! snw distribution after wind blowing 
     112      REAL(wp), DIMENSION(jpi,jpj) ::   ztri 
    111113      !!--------------------------------------------------------------------- 
    112114      ! 
    … …  
    141143 
    142144      ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 
    143       zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            ! transmission when hi>10cm 
    144       zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1 
     145      cloud_fra(:,:) = pp_cldf 
     146      ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm 
    145147      ! 
    146       WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
    147          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    148       ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm 
    149          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 
    150       ELSEWHERE                                                         ! zero when hs>0 
    151          qtr_ice_top(:,:,:) = 0._wp  
    152       END WHERE 
    153            
     148      DO jl = 1, jpl 
     149         WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm   
     150            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
     151         ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm 
     152            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 
     153         ELSEWHERE                                                         ! zero when hs>0 
     154            qtr_ice_top(:,:,jl) = 0._wp 
     155         END WHERE 
     156      ENDDO 
     157          
     158  
    154159   END SUBROUTINE usrdef_sbc_ice_flx 
    155160 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_AGRIF/EXPREF/1_namelist_cfg

    r12489 r13710  
    106106!!                                                                    !! 
    107107!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    108 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    109 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     108!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     109!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    110110!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    111111!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    115115&namdrg        !   top/bottom drag coefficient                          (default: NO selection) 
    116116!----------------------------------------------------------------------- 
    117    ln_OFF     = .true.     !  free-slip       : Cd = 0                   
     117   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    118118/ 
    119119!!====================================================================== 
    … …  
    197197!!                                                                    !! 
    198198!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    199 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    200199!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    201200!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_AGRIF/EXPREF/AGRIF_FixedGrids.in

    r9159 r13710  
    111 
    2 34 63 34 63 3 3 3 
     233 62 33 62 3 3 3 
    330 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_AGRIF/EXPREF/context_nemo.xml

    r12377 r13710  
    1111       <variable id="ref_month" type="int"> 01 </variable> 
    1212       <variable id="ref_day"   type="int"> 01 </variable> 
    13        <variable id="rau0"      type="float" > 1026.0 </variable> 
     13       <variable id="rho0"      type="float" > 1026.0 </variable> 
    1414       <variable id="cpocean"   type="float" > 3991.86795711963 </variable> 
    1515       <variable id="convSpsu"  type="float" > 0.99530670233846  </variable> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_AGRIF/EXPREF/file_def_nemo-ice.xml

    r11159 r13710  
    5353        <field field_ref="normstr"          name="normstr" /> 
    5454        <field field_ref="sheastr"          name="sheastr" /> 
    55         <field field_ref="isig1"            name="isig1"   /> 
    56         <field field_ref="isig2"            name="isig2"   /> 
    57         <field field_ref="isig3"            name="isig3"   /> 
     55       <field field_ref="sig1_pnorm"       name="sig1_pnorm"/> 
     56       <field field_ref="sig2_pnorm"       name="sig2_pnorm"/> 
    5857 
    5958        <!-- heat fluxes --> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_AGRIF/EXPREF/namelist_cfg

    r12489 r13710  
    106106!!                                                                    !! 
    107107!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    108 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    109 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     108!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     109!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    110110!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    111111!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    115115&namdrg        !   top/bottom drag coefficient                          (default: NO selection) 
    116116!----------------------------------------------------------------------- 
    117    ln_OFF     = .true.     !  free-slip       : Cd = 0                   
     117   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    118118/ 
    119119!!====================================================================== 
    … …  
    197197!!                                                                    !! 
    198198!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    199 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    200199!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    201200!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_AGRIF/EXPREF/namelist_ice_cfg

    r10535 r13710  
    8686!------------------------------------------------------------------------------ 
    8787   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    88    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     88   nn_iceini_file   =  1              !  netcdf file provided for initialization  
    8989 
    9090   sn_hti = 'initice'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90

    r10516 r13710  
    2626   PUBLIC   usr_def_hgr   ! called by domhgr.F90 
    2727 
     28   !! * Substitutions 
     29#  include "do_loop_substitute.h90" 
    2830   !!---------------------------------------------------------------------- 
    2931   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6264      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2] 
    6365      ! 
    64       INTEGER  ::   ji, jj   ! dummy loop indices 
     66      INTEGER  ::   ji, jj     ! dummy loop indices 
    6567      REAL(wp) ::   zphi0, zlam0, zbeta, zf0 
    66       REAL(wp) ::   zti, zui, ztj, zvj   ! local scalars 
     68      REAL(wp) ::   zti, ztj   ! local scalars 
    6769      !!------------------------------------------------------------------------------- 
    6870      ! 
    … …  
    7476 
    7577      !                          ========== 
    76       zlam0 = -(jpiglo-1)/2 * 1.e-3 * rn_dx 
    77       zphi0 = -(jpjglo-1)/2 * 1.e-3 * rn_dy 
    78  
    7978#if defined key_agrif  
    80       IF( .NOT. Agrif_Root() ) THEN 
     79      IF( Agrif_Root() ) THEN 
     80#endif 
     81         ! Compatibility WITH old version:  
     82         ! jperio = 7 =>  Ni0glo = jpigo_old_version - 2 
     83         !            =>  jpiglo-1 replaced by Ni0glo+1 
     84         zlam0 = -REAL( (Ni0glo+1)/2, wp) * 1.e-3 * rn_dx 
     85         zphi0 = -REAL( (Nj0glo+1)/2, wp) * 1.e-3 * rn_dy   ! +1 for compatibility with old version --> to be replaced by -1 as before 
     86#if defined key_agrif  
     87      ELSE 
     88         ! ! let lower left longitude and latitude from parent 
    8189!clem         zlam0  = Agrif_Parent(zlam0) + (Agrif_ix())*Agrif_Parent(rn_dx) * 1.e-5 
    8290!clem         zphi0  = Agrif_Parent(zphi0) + (Agrif_iy())*Agrif_Parent(rn_dy) * 1.e-5 
    83          zlam0 = ( 0.5_wp - ( Agrif_parent(jpiglo) - 1 ) / 2 ) * 1.e-3 * Agrif_irhox() * rn_dx  & 
     91         ! Compatibility WITH old version:  
     92         ! jperio = 0 =>  Ni0glo = jpigo_old_version 
     93         !            =>  Agrif_parent(jpiglo)-1 replaced by  Agrif_parent(Ni0glo)-1 
     94         zlam0 = ( 0.5_wp - REAL( ( Agrif_parent(Ni0glo)-1 ) / 2, wp) ) * 1.e-3 * Agrif_irhox() * rn_dx  & 
    8495            &  + ( Agrif_Ix() + nbghostcells - 1 ) * Agrif_irhox() * rn_dx * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dx * 1.e-3 
    85          zphi0 = ( 0.5_wp - ( Agrif_parent(jpjglo) - 1 ) / 2 ) * 1.e-3 * Agrif_irhoy() * rn_dy  & 
     96         zphi0 = ( 0.5_wp - REAL( ( Agrif_parent(Nj0glo)-1 ) / 2, wp) ) * 1.e-3 * Agrif_irhoy() * rn_dy  & 
    8697            &  + ( Agrif_Iy() + nbghostcells - 1 ) * Agrif_irhoy() * rn_dy * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dy * 1.e-3 
    8798      ENDIF 
    8899#endif          
    89100 
    90       DO jj = 1, jpj 
    91          DO ji = 1, jpi 
    92             zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) 
    93             zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 
    94  
    95             plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 
    96             plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 
    97             plamv(ji,jj) = plamt(ji,jj)  
    98             plamf(ji,jj) = plamu(ji,jj)  
    99     
    100             pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 
    101             pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 
    102             pphiu(ji,jj) = pphit(ji,jj)  
    103             pphif(ji,jj) = pphiv(ji,jj)  
    104          END DO 
    105       END DO 
     101      DO_2D( 1, 1, 1, 1 ) 
     102         zti = REAL( mig0_oldcmp(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
     103         ztj = REAL( mjg0_oldcmp(jj) - 1, wp )   ! start at j=0 in the global grid without halos 
     104          
     105         plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 *   zti 
     106         plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp ) 
     107         plamv(ji,jj) = plamt(ji,jj)  
     108         plamf(ji,jj) = plamu(ji,jj)  
     109          
     110         pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 *   ztj 
     111         pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * ( ztj + 0.5_wp ) 
     112         pphiu(ji,jj) = pphit(ji,jj)  
     113         pphif(ji,jj) = pphiv(ji,jj)  
     114      END_2D 
    106115          
    107116         ! Horizontal scale factors (in meters) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_AGRIF/MY_SRC/usrdef_nam.F90

    r12597 r13710  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
     16   USE dom_oce 
    1717   USE par_oce        ! ocean space and time domain 
    1818   USE phycst         ! physical constants 
    … …  
    8585         kpi = NINT( 300.e3 / rn_dx ) - 1 
    8686         kpj = NINT( 300.e3 / rn_dy ) - 1 
    87       ELSE 
    88          kpi = nbcellsx + 2 + 2*nbghostcells 
    89          kpj = nbcellsy + 2 + 2*nbghostcells 
     87         kpi = kpi - 2   ! for compatibility with old version (because kerio=7) --> to be removed 
     88         kpj = kpj - 2   ! for compatibility with old version (because kerio=7) --> to be removed 
     89      ELSE                           ! Global Domain size: add nbghostcells + 1 "land" point on each side 
     90         kpi  = nbcellsx + 2 * ( nbghostcells + 1 ) 
     91         kpj  = nbcellsy + 2 * ( nbghostcells + 1 ) 
     92!!$         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
     93!!$         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
    9094      ENDIF 
    9195      kpk = 2 
    … …  
    110114         WRITE(numout,*) '         LX [km]: ', zlx 
    111115         WRITE(numout,*) '         LY [km]: ', zly 
    112          WRITE(numout,*) '         resulting global domain size :        jpiglo = ', kpi 
    113          WRITE(numout,*) '                                               jpjglo = ', kpj 
     116         WRITE(numout,*) '         resulting global domain size :        Ni0glo = ', kpi 
     117         WRITE(numout,*) '                                               Nj0glo = ', kpj 
    114118         WRITE(numout,*) '                                               jpkglo = ', kpk 
    115119         WRITE(numout,*) '         Coriolis:', ln_corio 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_AGRIF/MY_SRC/usrdef_sbc.F90

    r12377 r13710  
    107107      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness 
    108108      !! 
     109      INTEGER  ::   jl 
    109110      REAL(wp) ::   zfr1, zfr2                 ! local variables 
    110111      REAL(wp), DIMENSION(jpi,jpj) ::   zsnw   ! snw distribution after wind blowing 
     112      REAL(wp), DIMENSION(jpi,jpj) ::   ztri 
    111113      !!--------------------------------------------------------------------- 
    112114      ! 
    … …  
    141143 
    142144      ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 
    143       zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            ! transmission when hi>10cm 
    144       zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1 
     145      cloud_fra(:,:) = pp_cldf 
     146      ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm 
    145147      ! 
    146       WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
    147          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    148       ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm 
    149          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 
    150       ELSEWHERE                                                         ! zero when hs>0 
    151          qtr_ice_top(:,:,:) = 0._wp  
    152       END WHERE 
     148      DO jl = 1, jpl 
     149         WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm   
     150            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
     151         ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm 
     152            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 
     153         ELSEWHERE                                                         ! zero when hs>0 
     154            qtr_ice_top(:,:,jl) = 0._wp 
     155         END WHERE 
     156      ENDDO 
    153157           
    154158   END SUBROUTINE usrdef_sbc_ice_flx 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP+/EXPREF/file_def_nemo-oce.xml

    r11889 r13710  
    2121      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->   
    2222 
    23       <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 
    24    <file id="file1" output_freq="1mo" name_suffix="_grid_T" description="ocean T grid variables" > 
    25      <field field_ref="toce"         name="votemper"  /> 
    26      <field field_ref="soce"         name="vosaline"  /> 
    27      <field field_ref="ssh"          name="sossheig"  /> 
     23   <file id="file1" output_freq="5d" name_suffix="_grid_T" description="ocean T grid variables" > 
     24     <field field_ref="toce"         name="votemper"  operation="average" freq_op="5d" > @toce_e3t / @e3t </field> 
     25     <field field_ref="soce"         name="vosaline"  operation="average" freq_op="5d" > @soce_e3t / @e3t </field> 
     26     <field field_ref="ssh"          name="sossheig" /> 
    2827          <!-- variable for ice shelf --> 
    29           <field field_ref="fwfisf_cav"       name="sowflisf"  /> 
    30           <field field_ref="isfgammat"    name="sogammat"  /> 
    31           <field field_ref="isfgammas"    name="sogammas"  /> 
     28          <field field_ref="fwfisf_cav"  name="sowflisf"  /> 
     29          <field field_ref="isfgammat"   name="sogammat"  /> 
     30          <field field_ref="isfgammas"   name="sogammas"  /> 
    3231          <field field_ref="ttbl_cav"    name="ttbl"  /> 
    33           <field field_ref="stbl"    name="stbl"  /> 
    34           <field field_ref="utbl"    name="utbl"  /> 
    35           <field field_ref="vtbl"    name="vtbl"  /> 
     32          <field field_ref="stbl"        name="stbl"  /> 
     33          <field field_ref="utbl"        name="utbl"  /> 
     34          <field field_ref="vtbl"        name="vtbl"  /> 
    3635        </file> 
    37    <file id="file2" output_freq="1mo" name_suffix="_grid_U" description="ocean U grid variables" > 
    38           <field field_ref="uoce"         name="vozocrtx" /> 
     36   <file id="file2" output_freq="5d" name_suffix="_grid_U" description="ocean U grid variables" > 
     37          <field field_ref="uoce"         name="vozocrtx" operation="average" freq_op="5d" > @uoce_e3u / @e3u </field> /> 
    3938        </file> 
    40    <file id="file3" output_freq="1mo" name_suffix="_grid_V" description="ocean V grid variables" > 
    41           <field field_ref="voce"         name="vomecrty" />  
     39   <file id="file3" output_freq="5d" name_suffix="_grid_V" description="ocean V grid variables" > 
     40          <field field_ref="voce"         name="vomecrty" operation="average" freq_op="5d" > @voce_e3v / @e3v </field> />  
    4241        </file> 
    4342      </file_group> 
     43 
     44      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 
    4445      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files --> 
    4546      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files --> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP+/EXPREF/namelist_cfg

    r12489 r13710  
    114114 
    115115   ln_usr      = .true.   !  user defined formulation                  (T => check usrdef_sbc) 
    116    nn_fwb      = 1 
     116   nn_fwb      = 4 
    117117/ 
    118118!----------------------------------------------------------------------- 
    … …  
    261261!!                                                                    !! 
    262262!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    263 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    264 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     263!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     264!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    265265!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    266266!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    273273/ 
    274274!----------------------------------------------------------------------- 
    275 &namdrg_top    !   TOP friction                                         (ln_OFF =F & ln_isfcav=T) 
     275&namdrg_top    !   TOP friction                                         (ln_drg_OFF =F & ln_isfcav=T) 
    276276!----------------------------------------------------------------------- 
    277277   rn_Cd0      =  2.5e-3   !  drag coefficient [-] 
    … …  
    279279/ 
    280280!----------------------------------------------------------------------- 
    281 &namdrg_bot    !   BOTTOM friction                                      (ln_OFF =F) 
     281&namdrg_bot    !   BOTTOM friction                                      (ln_drg_OFF =F) 
    282282!----------------------------------------------------------------------- 
    283283   rn_Cd0      =  2.5e-3    !  drag coefficient [-] 
    … …  
    308308&nameos        !   ocean Equation Of Seawater                           (default: NO selection) 
    309309!----------------------------------------------------------------------- 
    310    ln_teos10   = .false.         !  = Use TEOS-10 
    311    ln_eos80    = .false.         !  = Use EOS80 
    312    ln_leos     = .true.          !  = Use S-EOS (simplified Eq.) 
     310   ln_leos     = .true.          !  = Use L-EOS (linear Eq.) 
    313311                                 ! 
    314312   !                     ! S-EOS coefficients (ln_seos=T): 
    315    !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     313   !                             !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    316314   !                     ! L-EOS coefficients (ln_seos=T): 
    317    !                             !  rd(T,S,Z)*rau0 = rau0*(-a0*dT+b0*dS) 
     315   !                             !  rd(T,S,Z)*rho0 = rho0*(-a0*dT+b0*dS) 
    318316   rn_a0       =  3.7330e-5      !  thermal expension coefficient 
    319317   rn_b0       =  7.8430e-4      !  saline  expension coefficient 
    … …  
    463461!!                                                                    !! 
    464462!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    465 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    466463!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    467464!!   namdiu       Cool skin and warm layer models                       (default: OFF) 
    … …  
    480477/ 
    481478!----------------------------------------------------------------------- 
    482 &namptr        !   Poleward Transport Diagnostic                        (default: OFF) 
    483479!----------------------------------------------------------------------- 
    484480/ 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP+/MY_SRC/dtatsd.F90

    r12077 r13710  
    3636   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsddmp ! structure of input SST (file informations, fields read) 
    3737 
     38   !! * Substitutions 
     39#  include "do_loop_substitute.h90" 
    3840   !!---------------------------------------------------------------------- 
    3941   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6769      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
    6870      ! 
    69       REWIND( numnam_ref )              ! Namelist namtsd in reference namelist :  
    7071      READ  ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901) 
    7172901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtsd in reference namelist' ) 
    72       REWIND( numnam_cfg )              ! Namelist namtsd in configuration namelist : Parameters of the run 
    7373      READ  ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 ) 
    7474902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtsd in configuration namelist' ) 
    … …  
    191191         ENDIF 
    192192         ! 
    193          DO jj = 1, jpj                         ! vertical interpolation of T & S 
    194             DO ji = 1, jpi 
    195                DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    196                   zl = gdept_0(ji,jj,jk) 
    197                   IF(     zl < gdept_1d(1  ) ) THEN          ! above the first level of data 
    198                      ztp(jk) =  ptsd(ji,jj,1    ,jp_tem) 
    199                      zsp(jk) =  ptsd(ji,jj,1    ,jp_sal) 
    200                   ELSEIF( zl > gdept_1d(jpk) ) THEN          ! below the last level of data 
    201                      ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem) 
    202                      zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal) 
    203                   ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
    204                      DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
    205                         IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
    206                            zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
    207                            ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi  
    208                            zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 
    209                         ENDIF 
    210                      END DO 
    211                   ENDIF 
    212                END DO 
    213                DO jk = 1, jpkm1 
    214                   ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
    215                   ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk) 
    216                END DO 
    217                ptsd(ji,jj,jpk,jp_tem) = 0._wp 
    218                ptsd(ji,jj,jpk,jp_sal) = 0._wp 
     193         DO_2D( 1, 1, 1, 1 )                  ! vertical interpolation of T & S 
     194            DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
     195               zl = gdept_0(ji,jj,jk) 
     196               IF(     zl < gdept_1d(1  ) ) THEN          ! above the first level of data 
     197                  ztp(jk) =  ptsd(ji,jj,1    ,jp_tem) 
     198                  zsp(jk) =  ptsd(ji,jj,1    ,jp_sal) 
     199               ELSEIF( zl > gdept_1d(jpk) ) THEN          ! below the last level of data 
     200                  ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem) 
     201                  zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal) 
     202               ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
     203                  DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
     204                     IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
     205                        zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
     206                        ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi  
     207                        zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 
     208                     ENDIF 
     209                  END DO 
     210               ENDIF 
    219211            END DO 
    220          END DO 
     212            DO jk = 1, jpkm1 
     213               ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
     214               ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk) 
     215            END DO 
     216            ptsd(ji,jj,jpk,jp_tem) = 0._wp 
     217            ptsd(ji,jj,jpk,jp_sal) = 0._wp 
     218         END_2D 
    221219         !  
    222220      ELSE                                !==   z- or zps- coordinate   ==! 
    … …  
    226224         ! 
    227225         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
    228             DO jj = 1, jpj 
    229                DO ji = 1, jpi 
    230                   ik = mbkt(ji,jj)  
    231                   IF( ik > 1 ) THEN 
    232                      zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    233                      ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem) 
    234                      ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal) 
    235                   ENDIF 
    236                   ik = mikt(ji,jj) 
    237                   IF( ik > 1 ) THEN 
    238                      zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )  
    239                      ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem) 
    240                      ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal) 
    241                   END IF 
    242                END DO 
    243             END DO 
     226            DO_2D( 1, 1, 1, 1 ) 
     227               ik = mbkt(ji,jj)  
     228               IF( ik > 1 ) THEN 
     229                  zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
     230                  ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem) 
     231                  ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal) 
     232               ENDIF 
     233               ik = mikt(ji,jj) 
     234               IF( ik > 1 ) THEN 
     235                  zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )  
     236                  ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem) 
     237                  ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal) 
     238               END IF 
     239            END_2D 
    244240         ENDIF 
    245241         ! 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP+/MY_SRC/eosbn2.F90

    r12489 r13710  
    180180   REAL(wp) ::   BPE002 
    181181 
     182   !! * Substitutions 
     183#  include "do_loop_substitute.h90" 
     184#  include "domzgr_substitute.h90" 
    182185   !!---------------------------------------------------------------------- 
    183186   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    241244      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    242245         ! 
    243          DO jk = 1, jpkm1 
    244             DO jj = 1, jpj 
    245                DO ji = 1, jpi 
    246                   ! 
    247                   zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
    248                   zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
    249                   zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    250                   ztm = tmask(ji,jj,jk)                                         ! tmask 
     246         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     247            ! 
     248            zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
     249            zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     250            zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     251            ztm = tmask(ji,jj,jk)                                         ! tmask 
     252            ! 
     253            zn3 = EOS013*zt   & 
     254               &   + EOS103*zs+EOS003 
     255               ! 
     256            zn2 = (EOS022*zt   & 
     257               &   + EOS112*zs+EOS012)*zt   & 
     258               &   + (EOS202*zs+EOS102)*zs+EOS002 
     259               ! 
     260            zn1 = (((EOS041*zt   & 
     261               &   + EOS131*zs+EOS031)*zt   & 
     262               &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     263               &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     264               &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     265               ! 
     266            zn0 = (((((EOS060*zt   & 
     267               &   + EOS150*zs+EOS050)*zt   & 
     268               &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     269               &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     270               &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     271               &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     272               &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     273               ! 
     274            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     275            ! 
     276            prd(ji,jj,jk) = (  zn * r1_rho0 - 1._wp  ) * ztm  ! density anomaly (masked) 
     277            ! 
     278         END_3D 
     279         ! 
     280      CASE( np_seos )                !==  simplified EOS  ==! 
     281         ! 
     282         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     283            zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
     284            zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
     285            zh  = pdep (ji,jj,jk) 
     286            ztm = tmask(ji,jj,jk) 
     287            ! 
     288            zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
     289               &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
     290               &  - rn_nu * zt * zs 
     291               !                                  
     292            prd(ji,jj,jk) = zn * r1_rho0 * ztm                ! density anomaly (masked) 
     293         END_3D 
     294         ! 
     295      CASE( np_leos )                !==  linear ISOMIP EOS  ==! 
     296         ! 
     297         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     298            zt  = pts  (ji,jj,jk,jp_tem) - (-1._wp) 
     299            zs  = pts  (ji,jj,jk,jp_sal) - 34.2_wp 
     300            zh  = pdep (ji,jj,jk) 
     301            ztm = tmask(ji,jj,jk) 
     302            ! 
     303            zn =  rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 
     304            !                                  
     305            prd(ji,jj,jk) = zn * r1_rho0 * ztm                ! density anomaly (masked) 
     306         END_3D 
     307         ! 
     308      END SELECT 
     309      ! 
     310      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu  : ', kdim=jpk ) 
     311      ! 
     312      IF( ln_timing )   CALL timing_stop('eos-insitu') 
     313      ! 
     314   END SUBROUTINE eos_insitu 
     315 
     316 
     317   SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 
     318      !!---------------------------------------------------------------------- 
     319      !!                  ***  ROUTINE eos_insitu_pot  *** 
     320      !! 
     321      !! ** Purpose :   Compute the in situ density (ratio rho/rho0) and the 
     322      !!      potential volumic mass (Kg/m3) from potential temperature and 
     323      !!      salinity fields using an equation of state selected in the 
     324      !!     namelist. 
     325      !! 
     326      !! ** Action  : - prd  , the in situ density (no units) 
     327      !!              - prhop, the potential volumic mass (Kg/m3) 
     328      !! 
     329      !!---------------------------------------------------------------------- 
     330      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
     331      !                                                                ! 2 : salinity               [psu] 
     332      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-] 
     333      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     334      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
     335      ! 
     336      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
     337      INTEGER  ::   jdof 
     338      REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars 
     339      REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      - 
     340      REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors 
     341      !!---------------------------------------------------------------------- 
     342      ! 
     343      IF( ln_timing )   CALL timing_start('eos-pot') 
     344      ! 
     345      SELECT CASE ( neos ) 
     346      ! 
     347      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     348         ! 
     349         ! Stochastic equation of state 
     350         IF ( ln_sto_eos ) THEN 
     351            ALLOCATE(zn0_sto(1:2*nn_sto_eos)) 
     352            ALLOCATE(zn_sto(1:2*nn_sto_eos)) 
     353            ALLOCATE(zsign(1:2*nn_sto_eos)) 
     354            DO jsmp = 1, 2*nn_sto_eos, 2 
     355              zsign(jsmp)   = 1._wp 
     356              zsign(jsmp+1) = -1._wp 
     357            END DO 
     358            ! 
     359            DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     360               ! 
     361               ! compute density (2*nn_sto_eos) times: 
     362               ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts) 
     363               ! (2) for t-dt, s-ds (with the opposite fluctuation) 
     364               DO jsmp = 1, nn_sto_eos*2 
     365                  jdof   = (jsmp + 1) / 2 
     366                  zh     = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
     367                  zt     = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0    ! temperature 
     368                  zstemp = pts  (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp) 
     369                  zs     = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 )   ! square root salinity 
     370                  ztm    = tmask(ji,jj,jk)                                         ! tmask 
    251371                  ! 
    252372                  zn3 = EOS013*zt   & 
    … …  
    263383                     &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
    264384                     ! 
    265                   zn0 = (((((EOS060*zt   & 
     385                  zn0_sto(jsmp) = (((((EOS060*zt   & 
    266386                     &   + EOS150*zs+EOS050)*zt   & 
    267387                     &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
    … …  
    271391                     &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
    272392                     ! 
    273                   zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     393                  zn_sto(jsmp)  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp) 
     394               END DO 
     395               ! 
     396               ! compute stochastic density as the mean of the (2*nn_sto_eos) densities 
     397               prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp 
     398               DO jsmp = 1, nn_sto_eos*2 
     399                  prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp)                      ! potential density referenced at the surface 
    274400                  ! 
    275                   prd(ji,jj,jk) = (  zn * r1_rho0 - 1._wp  ) * ztm  ! density anomaly (masked) 
    276                   ! 
     401                  prd(ji,jj,jk) = prd(ji,jj,jk) + (  zn_sto(jsmp) * r1_rho0 - 1._wp  )   ! density anomaly (masked) 
    277402               END DO 
    278             END DO 
    279          END DO 
    280          ! 
    281       CASE( np_seos )                !==  simplified EOS  ==! 
    282          ! 
    283          DO jk = 1, jpkm1 
    284             DO jj = 1, jpj 
    285                DO ji = 1, jpi 
    286                   zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
    287                   zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
    288                   zh  = pdep (ji,jj,jk) 
    289                   ztm = tmask(ji,jj,jk) 
    290                   ! 
    291                   zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
    292                      &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
    293                      &  - rn_nu * zt * zs 
    294                      !                                  
    295                   prd(ji,jj,jk) = zn * r1_rho0 * ztm                ! density anomaly (masked) 
    296                END DO 
    297             END DO 
    298          END DO 
    299          ! 
    300       CASE( np_leos )                !==  linear ISOMIP EOS  ==! 
    301          ! 
    302          DO jk = 1, jpkm1 
    303             DO jj = 1, jpj 
    304                DO ji = 1, jpi 
    305                   zt  = pts  (ji,jj,jk,jp_tem) - (-1._wp) 
    306                   zs  = pts  (ji,jj,jk,jp_sal) - 34.2_wp 
    307                   zh  = pdep (ji,jj,jk) 
    308                   ztm = tmask(ji,jj,jk) 
    309                   ! 
    310                   zn =  rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 
    311                   !                                  
    312                   prd(ji,jj,jk) = zn * r1_rho0 * ztm                ! density anomaly (masked) 
    313                END DO 
    314             END DO 
    315          END DO 
    316          ! 
    317       END SELECT 
    318       ! 
    319       IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu  : ', kdim=jpk ) 
    320       ! 
    321       IF( ln_timing )   CALL timing_stop('eos-insitu') 
    322       ! 
    323    END SUBROUTINE eos_insitu 
    324  
    325  
    326    SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 
    327       !!---------------------------------------------------------------------- 
    328       !!                  ***  ROUTINE eos_insitu_pot  *** 
    329       !! 
    330       !! ** Purpose :   Compute the in situ density (ratio rho/rho0) and the 
    331       !!      potential volumic mass (Kg/m3) from potential temperature and 
    332       !!      salinity fields using an equation of state selected in the 
    333       !!     namelist. 
    334       !! 
    335       !! ** Action  : - prd  , the in situ density (no units) 
    336       !!              - prhop, the potential volumic mass (Kg/m3) 
    337       !! 
    338       !!---------------------------------------------------------------------- 
    339       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
    340       !                                                                ! 2 : salinity               [psu] 
    341       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-] 
    342       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
    343       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
    344       ! 
    345       INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
    346       INTEGER  ::   jdof 
    347       REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars 
    348       REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      - 
    349       REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors 
    350       !!---------------------------------------------------------------------- 
    351       ! 
    352       IF( ln_timing )   CALL timing_start('eos-pot') 
    353       ! 
    354       SELECT CASE ( neos ) 
    355       ! 
    356       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    357          ! 
    358          ! Stochastic equation of state 
    359          IF ( ln_sto_eos ) THEN 
    360             ALLOCATE(zn0_sto(1:2*nn_sto_eos)) 
    361             ALLOCATE(zn_sto(1:2*nn_sto_eos)) 
    362             ALLOCATE(zsign(1:2*nn_sto_eos)) 
    363             DO jsmp = 1, 2*nn_sto_eos, 2 
    364               zsign(jsmp)   = 1._wp 
    365               zsign(jsmp+1) = -1._wp 
    366             END DO 
    367             ! 
    368             DO jk = 1, jpkm1 
    369                DO jj = 1, jpj 
    370                   DO ji = 1, jpi 
    371                      ! 
    372                      ! compute density (2*nn_sto_eos) times: 
    373                      ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts) 
    374                      ! (2) for t-dt, s-ds (with the opposite fluctuation) 
    375                      DO jsmp = 1, nn_sto_eos*2 
    376                         jdof   = (jsmp + 1) / 2 
    377                         zh     = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
    378                         zt     = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0    ! temperature 
    379                         zstemp = pts  (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp) 
    380                         zs     = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 )   ! square root salinity 
    381                         ztm    = tmask(ji,jj,jk)                                         ! tmask 
    382                         ! 
    383                         zn3 = EOS013*zt   & 
    384                            &   + EOS103*zs+EOS003 
    385                            ! 
    386                         zn2 = (EOS022*zt   & 
    387                            &   + EOS112*zs+EOS012)*zt   & 
    388                            &   + (EOS202*zs+EOS102)*zs+EOS002 
    389                            ! 
    390                         zn1 = (((EOS041*zt   & 
    391                            &   + EOS131*zs+EOS031)*zt   & 
    392                            &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
    393                            &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
    394                            &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
    395                            ! 
    396                         zn0_sto(jsmp) = (((((EOS060*zt   & 
    397                            &   + EOS150*zs+EOS050)*zt   & 
    398                            &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
    399                            &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
    400                            &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
    401                            &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
    402                            &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
    403                            ! 
    404                         zn_sto(jsmp)  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp) 
    405                      END DO 
    406                      ! 
    407                      ! compute stochastic density as the mean of the (2*nn_sto_eos) densities 
    408                      prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp 
    409                      DO jsmp = 1, nn_sto_eos*2 
    410                         prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp)                      ! potential density referenced at the surface 
    411                         ! 
    412                         prd(ji,jj,jk) = prd(ji,jj,jk) + (  zn_sto(jsmp) * r1_rho0 - 1._wp  )   ! density anomaly (masked) 
    413                      END DO 
    414                      prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 
    415                      prd  (ji,jj,jk) = 0.5_wp * prd  (ji,jj,jk) * ztm / nn_sto_eos 
    416                   END DO 
    417                END DO 
    418             END DO 
     403               prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 
     404               prd  (ji,jj,jk) = 0.5_wp * prd  (ji,jj,jk) * ztm / nn_sto_eos 
     405            END_3D 
    419406            DEALLOCATE(zn0_sto,zn_sto,zsign) 
    420407         ! Non-stochastic equation of state 
    421408         ELSE 
    422             DO jk = 1, jpkm1 
    423                DO jj = 1, jpj 
    424                   DO ji = 1, jpi 
    425                      ! 
    426                      zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
    427                      zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
    428                      zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    429                      ztm = tmask(ji,jj,jk)                                         ! tmask 
    430                      ! 
    431                      zn3 = EOS013*zt   & 
    432                         &   + EOS103*zs+EOS003 
    433                         ! 
    434                      zn2 = (EOS022*zt   & 
    435                         &   + EOS112*zs+EOS012)*zt   & 
    436                         &   + (EOS202*zs+EOS102)*zs+EOS002 
    437                         ! 
    438                      zn1 = (((EOS041*zt   & 
    439                         &   + EOS131*zs+EOS031)*zt   & 
    440                         &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
    441                         &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
    442                         &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
    443                         ! 
    444                      zn0 = (((((EOS060*zt   & 
    445                         &   + EOS150*zs+EOS050)*zt   & 
    446                         &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
    447                         &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
    448                         &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
    449                         &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
    450                         &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
    451                         ! 
    452                      zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    453                      ! 
    454                      prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface 
    455                      ! 
    456                      prd(ji,jj,jk) = (  zn * r1_rho0 - 1._wp  ) * ztm      ! density anomaly (masked) 
    457                   END DO 
    458                END DO 
    459             END DO 
    460          ENDIF 
    461           
    462       CASE( np_seos )                !==  simplified EOS  ==! 
    463          ! 
    464          DO jk = 1, jpkm1 
    465             DO jj = 1, jpj 
    466                DO ji = 1, jpi 
    467                   zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
    468                   zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
    469                   zh  = pdep (ji,jj,jk) 
    470                   ztm = tmask(ji,jj,jk) 
    471                   !                                                     ! potential density referenced at the surface 
    472                   zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   & 
    473                      &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   & 
    474                      &  - rn_nu * zt * zs 
    475                   prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 
    476                   !                                                     ! density anomaly (masked) 
    477                   zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 
    478                   prd(ji,jj,jk) = zn * r1_rho0 * ztm 
    479                   ! 
    480                END DO 
    481             END DO 
    482          END DO 
    483          ! 
    484       CASE( np_leos )                !==  linear ISOMIP EOS  ==! 
    485          ! 
    486          DO jk = 1, jpkm1 
    487             DO jj = 1, jpj 
    488                DO ji = 1, jpi 
    489                   zt  = pts  (ji,jj,jk,jp_tem) - (-1._wp) 
    490                   zs  = pts  (ji,jj,jk,jp_sal) - 34.2_wp 
    491                   zh  = pdep (ji,jj,jk) 
    492                   ztm = tmask(ji,jj,jk) 
    493                   !                                                     ! potential density referenced at the surface 
    494                   zn =  rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 
    495                   prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 
    496                   !                                                     ! density anomaly (masked) 
    497                   prd(ji,jj,jk) = zn * r1_rho0 * ztm 
    498                   ! 
    499                END DO 
    500             END DO 
    501          END DO 
    502          ! 
    503       END SELECT 
    504       ! 
    505       IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 
    506       ! 
    507       IF( ln_timing )   CALL timing_stop('eos-pot') 
    508       ! 
    509    END SUBROUTINE eos_insitu_pot 
    510  
    511  
    512    SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 
    513       !!---------------------------------------------------------------------- 
    514       !!                  ***  ROUTINE eos_insitu_2d  *** 
    515       !! 
    516       !! ** Purpose :   Compute the in situ density (ratio rho/rho0) from 
    517       !!      potential temperature and salinity using an equation of state 
    518       !!      selected in the nameos namelist. * 2D field case 
    519       !! 
    520       !! ** Action  : - prd , the in situ density (no units) (unmasked) 
    521       !! 
    522       !!---------------------------------------------------------------------- 
    523       REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
    524       !                                                           ! 2 : salinity               [psu] 
    525       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                      [m] 
    526       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density 
    527       ! 
    528       INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    529       REAL(wp) ::   zt , zh , zs              ! local scalars 
    530       REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
    531       !!---------------------------------------------------------------------- 
    532       ! 
    533       IF( ln_timing )   CALL timing_start('eos2d') 
    534       ! 
    535       prd(:,:) = 0._wp 
    536       ! 
    537       SELECT CASE( neos ) 
    538       ! 
    539       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    540          ! 
    541          DO jj = 1, jpjm1 
    542             DO ji = 1, fs_jpim1   ! vector opt. 
    543                ! 
    544                zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
    545                zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
    546                zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     409            DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     410               ! 
     411               zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
     412               zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     413               zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     414               ztm = tmask(ji,jj,jk)                                         ! tmask 
    547415               ! 
    548416               zn3 = EOS013*zt   & 
    … …  
    569437               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    570438               ! 
    571                prd(ji,jj) = zn * r1_rho0 - 1._wp               ! unmasked in situ density anomaly 
    572                ! 
    573             END DO 
    574          END DO 
    575          ! 
    576          CALL lbc_lnk( 'eosbn2', prd, 'T', 1. )                    ! Lateral boundary conditions 
    577          ! 
     439               prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface 
     440               ! 
     441               prd(ji,jj,jk) = (  zn * r1_rho0 - 1._wp  ) * ztm      ! density anomaly (masked) 
     442            END_3D 
     443         ENDIF 
     444          
    578445      CASE( np_seos )                !==  simplified EOS  ==! 
    579446         ! 
    580          DO jj = 1, jpjm1 
    581             DO ji = 1, fs_jpim1   ! vector opt. 
    582                ! 
    583                zt    = pts  (ji,jj,jp_tem)  - 10._wp 
    584                zs    = pts  (ji,jj,jp_sal)  - 35._wp 
    585                zh    = pdep (ji,jj)                         ! depth at the partial step level 
    586                ! 
    587                zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
    588                   &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
    589                   &  - rn_nu * zt * zs 
    590                   ! 
    591                prd(ji,jj) = zn * r1_rho0               ! unmasked in situ density anomaly 
    592                ! 
    593             END DO 
    594          END DO 
    595          ! 
    596          CALL lbc_lnk( 'eosbn2', prd, 'T', 1. )                    ! Lateral boundary conditions 
     447         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     448            zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
     449            zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
     450            zh  = pdep (ji,jj,jk) 
     451            ztm = tmask(ji,jj,jk) 
     452            !                                                     ! potential density referenced at the surface 
     453            zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   & 
     454               &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   & 
     455               &  - rn_nu * zt * zs 
     456            prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 
     457            !                                                     ! density anomaly (masked) 
     458            zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 
     459            prd(ji,jj,jk) = zn * r1_rho0 * ztm 
     460            ! 
     461         END_3D 
     462         ! 
     463      CASE( np_leos )                !==  linear ISOMIP EOS  ==! 
     464         ! 
     465         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     466            zt  = pts  (ji,jj,jk,jp_tem) - (-1._wp) 
     467            zs  = pts  (ji,jj,jk,jp_sal) - 34.2_wp 
     468            zh  = pdep (ji,jj,jk) 
     469            ztm = tmask(ji,jj,jk) 
     470            !                                                     ! potential density referenced at the surface 
     471            zn =  rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 
     472            prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 
     473            !                                                     ! density anomaly (masked) 
     474            prd(ji,jj,jk) = zn * r1_rho0 * ztm 
     475            ! 
     476         END_3D 
     477         ! 
     478      END SELECT 
     479      ! 
     480      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 
     481      ! 
     482      IF( ln_timing )   CALL timing_stop('eos-pot') 
     483      ! 
     484   END SUBROUTINE eos_insitu_pot 
     485 
     486 
     487   SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 
     488      !!---------------------------------------------------------------------- 
     489      !!                  ***  ROUTINE eos_insitu_2d  *** 
     490      !! 
     491      !! ** Purpose :   Compute the in situ density (ratio rho/rho0) from 
     492      !!      potential temperature and salinity using an equation of state 
     493      !!      selected in the nameos namelist. * 2D field case 
     494      !! 
     495      !! ** Action  : - prd , the in situ density (no units) (unmasked) 
     496      !! 
     497      !!---------------------------------------------------------------------- 
     498      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
     499      !                                                           ! 2 : salinity               [psu] 
     500      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                      [m] 
     501      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density 
     502      ! 
     503      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     504      REAL(wp) ::   zt , zh , zs              ! local scalars 
     505      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     506      !!---------------------------------------------------------------------- 
     507      ! 
     508      IF( ln_timing )   CALL timing_start('eos2d') 
     509      ! 
     510      prd(:,:) = 0._wp 
     511      ! 
     512      SELECT CASE( neos ) 
     513      ! 
     514      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     515         ! 
     516         DO_2D( 1, 1, 1, 1 ) 
     517            ! 
     518            zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
     519            zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
     520            zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     521            ! 
     522            zn3 = EOS013*zt   & 
     523               &   + EOS103*zs+EOS003 
     524               ! 
     525            zn2 = (EOS022*zt   & 
     526               &   + EOS112*zs+EOS012)*zt   & 
     527               &   + (EOS202*zs+EOS102)*zs+EOS002 
     528               ! 
     529            zn1 = (((EOS041*zt   & 
     530               &   + EOS131*zs+EOS031)*zt   & 
     531               &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     532               &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     533               &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     534               ! 
     535            zn0 = (((((EOS060*zt   & 
     536               &   + EOS150*zs+EOS050)*zt   & 
     537               &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     538               &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     539               &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     540               &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     541               &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     542               ! 
     543            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     544            ! 
     545            prd(ji,jj) = zn * r1_rho0 - 1._wp               ! unmasked in situ density anomaly 
     546            ! 
     547         END_2D 
     548         ! 
     549      CASE( np_seos )                !==  simplified EOS  ==! 
     550         ! 
     551         DO_2D( 1, 1, 1, 1 ) 
     552            ! 
     553            zt    = pts  (ji,jj,jp_tem)  - 10._wp 
     554            zs    = pts  (ji,jj,jp_sal)  - 35._wp 
     555            zh    = pdep (ji,jj)                         ! depth at the partial step level 
     556            ! 
     557            zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
     558               &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
     559               &  - rn_nu * zt * zs 
     560               ! 
     561            prd(ji,jj) = zn * r1_rho0               ! unmasked in situ density anomaly 
     562            ! 
     563         END_2D 
    597564         ! 
    598565      CASE( np_leos )                !==  ISOMIP EOS  ==! 
    599566         ! 
    600          DO jj = 1, jpjm1 
    601             DO ji = 1, fs_jpim1   ! vector opt. 
    602                ! 
    603                zt    = pts  (ji,jj,jp_tem)  - (-1._wp) 
    604                zs    = pts  (ji,jj,jp_sal)  - 34.2_wp 
    605                zh    = pdep (ji,jj)                         ! depth at the partial step level 
    606                ! 
    607                zn =  rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 
    608                   ! 
    609                prd(ji,jj) = zn * r1_rho0               ! unmasked in situ density anomaly 
    610                ! 
    611             END DO 
    612          END DO 
    613          ! 
    614          CALL lbc_lnk( 'eosbn2', prd, 'T', 1. )                    ! Lateral boundary conditions 
     567         DO_2D( 1, 1, 1, 1 ) 
     568            ! 
     569            zt    = pts  (ji,jj,jp_tem)  - (-1._wp) 
     570            zs    = pts  (ji,jj,jp_sal)  - 34.2_wp 
     571            zh    = pdep (ji,jj)                         ! depth at the partial step level 
     572            ! 
     573            zn =  rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 
     574            ! 
     575            prd(ji,jj) = zn * r1_rho0               ! unmasked in situ density anomaly 
     576            ! 
     577         END_2D 
     578         ! 
    615579         ! 
    616580      END SELECT 
    617581      ! 
    618       IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
     582      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
    619583      ! 
    620584      IF( ln_timing )   CALL timing_stop('eos2d') 
    … …  
    648612      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    649613         ! 
    650          DO jk = 1, jpkm1 
    651             DO jj = 1, jpj 
    652                DO ji = 1, jpi 
    653                   ! 
    654                   zh  = gdept(ji,jj,jk,Kmm) * r1_Z0                                ! depth 
    655                   zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
    656                   zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    657                   ztm = tmask(ji,jj,jk)                                         ! tmask 
    658                   ! 
    659                   ! alpha 
    660                   zn3 = ALP003 
    661                   ! 
    662                   zn2 = ALP012*zt + ALP102*zs+ALP002 
    663                   ! 
    664                   zn1 = ((ALP031*zt   & 
    665                      &   + ALP121*zs+ALP021)*zt   & 
    666                      &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
    667                      &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
    668                      ! 
    669                   zn0 = ((((ALP050*zt   & 
    670                      &   + ALP140*zs+ALP040)*zt   & 
    671                      &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
    672                      &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
    673                      &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
    674                      &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
    675                      ! 
    676                   zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    677                   ! 
    678                   pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm 
    679                   ! 
    680                   ! beta 
    681                   zn3 = BET003 
    682                   ! 
    683                   zn2 = BET012*zt + BET102*zs+BET002 
    684                   ! 
    685                   zn1 = ((BET031*zt   & 
    686                      &   + BET121*zs+BET021)*zt   & 
    687                      &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
    688                      &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
    689                      ! 
    690                   zn0 = ((((BET050*zt   & 
    691                      &   + BET140*zs+BET040)*zt   & 
    692                      &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
    693                      &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
    694                      &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
    695                      &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
    696                      ! 
    697                   zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    698                   ! 
    699                   pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm 
    700                   ! 
    701                END DO 
    702             END DO 
    703          END DO 
     614         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     615            ! 
     616            zh  = gdept(ji,jj,jk,Kmm) * r1_Z0                                ! depth 
     617            zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     618            zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     619            ztm = tmask(ji,jj,jk)                                         ! tmask 
     620            ! 
     621            ! alpha 
     622            zn3 = ALP003 
     623            ! 
     624            zn2 = ALP012*zt + ALP102*zs+ALP002 
     625            ! 
     626            zn1 = ((ALP031*zt   & 
     627               &   + ALP121*zs+ALP021)*zt   & 
     628               &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
     629               &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
     630               ! 
     631            zn0 = ((((ALP050*zt   & 
     632               &   + ALP140*zs+ALP040)*zt   & 
     633               &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
     634               &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
     635               &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
     636               &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
     637               ! 
     638            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     639            ! 
     640            pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm 
     641            ! 
     642            ! beta 
     643            zn3 = BET003 
     644            ! 
     645            zn2 = BET012*zt + BET102*zs+BET002 
     646            ! 
     647            zn1 = ((BET031*zt   & 
     648               &   + BET121*zs+BET021)*zt   & 
     649               &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
     650               &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
     651               ! 
     652            zn0 = ((((BET050*zt   & 
     653               &   + BET140*zs+BET040)*zt   & 
     654               &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
     655               &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
     656               &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
     657               &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
     658               ! 
     659            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     660            ! 
     661            pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm 
     662            ! 
     663         END_3D 
    704664         ! 
    705665      CASE( np_seos )                  !==  simplified EOS  ==! 
    706666         ! 
    707          DO jk = 1, jpkm1 
    708             DO jj = 1, jpj 
    709                DO ji = 1, jpi 
    710                   zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
    711                   zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
    712                   zh  = gdept(ji,jj,jk,Kmm)                ! depth in meters at t-point 
    713                   ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask 
    714                   ! 
    715                   zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
    716                   pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm   ! alpha 
    717                   ! 
    718                   zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
    719                   pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm   ! beta 
    720                   ! 
    721                END DO 
    722             END DO 
    723          END DO 
     667         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     668            zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
     669            zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
     670            zh  = gdept(ji,jj,jk,Kmm)                ! depth in meters at t-point 
     671            ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask 
     672            ! 
     673            zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
     674            pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm   ! alpha 
     675            ! 
     676            zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
     677            pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm   ! beta 
     678            ! 
     679         END_3D 
    724680         ! 
    725681      CASE( np_leos )                  !==  linear ISOMIP EOS  ==! 
    726682         ! 
    727          DO jk = 1, jpkm1 
    728             DO jj = 1, jpj 
    729                DO ji = 1, jpi 
    730                   zt  = pts (ji,jj,jk,jp_tem) - (-1._wp) 
    731                   zs  = pts (ji,jj,jk,jp_sal) - 34.2_wp   ! abs. salinity anomaly (s-S0) 
    732                   zh  = gdept(ji,jj,jk,Kmm)                 ! depth in meters at t-point 
    733                   ztm = tmask(ji,jj,jk)                   ! land/sea bottom mask = surf. mask 
    734                   ! 
    735                   zn  = rn_a0 * rho0 
    736                   pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm   ! alpha 
    737                   ! 
    738                   zn  = rn_b0 * rho0 
    739                   pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm   ! beta 
    740                   ! 
    741                END DO 
    742             END DO 
    743          END DO 
     683         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     684            zt  = pts (ji,jj,jk,jp_tem) - (-1._wp) 
     685            zs  = pts (ji,jj,jk,jp_sal) - 34.2_wp   ! abs. salinity anomaly (s-S0) 
     686            zh  = gdept(ji,jj,jk,Kmm)                 ! depth in meters at t-point 
     687            ztm = tmask(ji,jj,jk)                   ! land/sea bottom mask = surf. mask 
     688            ! 
     689            zn  = rn_a0 * rho0 
     690            pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm   ! alpha 
     691            ! 
     692            zn  = rn_b0 * rho0 
     693            pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm   ! beta 
     694            ! 
     695         END_3D 
    744696         ! 
    745697      CASE DEFAULT 
    … …  
    749701      END SELECT 
    750702      ! 
    751       IF(ln_ctl)   CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', & 
    752          &                       tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', kdim=jpk ) 
     703      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', & 
     704         &                                  tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', kdim=jpk ) 
    753705      ! 
    754706      IF( ln_timing )   CALL timing_stop('rab_3d') 
    … …  
    783735      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    784736         ! 
    785          DO jj = 1, jpjm1 
    786             DO ji = 1, fs_jpim1   ! vector opt. 
    787                ! 
    788                zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
    789                zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
    790                zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    791                ! 
    792                ! alpha 
    793                zn3 = ALP003 
    794                ! 
    795                zn2 = ALP012*zt + ALP102*zs+ALP002 
    796                ! 
    797                zn1 = ((ALP031*zt   & 
    798                   &   + ALP121*zs+ALP021)*zt   & 
    799                   &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
    800                   &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
    801                   ! 
    802                zn0 = ((((ALP050*zt   & 
    803                   &   + ALP140*zs+ALP040)*zt   & 
    804                   &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
    805                   &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
    806                   &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
    807                   &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
    808                   ! 
    809                zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    810                ! 
    811                pab(ji,jj,jp_tem) = zn * r1_rho0 
    812                ! 
    813                ! beta 
    814                zn3 = BET003 
    815                ! 
    816                zn2 = BET012*zt + BET102*zs+BET002 
    817                ! 
    818                zn1 = ((BET031*zt   & 
    819                   &   + BET121*zs+BET021)*zt   & 
    820                   &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
    821                   &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
    822                   ! 
    823                zn0 = ((((BET050*zt   & 
    824                   &   + BET140*zs+BET040)*zt   & 
    825                   &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
    826                   &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
    827                   &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
    828                   &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
    829                   ! 
    830                zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    831                ! 
    832                pab(ji,jj,jp_sal) = zn / zs * r1_rho0 
    833                ! 
    834                ! 
    835             END DO 
    836          END DO 
    837          !                            ! Lateral boundary conditions 
    838          CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. )                     
     737         DO_2D( 1, 1, 1, 1 ) 
     738            ! 
     739            zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
     740            zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
     741            zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     742            ! 
     743            ! alpha 
     744            zn3 = ALP003 
     745            ! 
     746            zn2 = ALP012*zt + ALP102*zs+ALP002 
     747            ! 
     748            zn1 = ((ALP031*zt   & 
     749               &   + ALP121*zs+ALP021)*zt   & 
     750               &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
     751               &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
     752               ! 
     753            zn0 = ((((ALP050*zt   & 
     754               &   + ALP140*zs+ALP040)*zt   & 
     755               &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
     756               &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
     757               &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
     758               &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
     759               ! 
     760            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     761            ! 
     762            pab(ji,jj,jp_tem) = zn * r1_rho0 
     763            ! 
     764            ! beta 
     765            zn3 = BET003 
     766            ! 
     767            zn2 = BET012*zt + BET102*zs+BET002 
     768            ! 
     769            zn1 = ((BET031*zt   & 
     770               &   + BET121*zs+BET021)*zt   & 
     771               &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
     772               &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
     773               ! 
     774            zn0 = ((((BET050*zt   & 
     775               &   + BET140*zs+BET040)*zt   & 
     776               &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
     777               &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
     778               &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
     779               &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
     780               ! 
     781            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     782            ! 
     783            pab(ji,jj,jp_sal) = zn / zs * r1_rho0 
     784            ! 
     785            ! 
     786         END_2D 
    839787         ! 
    840788      CASE( np_seos )                  !==  simplified EOS  ==! 
    841789         ! 
    842          DO jj = 1, jpjm1 
    843             DO ji = 1, fs_jpim1   ! vector opt. 
    844                ! 
    845                zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
    846                zs    = pts  (ji,jj,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
    847                zh    = pdep (ji,jj)                   ! depth at the partial step level 
    848                ! 
    849                zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
    850                pab(ji,jj,jp_tem) = zn * r1_rho0   ! alpha 
    851                ! 
    852                zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
    853                pab(ji,jj,jp_sal) = zn * r1_rho0   ! beta 
    854                ! 
    855             END DO 
    856          END DO 
    857          !                            ! Lateral boundary conditions 
    858          CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. )                     
     790         DO_2D( 1, 1, 1, 1 ) 
     791            ! 
     792            zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
     793            zs    = pts  (ji,jj,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
     794            zh    = pdep (ji,jj)                   ! depth at the partial step level 
     795            ! 
     796            zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
     797            pab(ji,jj,jp_tem) = zn * r1_rho0   ! alpha 
     798            ! 
     799            zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
     800            pab(ji,jj,jp_sal) = zn * r1_rho0   ! beta 
     801            ! 
     802         END_2D 
    859803         ! 
    860804      CASE( np_leos )                  !==  linear ISOMIP EOS  ==! 
    861805         ! 
    862          DO jj = 1, jpjm1 
    863             DO ji = 1, fs_jpim1   ! vector opt. 
    864                ! 
    865                zt    = pts  (ji,jj,jp_tem) - (-1._wp)   ! pot. temperature anomaly (t-T0) 
    866                zs    = pts  (ji,jj,jp_sal) - 34.2_wp   ! abs. salinity anomaly (s-S0) 
    867                zh    = pdep (ji,jj)                   ! depth at the partial step level 
    868                ! 
    869                zn  = rn_a0 * rho0 
    870                pab(ji,jj,jp_tem) = zn * r1_rho0   ! alpha 
    871                ! 
    872                zn  = rn_b0 * rho0 
    873                pab(ji,jj,jp_sal) = zn * r1_rho0   ! beta 
    874                ! 
    875             END DO 
    876          END DO 
    877          ! 
    878          CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. )                    ! Lateral boundary conditions 
     806         DO_2D( 1, 1, 1, 1 ) 
     807            ! 
     808            zt    = pts  (ji,jj,jp_tem) - (-1._wp)   ! pot. temperature anomaly (t-T0) 
     809            zs    = pts  (ji,jj,jp_sal) - 34.2_wp   ! abs. salinity anomaly (s-S0) 
     810            zh    = pdep (ji,jj)                   ! depth at the partial step level 
     811            ! 
     812            zn  = rn_a0 * rho0 
     813            pab(ji,jj,jp_tem) = zn * r1_rho0   ! alpha 
     814            ! 
     815            zn  = rn_b0 * rho0 
     816            pab(ji,jj,jp_sal) = zn * r1_rho0   ! beta 
     817            ! 
     818         END_2D 
    879819         ! 
    880820      CASE DEFAULT 
    … …  
    884824      END SELECT 
    885825      ! 
    886       IF(ln_ctl)   CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', & 
    887          &                       tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' ) 
     826      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', & 
     827         &                                  tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' ) 
    888828      ! 
    889829      IF( ln_timing )   CALL timing_stop('rab_2d') 
    … …  
    1026966      IF( ln_timing )   CALL timing_start('bn2') 
    1027967      ! 
    1028       DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 ) 
    1029          DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90 
    1030             DO ji = 1, jpi 
    1031                zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   & 
    1032                   &  / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) )  
    1033                   ! 
    1034                zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw  
    1035                zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 
    1036                ! 
    1037                pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     & 
    1038                   &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  & 
    1039                   &            / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 
    1040             END DO 
    1041          END DO 
    1042       END DO 
    1043       ! 
    1044       IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', kdim=jpk ) 
     968      DO_3D( 1, 1, 1, 1, 2, jpkm1 )      ! interior points only (2=< jk =< jpkm1 ); surface and bottom value set to zero one for all in istate.F90 
     969         zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   & 
     970            &  / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) )  
     971            ! 
     972         zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw  
     973         zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 
     974         ! 
     975         pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     & 
     976            &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  & 
     977            &            / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 
     978      END_3D 
     979      ! 
     980      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', kdim=jpk ) 
    1045981      ! 
    1046982      IF( ln_timing )   CALL timing_stop('bn2') 
    … …  
    10781014      z1_T0   = 1._wp/40._wp 
    10791015      ! 
    1080       DO jj = 1, jpj 
    1081          DO ji = 1, jpi 
    1082             ! 
    1083             zt  = ctmp   (ji,jj) * z1_T0 
    1084             zs  = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 ) 
    1085             ztm = tmask(ji,jj,1) 
    1086             ! 
    1087             zn = ((((-2.1385727895e-01_wp*zt   & 
    1088                &   - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt   & 
    1089                &   + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt   & 
    1090                &   + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt   & 
    1091                &   + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs   & 
    1092                &      +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt   & 
    1093                &   + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs   & 
    1094                &      -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp 
    1095                ! 
    1096             zd = (2.0035003456_wp*zt   & 
    1097                &   -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt   & 
    1098                &   + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp 
    1099                ! 
    1100             ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm 
    1101                ! 
    1102          END DO 
    1103       END DO 
     1016      DO_2D( 1, 1, 1, 1 ) 
     1017         ! 
     1018         zt  = ctmp   (ji,jj) * z1_T0 
     1019         zs  = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 ) 
     1020         ztm = tmask(ji,jj,1) 
     1021         ! 
     1022         zn = ((((-2.1385727895e-01_wp*zt   & 
     1023            &   - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt   & 
     1024            &   + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt   & 
     1025            &   + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt   & 
     1026            &   + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs   & 
     1027            &      +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt   & 
     1028            &   + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs   & 
     1029            &      -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp 
     1030            ! 
     1031         zd = (2.0035003456_wp*zt   & 
     1032            &   -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt   & 
     1033            &   + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp 
     1034            ! 
     1035         ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm 
     1036            ! 
     1037      END_2D 
    11041038      ! 
    11051039      IF( ln_timing )   CALL timing_stop('eos_pt_from_ct') 
    … …  
    11331067         ! 
    11341068         z1_S0 = 1._wp / 35.16504_wp 
    1135          DO jj = 1, jpj 
    1136             DO ji = 1, jpi 
    1137                zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 )           ! square root salinity 
    1138                ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 
    1139                   &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 
    1140             END DO 
    1141          END DO 
     1069         DO_2D( 1, 1, 1, 1 ) 
     1070            zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 )           ! square root salinity 
     1071            ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 
     1072               &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 
     1073         END_2D 
    11421074         ptf(:,:) = ptf(:,:) * psal(:,:) 
    11431075         ! 
    11441076         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 
    11451077         ! 
    1146       CASE ( np_eos80, np_leos )                !==  PT,SP (UNESCO formulation)  ==! 
     1078      CASE ( np_eos80 )                !==  PT,SP (UNESCO formulation)  ==! 
    11471079         ! 
    11481080         ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   & 
    … …  
    11901122         IF( PRESENT( pdep ) )   ptf = ptf - 7.53e-4 * pdep 
    11911123         ! 
    1192       CASE ( np_eos80, np_leos )                !==  PT,SP (UNESCO formulation)  ==! 
     1124      CASE ( np_eos80 )                !==  PT,SP (UNESCO formulation)  ==! 
    11931125         ! 
    11941126         ptf = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal )   & 
    … …  
    12421174      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    12431175         ! 
    1244          DO jk = 1, jpkm1 
    1245             DO jj = 1, jpj 
    1246                DO ji = 1, jpi 
    1247                   ! 
    1248                   zh  = gdept(ji,jj,jk,Kmm) * r1_Z0                                ! depth 
    1249                   zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
    1250                   zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    1251                   ztm = tmask(ji,jj,jk)                                         ! tmask 
    1252                   ! 
    1253                   ! potential energy non-linear anomaly 
    1254                   zn2 = (PEN012)*zt   & 
    1255                      &   + PEN102*zs+PEN002 
    1256                      ! 
    1257                   zn1 = ((PEN021)*zt   & 
    1258                      &   + PEN111*zs+PEN011)*zt   & 
    1259                      &   + (PEN201*zs+PEN101)*zs+PEN001 
    1260                      ! 
    1261                   zn0 = ((((PEN040)*zt   & 
    1262                      &   + PEN130*zs+PEN030)*zt   & 
    1263                      &   + (PEN220*zs+PEN120)*zs+PEN020)*zt   & 
    1264                      &   + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt   & 
    1265                      &   + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000 
    1266                      ! 
    1267                   zn  = ( zn2 * zh + zn1 ) * zh + zn0 
    1268                   ! 
    1269                   ppen(ji,jj,jk)  = zn * zh * r1_rho0 * ztm 
    1270                   ! 
    1271                   ! alphaPE non-linear anomaly 
    1272                   zn2 = APE002 
    1273                   ! 
    1274                   zn1 = (APE011)*zt   & 
    1275                      &   + APE101*zs+APE001 
    1276                      ! 
    1277                   zn0 = (((APE030)*zt   & 
    1278                      &   + APE120*zs+APE020)*zt   & 
    1279                      &   + (APE210*zs+APE110)*zs+APE010)*zt   & 
    1280                      &   + ((APE300*zs+APE200)*zs+APE100)*zs+APE000 
    1281                      ! 
    1282                   zn  = ( zn2 * zh + zn1 ) * zh + zn0 
    1283                   !                               
    1284                   pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm 
    1285                   ! 
    1286                   ! betaPE non-linear anomaly 
    1287                   zn2 = BPE002 
    1288                   ! 
    1289                   zn1 = (BPE011)*zt   & 
    1290                      &   + BPE101*zs+BPE001 
    1291                      ! 
    1292                   zn0 = (((BPE030)*zt   & 
    1293                      &   + BPE120*zs+BPE020)*zt   & 
    1294                      &   + (BPE210*zs+BPE110)*zs+BPE010)*zt   & 
    1295                      &   + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000 
    1296                      ! 
    1297                   zn  = ( zn2 * zh + zn1 ) * zh + zn0 
    1298                   !                               
    1299                   pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm 
    1300                   ! 
    1301                END DO 
    1302             END DO 
    1303          END DO 
     1176         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     1177            ! 
     1178            zh  = gdept(ji,jj,jk,Kmm) * r1_Z0                                ! depth 
     1179            zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     1180            zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     1181            ztm = tmask(ji,jj,jk)                                         ! tmask 
     1182            ! 
     1183            ! potential energy non-linear anomaly 
     1184            zn2 = (PEN012)*zt   & 
     1185               &   + PEN102*zs+PEN002 
     1186               ! 
     1187            zn1 = ((PEN021)*zt   & 
     1188               &   + PEN111*zs+PEN011)*zt   & 
     1189               &   + (PEN201*zs+PEN101)*zs+PEN001 
     1190               ! 
     1191            zn0 = ((((PEN040)*zt   & 
     1192               &   + PEN130*zs+PEN030)*zt   & 
     1193               &   + (PEN220*zs+PEN120)*zs+PEN020)*zt   & 
     1194               &   + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt   & 
     1195               &   + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000 
     1196               ! 
     1197            zn  = ( zn2 * zh + zn1 ) * zh + zn0 
     1198            ! 
     1199            ppen(ji,jj,jk)  = zn * zh * r1_rho0 * ztm 
     1200            ! 
     1201            ! alphaPE non-linear anomaly 
     1202            zn2 = APE002 
     1203            ! 
     1204            zn1 = (APE011)*zt   & 
     1205               &   + APE101*zs+APE001 
     1206               ! 
     1207            zn0 = (((APE030)*zt   & 
     1208               &   + APE120*zs+APE020)*zt   & 
     1209               &   + (APE210*zs+APE110)*zs+APE010)*zt   & 
     1210               &   + ((APE300*zs+APE200)*zs+APE100)*zs+APE000 
     1211               ! 
     1212            zn  = ( zn2 * zh + zn1 ) * zh + zn0 
     1213            !                               
     1214            pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm 
     1215            ! 
     1216            ! betaPE non-linear anomaly 
     1217            zn2 = BPE002 
     1218            ! 
     1219            zn1 = (BPE011)*zt   & 
     1220               &   + BPE101*zs+BPE001 
     1221               ! 
     1222            zn0 = (((BPE030)*zt   & 
     1223               &   + BPE120*zs+BPE020)*zt   & 
     1224               &   + (BPE210*zs+BPE110)*zs+BPE010)*zt   & 
     1225               &   + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000 
     1226               ! 
     1227            zn  = ( zn2 * zh + zn1 ) * zh + zn0 
     1228            !                               
     1229            pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm 
     1230            ! 
     1231         END_3D 
    13041232         ! 
    13051233      CASE( np_seos )                !==  Vallis (2006) simplified EOS  ==! 
    13061234         ! 
    1307          DO jk = 1, jpkm1 
    1308             DO jj = 1, jpj 
    1309                DO ji = 1, jpi 
    1310                   zt  = pts(ji,jj,jk,jp_tem) - 10._wp  ! temperature anomaly (t-T0) 
    1311                   zs = pts (ji,jj,jk,jp_sal) - 35._wp  ! abs. salinity anomaly (s-S0) 
    1312                   zh  = gdept(ji,jj,jk,Kmm)              ! depth in meters  at t-point 
    1313                   ztm = tmask(ji,jj,jk)                ! tmask 
    1314                   zn  = 0.5_wp * zh * r1_rho0 * ztm 
    1315                   !                                    ! Potential Energy 
    1316                   ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 
    1317                   !                                    ! alphaPE 
    1318                   pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn 
    1319                   pab_pe(ji,jj,jk,jp_sal) =   rn_b0 * rn_mu2 * zn 
    1320                   ! 
    1321                END DO 
    1322             END DO 
    1323          END DO 
     1235         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     1236            zt  = pts(ji,jj,jk,jp_tem) - 10._wp  ! temperature anomaly (t-T0) 
     1237            zs = pts (ji,jj,jk,jp_sal) - 35._wp  ! abs. salinity anomaly (s-S0) 
     1238            zh  = gdept(ji,jj,jk,Kmm)              ! depth in meters  at t-point 
     1239            ztm = tmask(ji,jj,jk)                ! tmask 
     1240            zn  = 0.5_wp * zh * r1_rho0 * ztm 
     1241            !                                    ! Potential Energy 
     1242            ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 
     1243            !                                    ! alphaPE 
     1244            pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn 
     1245            pab_pe(ji,jj,jk,jp_sal) =   rn_b0 * rn_mu2 * zn 
     1246            ! 
     1247         END_3D 
    13241248         ! 
    13251249      CASE( np_leos )                !==  linear ISOMIP EOS  ==! 
    13261250         ! 
    1327          DO jk = 1, jpkm1 
    1328             DO jj = 1, jpj 
    1329                DO ji = 1, jpi 
    1330                   zt  = pts(ji,jj,jk,jp_tem) - (-1._wp)  ! temperature anomaly (t-T0) 
    1331                   zs = pts (ji,jj,jk,jp_sal) - 34.2_wp   ! abs. salinity anomaly (s-S0) 
    1332                   zh  = gdept(ji,jj,jk,Kmm)                ! depth in meters  at t-point 
    1333                   ztm = tmask(ji,jj,jk)                  ! tmask 
    1334                   zn  = 0.5_wp * zh * r1_rho0 * ztm 
    1335                   !                                    ! Potential Energy 
    1336                   ppen(ji,jj,jk) = 0. 
    1337                   !                                    ! alphaPE 
    1338                   pab_pe(ji,jj,jk,jp_tem) = 0. 
    1339                   pab_pe(ji,jj,jk,jp_sal) = 0. 
    1340                   ! 
    1341                END DO 
    1342             END DO 
    1343          END DO 
     1251         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     1252            zt  = pts(ji,jj,jk,jp_tem) - (-1._wp)  ! temperature anomaly (t-T0) 
     1253            zs = pts (ji,jj,jk,jp_sal) - 34.2_wp   ! abs. salinity anomaly (s-S0) 
     1254            zh  = gdept(ji,jj,jk,Kmm)                ! depth in meters  at t-point 
     1255            ztm = tmask(ji,jj,jk)                  ! tmask 
     1256            zn  = 0.5_wp * zh * r1_rho0 * ztm 
     1257            !                                    ! Potential Energy 
     1258            ppen(ji,jj,jk) = 0. 
     1259            !                                    ! alphaPE 
     1260            pab_pe(ji,jj,jk,jp_tem) = 0. 
     1261            pab_pe(ji,jj,jk,jp_sal) = 0. 
     1262            ! 
     1263         END_3D 
    13441264         ! 
    13451265      CASE DEFAULT 
    … …  
    13651285      INTEGER  ::   ioptio   ! local integer 
    13661286      !! 
    1367       NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS   , ln_LEOS, & 
    1368          &             rn_a0    , rn_b0   , rn_lambda1, rn_mu1 , & 
    1369          &                                  rn_lambda2, rn_mu2 , rn_nu 
    1370       !!---------------------------------------------------------------------- 
    1371       ! 
    1372       REWIND( numnam_ref )              ! Namelist nameos in reference namelist : equation of state 
     1287      NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS, ln_LEOS, rn_a0, rn_b0, & 
     1288         &             rn_lambda1, rn_mu1, rn_lambda2, rn_mu2, rn_nu 
     1289      !!---------------------------------------------------------------------- 
     1290      ! 
    13731291      READ  ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 ) 
    13741292901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nameos in reference namelist' ) 
    13751293      ! 
    1376       REWIND( numnam_cfg )              ! Namelist nameos in configuration namelist : equation of state 
    13771294      READ  ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 ) 
    13781295902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nameos in configuration namelist' ) 
    … …  
    18071724         ! 
    18081725      CASE( np_leos )                        !==  Linear ISOMIP EOS     ==! 
     1726 
     1727         r1_S0  = 0.875_wp/35.16504_wp   ! Used to convert CT in potential temperature when using bulk formulae (eos_pt_from_ct) 
     1728          
    18091729         IF(lwp) THEN 
    18101730            WRITE(numout,*) 
    … …  
    18151735            WRITE(numout,*) '             saline  cont. coef.   rn_b0      = ', rn_b0 
    18161736         ENDIF 
     1737         l_useCT = .TRUE.          ! Use conservative temperature 
    18171738         ! 
    18181739      CASE DEFAULT                     !==  ERROR in neos  ==! 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP+/MY_SRC/isf_oce.F90

    r12077 r13710  
    7575   ! 
    7676   ! 2.1 -------- ice shelf cavity parameter -------------- 
    77    LOGICAL , PUBLIC            :: l_isfoasis 
     77   LOGICAL , PUBLIC            :: l_isfoasis = .FALSE. 
    7878   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)    ::   risfload                    !: ice shelf load 
    7979   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)    ::   fwfisf_oasis 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP+/MY_SRC/isfcavgam.F90

    r12077 r13710  
    3030   PUBLIC   isfcav_gammats 
    3131 
     32#  include "domzgr_substitute.h90" 
    3233   !!---------------------------------------------------------------------- 
    3334   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    9192         pgs(:,:) = rn_gammas0 
    9293      CASE ( 'vel' ) ! gamma is proportional to u* 
    93          CALL gammats_vel      (                   zutbl, zvtbl, rCd0_top, r_ke0_top,               pgt, pgs ) 
     94         CALL gammats_vel      (                   zutbl, zvtbl, rCd0_top, rn_vtide**2,               pgt, pgs ) 
    9495      CASE ( 'vel_stab' ) ! gamma depends of stability of boundary layer and u* 
    95          CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, r_ke0_top, pqoce, pqfwf, pgt, pgs ) 
     96         CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, rn_vtide**2, pqoce, pqfwf, pgt, pgs ) 
    9697      CASE DEFAULT 
    9798         CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)') 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP+/MY_SRC/isfstp.F90

    r12077 r13710  
    1313   !!   isfstp       : compute iceshelf melt and heat flux 
    1414   !!---------------------------------------------------------------------- 
    15    ! 
    1615   USE isf_oce                                      ! isf variables 
    1716   USE isfload, ONLY: isf_load                      ! ice shelf load 
    … …  
    2120   USE isfcpl , ONLY: isfcpl_rst_write, isfcpl_init ! isf variables 
    2221 
    23    USE dom_oce, ONLY: ht, e3t, ln_isfcav, ln_linssh     ! ocean space and time domain 
     22   USE dom_oce        ! ocean space and time domain 
     23   USE oce      , ONLY: ssh                           ! sea surface height 
    2424   USE domvvl,  ONLY: ln_vvl_zstar                      ! zstar logical 
    2525   USE zdfdrg,  ONLY: r_Cdmin_top, r_ke0_top            ! vertical physics: top/bottom drag coef. 
    … …  
    3131 
    3232   IMPLICIT NONE 
    33  
    3433   PRIVATE 
    3534 
    3635   PUBLIC   isf_stp, isf_init, isf_nam  ! routine called in sbcmod and divhor 
    3736 
     37   !! * Substitutions 
     38#  include "domzgr_substitute.h90" 
    3839   !!---------------------------------------------------------------------- 
    3940   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    4142   !! Software governed by the CeCILL license (see ./LICENSE) 
    4243   !!---------------------------------------------------------------------- 
     44 
    4345CONTAINS 
    4446  
    … …  
    6062      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    6163      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index 
     64      !!---------------------------------------------------------------------- 
     65      INTEGER :: jk                               ! loop index 
     66      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t    ! e3t  
    6267      !!--------------------------------------------------------------------- 
    6368      ! 
    … …  
    7883         ! 1.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl) 
    7984         rhisf_tbl_cav(:,:) = rn_htbl * mskisf_cav(:,:) 
    80          CALL isf_tbl_lvl(ht, e3t(:,:,:,Kmm), misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav) 
     85         DO jk = 1, jpk 
     86            ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 
     87         END DO  
     88         CALL isf_tbl_lvl(ht(:,:), ze3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav) 
    8189         ! 
    8290         ! 1.3: compute ice shelf melt 
    … …  
    100108         ! by simplicity, we assume the top level where param applied do not change with time (done in init part) 
    101109         rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:) 
    102          CALL isf_tbl_lvl(ht, e3t(:,:,:,Kmm), misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par) 
     110         DO jk = 1, jpk 
     111            ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 
     112         END DO 
     113         CALL isf_tbl_lvl(ht(:,:), ze3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par) 
    103114         ! 
    104115         ! 2.3: compute ice shelf melt 
    … …  
    250261      IF ( l_isfoasis .AND. ln_isf ) THEN 
    251262         ! 
    252          CALL ctl_stop( ' ln_ctl and ice shelf not tested' ) 
     263         CALL ctl_stop( 'namelist combination ln_cpl and ln_isf not tested' ) 
    253264         ! 
    254265         ! NEMO coupled to ATMO model with isf cavity need oasis method for melt computation  
    … …  
    291302      !!---------------------------------------------------------------------- 
    292303      ! 
    293       REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs  
    294304      READ  ( numnam_ref, namisf, IOSTAT = ios, ERR = 901) 
    295305901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namisf in reference namelist' ) 
    296306      ! 
    297       REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs 
    298307      READ  ( numnam_cfg, namisf, IOSTAT = ios, ERR = 902 ) 
    299308902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namisf in configuration namelist' ) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP+/MY_SRC/istate.F90

    r12353 r13710  
    2424   USE dom_oce        ! ocean space and time domain  
    2525   USE daymod         ! calendar 
    26    USE divhor         ! horizontal divergence            (div_hor routine) 
    2726   USE dtatsd         ! data temperature and salinity   (dta_tsd routine) 
    2827   USE dtauvd         ! data: U & V current             (dta_uvd routine) 
    … …  
    3534   USE lib_mpp         ! MPP library 
    3635   USE restart         ! restart 
     36#if defined key_agrif 
     37   USE agrif_oce_interp 
     38   USE agrif_oce 
     39#endif    
    3740 
    3841   IMPLICIT NONE 
    … …  
    4144   PUBLIC   istate_init   ! routine called by step.F90 
    4245 
     46   !! * Substitutions 
     47#  include "do_loop_substitute.h90" 
     48#  include "domzgr_substitute.h90" 
    4349   !!---------------------------------------------------------------------- 
    4450   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    5763      ! 
    5864      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     65      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zgdept     ! 3D table  !!st patch to use gdept subtitute 
    5966!!gm see comment further down 
    6067      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace 
    … …  
    6875!!gm  Why not include in the first call of dta_tsd ?   
    6976!!gm  probably associated with the use of internal damping... 
    70                      CALL dta_tsd_init        ! Initialisation of T & S input data 
     77       CALL dta_tsd_init        ! Initialisation of T & S input data 
    7178!!gm to be moved in usrdef of C1D case 
    7279!      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data 
    … …  
    7582      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk 
    7683      rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk 
    77       ts   (:,:,:,:,Kaa) = 0._wp                               ! set one for all to 0 at level jpk 
     84      ts  (:,:,:,:,Kaa) = 0._wp                                   ! set one for all to 0 at level jpk 
    7885      rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk 
    7986#if defined key_agrif 
    … …  
    8289#endif 
    8390 
     91#if defined key_agrif 
     92      IF ( (.NOT.Agrif_root()).AND.ln_init_chfrpar ) THEN 
     93         numror = 0                           ! define numror = 0 -> no restart file to read 
     94         ln_1st_euler = .true.                ! Set time-step indicator at nit000 (euler forward) 
     95         CALL day_init  
     96         CALL agrif_istate( Kbb, Kmm, Kaa )   ! Interp from parent 
     97         ! 
     98         ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)  
     99         ssh (:,:,Kmm)     = ssh(:,:,Kbb) 
     100         uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
     101         vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
     102      ELSE 
     103#endif 
    84104      IF( ln_rstart ) THEN                    ! Restart from a file 
    85105         !                                    ! ------------------- 
    … …  
    90110         !                                    ! --------------- 
    91111         numror = 0                           ! define numror = 0 -> no restart file to read 
    92          neuler = 0                           ! Set time-step indicator at nit000 (euler forward) 
     112         l_1st_euler = .true.                 ! Set time-step indicator at nit000 (euler forward) 
    93113         CALL day_init                        ! model calendar (using both namelist and restart infos) 
    94114         !                                    ! Initialization of ocean to zero 
    … …  
    98118            ! 
    99119            ssh(:,:,Kbb)   = 0._wp               ! set the ocean at rest 
     120            uu  (:,:,:,Kbb) = 0._wp 
     121            vv  (:,:,:,Kbb) = 0._wp   
     122            ! 
    100123            IF( ll_wd ) THEN 
    101124               ssh(:,:,Kbb) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD  
    … …  
    103126               ! Apply minimum wetdepth criterion 
    104127               ! 
    105                DO jj = 1,jpj 
    106                   DO ji = 1,jpi 
    107                      IF( ht_0(ji,jj) + ssh(ji,jj,Kbb)  < rn_wdmin1 ) THEN 
    108                         ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 
    109                      ENDIF 
    110                   END DO 
    111                END DO  
     128               DO_2D( 1, 1, 1, 1 ) 
     129                  IF( ht_0(ji,jj) + ssh(ji,jj,Kbb)  < rn_wdmin1 ) THEN 
     130                     ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 
     131                  ENDIF 
     132               END_2D 
    112133            ENDIF  
    113             uu  (:,:,:,Kbb) = 0._wp 
    114             vv  (:,:,:,Kbb) = 0._wp   
    115             ! 
     134             ! 
    116135         ELSE                                 ! user defined initial T and S 
    117             CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )          
     136            DO jk = 1, jpk 
     137               zgdept(:,:,jk) = gdept(:,:,jk,Kbb) 
     138            END DO 
     139            CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )          
    118140         ENDIF 
    119141         ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
    … …  
    121143         uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
    122144         vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
    123          hdiv(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level 
    124          CALL div_hor( 0, Kbb, Kmm )         ! compute interior hdiv value   
    125 !!gm                                    hdiv(:,:,:) = 0._wp 
    126145 
    127146!!gm POTENTIAL BUG : 
    128147!!gm  ISSUE :  if ssh(:,:,Kbb) /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed 
    129 !!             as well as gdept and gdepw....   !!!!!  
     148!!             as well as gdept_ and gdepw_....   !!!!!  
    130149!!      ===>>>>   probably a call to domvvl initialisation here.... 
    131150 
    … …  
    151170         !  
    152171      ENDIF  
     172#if defined key_agrif 
     173      ENDIF 
     174#endif 
    153175      !  
    154176      ! Initialize "now" and "before" barotropic velocities: 
    … …  
    159181      ! 
    160182!!gm  the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 
    161       DO jk = 1, jpkm1 
    162          DO jj = 1, jpj 
    163             DO ji = 1, jpi 
    164                uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 
    165                vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 
    166                ! 
    167                uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 
    168                vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 
    169             END DO 
    170          END DO 
    171       END DO 
     183      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     184         uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 
     185         vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 
     186         ! 
     187         uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 
     188         vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 
     189      END_3D 
    172190      ! 
    173191      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP+/MY_SRC/sbcfwb.F90

    r12489 r13710  
    1717   USE dom_oce        ! ocean space and time domain 
    1818   USE sbc_oce        ! surface ocean boundary condition 
    19    USE isf_oce       ! ice shelf melting contribution 
     19   USE isf_oce , ONLY : fwfisf_cav, fwfisf_par, ln_isfcpl, ln_isfcpl_cons, risfcpl_cons_ssh ! ice shelf melting contribution 
    2020   USE sbc_ice , ONLY : snwice_mass, snwice_mass_b, snwice_fmass 
    2121   USE phycst         ! physical constants 
    … …  
    7171      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   ztmsk_tospread, zerp_cor    !   -      - 
    7272      REAL(wp)   ,DIMENSION(1) ::   z_fwfprv   
    73       COMPLEX(wp),DIMENSION(1) ::   y_fwfnow   
     73      COMPLEX(dp),DIMENSION(1) ::   y_fwfnow   
    7474      !!---------------------------------------------------------------------- 
    7575      ! 
    … …  
    9595         snwice_mass_b(:,:) = 0.e0               ! no sea-ice model is being used : no snow+ice mass 
    9696         snwice_mass  (:,:) = 0.e0 
     97         snwice_fmass (:,:) = 0.e0 
    9798#endif 
    9899         ! 
    … …  
    151152         ENDIF    
    152153         !                                         ! Update fwfold if new year start 
    153          ikty = 365 * 86400 / rn_Dt               !!bug  use of 365 days leap year or 360d year !!!!!!! 
     154         ikty = 365 * 86400 / rn_Dt                  !!bug  use of 365 days leap year or 360d year !!!!!!! 
    154155         IF( MOD( kt, ikty ) == 0 ) THEN 
    155156            a_fwb_b = a_fwb                           ! mean sea level taking into account the ice+snow 
    … …  
    205206            ! 
    206207!!gm   ===>>>>  lbc_lnk should be useless as all the computation is done over the whole domain ! 
    207             CALL lbc_lnk( 'sbcfwb', zerp_cor, 'T', 1. ) 
     208            CALL lbc_lnk( 'sbcfwb', zerp_cor, 'T', 1.0_wp ) 
    208209            ! 
    209210            emp(:,:) = emp(:,:) + zerp_cor(:,:) 
    … …  
    211212            erp(:,:) = erp(:,:) + zerp_cor(:,:) 
    212213            ! 
    213             IF( nprint == 1 .AND. lwp ) THEN                   ! control print 
     214            IF( lwp ) THEN                   ! control print 
    214215               IF( z_fwf < 0._wp ) THEN 
    215216                  WRITE(numout,*)'   z_fwf < 0' 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP+/MY_SRC/tradmp.F90

    r12353 r13710  
    5151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1) 
    5252 
     53   !! * Substitutions 
     54#  include "do_loop_substitute.h90" 
    5355   !!---------------------------------------------------------------------- 
    5456   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    110112      CASE( 0 )                        !*  newtonian damping throughout the water column  *! 
    111113         DO jn = 1, jpts 
    112             DO jk = 1, jpkm1 
    113                DO jj = 2, jpjm1 
    114                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    115                      pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs)           & 
    116                         &                  + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) ) 
    117                   END DO 
    118                END DO 
    119             END DO 
     114            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     115               pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs)           & 
     116                  &                  + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) ) 
     117            END_3D 
    120118         END DO 
    121119         ! 
    122120      CASE ( 1 )                       !*  no damping in the turbocline (avt > 5 cm2/s)  *! 
    123          DO jk = 1, jpkm1 
    124             DO jj = 2, jpjm1 
    125                DO ji = fs_2, fs_jpim1   ! vector opt. 
    126                   IF( avt(ji,jj,jk) <= avt_c ) THEN 
    127                      pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   & 
    128                         &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 
    129                      pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)   & 
    130                         &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 
    131                   ENDIF 
    132                END DO 
    133             END DO 
    134          END DO 
     121         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     122            IF( avt(ji,jj,jk) <= avt_c ) THEN 
     123               pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   & 
     124                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 
     125               pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)   & 
     126                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 
     127            ENDIF 
     128         END_3D 
    135129         ! 
    136130      CASE ( 2 )                       !*  no damping in the mixed layer   *! 
    137          DO jk = 1, jpkm1 
    138             DO jj = 2, jpjm1 
    139                DO ji = fs_2, fs_jpim1   ! vector opt. 
    140                   IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 
    141                      pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   & 
    142                         &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 
    143                      pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)   & 
    144                         &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 
    145                   ENDIF 
    146                END DO 
    147             END DO 
    148          END DO 
     131         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     132            IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 
     133               pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   & 
     134                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 
     135               pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)   & 
     136                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 
     137            ENDIF 
     138         END_3D 
    149139         ! 
    150140      END SELECT 
    … …  
    157147      ENDIF 
    158148      !                           ! Control print 
    159       IF(ln_ctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp  - Ta: ', mask1=tmask,   & 
    160          &                       tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     149      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp  - Ta: ', mask1=tmask,   & 
     150         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    161151      ! 
    162152      IF( ln_timing )   CALL timing_stop('tra_dmp') 
    … …  
    178168      !!---------------------------------------------------------------------- 
    179169      ! 
    180       REWIND( numnam_ref )   ! Namelist namtra_dmp in reference namelist : T & S relaxation 
    181170      READ  ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901) 
    182171901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_dmp in reference namelist' ) 
    183172      ! 
    184       REWIND( numnam_cfg )   ! Namelist namtra_dmp in configuration namelist : T & S relaxation 
    185173      READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 ) 
    186174902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist' ) 
    … …  
    220208         !                          ! Read in mask from file 
    221209         CALL iom_open ( cn_resto, imask) 
    222          CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto ) 
     210         CALL iom_get  ( imask, jpdom_auto, 'resto', resto ) 
    223211         CALL iom_close( imask ) 
    224212      ENDIF 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP/EXPREF/context_nemo.xml

    r12276 r13710  
    1111       <variable id="ref_month" type="int"> 01 </variable> 
    1212       <variable id="ref_day"   type="int"> 01 </variable> 
    13        <variable id="rau0"      type="float" > 1026.0 </variable> 
     13       <variable id="rho0"      type="float" > 1026.0 </variable> 
    1414       <variable id="cpocean"   type="float" > 3991.86795711963 </variable> 
    1515       <variable id="convSpsu"  type="float" > 0.99530670233846  </variable> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP/EXPREF/namelist_cfg

    r12489 r13710  
    227227!!                                                                    !! 
    228228!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    229 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    230 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     229!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     230!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    231231!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    232232!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    236236&namdrg        !   top/bottom drag coefficient                          (default: NO selection) 
    237237!----------------------------------------------------------------------- 
    238    ln_OFF     = .false.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
     238   ln_drg_OFF = .false.   !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    239239   ln_lin     = .false.    !      linear  drag: Cd = Cd0 Uc0                   &   namdrg_top) 
    240240   ln_non_lin = .true.     !  non-linear  drag: Cd = Cd0 |U| 
    … …  
    244244/ 
    245245!----------------------------------------------------------------------- 
    246 &namdrg_top    !   TOP friction                                         (ln_OFF =F & ln_isfcav=T) 
     246&namdrg_top    !   TOP friction                                         (ln_drg_OFF =F & ln_isfcav=T) 
    247247!----------------------------------------------------------------------- 
    248248   rn_Cd0     =  2.5e-3    !  drag coefficient [-] 
    … …  
    255255/ 
    256256!----------------------------------------------------------------------- 
    257 &namdrg_bot    !   BOTTOM friction                                      (ln_OFF =F) 
     257&namdrg_bot    !   BOTTOM friction                                      (ln_drg_OFF =F) 
    258258!----------------------------------------------------------------------- 
    259259   rn_Cd0     =  1.e-3    !  drag coefficient [-] 
    … …  
    423423!!                                                                    !! 
    424424!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    425 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    426425!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    427426!!   namdiu       Cool skin and warm layer models                       (default: OFF) 
    … …  
    438437/ 
    439438!----------------------------------------------------------------------- 
    440 &namptr        !   Poleward Transport Diagnostic                        (default: OFF) 
    441439!----------------------------------------------------------------------- 
    442440/ 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP/MY_SRC/usrdef_hgr.F90

    r10074 r13710  
    1414   !!   usr_def_hgr    : initialize the horizontal mesh for ISOMIP configuration 
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  ,  ONLY: nimpp, njmpp       ! ocean space and time domain 
     16   USE dom_oce 
    1717   USE par_oce         ! ocean space and time domain 
    1818   USE phycst          ! physical constants 
    … …  
    2727   PUBLIC   usr_def_hgr   ! called by domhgr.F90 
    2828 
     29   !! * Substitutions 
     30#  include "do_loop_substitute.h90" 
    2931   !!---------------------------------------------------------------------- 
    3032   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7577      ! 
    7678      !                       !==  grid point position  ==!   (in degrees) 
    77       DO jj = 1, jpj 
    78          DO ji = 1, jpi             ! longitude   (west coast at lon=0°) 
    79             plamt(ji,jj) = rn_e1deg * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )   
    80             plamu(ji,jj) = rn_e1deg * (          REAL( ji-1 + nimpp-1 , wp )  ) 
    81             plamv(ji,jj) = plamt(ji,jj) 
    82             plamf(ji,jj) = plamu(ji,jj) 
    83             !                       ! latitude   (south coast at lat= 81°) 
    84             pphit(ji,jj) = rn_e2deg * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  ) - 80._wp 
    85             pphiu(ji,jj) = pphit(ji,jj) 
    86             pphiv(ji,jj) = rn_e2deg * (          REAL( jj-1 + njmpp-1 , wp )  ) - 80_wp 
    87             pphif(ji,jj) = pphiv(ji,jj) 
    88          END DO 
    89       END DO 
     79      DO_2D( 1, 1, 1, 1 ) 
     80         !                       ! longitude   (west coast at lon=0°) 
     81         plamt(ji,jj) = rn_e1deg * (  - 0.5 + REAL( mig0_oldcmp(ji)-1 , wp )  )   
     82         plamu(ji,jj) = rn_e1deg * (          REAL( mig0_oldcmp(ji)-1 , wp )  ) 
     83         plamv(ji,jj) = plamt(ji,jj) 
     84         plamf(ji,jj) = plamu(ji,jj) 
     85         !                       ! latitude   (south coast at lat= 81°) 
     86         pphit(ji,jj) = rn_e2deg * (  - 0.5 + REAL( mjg0_oldcmp(jj)-1 , wp )  ) - 80._wp 
     87         pphiu(ji,jj) = pphit(ji,jj) 
     88         pphiv(ji,jj) = rn_e2deg * (          REAL( mjg0_oldcmp(jj)-1 , wp )  ) - 80_wp 
     89         pphif(ji,jj) = pphiv(ji,jj) 
     90      END_2D 
    9091      ! 
    9192      !                       !==  Horizontal scale factors  ==!   (in meters) 
    92       DO jj = 1, jpj 
    93          DO ji = 1, jpi 
    94             !                       ! e1   (zonal) 
    95             pe1t(ji,jj) = ra * rad * COS( rad * pphit(ji,jj) ) * rn_e1deg 
    96             pe1u(ji,jj) = ra * rad * COS( rad * pphiu(ji,jj) ) * rn_e1deg 
    97             pe1v(ji,jj) = ra * rad * COS( rad * pphiv(ji,jj) ) * rn_e1deg 
    98             pe1f(ji,jj) = ra * rad * COS( rad * pphif(ji,jj) ) * rn_e1deg 
    99             !                       ! e2   (meridional) 
    100             pe2t(ji,jj) = ra * rad * rn_e2deg 
    101             pe2u(ji,jj) = ra * rad * rn_e2deg 
    102             pe2v(ji,jj) = ra * rad * rn_e2deg 
    103             pe2f(ji,jj) = ra * rad * rn_e2deg 
    104          END DO 
    105       END DO 
     93      DO_2D( 1, 1, 1, 1 ) 
     94         !                       ! e1   (zonal) 
     95         pe1t(ji,jj) = ra * rad * COS( rad * pphit(ji,jj) ) * rn_e1deg 
     96         pe1u(ji,jj) = ra * rad * COS( rad * pphiu(ji,jj) ) * rn_e1deg 
     97         pe1v(ji,jj) = ra * rad * COS( rad * pphiv(ji,jj) ) * rn_e1deg 
     98         pe1f(ji,jj) = ra * rad * COS( rad * pphif(ji,jj) ) * rn_e1deg 
     99         !                       ! e2   (meridional) 
     100         pe2t(ji,jj) = ra * rad * rn_e2deg 
     101         pe2u(ji,jj) = ra * rad * rn_e2deg 
     102         pe2v(ji,jj) = ra * rad * rn_e2deg 
     103         pe2f(ji,jj) = ra * rad * rn_e2deg 
     104      END_2D 
    106105      !                             ! NO reduction of grid size in some straits  
    107106      ke1e2u_v    = 0               !    ==>> u_ & v_surfaces will be computed in dom_ghr routine 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP/MY_SRC/usrdef_nam.F90

    r12377 r13710  
    1515   !!   usr_def_hgr   : initialize the horizontal mesh  
    1616   !!---------------------------------------------------------------------- 
    17    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
    1817   USE dom_oce  , ONLY: ln_zco, ln_zps, ln_sco   ! flag of type of coordinate 
    1918   USE par_oce        ! ocean space and time domain 
    … …  
    9594         WRITE(numout,*) '         vertical   resolution                 rn_e3    = ', rn_e3   , ' meters' 
    9695         WRITE(numout,*) '      ISOMIP domain = 15° x 10° x 900 m' 
    97          WRITE(numout,*) '         resulting global domain size :        jpiglo   = ', kpi 
    98          WRITE(numout,*) '                                               jpjglo   = ', kpj 
     96         WRITE(numout,*) '         resulting global domain size :        Ni0glo   = ', kpi 
     97         WRITE(numout,*) '                                               Nj0glo   = ', kpj 
    9998         WRITE(numout,*) '                                               jpkglo   = ', kpk 
    10099         WRITE(numout,*) '   ' 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP/MY_SRC/usrdef_zgr.F90

    r12377 r13710  
    1616   !!--------------------------------------------------------------------- 
    1717   USE oce            ! ocean variables 
    18    USE dom_oce ,  ONLY: mj0   , mj1   , nimpp , njmpp  ! ocean space and time domain 
    19    USE dom_oce ,  ONLY: glamt , gphit                   ! ocean space and time domain 
     18   USE dom_oce ,  ONLY: mj0   , mj1    ! ocean space and time domain 
     19   USE dom_oce ,  ONLY: glamt , gphit  ! ocean space and time domain 
    2020   USE usrdef_nam     ! User defined : namelist variables 
    2121   ! 
    … …  
    3030   PUBLIC   usr_def_zgr   ! called by domzgr.F90 
    3131 
     32   !! * Substitutions 
     33#  include "do_loop_substitute.h90" 
    3234   !!---------------------------------------------------------------------- 
    3335   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6567      REAL(wp), DIMENSION(jpi,jpj) ::   zht  , zhu         ! bottom depth 
    6668      REAL(wp), DIMENSION(jpi,jpj) ::   zhisf, zhisfu      ! top depth 
    67       REAL(wp), DIMENSION(jpi,jpj) ::   zmsk  
    68       REAL(wp), DIMENSION(jpi,jpj) ::   z2d                ! 2d workspace 
    6969      !!---------------------------------------------------------------------- 
    7070      ! 
    … …  
    8585      !                       !==  isfdraft  ==! 
    8686      ! 
    87       ! the ocean basin surrounded by land (1 grid-point) set through lbc_lnk call as jperio=0  
    88       z2d(:,:) = 1._wp                    ! surface ocean is the 1st level 
    89       CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90) 
    90       zmsk(:,:) = NINT( z2d(:,:) ) 
    91       ! 
    92       ! 
    9387      zht  (:,:) = rbathy  
    9488      zhisf(:,:) = 200._wp 
    95       ij0 = 1 ; ij1 = 40 
     89      ij0 = 1   ;   ij1 = 40+nn_hls 
    9690      DO jj = mj0(ij0), mj1(ij1) 
    9791         zhisf(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp 
    9892      END DO 
    99       zhisf(:,:) = zhisf(:,:) * zmsk(:,:) 
    10093      ! 
    10194      CALL zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! Reference z-coordinate system 
    … …  
    132125            pe3vw(:,:,jk) = pe3w_1d (jk) 
    133126         END DO 
    134          DO jj = 1, jpj                      ! top scale factors and depth at T- and W-points 
    135             DO ji = 1, jpi 
    136                ik = k_top(ji,jj) 
    137                IF ( ik > 2 ) THEN 
    138                   ! pdeptw at the interface 
    139                   pdepw(ji,jj,ik  ) = MAX( zhisf(ji,jj) , pdepw(ji,jj,ik) ) 
    140                   ! e3t in both side of the interface 
    141                   pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 
    142                   ! pdept in both side of the interface (from previous e3t) 
    143                   pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp 
    144                   pdept(ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pe3t (ji,jj,ik  ) * 0.5_wp 
    145                   ! pe3w on both side of the interface 
    146                   pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik  ) 
    147                   pe3w (ji,jj,ik  ) = pdept(ji,jj,ik  ) - pdept(ji,jj,ik-1) 
    148                   ! e3t into the ice shelf 
    149                   pe3t (ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pdepw(ji,jj,ik-1) 
    150                   pe3w (ji,jj,ik-1) = pdept(ji,jj,ik-1) - pdept(ji,jj,ik-2) 
    151                END IF 
    152             END DO 
    153          END DO          
    154          DO jj = 1, jpj                      ! bottom scale factors and depth at T- and W-points 
    155             DO ji = 1, jpi 
    156                ik = k_bot(ji,jj) 
    157                pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 
     127         ! top scale factors and depth at T- and W-points 
     128         DO_2D( 1, 1, 1, 1 ) 
     129            ik = k_top(ji,jj) 
     130            IF ( ik > 2 ) THEN 
     131               ! pdeptw at the interface 
     132               pdepw(ji,jj,ik  ) = MAX( zhisf(ji,jj) , pdepw(ji,jj,ik) ) 
     133               ! e3t in both side of the interface 
    158134               pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 
    159                pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  )  
    160                ! 
     135               ! pdept in both side of the interface (from previous e3t) 
    161136               pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp 
    162                pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 
    163                pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) 
    164             END DO 
    165          END DO          
     137               pdept(ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pe3t (ji,jj,ik  ) * 0.5_wp 
     138               ! pe3w on both side of the interface 
     139               pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik  ) 
     140               pe3w (ji,jj,ik  ) = pdept(ji,jj,ik  ) - pdept(ji,jj,ik-1) 
     141               ! e3t into the ice shelf 
     142               pe3t (ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pdepw(ji,jj,ik-1) 
     143               pe3w (ji,jj,ik-1) = pdept(ji,jj,ik-1) - pdept(ji,jj,ik-2) 
     144            END IF 
     145         END_2D 
     146         ! bottom scale factors and depth at T- and W-points 
     147         DO_2D( 1, 1, 1, 1 ) 
     148            ik = k_bot(ji,jj) 
     149            pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 
     150            pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 
     151            pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  )  
     152            ! 
     153            pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp 
     154            pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 
     155            pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) 
     156         END_2D        
    166157         !                                   ! bottom scale factors and depth at  U-, V-, UW and VW-points 
    167158         pe3u (:,:,:) = pe3t(:,:,:) 
    168159         pe3uw(:,:,:) = pe3w(:,:,:) 
    169          DO jk = 1, jpk                      ! Computed as the minimum of neighbooring scale factors 
    170             DO jj = 1, jpjm1 
    171                DO ji = 1, jpi 
    172                   pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) ) 
    173                   pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) ) 
    174                   pe3f (ji,jj,jk) = pe3v(ji,jj,jk) 
    175                END DO 
    176             END DO 
    177          END DO 
     160         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     161         !                                   ! Computed as the minimum of neighbooring scale factors 
     162            pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) ) 
     163            pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) ) 
     164            pe3f (ji,jj,jk) = pe3v(ji,jj,jk) 
     165         END_3D 
    178166         CALL lbc_lnk( 'usrdef_zgr', pe3v , 'V', 1._wp )   ;   CALL lbc_lnk( 'usrdef_zgr', pe3vw, 'V', 1._wp ) 
    179167         CALL lbc_lnk( 'usrdef_zgr', pe3f , 'F', 1._wp ) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/LOCK_EXCHANGE/EXPREF/context_nemo.xml

    r12276 r13710  
    1111       <variable id="ref_month" type="int"> 01 </variable> 
    1212       <variable id="ref_day"   type="int"> 01 </variable> 
    13        <variable id="rau0"      type="float" > 1026.0 </variable> 
     13       <variable id="rho0"      type="float" > 1026.0 </variable> 
    1414       <variable id="cpocean"   type="float" > 3991.86795711963 </variable> 
    1515       <variable id="convSpsu"  type="float" > 0.99530670233846  </variable> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_flux_cen2_cfg

    r12489 r13710  
    6565&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    6666!----------------------------------------------------------------------- 
    67    ln_OFF     = .true.    !  free-slip       : Cd = 0                   
     67   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    6868/ 
    6969!----------------------------------------------------------------------- 
    … …  
    7272   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    7373   !                     ! S-EOS coefficients (nn_eos=1): 
    74    !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     74   !                          !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    7575   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1) 
    7676   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_flux_ubs_cfg

    r12489 r13710  
    110110!!                                                                    !! 
    111111!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    112 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    113 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     112!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     113!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    114114!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    115115!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    119119&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    120120!----------------------------------------------------------------------- 
    121    ln_OFF     = .true.    !  free-slip       : Cd = 0                   
     121   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    122122/ 
    123123!!====================================================================== 
    … …  
    137137   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    138138   !                     ! S-EOS coefficients (nn_eos=1): 
    139    !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     139   !                          !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    140140   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1) 
    141141   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1) 
    … …  
    271271!!                                                                    !! 
    272272!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    273 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    274273!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    275274!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_eenH_cfg

    r12489 r13710  
    6565&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    6666!----------------------------------------------------------------------- 
    67    ln_OFF     = .true.    !  free-slip       : Cd = 0                   
     67   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    6868/ 
    6969!----------------------------------------------------------------------- 
    … …  
    7272   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    7373   !                     ! S-EOS coefficients (nn_eos=1): 
    74    !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     74   !                          !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    7575   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1) 
    7676   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_een_cfg

    r12489 r13710  
    6565&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    6666!----------------------------------------------------------------------- 
    67    ln_OFF     = .true.    !  free-slip       : Cd = 0                   
     67   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    6868/ 
    6969!----------------------------------------------------------------------- 
    … …  
    7272   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    7373   !                     ! S-EOS coefficients (nn_eos=1): 
    74    !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     74   !                          !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    7575   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1) 
    7676   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_ene_cfg

    r12489 r13710  
    6565&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    6666!----------------------------------------------------------------------- 
    67    ln_OFF     = .true.    !  free-slip       : Cd = 0                   
     67   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    6868/ 
    6969!----------------------------------------------------------------------- 
    … …  
    7272   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    7373   !                     ! S-EOS coefficients (nn_eos=1): 
    74    !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     74   !                          !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    7575   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1) 
    7676   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_ens_cfg

    r12489 r13710  
    6565&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    6666!----------------------------------------------------------------------- 
    67    ln_OFF     = .true.    !  free-slip       : Cd = 0                   
     67   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    6868/ 
    6969!----------------------------------------------------------------------- 
    … …  
    7272   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    7373   !                     ! S-EOS coefficients (nn_eos=1): 
    74    !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     74   !                          !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    7575   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1) 
    7676   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_flux_cen2_cfg

    r12489 r13710  
    6565&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    6666!----------------------------------------------------------------------- 
    67    ln_OFF     = .true.    !  free-slip       : Cd = 0                   
     67   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    6868/ 
    6969!----------------------------------------------------------------------- 
    … …  
    7272   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    7373   !                     ! S-EOS coefficients (nn_eos=1): 
    74    !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     74   !                          !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    7575   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1) 
    7676   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_flux_ubs_cfg

    r12489 r13710  
    6565&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    6666!----------------------------------------------------------------------- 
    67    ln_OFF     = .true.    !  free-slip       : Cd = 0                   
     67   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    6868/ 
    6969!----------------------------------------------------------------------- 
    … …  
    7272   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    7373   !                     ! S-EOS coefficients (nn_eos=1): 
    74    !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     74   !                          !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    7575   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1) 
    7676   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_eenH_cfg

    r12489 r13710  
    6565&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    6666!----------------------------------------------------------------------- 
    67    ln_OFF     = .true.    !  free-slip       : Cd = 0                   
     67   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    6868/ 
    6969!----------------------------------------------------------------------- 
    … …  
    7272   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    7373   !                     ! S-EOS coefficients (nn_eos=1): 
    74    !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     74   !                          !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    7575   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1) 
    7676   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_een_cfg

    r12489 r13710  
    6565&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    6666!----------------------------------------------------------------------- 
    67    ln_OFF     = .true.    !  free-slip       : Cd = 0                   
     67   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    6868/ 
    6969!----------------------------------------------------------------------- 
    … …  
    7272   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    7373   !                     ! S-EOS coefficients (nn_eos=1): 
    74    !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     74   !                          !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    7575   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1) 
    7676   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_ene_cfg

    r12489 r13710  
    6565&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    6666!----------------------------------------------------------------------- 
    67    ln_OFF     = .true.    !  free-slip       : Cd = 0                   
     67   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    6868/ 
    6969!----------------------------------------------------------------------- 
    … …  
    7272   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    7373   !                     ! S-EOS coefficients (nn_eos=1): 
    74    !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     74   !                          !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    7575   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1) 
    7676   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_ens_cfg

    r12489 r13710  
    6565&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    6666!----------------------------------------------------------------------- 
    67    ln_OFF     = .true.    !  free-slip       : Cd = 0                   
     67   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    6868/ 
    6969!----------------------------------------------------------------------- 
    … …  
    7272   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    7373   !                     ! S-EOS coefficients (nn_eos=1): 
    74    !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     74   !                          !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    7575   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1) 
    7676   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90

    r10074 r13710  
    1313   !!   usr_def_hgr    : initialize the horizontal mesh for LOCK_EXCHANGE configuration 
    1414   !!---------------------------------------------------------------------- 
    15    USE dom_oce  ,  ONLY: nimpp, njmpp       ! ocean space and time domain 
     15   USE dom_oce 
    1616   USE par_oce         ! ocean space and time domain 
    1717   USE phycst          ! physical constants 
    … …  
    2626   PUBLIC   usr_def_hgr   ! called by domhgr.F90 
    2727 
     28   !! * Substitutions 
     29#  include "do_loop_substitute.h90" 
    2830   !!---------------------------------------------------------------------- 
    2931   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7274      !                       !==  grid point position  ==!   (in kilometers) 
    7375      zfact = rn_dx * 1.e-3         ! conversion in km 
    74       DO jj = 1, jpj 
    75          DO ji = 1, jpi             ! longitude 
    76             plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )   
    77             plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  ) 
    78             plamv(ji,jj) = plamt(ji,jj) 
    79             plamf(ji,jj) = plamu(ji,jj) 
    80             !                       ! latitude 
    81             pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  ) 
    82             pphiu(ji,jj) = pphit(ji,jj) 
    83             pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  ) 
    84             pphif(ji,jj) = pphiv(ji,jj) 
    85          END DO 
    86       END DO 
     76      DO_2D( 1, 1, 1, 1 ) 
     77         !                       ! longitude 
     78         plamt(ji,jj) = zfact * (  - 0.5 + REAL( mig0_oldcmp(ji)-1 , wp )  )   
     79         plamu(ji,jj) = zfact * (          REAL( mig0_oldcmp(ji)-1 , wp )  ) 
     80         plamv(ji,jj) = plamt(ji,jj) 
     81         plamf(ji,jj) = plamu(ji,jj) 
     82         !                       ! latitude 
     83         pphit(ji,jj) = zfact * (  - 0.5 + REAL( mjg0_oldcmp(jj)-1 , wp )  ) 
     84         pphiu(ji,jj) = pphit(ji,jj) 
     85         pphiv(ji,jj) = zfact * (          REAL( mjg0_oldcmp(jj)-1 , wp )  ) 
     86         pphif(ji,jj) = pphiv(ji,jj) 
     87      END_2D 
    8788      ! 
    8889      !                       !==  Horizontal scale factors  ==!   (in meters)  

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/LOCK_EXCHANGE/MY_SRC/usrdef_nam.F90

    r12377 r13710  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
    1716   USE par_oce        ! ocean space and time domain 
    1817   USE phycst         ! physical constants 
    … …  
    8584         WRITE(numout,*) '      vertical   resolution                    rn_dz  = ', rn_dz, ' meters' 
    8685         WRITE(numout,*) '      LOCK_EXCHANGE domain = 64 km  x  3 grid-points  x  20 m' 
    87          WRITE(numout,*) '         resulting global domain size :        jpiglo = ', kpi 
    88          WRITE(numout,*) '                                               jpjglo = ', kpj 
     86         WRITE(numout,*) '         resulting global domain size :        Ni0glo = ', kpi 
     87         WRITE(numout,*) '                                               Nj0glo = ', kpj 
    8988         WRITE(numout,*) '                                               jpkglo = ', kpk 
    9089         WRITE(numout,*) '   ' 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/OVERFLOW/EXPREF/context_nemo.xml

    r12276 r13710  
    1111       <variable id="ref_month" type="int"> 01 </variable> 
    1212       <variable id="ref_day"   type="int"> 01 </variable> 
    13        <variable id="rau0"      type="float" > 1026.0 </variable> 
     13       <variable id="rho0"      type="float" > 1026.0 </variable> 
    1414       <variable id="cpocean"   type="float" > 3991.86795711963 </variable> 
    1515       <variable id="convSpsu"  type="float" > 0.99530670233846  </variable> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/OVERFLOW/EXPREF/namelist_sco_FCT2_flux_cen-ahm1000_cfg

    r12489 r13710  
    2121   nn_it000    =       1   !  first time step 
    2222   nn_itend    =    6120  ! here 17h of simulation  (=6120 time-step)  
    23    !nn_itend    =    5760   ! here 16h of simulation  (=5760 time-step) abort after 5802 for zps: pb of physics conditions 
    2423   nn_istate   =       0   !  output the initial state (1) or not (0) 
    2524   nn_stock    =    6120   !  frequency of creation of a restart file (modulo referenced to 1) 
    … …  
    7170&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    7271!----------------------------------------------------------------------- 
    73    ln_OFF     = .true.     !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
     72   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    7473   ln_lin     = .false.    !      linear  drag: Cd = Cd0 Uc0                   &   namdrg_top) 
    7574   ln_non_lin = .false.    !  non-linear  drag: Cd = Cd0 |U| 
    … …  
    8281!----------------------------------------------------------------------- 
    8382   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    84    !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     83   !                             !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    8584   rn_a0       =  0.2         !  thermal expension coefficient (for simplified equation of state) 
    8685   rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/OVERFLOW/EXPREF/namelist_sco_FCT2_flux_ubs_cfg

    r12489 r13710  
    2121   nn_it000    =       1   !  first time step 
    2222   nn_itend    =    6120  ! here 17h of simulation  (=6120 time-step)  
    23    !nn_itend    =    5760   ! here 16h of simulation  (=5760 time-step) abort after 5802 for zps: pb of physics conditions 
    2423   nn_istate   =       0   !  output the initial state (1) or not (0) 
    2524   nn_stock    =    1080   !  frequency of creation of a restart file (modulo referenced to 1) 
    … …  
    7170&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    7271!----------------------------------------------------------------------- 
    73    ln_OFF    = .true.     !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
     72   ln_drg_OFF = .true.     !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    7473   ln_lin     = .false.    !      linear  drag: Cd = Cd0 Uc0                   &   namdrg_top) 
    7574   ln_non_lin = .false.    !  non-linear  drag: Cd = Cd0 |U| 
    … …  
    8281!----------------------------------------------------------------------- 
    8382   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    84    !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     83   !                             !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    8584   rn_a0       =  0.2         !  thermal expension coefficient (for simplified equation of state) 
    8685   rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/OVERFLOW/EXPREF/namelist_sco_FCT4_flux_cen-ahm1000_cfg

    r12489 r13710  
    2121   nn_it000    =       1   !  first time step 
    2222   nn_itend    =    6120  ! here 17h of simulation  (=6120 time-step)  
    23    !nn_itend    =    5760   ! here 16h of simulation  (=5760 time-step) abort after 5802 for zps: pb of physics conditions 
    2423   nn_istate   =       0   !  output the initial state (1) or not (0) 
    2524   nn_stock    =    6120   !  frequency of creation of a restart file (modulo referenced to 1) 
    … …  
    7170&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    7271!----------------------------------------------------------------------- 
    73    ln_OFF     = .true.     !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
     72   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    7473   ln_lin     = .false.    !      linear  drag: Cd = Cd0 Uc0                   &   namdrg_top) 
    7574   ln_non_lin = .false.    !  non-linear  drag: Cd = Cd0 |U| 
    … …  
    8281!----------------------------------------------------------------------- 
    8382   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    84    !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     83   !                             !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    8584   rn_a0       =  0.2         !  thermal expension coefficient (for simplified equation of state) 
    8685   rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/OVERFLOW/EXPREF/namelist_sco_FCT4_flux_ubs_cfg

    r12489 r13710  
    2121   nn_it000    =       1   !  first time step 
    2222   nn_itend    =    6120  ! here 17h of simulation  (=6120 time-step)  
    23    !nn_itend    =    5760   ! here 16h of simulation  (=5760 time-step) abort after 5802 for zps: pb of physics conditions 
    2423   nn_istate   =       0   !  output the initial state (1) or not (0) 
    2524   nn_stock    =    1080   !  frequency of creation of a restart file (modulo referenced to 1) 
    … …  
    7170&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    7271!----------------------------------------------------------------------- 
    73    ln_OFF     = .true.     !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
     72   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    7473   ln_lin     = .false.    !      linear  drag: Cd = Cd0 Uc0                   &   namdrg_top) 
    7574   ln_non_lin = .false.    !  non-linear  drag: Cd = Cd0 |U| 
    … …  
    8281!----------------------------------------------------------------------- 
    8382   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    84    !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     83   !                             !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    8584   rn_a0       =  0.2         !  thermal expension coefficient (for simplified equation of state) 
    8685   rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/OVERFLOW/EXPREF/namelist_zps_FCT2_flux_ubs_cfg

    r12489 r13710  
    2020   cn_exp      =   "OVF_zps_FCT2_flux_ubs"  !  experience name 
    2121   nn_it000    =       1   !  first time step 
    22    !nn_itend    =    6120  ! here 17h of simulation  (=6120 time-step)  
    2322   nn_itend    =    5760   ! here 16h of simulation  (=5760 time-step) abort after 5802 for zps: pb of physics conditions 
    2423   nn_istate   =       0   !  output the initial state (1) or not (0) 
    … …  
    7170&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    7271!----------------------------------------------------------------------- 
    73    ln_OFF     = .true.     !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
     72   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    7473   ln_lin     = .false.    !      linear  drag: Cd = Cd0 Uc0                   &   namdrg_top) 
    7574   ln_non_lin = .false.    !  non-linear  drag: Cd = Cd0 |U| 
    … …  
    8281!----------------------------------------------------------------------- 
    8382   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    84    !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     83   !                             !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    8584   rn_a0       =  0.2         !  thermal expension coefficient (for simplified equation of state) 
    8685   rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/OVERFLOW/EXPREF/namelist_zps_FCT4_flux_ubs_cfg

    r12489 r13710  
    105105!!                                                                    !! 
    106106!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    107 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    108 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     107!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     108!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    109109!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    110110!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    114114&namdrg        !   top/bottom drag coefficient                          (default: NO selection) 
    115115!----------------------------------------------------------------------- 
    116    ln_OFF    = .true.     !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
     116   ln_drg_OFF = .true.     !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    117117   ln_lin     = .false.    !      linear  drag: Cd = Cd0 Uc0                   &   namdrg_top) 
    118118   ln_non_lin = .false.    !  non-linear  drag: Cd = Cd0 |U| 
    … …  
    136136!----------------------------------------------------------------------- 
    137137   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    138    !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     138   !                             !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    139139   rn_a0       =  0.2         !  thermal expension coefficient (for simplified equation of state) 
    140140   rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state) 
    … …  
    289289!!                                                                    !! 
    290290!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    291 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    292291!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    293292!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/OVERFLOW/EXPREF/namelist_zps_FCT4_vect_een_cfg

    r12489 r13710  
    2020   cn_exp      =   "OVF_zps_FCT4_vect_een"  !  experience name 
    2121   nn_it000    =       1   !  first time step 
    22    !nn_itend    =    6120  ! here 17h of simulation  (=6120 time-step)  
    2322   nn_itend    =    5760   ! here 16h of simulation  (=5760 time-step) abort after 5802 for zps: pb of physics conditions 
    2423   nn_istate   =       0   !  output the initial state (1) or not (0) 
    … …  
    7170&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    7271!----------------------------------------------------------------------- 
    73    ln_OFF     = .true.     !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
     72   ln_drg_OFF = .true.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    7473   ln_lin     = .false.    !      linear  drag: Cd = Cd0 Uc0                   &   namdrg_top) 
    7574   ln_non_lin = .false.    !  non-linear  drag: Cd = Cd0 |U| 
    … …  
    8281!----------------------------------------------------------------------- 
    8382   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    84    !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     83   !                             !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    8584   rn_a0       =  0.2         !  thermal expension coefficient (for simplified equation of state) 
    8685   rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90

    r10074 r13710  
    1313   !!   usr_def_hgr    : initialize the horizontal mesh for OVERFLOW configuration 
    1414   !!---------------------------------------------------------------------- 
    15    USE dom_oce  ,  ONLY: nimpp, njmpp       ! ocean space and time domain 
     15   USE dom_oce 
    1616   USE par_oce         ! ocean space and time domain 
    1717   USE phycst          ! physical constants 
    … …  
    2626   PUBLIC   usr_def_hgr   ! called by domhgr.F90 
    2727 
     28   !! * Substitutions 
     29#  include "do_loop_substitute.h90" 
    2830   !!---------------------------------------------------------------------- 
    2931   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7274      !                       !==  grid point position  ==!   (in kilometers) 
    7375      zfact = rn_dx * 1.e-3         ! conversion in km 
    74       DO jj = 1, jpj 
    75          DO ji = 1, jpi             ! longitude 
    76             plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )   
    77             plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  ) 
    78             plamv(ji,jj) = plamt(ji,jj) 
    79             plamf(ji,jj) = plamu(ji,jj) 
    80             !                       ! latitude 
    81             pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  ) 
    82             pphiu(ji,jj) = pphit(ji,jj) 
    83             pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  ) 
    84             pphif(ji,jj) = pphiv(ji,jj) 
    85          END DO 
    86       END DO 
     76      DO_2D( 1, 1, 1, 1 ) 
     77         !                       ! longitude 
     78         plamt(ji,jj) = zfact * (  - 0.5 + REAL( mig0_oldcmp(ji)-1 , wp )  )   
     79         plamu(ji,jj) = zfact * (          REAL( mig0_oldcmp(ji)-1 , wp )  ) 
     80         plamv(ji,jj) = plamt(ji,jj) 
     81         plamf(ji,jj) = plamu(ji,jj) 
     82         !                       ! latitude 
     83         pphit(ji,jj) = zfact * (  - 0.5 + REAL( mjg0_oldcmp(jj)-1 , wp )  ) 
     84         pphiu(ji,jj) = pphit(ji,jj) 
     85         pphiv(ji,jj) = zfact * (          REAL( mjg0_oldcmp(jj)-1 , wp )  ) 
     86         pphif(ji,jj) = pphiv(ji,jj) 
     87      END_2D 
    8788      ! 
    8889      !                       !==  Horizontal scale factors  ==!   (in meters)  

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/OVERFLOW/MY_SRC/usrdef_nam.F90

    r12377 r13710  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
    1716   USE dom_oce  , ONLY: ln_zco, ln_zps, ln_sco   ! flag of type of coordinate 
    1817   USE par_oce        ! ocean space and time domain 
    … …  
    8685      WRITE(numout,*) '      vertical   resolution                    rn_dz  = ', rn_dz, ' meters' 
    8786      WRITE(numout,*) '      OVERFLOW domain = 200 km x 3 grid-points x 2000 m' 
    88       WRITE(numout,*) '         resulting global domain size :        jpiglo = ', kpi 
    89       WRITE(numout,*) '                                               jpjglo = ', kpj 
     87      WRITE(numout,*) '         resulting global domain size :        Ni0glo = ', kpi 
     88      WRITE(numout,*) '                                               Nj0glo = ', kpj 
    9089      WRITE(numout,*) '                                               jpkglo = ', kpk 
    9190      ! 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90

    r12377 r13710  
    1515   !!--------------------------------------------------------------------- 
    1616   USE oce            ! ocean variables 
    17    USE dom_oce ,  ONLY: mi0, mi1, nimpp, njmpp   ! ocean space and time domain 
    18    USE dom_oce ,  ONLY: glamt                    ! ocean space and time domain 
     17   USE dom_oce ,  ONLY: mi0, mi1   ! ocean space and time domain 
     18   USE dom_oce ,  ONLY: glamt      ! ocean space and time domain 
    1919   USE usrdef_nam     ! User defined : namelist variables 
    2020   ! 
    … …  
    2929   PUBLIC   usr_def_zgr   ! called by domzgr.F90 
    3030 
     31   !! * Substitutions 
     32#  include "do_loop_substitute.h90" 
    3133   !!---------------------------------------------------------------------- 
    3234   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    182184            pe3vw(:,:,jk) = pe3w_1d (jk) 
    183185         END DO 
    184          DO jj = 1, jpj                      ! bottom scale factors and depth at T- and W-points 
    185             DO ji = 1, jpi 
    186                ik = k_bot(ji,jj) 
    187                   pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 
    188                   pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 
    189                   pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  )  
    190                   ! 
    191                   pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp 
    192                   pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 
    193                   pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)              ! = pe3t (ji,jj,ik  ) 
    194             END DO 
    195          END DO          
     186         DO_2D( 1, 1, 1, 1 ) 
     187            ik = k_bot(ji,jj) 
     188            pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 
     189            pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 
     190            pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  )  
     191            ! 
     192            pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp 
     193            pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 
     194            pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)              ! = pe3t (ji,jj,ik  ) 
     195         END_2D          
    196196         !                                   ! bottom scale factors and depth at  U-, V-, UW and VW-points 
    197197         !                                   ! usually Computed as the minimum of neighbooring scale factors 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/README.rst

    r11743 r13710  
    205205   :style: unsrt 
    206206   :labelprefix: T 
     207 
     208CPL_OASIS 
     209--------- 
     210| This test case checks the OASIS interface in OCE/SBC, allowing to set up  
     211a coupled configuration through OASIS. See CPL_OASIS/README.md for more information. 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/STATION_ASF/EXPREF/file_def_nemo-oce.xml

    r11930 r13710  
    2828      <field field_ref="empmr"        name="empmr" /> 
    2929      <!-- --> 
    30       <field field_ref="taum"         name="taum"     /> 
    31       <field field_ref="wspd"         name="windsp"   /> 
     30      <field field_ref="taum"         name="taum"   /> 
     31      <field field_ref="wspd"         name="windsp" /> 
     32      <!-- --> 
     33      <field field_ref="Cd_oce"       name="Cd_oce" /> 
     34      <field field_ref="Ce_oce"       name="Ce_oce" /> 
     35      <field field_ref="Ch_oce"       name="Ch_oce" /> 
     36      <field field_ref="theta_zt"     name="theta_zt" /> 
     37      <field field_ref="q_zt"         name="q_zt" /> 
     38      <field field_ref="theta_zu"     name="theta_zu" /> 
     39      <field field_ref="q_zu"         name="q_zu" /> 
     40      <field field_ref="ssq"          name="ssq" /> 
     41      <field field_ref="wspd_blk"     name="wspd_blk" />       
    3242    </file> 
    3343 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/STATION_ASF/EXPREF/launch_sasf.sh

    r12615 r13710  
    11#!/bin/bash 
    22 
    3 # NEMO directory where to fetch compiled STATION_ASF nemo.exe + setup: 
    4 NEMO_DIR=`pwd | sed -e "s|/tests/STATION_ASF/EXPREF||g"` 
     3################################################################ 
     4# 
     5# Script to launch a set of STATION_ASF simulations 
     6# 
     7# L. Brodeau, 2020 
     8# 
     9################################################################ 
    510 
    6 echo "Using NEMO_DIR=${NEMO_DIR}" 
    7  
    8 # what directory inside "tests" actually contains the compiled test-case? 
     11# What directory inside "tests" actually contains the compiled "nemo.exe" for STATION_ASF ? 
    912TC_DIR="STATION_ASF2" 
    1013 
    11 # => so the executable to use is: 
    12 NEMO_EXE="${NEMO_DIR}/tests/${TC_DIR}/BLD/bin/nemo.exe" 
     14expdir=`basename ${PWD}`; # we expect "EXPREF" or "EXP00" normally... 
     15 
     16# NEMOGCM root directory: 
     17NEMO_ROOT_DIR=`pwd | sed -e "s|/tests/STATION_ASF/${expdir}||g"` 
     18 
     19# NEMOGCM root directory where to fetch compiled STATION_ASF nemo.exe: 
     20SASF_WRK_DIR="${NEMO_ROOT_DIR}/tests/${TC_DIR}" 
    1321 
    1422# Directory where to run the simulation: 
    15 WORK_DIR="${HOME}/tmp/STATION_ASF" 
     23PROD_DIR="${HOME}/tmp/STATION_ASF" 
    1624 
    1725 
    18 # FORC_DIR => Directory containing sea-surface + atmospheric forcings 
    19 #             (get it there https://drive.google.com/file/d/1MxNvjhRHmMrL54y6RX7WIaM9-LGl--ZP/): 
    20 if [ `hostname` = "merlat"        ]; then 
    21     FORC_DIR="/MEDIA/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 
    22 elif [ `hostname` = "luitel"        ]; then 
    23     FORC_DIR="/data/gcm_setup/STATION_ASF/input_data_STATION_ASF_2016-2018" 
    24 elif [ `hostname` = "ige-meom-cal1" ]; then 
    25     FORC_DIR="/mnt/meom/workdir/brodeau/STATION_ASF/input_data_STATION_ASF_2016-2018" 
    26 elif [ `hostname` = "salvelinus" ]; then 
    27     FORC_DIR="/opt/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 
    28 else 
    29     echo "Boo!"; exit 
    30 fi 
    31 #====================== 
    32 mkdir -p ${WORK_DIR} 
     26####### End of normal user configurable section ####### 
     27 
     28#================================================================================ 
     29 
     30SASF_REF_DIR="${NEMO_ROOT_DIR}/tests/STATION_ASF" 
     31if [ ! -d ${SASF_REF_DIR} ]; then echo " Mhhh, no EXPREF directory ${SASF_REF_DIR} !"; exit; fi 
     32 
     33# NEMO executable to use is: 
     34NEMO_EXE="${SASF_WRK_DIR}/BLD/bin/nemo.exe" 
     35if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled 'nemo.exe' found into `dirname ${NEMO_EXE}` !"; exit; fi 
     36 
     37DATA_IN_DIR="${SASF_REF_DIR}/input_data" ; # Directory containing sea-surface + atmospheric input data 
     38if [ ! -d ${DATA_IN_DIR} ]; then echo "PROBLEM!!! => did not find directory 'input_data' with input forcing..."; exit; fi 
     39 
     40SASF_EXPREF=${SASF_REF_DIR}/${expdir}  ; # STATION_ASF EXPREF directory from which to use namelists and XIOS xml files... 
     41if [ ! -d ${SASF_EXPREF} ]; then echo " Mhhh, no ${expdir} directory ${SASF_EXPREF} !"; exit; fi 
    3342 
    3443 
    35 if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled nemo.exe found into ${NEMO_DIR}/tests/STATION_ASF/BLD/bin !"; exit; fi 
     44echo "###########################################################" 
     45echo "#        S T A T I O N   A i r  -  S e a   F l u x        #" 
     46echo "###########################################################" 
     47echo 
     48echo "  * NEMO reference root directory is: ${NEMO_ROOT_DIR}" 
     49echo "  * STATION_ASF work directory is: ${SASF_WRK_DIR}" 
     50echo "       ==> NEMO EXE to use: ${NEMO_EXE}" 
     51echo 
     52echo "  * Input forcing data into: ${DATA_IN_DIR}" 
     53echo "  * Production will be done into: ${PROD_DIR}" 
     54echo "  * Directory in which namelists and xml files are fetched:" 
     55echo "       ==> ${SASF_EXPREF}" 
     56echo 
    3657 
    37 NEMO_EXPREF="${NEMO_DIR}/tests/STATION_ASF/EXPREF" 
    38 if [ ! -d ${NEMO_EXPREF} ]; then echo " Mhhh, no EXPREF directory ${NEMO_EXPREF} !"; exit; fi 
     58mkdir -p ${PROD_DIR} 
    3959 
    40 rsync -avP ${NEMO_EXE}          ${WORK_DIR}/ 
     60rsync -avP ${NEMO_EXE}          ${PROD_DIR}/ 
    4161 
    4262for ff in "context_nemo.xml" "domain_def_nemo.xml" "field_def_nemo-oce.xml" "file_def_nemo-oce.xml" "grid_def_nemo.xml" "iodef.xml" "namelist_ref"; do 
    43     if [ ! -f ${NEMO_EXPREF}/${ff} ]; then echo " Mhhh, ${ff} not found into ${NEMO_EXPREF} !"; exit; fi 
    44     rsync -avPL ${NEMO_EXPREF}/${ff} ${WORK_DIR}/ 
     63    if [ ! -f ${SASF_EXPREF}/${ff} ]; then echo " Mhhh, ${ff} not found into ${SASF_EXPREF} !"; exit; fi 
     64    rsync -avPL ${SASF_EXPREF}/${ff} ${PROD_DIR}/ 
    4565done 
    4666 
    4767# Copy forcing to work directory: 
    48 rsync -avP ${FORC_DIR}/Station_PAPA_50N-145W*.nc ${WORK_DIR}/ 
     68rsync -avP ${DATA_IN_DIR}/Station_PAPA_50N-145W*.nc ${PROD_DIR}/ 
    4969 
    5070for CASE in "ECMWF" "COARE3p6" "NCAR" "ECMWF-noskin" "COARE3p6-noskin"; do 
    … …  
    5878    scase=`echo "${CASE}" | tr '[:upper:]' '[:lower:]'` 
    5979 
    60     rm -f ${WORK_DIR}/namelist_cfg 
    61     rsync -avPL ${NEMO_EXPREF}/namelist_${scase}_cfg ${WORK_DIR}/namelist_cfg 
     80    rm -f ${PROD_DIR}/namelist_cfg 
     81    rsync -avPL ${SASF_EXPREF}/namelist_${scase}_cfg ${PROD_DIR}/namelist_cfg 
    6282 
    63     cd ${WORK_DIR}/ 
     83    cd ${PROD_DIR}/ 
    6484    echo 
    6585    echo "Launching NEMO !" 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/STATION_ASF/EXPREF/namelist_coare3p6-noskin_cfg

    r12615 r13710  
    2929   cn_exp      =  'STATION_ASF-COARE3p6-noskin'  !  experience name 
    3030   nn_it000    =    1   !  first time step 
    31    nn_itend    =    26280   !  last  time step (std 5840) 
    32    nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     31!!!   nn_itend    =    26304   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     32!!!   nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     33   nn_itend    =    8760   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     34   nn_date0    = 20180101  !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
    3335   nn_time0    =       0   !  initial time of day in hhmm 
    34    nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
     36   nn_leapy    =       1   !  Leap year calendar (1) or not (0) 
    3537   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
    3638      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T) 
    … …  
    4547   nn_istate   =       0   !  output the initial state (1) or not (0) 
    4648   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 
    47    nn_stock    =    26280   ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 
    48    nn_write    =    26280   ! 1year @ dt=3600 s / frequency of write in the output file   (modulo referenced to nn_it000) 
     49   !! 
     50!!!   nn_stock    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     51!!!   nn_write    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     52   nn_stock    =    8760   ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     53   nn_write    =    8760   ! 1 year at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     54   !! 
    4955   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%) 
    5056   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard 
    … …  
    195201!!                                                                    !! 
    196202!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    197 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    198 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     203!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     204!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    199205!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    200206!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    244250!!                                                                    !! 
    245251!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    246 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    247252!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    248253!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/STATION_ASF/EXPREF/namelist_coare3p6_cfg

    r12615 r13710  
    2929   cn_exp      =  'STATION_ASF-COARE3p6'  !  experience name 
    3030   nn_it000    =    1   !  first time step 
    31    nn_itend    =    26280   !  last  time step (std 5840) 
    32    nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     31!!!   nn_itend    =    26304   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     32!!!   nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     33   nn_itend    =    8760   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     34   nn_date0    = 20180101  !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
    3335   nn_time0    =       0   !  initial time of day in hhmm 
    34    nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
     36   nn_leapy    =       1   !  Leap year calendar (1) or not (0) 
    3537   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
    3638      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T) 
    … …  
    4547   nn_istate   =       0   !  output the initial state (1) or not (0) 
    4648   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 
    47    nn_stock    =    26280   ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 
    48    nn_write    =    26280   ! 1year @ dt=3600 s / frequency of write in the output file   (modulo referenced to nn_it000) 
     49   !! 
     50!!!   nn_stock    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     51!!!   nn_write    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     52   nn_stock    =    8760   ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     53   nn_write    =    8760   ! 1 year at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     54   !! 
    4955   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%) 
    5056   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard 
    … …  
    134140      ln_humi_rlh = .true.  !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
    135141   ! 
    136    cn_dir      = './'      !  root directory for the bulk data location 
     142   cn_dir = './'  !  root directory for the bulk data location 
    137143   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
    138144   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ !       weights filename               ! rotation ! land/sea mask ! 
    … …  
    163169      ln_read_frq = .false.   !  specify whether we must read frq or not 
    164170 
    165    cn_dir      = './'      !  root directory for the ocean data location 
     171   cn_dir      = './'     !  root directory for the ocean data location 
    166172   !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
    167173   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
    … …  
    195201!!                                                                    !! 
    196202!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    197 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    198 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     203!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     204!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    199205!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    200206!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    215221&nameos        !   ocean Equation Of Seawater                           (default: NO selection) 
    216222!----------------------------------------------------------------------- 
    217    ln_eos80    = .true.         !  = Use EOS80 
     223   ln_eos80    = .true.          !  = Use EOS80 
    218224/ 
    219225!!====================================================================== 
    … …  
    244250!!                                                                    !! 
    245251!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    246 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    247252!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    248253!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/STATION_ASF/EXPREF/namelist_ecmwf-noskin_cfg

    r12615 r13710  
    2929   cn_exp      =  'STATION_ASF-ECMWF-noskin'  !  experience name 
    3030   nn_it000    =    1   !  first time step 
    31    nn_itend    =    26280   !  last  time step (std 5840) 
    32    nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     31!!!   nn_itend    =    26304   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     32!!!   nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     33   nn_itend    =    8760   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     34   nn_date0    = 20180101  !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
    3335   nn_time0    =       0   !  initial time of day in hhmm 
    34    nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
     36   nn_leapy    =       1   !  Leap year calendar (1) or not (0) 
    3537   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
    3638      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T) 
    … …  
    4547   nn_istate   =       0   !  output the initial state (1) or not (0) 
    4648   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 
    47    nn_stock    =    26280   ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 
    48    nn_write    =    26280   ! 1year @ dt=3600 s / frequency of write in the output file   (modulo referenced to nn_it000) 
     49   !! 
     50!!!   nn_stock    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     51!!!   nn_write    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     52   nn_stock    =    8760   ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     53   nn_write    =    8760   ! 1 year at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     54   !! 
    4955   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%) 
    5056   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard 
    … …  
    195201!!                                                                    !! 
    196202!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    197 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    198 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     203!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     204!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    199205!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    200206!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    244250!!                                                                    !! 
    245251!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    246 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    247252!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    248253!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/STATION_ASF/EXPREF/namelist_ecmwf_cfg

    r12615 r13710  
    2929   cn_exp      =  'STATION_ASF-ECMWF'  !  experience name 
    3030   nn_it000    =    1   !  first time step 
    31    nn_itend    =    26280   !  last  time step (std 5840) 
    32    nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     31!!!   nn_itend    =    26304   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     32!!!   nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     33   nn_itend    =    8760   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     34   nn_date0    = 20180101  !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
    3335   nn_time0    =       0   !  initial time of day in hhmm 
    34    nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
     36   nn_leapy    =       1   !  Leap year calendar (1) or not (0) 
    3537   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
    3638      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T) 
    … …  
    4547   nn_istate   =       0   !  output the initial state (1) or not (0) 
    4648   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 
    47    nn_stock    =    26280   ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 
    48    nn_write    =    26280   ! 1year @ dt=3600 s / frequency of write in the output file   (modulo referenced to nn_it000) 
     49   !! 
     50!!!   nn_stock    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     51!!!   nn_write    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     52   nn_stock    =    8760   ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     53   nn_write    =    8760   ! 1 year at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     54   !! 
    4955   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%) 
    5056   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard 
    … …  
    134140      ln_humi_rlh = .true.  !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
    135141   ! 
    136    cn_dir      = './'      !  root directory for the bulk data location 
     142   cn_dir = './'  !  root directory for the bulk data location 
    137143   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
    138144   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ !       weights filename               ! rotation ! land/sea mask ! 
    … …  
    163169      ln_read_frq = .false.   !  specify whether we must read frq or not 
    164170 
    165    cn_dir      = './'      !  root directory for the ocean data location 
     171   cn_dir      = './'     !  root directory for the ocean data location 
    166172   !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
    167173   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
    … …  
    195201!!                                                                    !! 
    196202!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    197 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    198 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     203!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     204!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    199205!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    200206!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    215221&nameos        !   ocean Equation Of Seawater                           (default: NO selection) 
    216222!----------------------------------------------------------------------- 
    217    ln_eos80    = .true.         !  = Use EOS80 
     223   ln_eos80    = .true.          !  = Use EOS80 
    218224/ 
    219225!!====================================================================== 
    … …  
    244250!!                                                                    !! 
    245251!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    246 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    247252!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    248253!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/STATION_ASF/EXPREF/namelist_ncar_cfg

    r12615 r13710  
    2929   cn_exp      =  'STATION_ASF-NCAR'  !  experience name 
    3030   nn_it000    =    1   !  first time step 
    31    nn_itend    =    26280   !  last  time step (std 5840) 
    32    nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     31!!!   nn_itend    =    26304   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     32!!!   nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     33   nn_itend    =    8760   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     34   nn_date0    = 20180101  !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
    3335   nn_time0    =       0   !  initial time of day in hhmm 
    34    nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
     36   nn_leapy    =       1   !  Leap year calendar (1) or not (0) 
    3537   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
    3638      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T) 
    … …  
    4547   nn_istate   =       0   !  output the initial state (1) or not (0) 
    4648   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 
    47    nn_stock    =    26280   ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 
    48    nn_write    =    26280   ! 1year @ dt=3600 s / frequency of write in the output file   (modulo referenced to nn_it000) 
     49   !! 
     50!!!   nn_stock    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     51!!!   nn_write    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     52   nn_stock    =    8760   ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     53   nn_write    =    8760   ! 1 year at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     54   !! 
    4955   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%) 
    5056   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard 
    … …  
    134140      ln_humi_rlh = .true.  !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
    135141   ! 
    136    cn_dir      = './'      !  root directory for the bulk data location 
     142   cn_dir = './'  !  root directory for the bulk data location 
    137143   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
    138144   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ !       weights filename               ! rotation ! land/sea mask ! 
    … …  
    163169      ln_read_frq = .false.   !  specify whether we must read frq or not 
    164170 
    165    cn_dir      = './'      !  root directory for the ocean data location 
     171   cn_dir      = './'     !  root directory for the ocean data location 
    166172   !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
    167173   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
    … …  
    195201!!                                                                    !! 
    196202!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    197 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    198 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     203!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     204!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    199205!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    200206!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    215221&nameos        !   ocean Equation Of Seawater                           (default: NO selection) 
    216222!----------------------------------------------------------------------- 
    217    ln_eos80    = .true.         !  = Use EOS80 
     223   ln_eos80    = .true.          !  = Use EOS80 
    218224/ 
    219225!!====================================================================== 
    … …  
    244250!!                                                                    !! 
    245251!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    246 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    247252!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    248253!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/STATION_ASF/EXPREF/plot_station_asf.py

    r12629 r13710  
    1 #!/usr/bin/env python 
     1#!/usr/bin/env python3 
    22# -*- Mode: Python; coding: utf-8; indent-tabs-mode: nil; tab-width: 4 -*- 
    33 
    4 # Post-diagnostic of STATION_ASF /  L. Brodeau, 2019 
     4# Post-diagnostic of STATION_ASF /  L. Brodeau, 2020 
    55 
    66import sys 
    77from os import path as path 
    8 #from string import replace 
    98import math 
    109import numpy as nmp 
    11 #import scipy.signal as signal 
    1210from netCDF4 import Dataset 
    1311import matplotlib as mpl 
    … …  
    1513import matplotlib.pyplot as plt 
    1614import matplotlib.dates as mdates 
    17 #from string import find 
    18 #import warnings 
    19 #warnings.filterwarnings("ignore") 
    20 #import time 
    21  
    22 #import barakuda_plot as bp 
    23 #import barakuda_tool as bt 
    24  
    25 reload(sys) 
    26 sys.setdefaultencoding('utf8') 
    27  
    28 cy1     = '2016' ; # First year 
     15 
     16cy1     = '2018' ; # First year 
    2917cy2     = '2018' ; # Last year 
    30  
    31 jt0 = 0 
    32 jt0 = 17519 
    33  
    3418 
    3519dir_figs='.' 
    … …  
    7256narg = len(sys.argv) 
    7357if narg != 2: 
    74     print 'Usage: '+sys.argv[0]+' <DIR_OUT_SASF>'; sys.exit(0) 
     58    print('Usage: '+sys.argv[0]+' <DIR_OUT_SASF>'); sys.exit(0) 
    7559cdir_data = sys.argv[1] 
    7660 
    … …  
    8266def chck4f(cf): 
    8367    cmesg = 'ERROR: File '+cf+' does not exist !!!' 
    84     if not path.exists(cf): print cmesg ; sys.exit(0) 
     68    if not path.exists(cf): print(cmesg); sys.exit(0) 
    8569 
    8670###cf_in = nmp.empty((), dtype="S10") 
    … …  
    10488# Getting time array from the first file: 
    10589id_in = Dataset(cf_in[0]) 
    106 vt = id_in.variables['time_counter'][jt0:] 
     90vt = id_in.variables['time_counter'][:] 
    10791cunit_t = id_in.variables['time_counter'].units ; print(' "time_counter" is in "'+cunit_t+'"') 
    10892id_in.close() 
    … …  
    138122            if ctest == 'skin':   id_in = Dataset(cf_in[ja]) 
    139123            if ctest == 'noskin': id_in = Dataset(cf_in_ns[ja]) 
    140             xF[:,ja] = id_in.variables[L_VNEM[jv]][jt0:,1,1] # only the center point of the 3x3 spatial domain! 
     124            xF[:,ja] = id_in.variables[L_VNEM[jv]][:,1,1] # only the center point of the 3x3 spatial domain! 
    141125            if ja == 0: cvar_lnm = id_in.variables[L_VNEM[jv]].long_name 
    142126            id_in.close() 
    … …  
    180164                rmlt = 10.**(int(romagn)) / 2. 
    181165                yrng = math.copysign( math.ceil(abs(rmax)/rmlt)*rmlt , rmax) 
    182                 #print 'yrng = ', yrng ;  #sys.exit(0) 
    183166 
    184167                fig = plt.figure(num = 10+jv, figsize=size_fig, facecolor='w', edgecolor='k') 
    … …  
    211194    for ja in range(nb_algos-1): 
    212195        id_in = Dataset(cf_in[ja]) 
    213         xF[:,ja]   = id_in.variables[L_VNEM[jv]][jt0:,1,1] # only the center point of the 3x3 spatial domain! 
     196        xF[:,ja]   = id_in.variables[L_VNEM[jv]][:,1,1] # only the center point of the 3x3 spatial domain! 
    214197        if ja == 0: cvar_lnm = id_in.variables[L_VNEM[jv]].long_name 
    215198        id_in.close() 
    216199        # 
    217200        id_in = Dataset(cf_in_ns[ja]) 
    218         xFns[:,ja] = id_in.variables[L_VNEM[jv]][jt0:,1,1] # only the center point of the 3x3 spatial domain! 
     201        xFns[:,ja] = id_in.variables[L_VNEM[jv]][:,1,1] # only the center point of the 3x3 spatial domain! 
    219202        if ja == 0: cvar_lnm = id_in.variables[L_VNEM[jv]].long_name 
    220203        id_in.close() 
    … …  
    229212    rmlt = 10.**(int(romagn)) / 2. 
    230213    yrng = math.copysign( math.ceil(abs(rmax)/rmlt)*rmlt , rmax) 
    231     print 'yrng = ', yrng ;  #sys.exit(0) 
    232  
    233  
    234  
    235  
     214 
     215     
    236216    for ja in range(nb_algos-1): 
    237217 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/STATION_ASF/MY_SRC/nemogcm.F90

    r12641 r13710  
    3030   USE step_c1d       ! Time stepping loop for the 1D configuration 
    3131   ! 
     32   USE prtctl         ! Print control 
    3233   USE in_out_manager ! I/O manager 
    3334   USE lib_mpp        ! distributed memory computing 
    … …  
    100101      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    101102         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    102          CALL ctl_stop( ctmp1 ) 
     103         WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files' 
     104         CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 
    103105      ENDIF 
    104106      ! 
    … …  
    130132      INTEGER ::   ios, ilocal_comm   ! local integers 
    131133      !! 
    132       NAMELIST/namctl/ sn_cfctl,  nn_print, nn_ictls, nn_ictle,             & 
    133          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    134          &             ln_timing, ln_diacfl 
     134      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                & 
     135         &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle 
    135136      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    136137      !!---------------------------------------------------------------------- 
    … …  
    184185      ! 
    185186      ! finalize the definition of namctl variables 
    186       IF( sn_cfctl%l_allon ) THEN 
    187          ! Turn on all options. 
    188          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    189          ! Ensure all processors are active 
    190          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    191       ELSEIF( sn_cfctl%l_config ) THEN 
    192          ! Activate finer control of report outputs 
    193          ! optionally switch off output from selected areas (note this only 
    194          ! applies to output which does not involve global communications) 
    195          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    196            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    197            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    198       ELSE 
    199          ! turn off all options. 
    200          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    201       ENDIF 
     187      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     188         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    202189      ! 
    203190      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
    … …  
    245232      ! 
    246233      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
    247          CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     234         CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    248235      ELSE                              ! user-defined namelist 
    249          CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     236         CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    250237      ENDIF 
    251238      ! 
    … …  
    308295         WRITE(numout,*) '~~~~~~~~' 
    309296         WRITE(numout,*) '   Namelist namctl' 
    310          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    311          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    312          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    313297         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    314298         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
    … …  
    322306         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    323307         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    324          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    325          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    326          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    327          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    328          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    329          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    330          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    331308         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    332309         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    333310      ENDIF 
    334311      ! 
    335       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    336       nictls    = nn_ictls 
    337       nictle    = nn_ictle 
    338       njctls    = nn_jctls 
    339       njctle    = nn_jctle 
    340       isplt     = nn_isplt 
    341       jsplt     = nn_jsplt 
    342  
     312      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    343313      IF(lwp) THEN                  ! control print 
    344314         WRITE(numout,*) 
    … …  
    351321         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    352322      ENDIF 
    353       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    354       ! 
    355       !                             ! Parameter control 
    356       ! 
    357       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    358          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    359             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    360          ELSE 
    361             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    362                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    363                   &           ' - the print control will be done over the whole domain' ) 
    364             ENDIF 
    365             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    366          ENDIF 
    367          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    368          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    369          ! 
    370          !                              ! indices used for the SUM control 
    371          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    372             lsp_area = .FALSE. 
    373          ELSE                                             ! print control done over a specific  area 
    374             lsp_area = .TRUE. 
    375             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    376                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    377                nictls = 1 
    378             ENDIF 
    379             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    380                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    381                nictle = jpiglo 
    382             ENDIF 
    383             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    384                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    385                njctls = 1 
    386             ENDIF 
    387             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    388                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    389                njctle = jpjglo 
    390             ENDIF 
    391          ENDIF 
    392       ENDIF 
    393323      ! 
    394324      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  & 
    … …  
    446376 
    447377    
    448    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     378   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    449379      !!---------------------------------------------------------------------- 
    450380      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    451381      !! 
    452382      !! ** Purpose :   Set elements of the output control structure to setto. 
    453       !!                for_all should be .false. unless all areas are to be 
    454       !!                treated identically. 
    455383      !! 
    456384      !! ** Method  :   Note this routine can be used to switch on/off some 
    457       !!                types of output for selected areas but any output types 
    458       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    459       !!                should be protected from selective switching by the 
    460       !!                for_all argument 
    461       !!---------------------------------------------------------------------- 
    462       LOGICAL :: setto, for_all 
    463       TYPE(sn_ctl) :: sn_cfctl 
    464       !!---------------------------------------------------------------------- 
    465       IF( for_all ) THEN 
    466          sn_cfctl%l_runstat = setto 
    467          sn_cfctl%l_trcstat = setto 
    468       ENDIF 
     385      !!                types of output for selected areas. 
     386      !!---------------------------------------------------------------------- 
     387      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     388      LOGICAL     , INTENT(in   ) :: setto 
     389      !!---------------------------------------------------------------------- 
     390      sn_cfctl%l_runstat = setto 
     391      sn_cfctl%l_trcstat = setto 
    469392      sn_cfctl%l_oceout  = setto 
    470393      sn_cfctl%l_layout  = setto 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/STATION_ASF/MY_SRC/stpctl.F90

    r12254 r13710  
    1919   USE dom_oce         ! ocean space and time domain variables 
    2020   USE sbc_oce         ! surface fluxes and stuff 
     21   ! 
    2122   USE diawri          ! Standard run outputs       (dia_wri_state routine) 
    22    ! 
    2323   USE in_out_manager  ! I/O manager 
    2424   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2525   USE lib_mpp         ! distributed memory computing 
    26  
     26   ! 
    2727   USE netcdf          ! NetCDF library 
    2828   IMPLICIT NONE 
    … …  
    3131   PUBLIC stp_ctl           ! routine called by step.F90 
    3232 
    33    INTEGER  ::   idrun, idtime, idtau, idqns, idemp, istatus 
    34    LOGICAL  ::   lsomeoce 
     33   INTEGER                ::   nrunid   ! netcdf file id 
     34   INTEGER, DIMENSION(3)  ::   nvarid   ! netcdf variable id 
    3535   !!---------------------------------------------------------------------- 
    3636   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
    … …  
    4040CONTAINS 
    4141 
    42    SUBROUTINE stp_ctl( kt, Kbb, Kmm, kindic ) 
     42   SUBROUTINE stp_ctl( kt, Kmm ) 
    4343      !!---------------------------------------------------------------------- 
    4444      !!                    ***  ROUTINE stp_ctl  *** 
    45       !! 
     45      !!                      
    4646      !! ** Purpose :   Control the run 
    4747      !! 
    4848      !! ** Method  : - Save the time step in numstp 
    49       !!              - Print it each 50 time steps 
    50       !!              - Stop the run IF problem encountered by setting indic=-3 
     49      !!              - Stop the run IF problem encountered by setting nstop > 0 
     50      !!                Problems checked: wind stress module  max larger than 5 N/m^2 
     51      !!                                  non-solar heat flux max larger than 2000 W/m^2 
     52      !!                                  Evaporation-Precip  max larger than 1.E-3 kg/m^2/s 
    5153      !! 
    5254      !! ** Actions :   "time.step" file = last ocean time-step 
    5355      !!                "run.stat"  file = run statistics 
    54       !!                nstop indicator sheared among all local domain (lk_mpp=T) 
     56      !!                 nstop indicator sheared among all local domain 
    5557      !!---------------------------------------------------------------------- 
    5658      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    57       INTEGER, INTENT(in   ) ::   Kbb, Kmm      ! ocean time level index 
    58       INTEGER, INTENT(inout) ::   kindic   ! error indicator 
    59       !! 
    60       REAL(wp), DIMENSION(3) ::   zmax 
    61       LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns 
    62       CHARACTER(len=20) :: clname 
    63       !!---------------------------------------------------------------------- 
    64       ! 
    65       ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
    66       ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 
    67       ll_wrtruns = ll_colruns .AND. lwm 
    68       IF( kt == nit000 .AND. lwp ) THEN 
    69          WRITE(numout,*) 
    70          WRITE(numout,*) 'stp_ctl : time-stepping control' 
    71          WRITE(numout,*) '~~~~~~~' 
    72          !                                ! open time.step file 
    73          IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    74          !                                ! open run.stat file(s) at start whatever 
    75          !                                ! the value of sn_cfctl%ptimincr 
    76          IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 
     59      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index 
     60      !! 
     61      INTEGER                         ::   ji                                    ! dummy loop indices 
     62      INTEGER                         ::   idtime, istatus 
     63      INTEGER , DIMENSION(4)          ::   iareasum, iareamin, iareamax 
     64      INTEGER , DIMENSION(3,3)        ::   iloc                                  ! min/max loc indices 
     65      REAL(wp)                        ::   zzz                                   ! local real  
     66      REAL(wp), DIMENSION(4)          ::   zmax, zmaxlocal 
     67      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce 
     68      LOGICAL, DIMENSION(jpi,jpj)     ::   llmsk 
     69      CHARACTER(len=20)               ::   clname 
     70      !!---------------------------------------------------------------------- 
     71      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
     72      ! 
     73      ll_wrtstp  = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
     74      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1  
     75      ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 
     76      ! 
     77      IF( kt == nit000 ) THEN 
     78         ! 
     79         IF( lwp ) THEN 
     80            WRITE(numout,*) 
     81            WRITE(numout,*) 'stp_ctl : time-stepping control' 
     82            WRITE(numout,*) '~~~~~~~' 
     83         ENDIF 
     84         !                                ! open time.step    ascii file, done only by 1st subdomain 
     85         IF( lwm )   CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     86         ! 
     87         IF( ll_wrtruns ) THEN 
     88            !                             ! open run.stat     ascii file, done only by 1st subdomain 
    7789            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     90            !                             ! open run.stat.nc netcdf file, done only by 1st subdomain 
    7891            clname = 'run.stat.nc' 
    7992            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    80             istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun ) 
    81             istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 
    82             istatus = NF90_DEF_VAR( idrun, 'tau_max', NF90_DOUBLE, (/ idtime /), idtau ) 
    83             istatus = NF90_DEF_VAR( idrun, 'qns_max', NF90_DOUBLE, (/ idtime /), idqns   ) 
    84             istatus = NF90_DEF_VAR( idrun, 'emp_max', NF90_DOUBLE, (/ idtime /), idemp   ) 
    85             istatus = NF90_ENDDEF(idrun) 
    86          ENDIF 
    87       ENDIF 
    88       IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    89       ! 
    90       IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file) 
     93            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 
     94            istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 
     95            istatus = NF90_DEF_VAR( nrunid, 'tau_max', NF90_DOUBLE, (/ idtime /), nvarid(1) ) 
     96            istatus = NF90_DEF_VAR( nrunid, 'qns_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 
     97            istatus = NF90_DEF_VAR( nrunid, 'emp_max', NF90_DOUBLE, (/ idtime /), nvarid(3) ) 
     98            istatus = NF90_ENDDEF(nrunid) 
     99         ENDIF 
     100         !     
     101      ENDIF 
     102      ! 
     103      !                                   !==              write current time step              ==! 
     104      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
     105      IF( lwm .AND. ll_wrtstp ) THEN 
    91106         WRITE ( numstp, '(1x, i8)' )   kt 
    92107         REWIND( numstp ) 
    93108      ENDIF 
    94       ! 
    95       !                                   !==  test of extrema  ==! 
    96       zmax(1) = MAXVAL(     taum(:,:)   , mask = tmask(:,:,1) == 1._wp )                                         ! max wind stress module 
    97       zmax(2) = MAXVAL( ABS( qns(:,:) ) , mask = tmask(:,:,1) == 1._wp )                                         ! max non-solar heat flux 
    98       zmax(3) = MAXVAL( ABS( emp(:,:) ) , mask = tmask(:,:,1) == 1._wp )                                         ! max E-P 
    99       ! 
     109      !                                   !==            test of local extrema           ==! 
     110      !                                   !==  done by all processes at every time step  ==! 
     111      ! 
     112      llmsk(   1:Nis1,:) = .FALSE.                                              ! exclude halos from the checked region 
     113      llmsk(Nie1: jpi,:) = .FALSE. 
     114      llmsk(:,   1:Njs1) = .FALSE. 
     115      llmsk(:,Nje1: jpj) = .FALSE. 
     116      ! 
     117      llmsk(Nis0:Nie0,Njs0:Nje0) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp        ! test only the inner domain 
     118      ! 
     119      ll_0oce = .NOT. ANY( llmsk(:,:) )                                         ! no ocean point in the inner domain? 
     120      ! 
     121      zmax(1) = MAXVAL(     taum(:,:)  , mask = llmsk )                         ! max wind stress module 
     122      zmax(2) = MAXVAL( ABS( qns(:,:) ), mask = llmsk )                         ! max non-solar heat flux 
     123      zmax(3) = MAXVAL( ABS( emp(:,:) ), mask = llmsk )                         ! max E-P 
     124      zmax(4) = REAL( nstop, wp )                                               ! stop indicator 
     125      ! 
     126      !                                   !==               get global extrema             ==! 
     127      !                                   !==  done by all processes if writting run.stat  ==! 
    100128      IF( ll_colruns ) THEN 
     129         zmaxlocal(:) = zmax(:) 
    101130         CALL mpp_max( "stpctl", zmax )          ! max over the global domain 
    102          nstop = NINT( zmax(3) )                 ! nstop indicator sheared among all local domains 
    103       ENDIF 
    104       !                                   !==  run statistics  ==!   ("run.stat" files) 
     131         nstop = NINT( zmax(4) )                 ! update nstop indicator (now sheared among all local domains) 
     132      ELSE 
     133         ! if no ocean point: MAXVAL returns -HUGE => we must overwrite this value to avoid error handling bellow. 
     134         IF( ll_0oce )   zmax(1:3) = 0._wp       ! default "valid" values... 
     135      ENDIF 
     136      !                                   !==               error handling               ==! 
     137      !                                   !==              write "run.stat" files              ==! 
     138      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
    105139      IF( ll_wrtruns ) THEN 
    106140         WRITE(numrun,9500) kt, zmax(1), zmax(2), zmax(3) 
    107          istatus = NF90_PUT_VAR( idrun, idtau, (/ zmax(1)/), (/kt/), (/1/) ) 
    108          istatus = NF90_PUT_VAR( idrun, idqns, (/ zmax(2)/), (/kt/), (/1/) ) 
    109          istatus = NF90_PUT_VAR( idrun, idemp, (/ zmax(3)/), (/kt/), (/1/) ) 
    110          IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 
    111          IF( kt == nitend         ) istatus = NF90_CLOSE(idrun) 
     141         DO ji = 1, 3 
     142            istatus = NF90_PUT_VAR( nrunid, nvarid(ji), (/zmax(ji)/), (/kt/), (/1/) ) 
     143         END DO 
     144         IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 
    112145      END IF 
    113       !                                   !==  error handling  ==! 
    114       IF( ( sn_cfctl%l_glochk .OR. lsomeoce ) .AND. (   &  ! domain contains some ocean points, check for sensible ranges 
    115          &  zmax(1) >    5._wp .OR.   &             ! too large wind stress ( > 5 N/m^2 ) 
    116          &  zmax(2) > 2000._wp .OR.   &             ! too large non-solar heat flux ( > 2000 W/m^2) 
    117          &  zmax(3) > 1.E-3_wp .OR.   &             ! too large net freshwater flux ( kg/m^2/s) 
    118          &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN   ! NaN encounter in the tests 
    119  
    120          !! We are 1D so no need to find a spatial location of the rogue point. 
    121  
     146      !                                   !==               error handling               ==! 
     147      !                                   !==  done by all processes at every time step  ==! 
     148      ! 
     149      IF(   zmax(1) >    5._wp .OR.   &                   ! too large wind stress         ( > 5 N/m^2 ) 
     150         &  zmax(2) > 2000._wp .OR.   &                   ! too large non-solar heat flux ( > 2000 W/m^2 ) 
     151         &  zmax(3) > 1.E-3_wp .OR.   &                   ! too large net freshwater flux ( > 1.E-3 kg/m^2/s ) 
     152         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR.   &               ! NaN encounter in the tests 
     153         &  ABS(   zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
     154         ! 
     155         iloc(:,:) = 0 
     156         IF( ll_colruns ) THEN   ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 
     157            ! first: close the netcdf file, so we can read it 
     158            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
     159            ! get global loc on the min/max 
     160            CALL mpp_maxloc( 'stpctl',    taum(:,:)  , llmsk, zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     161            CALL mpp_maxloc( 'stpctl',ABS( qns(:,:) ), llmsk, zzz, iloc(1:2,2) ) 
     162            CALL mpp_minloc( 'stpctl',ABS( emp(:,:) ), llmsk, zzz, iloc(1:2,3) ) 
     163            ! find which subdomain has the max. 
     164            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
     165            DO ji = 1, 4 
     166               IF( zmaxlocal(ji) == zmax(ji) ) THEN 
     167                  iareamin(ji) = narea   ;   iareamax(ji) = narea   ;   iareasum(ji) = 1 
     168               ENDIF 
     169            END DO 
     170            CALL mpp_min( "stpctl", iareamin )         ! min over the global domain 
     171            CALL mpp_max( "stpctl", iareamax )         ! max over the global domain 
     172            CALL mpp_sum( "stpctl", iareasum )         ! sum over the global domain 
     173         ELSE                    ! find local min and max locations: 
     174            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
     175            iloc(1:2,1) = MAXLOC(     taum(:,:)  , mask = llmsk ) 
     176            iloc(1:2,2) = MAXLOC( ABS( qns(:,:) ), mask = llmsk ) 
     177            iloc(1:2,3) = MINLOC( ABS( emp(:,:) ), mask = llmsk ) 
     178            DO ji = 1, 3   ! local domain indices ==> global domain indices, excluding halos 
     179               iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 
     180            END DO 
     181            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
     182         ENDIF 
     183         ! 
    122184         WRITE(ctmp1,*) ' stp_ctl: |tau_mod| > 5 N/m2  or  |qns| > 2000 W/m2  or |emp| > 1.E-3 or  NaN encounter in the tests' 
    123          WRITE(ctmp2,9500) kt,   zmax(1), zmax(2), zmax(3) 
    124          WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort.nc file' 
    125  
     185         CALL wrt_line( ctmp2, kt, '|tau| max',  zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
     186         CALL wrt_line( ctmp3, kt, '|qns| max',  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
     187         CALL wrt_line( ctmp4, kt, 'emp   max',  zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 
     188         IF( Agrif_Root() ) THEN 
     189            WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort* files' 
     190         ELSE 
     191            WRITE(ctmp6,*) '      ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 
     192         ENDIF 
     193         ! 
    126194         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file 
    127  
    128          IF( .NOT. sn_cfctl%l_glochk ) THEN 
    129             WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea 
    130             CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ' ', ctmp6, ' ' ) 
    131          ELSE 
    132             CALL ctl_stop( ctmp1, ' ', ctmp2, ' ', ctmp6, ' ' ) 
    133          ENDIF 
    134  
    135          kindic = -3 
    136          ! 
     195         ! 
     196         IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
     197            IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     198            ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
     199            ENDIF 
     200         ELSE                                    ! only mpi subdomains with errors are here -> STOP now 
     201            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     202         ENDIF 
     203         ! 
     204      ENDIF 
     205      ! 
     206      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet... 
     207         ngrdstop = Agrif_Fixed()                                           ! store which grid got this error 
     208         IF( .NOT. ll_colruns .AND. jpnij > 1 )   CALL ctl_stop( 'STOP' )   ! we must abort here to avoid MPI deadlock 
    137209      ENDIF 
    138210      ! 
    … …  
    140212      ! 
    141213   END SUBROUTINE stp_ctl 
     214 
     215 
     216   SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 
     217      !!---------------------------------------------------------------------- 
     218      !!                     ***  ROUTINE wrt_line  *** 
     219      !! 
     220      !! ** Purpose :   write information line 
     221      !! 
     222      !!---------------------------------------------------------------------- 
     223      CHARACTER(len=*),      INTENT(  out) ::   cdline 
     224      CHARACTER(len=*),      INTENT(in   ) ::   cdprefix 
     225      REAL(wp),              INTENT(in   ) ::   pval 
     226      INTEGER, DIMENSION(3), INTENT(in   ) ::   kloc 
     227      INTEGER,               INTENT(in   ) ::   kt, ksum, kmin, kmax 
     228      ! 
     229      CHARACTER(len=80) ::   clsuff 
     230      CHARACTER(len=9 ) ::   clkt, clsum, clmin, clmax 
     231      CHARACTER(len=9 ) ::   cli, clj, clk 
     232      CHARACTER(len=1 ) ::   clfmt 
     233      CHARACTER(len=4 ) ::   cl4   ! needed to be able to compile with Agrif, I don't know why 
     234      INTEGER           ::   ifmtk 
     235      !!---------------------------------------------------------------------- 
     236      WRITE(clkt , '(i9)') kt 
     237       
     238      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
     239      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
     240      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum 
     241      WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1    ! how many digits to we need to write ? (we decide max = 9) 
     242      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1 
     243                                   WRITE(clmax, cl4) kmax-1 
     244      ! 
     245      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1      ! how many digits to we need to write jpiglo? (we decide max = 9) 
     246      cl4 = '(i'//clfmt//')'   ;   WRITE(cli, cl4) kloc(1)      ! this is ok with AGRIF 
     247      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1      ! how many digits to we need to write jpjglo? (we decide max = 9) 
     248      cl4 = '(i'//clfmt//')'   ;   WRITE(clj, cl4) kloc(2)      ! this is ok with AGRIF 
     249      ! 
     250      IF( ksum == 1 ) THEN   ;   WRITE(clsuff,9100) TRIM(clmin) 
     251      ELSE                   ;   WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 
     252      ENDIF 
     253      IF(kloc(3) == 0) THEN 
     254         ifmtk = INT(LOG10(REAL(jpk,wp))) + 1                   ! how many digits to we need to write jpk? (we decide max = 9) 
     255         clk = REPEAT(' ', ifmtk)                               ! create the equivalent in blank string 
     256         WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 
     257      ELSE 
     258         WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1      ! how many digits to we need to write jpk? (we decide max = 9) 
     259         !!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF 
     260         cl4 = '(i'//clfmt//')'   ;   WRITE(clk, cl4) kloc(3)   ! this is ok with AGRIF 
     261         WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj),    TRIM(clk), TRIM(clsuff) 
     262      ENDIF 
     263      ! 
     2649100  FORMAT('MPI rank ', a) 
     2659200  FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 
     2669300  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j   ', a, ' ', a, ' ', a, ' ', a) 
     2679400  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 
     268      ! 
     269   END SUBROUTINE wrt_line 
     270 
    142271 
    143272   !!====================================================================== 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90

    r12629 r13710  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain 
    1716   USE c1d      ,  ONLY: rn_lon1d, rn_lat1d ! ocean lon/lat define by namelist 
    1817   USE par_oce        ! ocean space and time domain 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/STATION_ASF/MY_SRC/usrdef_nam.F90

    r12629 r13710  
    1515   !!   usr_def_hgr   : initialize the horizontal mesh  
    1616   !!---------------------------------------------------------------------- 
    17    USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain 
    18 !!!   USE dom_oce  , ONLY: ln_zco, ln_zps, ln_sco   ! flag of type of coordinate 
    1917   USE par_oce        ! ocean space and time domain 
    2018   USE phycst         ! physical constants 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/STATION_ASF/README.md

    r12031 r13710  
     1# *Station Air-Sea Fluxes* demonstration case 
    12 
    2 ## WARNING: TOTALLY-ALPHA-STUFF / DOCUMENT IN THE PROCESS OF BEING WRITEN! 
     3Last successful test done with NEMOGCM trunk: `r13263` 
    34 
    4 # *Station Air-Sea Fluxes* demonstration case 
     5Author: Laurent Brodeau, 2020 
     6 
     7NOTE: if working with the trunk of NEMO, you are strongly advised to use the same test-case but on the `NEMO-examples` GitHub depo: 
     8https://github.com/NEMO-ocean/NEMO-examples/tree/master/STATION_ASF 
    59 
    610## Objectives 
    711 
    8 ```STATION_ASF``` is a demonstration case that mimics an in-situ station (buoy, platform) dedicated to the estimation of surface air-sea fluxes by means of the measurement of traditional meteorological surface parameters. 
     12```STATION_ASF``` is a demonstration test-case that mimics a (static) in-situ station (buoy, platform) dedicated to the estimation of surface air-sea fluxes by means of *widely-measured* (bulk) meteorological surface parameters. 
    913 
    10 ```STATION_ASF``` is based on the merging of the "single column" and the "standalone surface module" configurations of NEMO. In short, it coulb defined as "SAS meets C1D". As such, the spatial domain of ```STATION_ASF``` is punctual (1D, well actually 3 x 3 as in C1D). 
     14```STATION_ASF``` has been constructed by merging the *single column* and the *standalone surface module* configurations of NEMO. In short, it can be defined as "SAS meets C1D". As such, the spatial domain of ```STATION_ASF``` is punctual (1D, well actually 3 x 3 as in C1D). 
    1115 
    12 ```STATION_ASF``` is therefore a versatile tool, and extremely light in terms of computing requirements, to test the different bulk algorithms and cool-skin/warm-layer parameterization options included in NEMO. 
     16```STATION_ASF``` is therefore a versatile tool, and extremely lightweight in terms of computing requirements, to test the different bulk algorithms and cool-skin/warm-layer parameterization options included in NEMO. 
    1317 
    1418As input ```STATION_ASF``` will require the traditional *bulk* sea surface parameters: 
    1519 
    16 - sea surface temperature (SST) at $z_{SST}$ meters below the surface 
     20- Bulk sea surface temperature (SST) at _z<sub>SST</sub>_ meters below the surface 
    1721- Surface current vector 
    1822- Sea surface salinity 
    … …  
    2024as well as the usual surface atmospheric state: 
    2125 
    22 - air temperature at $z_t$ meters above the surface 
    23 - air humidity  at $z_t$ meters above the surface (specific humidity or relative humidity or dew-point temperature) 
    24 - wind speed vector at $z_u$ meters above the surface 
     26- air temperature at _z<sub>t</sub>_ meters above the surface 
     27- air humidity  at _z<sub>t</sub>_ meters above the surface (specific humidity or relative humidity or dew-point temperature) 
     28- wind speed vector at _z<sub>u</sub>_ meters above the surface 
    2529- Sea level atmospheric pressure (SLP) 
    2630- Downwelling solar radiation 
    2731- Downwelling longwave radiation 
    2832 
     33### Example of diagnostics from `STATION_ASF` 
     34 
     35(Generated with script `./EXPREF/plot_station_asf_simple.py`) 
     36 
     37![plot](https://github.com/NEMO-ocean/NEMO-examples/blob/master/STATION_ASF/figs/01_temperatures_ECMWF.svg) 
     38 
     39![plot](https://github.com/NEMO-ocean/NEMO-examples/blob/master/STATION_ASF/figs/Cd.svg) 
     40 
     41![plot](https://github.com/NEMO-ocean/NEMO-examples/blob/master/STATION_ASF/figs/dT_skin.svg) 
     42 
     43![plot](https://github.com/NEMO-ocean/NEMO-examples/blob/master/STATION_ASF/figs/Qlat.svg) 
    2944 
    3045 
    3146## Physical description 
    3247 
    33 ### Important namelist parameters speficic to STATION_ASF 
     48### Important namelist parameters specific to STATION_ASF 
    3449 
    35 * ```rn_dept1@namusr_def:``` depth (m) at which the prescribed SST is taken (i.e. depth of first T-point); important due to impact on warm-layer estimate, the deeper, the more pronounced! 
     50* ```rn_dept1@namusr_def:``` depth (m) at which the prescribed SST is taken (*i.e.* depth of first T-point); important due to impact on warm-layer estimate, the deeper, the more pronounced! 
    3651 
    3752* ```rn_lat1d,rn_lon1d@namc1d:``` fixed coordinates of the location of the station (buoy, platform, etc). 
    … …  
    4560## Input files to test STATION ASF 
    4661 
    47 Three full years of processed hourly data from the PAPA station (buoy) can be downloaded here: 
    48 https://drive.google.com/file/d/1MxNvjhRHmMrL54y6RX7WIaM9-LGl--ZP/ 
     62One full year (2018) of processed hourly data from the PAPA station (buoy) is found into the `input_data` directory. 
     63These three files are everything you need to play with the set of *namelists* provided for this test-case. 
    4964 
    50 These three files are everything you need to play with the set of namelists provided for this test-case. 
    51  
    52 - ```Station_PAPA_50N-145W_atm_hourly.nc```  → contains hourly surface atmospheric state 
    53 - ```Station_PAPA_50N-145W_precip_daily.nc``` → contains daily precipitation 
    54 - ```Station_PAPA_50N-145W_oce_hourly.nc``` → contains hourly sea surface state 
     65- ```Station_PAPA_50N-145W_atm_hourly_y2018.nc```  → contains hourly surface atmospheric state 
     66- ```Station_PAPA_50N-145W_precip_daily_y2018.nc``` → contains daily precipitation 
     67- ```Station_PAPA_50N-145W_oce_hourly_y2018.nc``` → contains hourly sea surface state 
    5568 
    5669For station PAPA (50.1 N, 144.9 W), air temperature and humidity are measured at 2.5 m, the wind speed at 4 m, and the SST at 1 m below the surface, hence the following namelist parameters are given: 
    5770 
    58 - ```rn_dept1 =    1.  ``` (&namusr_def) 
    59 - ```rn_lat1d =  50.1 ``` (&namc1d) 
    60 - ```rn_lon1d = 215.1``` (&namc1d) 
    61 - ```rn_zqt   =   2.5``` (&namsbc_blk) 
    62 - ```rn_zu    =    4.``` (&namsbc_blk) 
     71- `&namusr_def` 
     72  - ```rn_dept1 =    1.  ``` 
     73- `&namc1d` 
     74  - ```rn_lat1d =  50.1 ``` 
     75  - ```rn_lon1d = 215.1``` 
     76- `&namsbc_blk` 
     77  - ```rn_zqt   =   2.5``` 
     78  - ```rn_zu    =    4.``` 
    6379 
    6480 
    … …  
    6884First compile the test-case as follows (compile with xios-2.5 support → check your ARCH file): 
    6985 
    70 ```./makenemo -m <your_arch> -n STATION_ASF -j 4 -a STATION_ASF``` 
     86```./makenemo -a STATION_ASF -m <your_arch> -n STATION_ASF2 -j 4``` 
    7187 
    7288Then you can use the script ``launch_sasf.sh`` found in  ```EXPREF/``` to launch 3 simulations (one for each bulk parameterization available). You need to adapt the following variable to your environment in the script: 
    7389 
    74 - ```NEMO_DIR``` : NEMO root directory where to fetch compiled STATION_ASF ```nemo.exe``` + setup (such as ```${NEMO_DIR}/tests/STATION_ASF```) 
     90- ```NEMO_ROOT_DIR``` : NEMO root directory where to fetch compiled STATION_ASF ```nemo.exe``` + setup (such as ```${NEMO_ROOT_DIR}/tests/STATION_ASF```) 
    7591 
    76 - ```WORK_DIR``` :  Directory where to run the simulation 
     92- ```PROD_DIR``` :  Directory where to run the simulation 
    7793 
    78 - ```FORC_DIR```  Directory containing sea-surface + atmospheric forcings (get it there https://drive.google.com/file/d/1MxNvjhRHmMrL54y6RX7WIaM9-LGl--ZP/) 
     94- ```DATA_IN_DIR``` : Directory containing sea-surface + atmospheric forcings (found here in ```input_data/```) 
    7995 
     96If everything goes according to plan, ``launch_sasf.sh`` should have generated the 3 following sets of output files into `${PROD_DIR}/output`: 
     97 
     98    STATION_ASF-COARE3p6_1h_20180101_20181231_gridT.nc 
     99    STATION_ASF-COARE3p6_1h_20180101_20181231_gridU.nc  
     100    STATION_ASF-COARE3p6_1h_20180101_20181231_gridV.nc  
     101    STATION_ASF-ECMWF_1h_20180101_20181231_gridT.nc  
     102    STATION_ASF-ECMWF_1h_20180101_20181231_gridU.nc  
     103    STATION_ASF-ECMWF_1h_20180101_20181231_gridV.nc  
     104    STATION_ASF-NCAR_1h_20180101_20181231_gridT.nc  
     105    STATION_ASF-NCAR_1h_20180101_20181231_gridU.nc  
     106    STATION_ASF-NCAR_1h_20180101_20181231_gridV.nc 
     107 
     108--- 
     109 
     110*/Laurent, July 2020.* 
     111 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/EXPREF/1_context_nemo.xml

    r12276 r13710  
    1111       <variable id="ref_month" type="int"> 01 </variable> 
    1212       <variable id="ref_day"   type="int"> 01 </variable> 
    13        <variable id="rau0"      type="float" > 1026.0 </variable> 
     13       <variable id="rho0"      type="float" > 1026.0 </variable> 
    1414       <variable id="cpocean"   type="float" > 3991.86795711963 </variable> 
    1515       <variable id="convSpsu"  type="float" > 0.99530670233846  </variable> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/EXPREF/1_namelist_cfg

    r12489 r13710  
    9898&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    9999!----------------------------------------------------------------------- 
    100    ln_spc_dyn    = .true.  !  use 0 as special value for dynamics 
    101    rn_sponge_tra =  800.   !  coefficient for tracer   sponge layer [m2/s] 
    102    rn_sponge_dyn =  800.   !  coefficient for dynamics sponge layer [m2/s] 
    103    ln_chk_bathy  = .FALSE. ! 
     100   rn_sponge_tra =  0.00768   !  coefficient for tracer   sponge layer [] 
     101   rn_sponge_dyn =  0.00768   !  coefficient for dynamics sponge layer [] 
    104102/ 
    105103!!====================================================================== 
    … …  
    107105!!                                                                    !! 
    108106!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    109 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    110 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     107!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     108!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    111109!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    112110!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    116114&namdrg        !   top/bottom drag coefficient                          (default: NO selection) 
    117115!----------------------------------------------------------------------- 
    118    ln_OFF     = .true.    !  free-slip       : Cd = 0 
     116   ln_drg_OFF = .true.     !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    119117/ 
    120118!!====================================================================== 
    … …  
    133131!----------------------------------------------------------------------- 
    134132   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    135       !                            !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     133      !                            !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    136134      rn_a0       =  0.28        !  thermal expension coefficient (for simplified equation of state) 
    137135      rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state) 
    … …  
    268266!!                                                                    !! 
    269267!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    270 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    271268!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    272269!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/EXPREF/context_nemo.xml

    r12276 r13710  
    1111       <variable id="ref_month" type="int"> 01 </variable> 
    1212       <variable id="ref_day"   type="int"> 01 </variable> 
    13        <variable id="rau0"      type="float" > 1026.0 </variable> 
     13       <variable id="rho0"      type="float" > 1026.0 </variable> 
    1414       <variable id="cpocean"   type="float" > 3991.86795711963 </variable> 
    1515       <variable id="convSpsu"  type="float" > 0.99530670233846  </variable> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/EXPREF/namelist_cfg

    r12489 r13710  
    9999!!                                                                    !! 
    100100!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    101 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    102 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     101!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     102!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    103103!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    104104!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    108108&namdrg        !   top/bottom drag coefficient                          (default: NO selection) 
    109109!----------------------------------------------------------------------- 
    110    ln_OFF     = .true.    !  free-slip       : Cd = 0 
     110   ln_drg_OFF  = .true.   !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    111111/ 
    112112!!====================================================================== 
    … …  
    125125!----------------------------------------------------------------------- 
    126126   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    127    !                            !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     127   !                            !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    128128   rn_a0       =  0.28        !  thermal expension coefficient (for simplified equation of state) 
    129129   rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state) 
    … …  
    259259!!                                                                    !! 
    260260!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    261 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    262261!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    263262!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/MY_SRC/domvvl.F90

    r12489 r13710  
    99   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability 
    1010   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping 
     11   !!            4.x  ! 2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio 
    1112   !!---------------------------------------------------------------------- 
    1213 
    13    !!---------------------------------------------------------------------- 
    14    !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
    15    !!   dom_vvl_sf_nxt   : Compute next vertical scale factors 
    16    !!   dom_vvl_sf_update   : Swap vertical scale factors and update the vertical grid 
    17    !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 
    18    !!   dom_vvl_rst      : read/write restart file 
    19    !!   dom_vvl_ctl      : Check the vvl options 
    20    !!---------------------------------------------------------------------- 
    2114   USE oce             ! ocean dynamics and tracers 
    2215   USE phycst          ! physical constant 
    … …  
    3629   PRIVATE 
    3730 
    38    PUBLIC  dom_vvl_init       ! called by domain.F90 
    39    PUBLIC  dom_vvl_zgr        ! called by isfcpl.F90 
    40    PUBLIC  dom_vvl_sf_nxt     ! called by step.F90 
    41    PUBLIC  dom_vvl_sf_update  ! called by step.F90 
    42    PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
    43  
    4431   !                                                      !!* Namelist nam_vvl 
    4532   LOGICAL , PUBLIC :: ln_vvl_zstar           = .FALSE.    ! zstar  vertical coordinate 
    … …  
    6350   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence 
    6451 
     52#if defined key_qco 
     53   !!---------------------------------------------------------------------- 
     54   !!   'key_qco'      EMPTY MODULE      Quasi-Eulerian vertical coordonate 
     55   !!---------------------------------------------------------------------- 
     56#else 
     57   !!---------------------------------------------------------------------- 
     58   !!   Default key      Old management of time varying vertical coordinate 
     59   !!---------------------------------------------------------------------- 
     60    
     61   !!---------------------------------------------------------------------- 
     62   !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
     63   !!   dom_vvl_sf_nxt   : Compute next vertical scale factors 
     64   !!   dom_vvl_sf_update   : Swap vertical scale factors and update the vertical grid 
     65   !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 
     66   !!   dom_vvl_rst      : read/write restart file 
     67   !!   dom_vvl_ctl      : Check the vvl options 
     68   !!---------------------------------------------------------------------- 
     69 
     70   PUBLIC  dom_vvl_init       ! called by domain.F90 
     71   PUBLIC  dom_vvl_zgr        ! called by isfcpl.F90 
     72   PUBLIC  dom_vvl_sf_nxt     ! called by step.F90 
     73   PUBLIC  dom_vvl_sf_update  ! called by step.F90 
     74   PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
     75    
     76   !! * Substitutions 
     77#  include "do_loop_substitute.h90" 
    6578   !!---------------------------------------------------------------------- 
    6679   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    133146      ! 
    134147   END SUBROUTINE dom_vvl_init 
    135    ! 
     148 
     149 
    136150   SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa) 
    137151      !!---------------------------------------------------------------------- 
    … …  
    188202      gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 
    189203      gdepw(:,:,1,Kbb) = 0.0_wp 
    190       DO jk = 2, jpk                               ! vertical sum 
    191          DO jj = 1,jpj 
    192             DO ji = 1,jpi 
    193                !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    194                !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
    195                !                             ! 0.5 where jk = mikt      
     204      DO_3D( 1, 1, 1, 1, 2, jpk ) 
     205         !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
     206         !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
     207         !                             ! 0.5 where jk = mikt      
    196208!!gm ???????   BUG ?  gdept(:,:,:,Kmm) as well as gde3w  does not include the thickness of ISF ?? 
    197                zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 
    198                gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
    199                gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  & 
    200                   &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm))  
    201                gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
    202                gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 
    203                gdept(ji,jj,jk,Kbb) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb))  & 
    204                   &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb))  
    205             END DO 
    206          END DO 
    207       END DO 
     209         zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 
     210         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
     211         gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  & 
     212            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm))  
     213         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
     214         gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 
     215         gdept(ji,jj,jk,Kbb) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb))  & 
     216            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb))  
     217      END_3D 
    208218      ! 
    209219      !                    !==  thickness of the water column  !!   (ocean portion only) 
    … …  
    240250         ENDIF 
    241251         IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator 
    242             DO jj = 1, jpj 
    243                DO ji = 1, jpi 
     252            DO_2D( 1, 1, 1, 1 ) 
    244253!!gm  case |gphi| >= 6 degrees is useless   initialized just above by default 
    245                   IF( ABS(gphit(ji,jj)) >= 6.) THEN 
    246                      ! values outside the equatorial band and transition zone (ztilde) 
    247                      frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp ) 
    248                      frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 
    249                   ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star 
    250                      ! values inside the equatorial band (ztilde as zstar) 
    251                      frq_rst_e3t(ji,jj) =  0.0_wp 
    252                      frq_rst_hdv(ji,jj) =  1.0_wp / rn_Dt 
    253                   ELSE                                      ! transition band (2.5 to 6 degrees N/S) 
    254                      !                                      ! (linearly transition from z-tilde to z-star) 
    255                      frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   & 
    256                         &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  & 
    257                         &                                          * 180._wp / 3.5_wp ) ) 
    258                      frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt)                                & 
    259                         &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp   & 
    260                         &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  & 
    261                         &                                          * 180._wp / 3.5_wp ) ) 
    262                   ENDIF 
    263                END DO 
    264             END DO 
     254               IF( ABS(gphit(ji,jj)) >= 6.) THEN 
     255                  ! values outside the equatorial band and transition zone (ztilde) 
     256                  frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp ) 
     257                  frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 
     258               ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star 
     259                  ! values inside the equatorial band (ztilde as zstar) 
     260                  frq_rst_e3t(ji,jj) =  0.0_wp 
     261                  frq_rst_hdv(ji,jj) =  1.0_wp / rn_Dt 
     262               ELSE                                      ! transition band (2.5 to 6 degrees N/S) 
     263                  !                                      ! (linearly transition from z-tilde to z-star) 
     264                  frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   & 
     265                     &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  & 
     266                     &                                          * 180._wp / 3.5_wp ) ) 
     267                  frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt)                                & 
     268                     &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp   & 
     269                     &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  & 
     270                     &                                          * 180._wp / 3.5_wp ) ) 
     271               ENDIF 
     272            END_2D 
    265273            IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
    266274               IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
    267                   ii0 = 103   ;   ii1 = 111        
    268                   ij0 = 128   ;   ij1 = 135   ;    
     275                  ii0 = 103 + nn_hls - 1   ;   ii1 = 111 + nn_hls - 1       
     276                  ij0 = 128 + nn_hls       ;   ij1 = 135 + nn_hls 
    269277                  frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
    270278                  frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rn_Dt 
    … …  
    326334      LOGICAL                ::   ll_do_bclinic         ! local logical 
    327335      REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
    328       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t 
     336      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ze3t 
     337      LOGICAL , DIMENSION(:,:,:), ALLOCATABLE ::   llmsk 
    329338      !!---------------------------------------------------------------------- 
    330339      ! 
    … …  
    357366      END DO 
    358367      ! 
    359       IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate ! 
    360          !                                                            ! ------baroclinic part------ ! 
     368      IF( (ln_vvl_ztilde .OR. ln_vvl_layer) .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate ! 
     369         !                                                               ! ------baroclinic part------ ! 
    361370         ! I - initialization 
    362371         ! ================== 
    … …  
    411420         zwu(:,:) = 0._wp 
    412421         zwv(:,:) = 0._wp 
    413          DO jk = 1, jpkm1        ! a - first derivative: diffusive fluxes 
    414             DO jj = 1, jpjm1 
    415                DO ji = 1, jpim1   ! vector opt. 
    416                   un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           & 
    417                      &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
    418                   vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           &  
    419                      &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) ) 
    420                   zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 
    421                   zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 
    422                END DO 
    423             END DO 
    424          END DO 
    425          DO jj = 1, jpj          ! b - correction for last oceanic u-v points 
    426             DO ji = 1, jpi 
    427                un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 
    428                vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 
    429             END DO 
    430          END DO 
    431          DO jk = 1, jpkm1        ! c - second derivative: divergence of diffusive fluxes 
    432             DO jj = 2, jpjm1 
    433                DO ji = 2, jpim1   ! vector opt. 
    434                   tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    & 
    435                      &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    & 
    436                      &                                            ) * r1_e1e2t(ji,jj) 
    437                END DO 
    438             END DO 
    439          END DO 
     422         DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     423            un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           & 
     424               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
     425            vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           &  
     426               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) ) 
     427            zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 
     428            zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 
     429         END_3D 
     430         DO_2D( 1, 1, 1, 1 ) 
     431            un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 
     432            vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 
     433         END_2D 
     434         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     435            tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    & 
     436               &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    & 
     437               &                                            ) * r1_e1e2t(ji,jj) 
     438         END_3D 
    440439         !                       ! d - thickness diffusion transport: boundary conditions 
    441440         !                             (stored for tracer advction and continuity equation) 
    … …  
    444443         ! 4 - Time stepping of baroclinic scale factors 
    445444         ! --------------------------------------------- 
    446          ! Leapfrog time stepping 
    447          ! ~~~~~~~~~~~~~~~~~~~~~~ 
    448445         CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 
    449446         tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + rDt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 
    … …  
    451448         ! Maximum deformation control 
    452449         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    453          ze3t(:,:,jpk) = 0._wp 
    454          DO jk = 1, jpkm1 
    455             ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    456          END DO 
    457          z_tmax = MAXVAL( ze3t(:,:,:) ) 
    458          CALL mpp_max( 'domvvl', z_tmax )                 ! max over the global domain 
    459          z_tmin = MINVAL( ze3t(:,:,:) ) 
    460          CALL mpp_min( 'domvvl', z_tmin )                 ! min over the global domain 
     450         ALLOCATE( ze3t(jpi,jpj,jpk), llmsk(jpi,jpj,jpk) ) 
     451         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     452            ze3t(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) / e3t_0(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     453         END_3D 
     454         ! 
     455         llmsk(   1:Nis1,:,:) = .FALSE.   ! exclude halos from the checked region 
     456         llmsk(Nie1: jpi,:,:) = .FALSE. 
     457         llmsk(:,   1:Njs1,:) = .FALSE. 
     458         llmsk(:,Nje1: jpj,:) = .FALSE. 
     459         ! 
     460         llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp                  ! define only the inner domain 
     461         z_tmax = MAXVAL( ze3t(:,:,:), mask = llmsk )   ;   CALL mpp_max( 'domvvl', z_tmax )   ! max over the global domain 
     462         z_tmin = MINVAL( ze3t(:,:,:), mask = llmsk )   ;   CALL mpp_min( 'domvvl', z_tmin )   ! min over the global domain 
    461463         ! - ML - test: for the moment, stop simulation for too large e3_t variations 
    462464         IF( ( z_tmax >  rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 
    463             IF( lk_mpp ) THEN 
    464                CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 
    465                CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 
    466             ELSE 
    467                ijk_max = MAXLOC( ze3t(:,:,:) ) 
    468                ijk_max(1) = ijk_max(1) + nimpp - 1 
    469                ijk_max(2) = ijk_max(2) + njmpp - 1 
    470                ijk_min = MINLOC( ze3t(:,:,:) ) 
    471                ijk_min(1) = ijk_min(1) + nimpp - 1 
    472                ijk_min(2) = ijk_min(2) + njmpp - 1 
    473             ENDIF 
     465            CALL mpp_maxloc( 'domvvl', ze3t, llmsk, z_tmax, ijk_max ) 
     466            CALL mpp_minloc( 'domvvl', ze3t, llmsk, z_tmin, ijk_min ) 
    474467            IF (lwp) THEN 
    475468               WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax 
    … …  
    480473            ENDIF 
    481474         ENDIF 
     475         DEALLOCATE( ze3t, llmsk ) 
    482476         ! - ML - end test 
    483477         ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 
    … …  
    646640      ! Horizontal scale factor interpolations 
    647641      ! -------------------------------------- 
    648       ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are allready computed in dynnxt 
     642      ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 
    649643      ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 
    650644       
    … …  
    663657      gdepw(:,:,1,Kmm) = 0.0_wp 
    664658      gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 
    665       DO jk = 2, jpk 
    666          DO jj = 1,jpj 
    667             DO ji = 1,jpi 
    668               !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    669                                                                  ! 1 for jk = mikt 
    670                zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
    671                gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
    672                gdept(ji,jj,jk,Kmm) =    zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) )  & 
    673                    &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) )  
    674                gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
    675             END DO 
    676          END DO 
    677       END DO 
     659      DO_3D( 1, 1, 1, 1, 2, jpk ) 
     660        !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
     661                                                           ! 1 for jk = mikt 
     662         zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
     663         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
     664         gdept(ji,jj,jk,Kmm) =    zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) )  & 
     665             &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) )  
     666         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
     667      END_3D 
    678668 
    679669      ! Local depth and Inverse of the local depth of the water 
    … …  
    722712         ! 
    723713      CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean 
    724          DO jk = 1, jpk 
    725             DO jj = 1, jpjm1 
    726                DO ji = 1, jpim1   ! vector opt. 
    727                   pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   & 
    728                      &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     & 
    729                      &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 
    730                END DO 
    731             END DO 
    732          END DO 
     714         DO_3D( 1, 0, 1, 0, 1, jpk ) 
     715            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   & 
     716               &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     & 
     717               &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 
     718         END_3D 
    733719         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp ) 
    734720         pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 
    735721         ! 
    736722      CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean 
    737          DO jk = 1, jpk 
    738             DO jj = 1, jpjm1 
    739                DO ji = 1, jpim1   ! vector opt. 
    740                   pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   & 
    741                      &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     & 
    742                      &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 
    743                END DO 
    744             END DO 
    745          END DO 
     723         DO_3D( 1, 0, 1, 0, 1, jpk ) 
     724            pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   & 
     725               &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     & 
     726               &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 
     727         END_3D 
    746728         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp ) 
    747729         pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 
    748730         ! 
    749731      CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean 
    750          DO jk = 1, jpk 
    751             DO jj = 1, jpjm1 
    752                DO ji = 1, jpim1   ! vector opt. 
    753                   pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 
    754                      &                       *    r1_e1e2f(ji,jj)                                                  & 
    755                      &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     & 
    756                      &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 
    757                END DO 
    758             END DO 
    759          END DO 
     732         DO_3D( 1, 0, 1, 0, 1, jpk ) 
     733            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 
     734               &                       *    r1_e1e2f(ji,jj)                                                  & 
     735               &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     & 
     736               &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 
     737         END_3D 
    760738         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp ) 
    761739         pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 
    … …  
    825803         IF( ln_rstart ) THEN                   !* Read the restart file 
    826804            CALL rst_read_open                  !  open the restart file if necessary 
    827             CALL iom_get( numror, jpdom_autoglo, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     805            CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
    828806            ! 
    829807            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    … …  
    832810            id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 
    833811            id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 
     812            ! 
    834813            !                             ! --------- ! 
    835814            !                             ! all cases ! 
    836815            !                             ! --------- ! 
     816            ! 
    837817            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    838                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    839                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     818               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     819               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
    840820               ! needed to restart if land processor not computed  
    841821               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    … …  
    850830               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files' 
    851831               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    852                IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.' 
    853                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     832               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
     833               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    854834               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    855835               l_1st_euler = .true. 
    … …  
    857837               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files' 
    858838               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    859                IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.' 
    860                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     839               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
     840               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
    861841               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    862842               l_1st_euler = .true. 
    … …  
    864844               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file' 
    865845               IF(lwp) write(numout,*) 'Compute scale factor from sshn' 
    866                IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.' 
     846               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    867847               DO jk = 1, jpk 
    868848                  e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 
    … …  
    883863               !                          ! ----------------------- ! 
    884864               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    885                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
    886                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
     865                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
     866                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
    887867               ELSE                            ! one at least array is missing 
    888868                  tilde_e3t_b(:,:,:) = 0.0_wp 
    … …  
    893873                  !                       ! ------------ ! 
    894874                  IF( id5 > 0 ) THEN  ! required array exists 
    895                      CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
     875                     CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
    896876                  ELSE                ! array is missing 
    897877                     hdiv_lf(:,:,:) = 0.0_wp 
    … …  
    917897                  ssh(:,:,Kbb) = -ssh_ref 
    918898 
    919                   DO jj = 1, jpj 
    920                      DO ji = 1, jpi 
    921                         IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth 
    922                            ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 
    923                            ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 
    924                         ENDIF 
    925                      ENDDO 
    926                   ENDDO 
     899                  DO_2D( 1, 1, 1, 1 ) 
     900                     IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth 
     901                        ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 
     902                        ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 
     903                     ENDIF 
     904                  END_2D 
    927905               ENDIF !If test case else 
    928906 
    … …  
    935913               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    936914 
    937                DO ji = 1, jpi 
    938                   DO jj = 1, jpj 
    939                      IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
    940                        CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 
    941                      ENDIF 
    942                   END DO  
    943                END DO  
     915               DO_2D( 1, 1, 1, 1 ) 
     916                  IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
     917                     CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 
     918                  ENDIF 
     919               END_2D 
    944920               ! 
    945921            ELSE 
    … …  
    10641040   END SUBROUTINE dom_vvl_ctl 
    10651041 
     1042#endif 
     1043 
    10661044   !!====================================================================== 
    10671045END MODULE domvvl 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/MY_SRC/usrdef_hgr.F90

    r10074 r13710  
    2626   PUBLIC   usr_def_hgr   ! called by domhgr.F90 
    2727 
     28   !! * Substitutions 
     29#  include "do_loop_substitute.h90" 
    2830   !!---------------------------------------------------------------------- 
    2931   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6163      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2] 
    6264      ! 
    63       INTEGER  ::   ji, jj   ! dummy loop indices 
     65      INTEGER  ::   ji, jj     ! dummy loop indices 
    6466      REAL(wp) ::   zphi0, zlam0, zbeta, zf0 
    65       REAL(wp) ::   zti, zui, ztj, zvj   ! local scalars 
     67      REAL(wp) ::   zti, ztj   ! local scalars 
    6668      !!------------------------------------------------------------------------------- 
    6769      ! 
    … …  
    7577      ! Position coordinates (in kilometers) 
    7678      !                          ========== 
    77       zlam0 = -(jpiglo-1)/2 * 1.e-3 * rn_dx 
    78       zphi0 = -(jpjglo-1)/2 * 1.e-3 * rn_dy  
    79  
     79#if defined key_agrif  
     80      IF( Agrif_Root() ) THEN 
     81#endif 
     82         ! Compatibility WITH old version:  
     83         ! jperio = 0 =>  Ni0glo = jpigo_old_version 
     84         !            =>  jpiglo-1 replaced by Ni0glo-1 
     85         zlam0 = -REAL( (Ni0glo-1)/2, wp) * 1.e-3 * rn_dx 
     86         zphi0 = -REAL( (Nj0glo-1)/2, wp) * 1.e-3 * rn_dy  
    8087#if defined key_agrif 
    81       ! ! let lower left longitude and latitude from parent 
    82       IF (.NOT.Agrif_root()) THEN 
    83           zlam0 = (0.5_wp-(Agrif_parent(jpiglo)-1)/2)*1.e-3*Agrif_irhox()*rn_dx & 
    84              &+(Agrif_Ix()+nbghostcells-1)*Agrif_irhox()*rn_dx*1.e-3-(0.5_wp+nbghostcells)*rn_dx*1.e-3 
    85           zphi0 = (0.5_wp-(Agrif_parent(jpjglo)-1)/2)*1.e-3*Agrif_irhoy()*rn_dy & 
    86              &+(Agrif_Iy()+nbghostcells-1)*Agrif_irhoy()*rn_dy*1.e-3-(0.5_wp+nbghostcells)*rn_dy*1.e-3 
     88      ELSE 
     89         ! ! let lower left longitude and latitude from parent 
     90         ! Compatibility WITH old version:  
     91         ! jperio = 0 =>  Ni0glo = jpigo_old_version 
     92         !            =>  Agrif_parent(jpiglo)-1 replaced by  Agrif_parent(Ni0glo)-1 
     93         zlam0 = ( 0.5_wp - REAL( ( Agrif_parent(Ni0glo)-1 ) / 2, wp) ) * 1.e-3 * Agrif_irhox() * rn_dx  & 
     94            &  + ( Agrif_Ix() + nbghostcells - 1 ) * Agrif_irhox() * rn_dx * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dx * 1.e-3 
     95         zphi0 = ( 0.5_wp - REAL( ( Agrif_parent(Nj0glo)-1 ) / 2, wp) ) * 1.e-3 * Agrif_irhoy() * rn_dy  & 
     96            &  + ( Agrif_Iy() + nbghostcells - 1 ) * Agrif_irhoy() * rn_dy * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dy * 1.e-3 
    8797      ENDIF  
    8898#endif 
    8999          
    90       DO jj = 1, jpj 
    91          DO ji = 1, jpi 
    92             zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) 
    93             zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 
    94  
    95             plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 
    96             plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 
    97             plamv(ji,jj) = plamt(ji,jj)  
    98             plamf(ji,jj) = plamu(ji,jj)  
    99     
    100             pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 
    101             pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 
    102             pphiu(ji,jj) = pphit(ji,jj)  
    103             pphif(ji,jj) = pphiv(ji,jj)  
    104          END DO 
    105       END DO 
     100      DO_2D( 1, 1, 1, 1 ) 
     101         zti = REAL( mig0_oldcmp(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
     102         ztj = REAL( mjg0_oldcmp(jj) - 1, wp )   ! start at j=0 in the global grid without halos 
     103          
     104         plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 *   zti 
     105         plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp ) 
     106         plamv(ji,jj) = plamt(ji,jj)  
     107         plamf(ji,jj) = plamu(ji,jj)  
     108          
     109         pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 *   ztj 
     110         pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * ( ztj + 0.5_wp ) 
     111         pphiu(ji,jj) = pphit(ji,jj)  
     112         pphif(ji,jj) = pphiv(ji,jj)  
     113      END_2D 
    106114      !      
    107115      ! Horizontal scale factors (in meters) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/MY_SRC/usrdef_istate.F90

    r12489 r13710  
    2828   PUBLIC   usr_def_istate   ! called by istate.F90 
    2929 
     30   !! * Substitutions 
     31#  include "do_loop_substitute.h90" 
    3032   !!---------------------------------------------------------------------- 
    3133   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7375      ! Sea level: 
    7476      za = -zP0 * (1._wp-EXP(-zH)) / (grav*(zH-1._wp + EXP(-zH))) 
    75       DO ji=1, jpi 
    76          DO jj=1, jpj 
    77             zx = glamt(ji,jj) * 1.e3 
    78             zy = gphit(ji,jj) * 1.e3 
    79             zrho1 = rho0 + za * EXP(-(zx**2+zy**2)/zlambda**2) 
    80             pssh(ji,jj) = zP0 * EXP(-(zx**2+zy**2)/zlambda**2)/(zrho1*grav) * ptmask(ji,jj,1) 
    81          END DO 
    82       END DO 
     77      DO_2D( 1, 1, 1, 1 ) 
     78         zx = glamt(ji,jj) * 1.e3 
     79         zy = gphit(ji,jj) * 1.e3 
     80         zrho1 = rho0 + za * EXP(-(zx**2+zy**2)/zlambda**2) 
     81         pssh(ji,jj) = zP0 * EXP(-(zx**2+zy**2)/zlambda**2)/(zrho1*grav) * ptmask(ji,jj,1) 
     82      END_2D 
    8383      ! 
    8484      ! temperature:          
    85       DO ji=1, jpi 
    86          DO jj=1, jpj 
    87             zx = glamt(ji,jj) * 1.e3 
    88             zy = gphit(ji,jj) * 1.e3 
    89             DO jk=1,jpk 
    90                zdt =  pdept(ji,jj,jk)  
    91                zrho1 = rho0 * (1._wp + zn2*zdt/grav) 
    92                IF (zdt < zH) THEN 
    93                   zrho1 = zrho1 - zP0 * (1._wp-EXP(zdt-zH)) & 
    94                           & * EXP(-(zx**2+zy**2)/zlambda**2) / (grav*(zH -1._wp + exp(-zH))); 
    95                ENDIF 
    96                pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 
    97             END DO 
     85      DO_2D( 1, 1, 1, 1 ) 
     86         zx = glamt(ji,jj) * 1.e3 
     87         zy = gphit(ji,jj) * 1.e3 
     88         DO jk=1,jpk 
     89            zdt =  pdept(ji,jj,jk)  
     90            zrho1 = rho0 * (1._wp + zn2*zdt/grav) 
     91            IF (zdt < zH) THEN 
     92               zrho1 = zrho1 - zP0 * (1._wp-EXP(zdt-zH)) & 
     93                  & * EXP(-(zx**2+zy**2)/zlambda**2) / (grav*(zH -1._wp + EXP(-zH))); 
     94            ENDIF 
     95            pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 
    9896         END DO 
    99       END DO 
     97      END_2D 
    10098      ! 
    10199      ! salinity:   
    … …  
    104102      ! velocities: 
    105103      za = 2._wp * zP0 / (zf0 * rho0 * zlambda**2) 
    106       DO ji=1, jpim1 
    107          DO jj=1, jpj 
    108             zx = glamu(ji,jj) * 1.e3 
    109             zy = gphiu(ji,jj) * 1.e3 
    110             DO jk=1, jpk 
    111                zdu = 0.5_wp * (pdept(ji  ,jj,jk) + pdept(ji+1,jj,jk)) 
    112                IF (zdu < zH) THEN 
    113                   zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH)) 
    114                   pu(ji,jj,jk) = (za * zf * zy * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk) 
    115                ELSE 
    116                   pu(ji,jj,jk) = 0._wp 
    117                ENDIF 
    118             END DO 
     104      DO_2D( 0, 0, 0, 0 ) 
     105         zx = glamu(ji,jj) * 1.e3 
     106         zy = gphiu(ji,jj) * 1.e3 
     107         DO jk=1, jpk 
     108            zdu = 0.5_wp * (pdept(ji  ,jj,jk) + pdept(ji+1,jj,jk)) 
     109            IF (zdu < zH) THEN 
     110               zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH)) 
     111               pu(ji,jj,jk) = (za * zf * zy * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk) 
     112            ELSE 
     113               pu(ji,jj,jk) = 0._wp 
     114            ENDIF 
    119115         END DO 
    120       END DO 
     116      END_2D 
    121117      ! 
    122       DO ji=1, jpi 
    123          DO jj=1, jpjm1 
    124             zx = glamv(ji,jj) * 1.e3 
    125             zy = gphiv(ji,jj) * 1.e3 
    126             DO jk=1, jpk 
    127                zdv = 0.5_wp * (pdept(ji  ,jj,jk) + pdept(ji,jj+1,jk)) 
    128                IF (zdv < zH) THEN 
    129                   zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH)) 
    130                   pv(ji,jj,jk) = -(za * zf * zx * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk) 
    131                ELSE 
    132                   pv(ji,jj,jk) = 0._wp 
    133                ENDIF 
    134             END DO 
     118      DO_2D( 0, 0, 0, 0 ) 
     119         zx = glamv(ji,jj) * 1.e3 
     120         zy = gphiv(ji,jj) * 1.e3 
     121         DO jk=1, jpk 
     122            zdv = 0.5_wp * (pdept(ji  ,jj,jk) + pdept(ji,jj+1,jk)) 
     123            IF (zdv < zH) THEN 
     124               zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH)) 
     125               pv(ji,jj,jk) = -(za * zf * zx * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk) 
     126            ELSE 
     127               pv(ji,jj,jk) = 0._wp 
     128            ENDIF 
    135129         END DO 
    136       END DO 
    137  
    138       CALL lbc_lnk( 'usrdef_istate', pu, 'U', -1. ) 
    139       CALL lbc_lnk( 'usrdef_istate', pv, 'V', -1. ) 
     130      END_2D 
     131      ! 
     132      CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 
    140133      !    
    141134   END SUBROUTINE usr_def_istate 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/MY_SRC/usrdef_nam.F90

    r12377 r13710  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
     16   USE dom_oce 
    1717   USE par_oce        ! ocean space and time domain 
    1818   USE phycst         ! physical constants 
    … …  
    8484         kpi = NINT( 1800.e3  / rn_dx ) + 3   
    8585         kpj = NINT( 1800.e3  / rn_dy ) + 3  
    86       ELSE 
    87          kpi  = nbcellsx + 2 + 2*nbghostcells 
    88          kpj  = nbcellsy + 2 + 2*nbghostcells 
     86      ELSE                          ! Global Domain size: add nbghostcells + 1 "land" point on each side 
     87         kpi  = nbcellsx + 2 * ( nbghostcells + 1 ) 
     88         kpj  = nbcellsy + 2 * ( nbghostcells + 1 ) 
     89!!$         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
     90!!$         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
    8991      ENDIF 
    9092      kpk = NINT( 5000._wp / rn_dz ) + 1 
    … …  
    104106         WRITE(numout,*) '      horizontal resolution             rn_dy  = ', rn_dy, ' m' 
    105107         WRITE(numout,*) '      vertical resolution               rn_dz  = ', rn_dz, ' m' 
     108         WRITE(numout,*) '      resulting global domain size :    Ni0glo = ', kpi 
     109         WRITE(numout,*) '                                        Nj0glo = ', kpj 
     110         WRITE(numout,*) '                                        jpkglo = ', kpk 
    106111         WRITE(numout,*) '      VORTEX domain: ' 
    107112         WRITE(numout,*) '         LX [km]: ', zlx 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/MY_SRC/usrdef_zgr.F90

    r12377 r13710  
    192192      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
    193193      ! 
    194       k_bot(:,:) = INT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere 
     194      k_bot(:,:) = NINT( z2d(:,:) )          ! =jpkm1 over the ocean point, =0 elsewhere 
    195195      ! 
    196196      k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/WAD/EXPREF/context_nemo.xml

    r12276 r13710  
    1111       <variable id="ref_month" type="int"> 01 </variable> 
    1212       <variable id="ref_day"   type="int"> 01 </variable> 
    13        <variable id="rau0"      type="float" > 1026.0 </variable> 
     13       <variable id="rho0"      type="float" > 1026.0 </variable> 
    1414       <variable id="cpocean"   type="float" > 3991.86795711963 </variable> 
    1515       <variable id="convSpsu"  type="float" > 0.99530670233846  </variable> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/WAD/EXPREF/namelist_cfg

    r12489 r13710  
    200200!!                                                                    !! 
    201201!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    202 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    203 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     202!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     203!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    204204!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    205205!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    253253                                 ! 
    254254   !                     ! S-EOS coefficients (ln_seos=T): 
    255    !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     255   !                             !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    256256   rn_a0       =  1.6550e-1      !  thermal expension coefficient (nn_eos= 1) 
    257257   rn_b0       =  7.6554e-1      !  saline  expension coefficient (nn_eos= 1) 
    … …  
    263263!!org GYRE   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2) 
    264264!!org GYRE   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2) 
    265 !!org  caution  now a0 = alpha / rau0   with rau0 = 1026 
     265!!org  caution  now a0 = alpha / rho0   with rho0 = 1026 
    266266/ 
    267267!----------------------------------------------------------------------- 
    … …  
    417417!!                                                                    !! 
    418418!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    419 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    420419!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    421420!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/WAD/MY_SRC/usrdef_hgr.F90

    r10074 r13710  
    1313   !!   usr_def_hgr    : initialize the horizontal mesh for WAD_TEST_CASES configuration 
    1414   !!---------------------------------------------------------------------- 
    15    USE dom_oce  ,  ONLY: nimpp, njmpp       ! ocean space and time domain 
     15   USE dom_oce 
    1616   USE par_oce         ! ocean space and time domain 
    1717   USE phycst          ! physical constants 
    … …  
    2626   PUBLIC   usr_def_hgr   ! called by domhgr.F90 
    2727 
     28   !! * Substitutions 
     29#  include "do_loop_substitute.h90" 
    2830   !!---------------------------------------------------------------------- 
    2931   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7274      !                       !==  grid point position  ==!   (in kilometers) 
    7375      zfact = rn_dx * 1.e-3         ! conversion in km 
    74       DO jj = 1, jpj 
    75          DO ji = 1, jpi             ! longitude 
    76             plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )   
    77             plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  ) 
    78             plamv(ji,jj) = plamt(ji,jj) 
    79             plamf(ji,jj) = plamu(ji,jj) 
    80             !                       ! latitude 
    81             pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  ) 
    82             pphiu(ji,jj) = pphit(ji,jj) 
    83             pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  ) 
    84             pphif(ji,jj) = pphiv(ji,jj) 
    85          END DO 
    86       END DO 
     76      DO_2D( 1, 1, 1, 1 ) 
     77         !                       ! longitude 
     78         plamt(ji,jj) = zfact * (  - 0.5 + REAL( mig0_oldcmp(ji)-1 , wp )  )   
     79         plamu(ji,jj) = zfact * (          REAL( mig0_oldcmp(ji)-1 , wp )  ) 
     80         plamv(ji,jj) = plamt(ji,jj) 
     81         plamf(ji,jj) = plamu(ji,jj) 
     82         !                       ! latitude 
     83         pphit(ji,jj) = zfact * (  - 0.5 + REAL( mjg0_oldcmp(jj)-1 , wp )  ) 
     84         pphiu(ji,jj) = pphit(ji,jj) 
     85         pphiv(ji,jj) = zfact * (          REAL( mjg0_oldcmp(jj)-1 , wp )  ) 
     86         pphif(ji,jj) = pphiv(ji,jj) 
     87      END_2D 
    8788      ! 
    8889      !                       !==  Horizontal scale factors  ==!   (in meters)  

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/WAD/MY_SRC/usrdef_istate.F90

    r10074 r13710  
    2626   PUBLIC   usr_def_istate   ! called in istate.F90 
    2727 
     28   !! * Substitutions 
     29#  include "do_loop_substitute.h90" 
    2830   !!---------------------------------------------------------------------- 
    2931   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    174176      ! Apply minimum wetdepth criterion 
    175177      ! 
    176       do jj = 1,jpj 
    177          do ji = 1,jpi 
    178             IF( ht_0(ji,jj) + pssh(ji,jj) < rn_wdmin1 ) THEN 
    179                pssh(ji,jj) = ptmask(ji,jj,1)*( rn_wdmin1 - ht_0(ji,jj) ) 
    180             ENDIF 
    181          end do 
    182       end do 
     178      DO_2D( 1, 1, 1, 1 ) 
     179         IF( ht_0(ji,jj) + pssh(ji,jj) < rn_wdmin1 ) THEN 
     180            pssh(ji,jj) = ptmask(ji,jj,1)*( rn_wdmin1 - ht_0(ji,jj) ) 
     181         ENDIF 
     182      END_2D 
    183183      ! 
    184184   END SUBROUTINE usr_def_istate 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/WAD/MY_SRC/usrdef_nam.F90

    r12377 r13710  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
    1716   USE par_oce        ! ocean space and time domain 
    1817   USE phycst         ! physical constants 
    … …  
    7776      !                             ! Set the lateral boundary condition of the global domain 
    7877      kperio = 0                    ! WAD_TEST_CASES configuration : closed domain 
    79       IF( nn_wad_test == 8 ) kperio = 7 ! North-South cyclic test 
     78      IF( nn_wad_test == 8 ) THEN 
     79         kperio = 7         ! North-South cyclic test 
     80         kpi = kpi - 2      ! no closed boundary 
     81         kpj = kpj - 2      ! no closed boundary 
     82      ENDIF 
    8083      ! 
    8184      !                             ! control print 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/WAD/MY_SRC/usrdef_zgr.F90

    r12377 r13710  
    1515   !!--------------------------------------------------------------------- 
    1616   USE oce            ! ocean variables 
    17    USE dom_oce ,  ONLY: ht_0, mi0, mi1, nimpp, njmpp,  & 
    18                       & mj0, mj1, glamt, gphit         ! ocean space and time domain 
     17   USE dom_oce ,  ONLY: ht_0, mi0, mi1, mj0, mj1, glamt, gphit         ! ocean space and time domain 
    1918   USE usrdef_nam     ! User defined : namelist variables 
    2019   USE wet_dry ,  ONLY: rn_wdmin1, rn_wdmin2, rn_wdld  ! Wetting and drying 
    … …  
    2928   PUBLIC   usr_def_zgr        ! called by domzgr.F90 
    3029 
     30   !! * Substitutions 
     31#  include "do_loop_substitute.h90" 
    3132   !!---------------------------------------------------------------------- 
    3233   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    242243      ! at v-point: averaging zht 
    243244      zhv = 0._wp 
    244       DO jj = 1, jpjm1 
    245          zhv(:,jj) = 0.5_wp * ( zht(:,jj) + zht(:,jj+1) ) 
    246       END DO 
     245      DO_2D( 0, 0, 0, 0 ) 
     246         zhv(ji,jj) = 0.5_wp * ( zht(ji,jj) + zht(ji,jj+1) ) 
     247      END_2D 
    247248      CALL lbc_lnk( 'usrdef_zgr', zhv, 'V', 1. )     ! boundary condition: this mask the surrounding grid-points 
    248249      DO jj = mj0(1), mj1(1)   ! first  row of global domain only 
    … …  
    279280         ht_0 = zht 
    280281         k_bot(:,:) = jpkm1 * k_top(:,:)  !* bottom ocean = jpk-1 (here use k_top as a land mask) 
    281          DO jj = 1, jpj 
    282             DO ji = 1, jpi 
    283               IF( zht(ji,jj) <= -(rn_wdld - rn_wdmin2)) THEN 
    284                 k_bot(ji,jj) = 0 
    285                 k_top(ji,jj) = 0 
    286               ENDIF 
    287            END DO 
    288          END DO 
     282         DO_2D( 1, 1, 1, 1 ) 
     283            IF( zht(ji,jj) <= -(rn_wdld - rn_wdmin2)) THEN 
     284               k_bot(ji,jj) = 0 
     285               k_top(ji,jj) = 0 
     286            ENDIF 
     287         END_2D 
    289288         ! 
    290289         !                                !* terrain-following coordinate with e3.(k)=cst) 
    291290         !                                !  OVERFLOW case : identical with j-index (T=V, U=F) 
    292          DO jj = 1, jpjm1 
    293             DO ji = 1, jpim1 
    294               z1_jpkm1 = 1._wp / REAL( k_bot(ji,jj) - k_top(ji,jj) + 1 , wp) 
    295               DO jk = 1, jpk 
    296                   zwet = MAX( zht(ji,jj), rn_wdmin1 ) 
    297                   pdept(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk   , wp ) - 0.5_wp ) 
    298                   pdepw(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk-1 , wp )          ) 
    299                   pe3t (ji,jj,jk) = zwet * z1_jpkm1 
    300                   pe3w (ji,jj,jk) = zwet * z1_jpkm1 
    301                   zwet = MAX( zhu(ji,jj), rn_wdmin1 ) 
    302                   pe3u (ji,jj,jk) = zwet * z1_jpkm1 
    303                   pe3uw(ji,jj,jk) = zwet * z1_jpkm1 
    304                   pe3f (ji,jj,jk) = zwet * z1_jpkm1 
    305                   zwet = MAX( zhv(ji,jj), rn_wdmin1 ) 
    306                   pe3v (ji,jj,jk) = zwet * z1_jpkm1 
    307                   pe3vw(ji,jj,jk) = zwet * z1_jpkm1 
    308               END DO       
    309            END DO       
    310          END DO       
     291         DO_2D( 0, 0, 0, 0 ) 
     292            z1_jpkm1 = 1._wp / REAL( k_bot(ji,jj) - k_top(ji,jj) + 1 , wp) 
     293            DO jk = 1, jpk 
     294               zwet = MAX( zht(ji,jj), rn_wdmin1 ) 
     295               pdept(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk   , wp ) - 0.5_wp ) 
     296               pdepw(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk-1 , wp )          ) 
     297               pe3t (ji,jj,jk) = zwet * z1_jpkm1 
     298               pe3w (ji,jj,jk) = zwet * z1_jpkm1 
     299               zwet = MAX( zhu(ji,jj), rn_wdmin1 ) 
     300               pe3u (ji,jj,jk) = zwet * z1_jpkm1 
     301               pe3uw(ji,jj,jk) = zwet * z1_jpkm1 
     302               pe3f (ji,jj,jk) = zwet * z1_jpkm1 
     303               zwet = MAX( zhv(ji,jj), rn_wdmin1 ) 
     304               pe3v (ji,jj,jk) = zwet * z1_jpkm1 
     305               pe3vw(ji,jj,jk) = zwet * z1_jpkm1 
     306            END DO 
     307         END_2D      
    311308         CALL lbc_lnk( 'usrdef_zgr', pdept, 'T', 1. ) 
    312309         CALL lbc_lnk( 'usrdef_zgr', pdepw, 'T', 1. ) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/demo_cfgs.txt

    r12377 r13710  
    1111BENCH OCE ICE TOP 
    1212STATION_ASF OCE 
     13CPL_OASIS  OCE TOP ICE NST 
Note: See TracChangeset for help on using the changeset viewer.