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 12482 – NEMO

Changeset 12482


Ignore:
Timestamp:
2020-02-28T11:26:52+01:00 (3 years ago)
Author:
techene
Message:

new reference without ztilde, duplicated modules and routines to be modified from zstar MLF to zstar LF

Location:
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE
Files:
2 added
6 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diamlr.F90

    r12377 r12482  
    3333   !!---------------------------------------------------------------------- 
    3434CONTAINS 
    35     
     35 
    3636   SUBROUTINE dia_mlr_init 
    3737      !!---------------------------------------------------------------------- 
    3838      !!                 ***  ROUTINE dia_mlr_init  *** 
    3939      !! 
    40       !! ** Purpose : initialisation of IOM context management for  
     40      !! ** Purpose : initialisation of IOM context management for 
    4141      !!              multiple-linear-regression analysis 
    4242      !! 
    … …  
    145145            ! Retrieve information (frequency, phase, nodal correction) about all 
    146146            ! available tidal constituents for placeholder substitution below 
    147             ctide_selected(1:34) = (/ 'Mf', 'Mm', 'Ssa', 'Mtm', 'Msf',    & 
    148                &                      'Msqm', 'Sa', 'K1', 'O1', 'P1',     & 
    149                &                      'Q1', 'J1', 'S1', 'M2', 'S2', 'N2', & 
    150                &                      'K2', 'nu2', 'mu2', '2N2', 'L2',    & 
    151                &                      'T2', 'eps2', 'lam2', 'R2', 'M3',   & 
    152                &                      'MKS2', 'MN4', 'MS4', 'M4', 'N4',   & 
    153                &                      'S4', 'M6', 'M8' /) 
     147            ctide_selected(1:34) = (/ 'Mf  ', 'Mm  ', 'Ssa ', 'Mtm ', 'Msf ',    & 
     148   &                      'Msqm', 'Sa  ', 'K1  ', 'O1  ', 'P1  ',     & 
     149   &                      'Q1  ', 'J1  ', 'S1  ', 'M2  ', 'S2  ', 'N2  ', & 
     150   &                      'K2  ', 'nu2 ', 'mu2 ', '2N2 ', 'L2  ',    & 
     151   &                      'T2  ', 'eps2', 'lam2', 'R2  ', 'M3  ',   & 
     152   &                      'MKS2', 'MN4 ', 'MS4 ', 'M4  ', 'N4  ',   & 
     153   &                      'S4  ', 'M6  ', 'M8  ' /) 
    154154            CALL tide_init_harmonics(ctide_selected, stideconst) 
    155155            itide = size(stideconst) 
    … …  
    157157            itide = 0 
    158158         ENDIF 
    159           
     159 
    160160         DO jm = 1, jpscanmax 
    161161            WRITE (cl3i, '(i3.3)') jm 
    … …  
    236236               ! If enabled, keep handle in list of fields selected for analysis 
    237237               IF ( llxatt_enabled ) THEN 
    238                    
     238 
    239239                  ! Set name attribute (and overwrite possible pre-configured name) 
    240240                  ! with field id to enable id string retrieval from stored handle 
    … …  
    323323            CALL xios_set_attr  ( slxhdl_fld, standard_name=TRIM( clxatt_comment ), long_name=TRIM( clxatt_expr ),   & 
    324324               &                  operation="average" ) 
    325                 
     325 
    326326            ! iii) set up the output of scalar products with itself and with 
    327327            !      other active regressors 
    … …  
    416416      zadatrj2d(:,:) = adatrj*86400.0_wp 
    417417      IF ( iom_use('diamlr_time') ) CALL iom_put('diamlr_time', zadatrj2d) 
    418        
     418 
    419419      IF( ln_timing )   CALL timing_stop('dia_mlr') 
    420420 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/dom_oce.F90

    r12377 r12482  
    22   !!====================================================================== 
    33   !!                       ***  MODULE dom_oce  *** 
    4    !!        
     4   !! 
    55   !! ** Purpose :   Define in memory all the ocean space domain variables 
    66   !!====================================================================== 
    7    !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate  
     7   !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate 
    88   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level 
    99   !!            3.4  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    … …  
    1313   !!             -   ! 2015-11  (G. Madec, A. Coward)  time varying zgr by default 
    1414   !!            4.1  ! 2019-08  (A. Coward, D. Storkey) rename prognostic variables in preparation for new time scheme. 
     15   !!            4.x  ! 2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio 
    1516   !!---------------------------------------------------------------------- 
    1617 
    … …  
    7273   !                                !  = 6 cyclic East-West AND North fold F-point pivot 
    7374   !                                !  = 7 bi-cyclic East-West AND North-South 
    74    LOGICAL, PUBLIC ::   l_Iperio, l_Jperio   !   should we explicitely take care I/J periodicity  
     75   LOGICAL, PUBLIC ::   l_Iperio, l_Jperio   !   should we explicitely take care I/J periodicity 
    7576 
    7677   !                                 !  domain MPP decomposition parameters 
    … …  
    8283   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy(:)    !: mark i-direction local boundaries for BDY open boundaries 
    8384   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy(:)    !: mark j-direction local boundaries for BDY open boundaries 
    84    INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy_b(:)  !: mark i-direction of neighbours local boundaries for BDY open boundaries   
    85    INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy_b(:)  !: mark j-direction of neighbours local boundaries for BDY open boundaries   
     85   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy_b(:)  !: mark i-direction of neighbours local boundaries for BDY open boundaries 
     86   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy_b(:)  !: mark j-direction of neighbours local boundaries for BDY open boundaries 
    8687 
    8788   INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4) 
    … …  
    127128   LOGICAL, PUBLIC ::   ln_zps       !: z-coordinate - partial step 
    128129   LOGICAL, PUBLIC ::   ln_sco       !: s-coordinate or hybrid z-s coordinate 
    129    LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF  
     130   LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF 
    130131   !                                                        !  reference scale factors 
    131132   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0   !: t- vert. scale factor [m] 
    … …  
    139140   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e3t, e3u, e3v, e3w, e3uw, e3vw  !: vert. scale factor [m] 
    140141   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   e3f                             !: F-point vert. scale factor [m] 
     142   !                                                        !  time-dependent ratio ssh / h_0 
     143   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   r3t, r3u, r3v                   !: [-] 
     144   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   r3f                             !: [-] 
     145   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   r3t_f, r3u_f, r3v_f             !: [-] 
    141146 
    142147   !                                                        !  reference depths of cells 
    … …  
    145150   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0  !: w- depth (sum of e3w) [m] 
    146151   !                                                        !  time-dependent depths of cells 
    147    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  gdept, gdepw   
    148    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gde3w   
    149     
     152   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  gdept, gdepw 
     153   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gde3w 
     154 
    150155   !                                                      !  reference heights of water column 
    151156   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0  !: t-depth              [m] 
    152157   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0  !: u-depth              [m] 
    153158   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hv_0  !: v-depth              [m] 
     159   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hf_0  !: f-depth              [m] 
     160   !                                                      !  reciprocal reference heights of water column 
     161   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   r1_ht_0, r1_hu_0, r1_hv_0, r1_hf_0   !: t-depth   [1/m] 
    154162                                                          ! time-dependent heights of water column 
    155163   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ht                     !: height of water column at T-points [m] 
    … …  
    157165 
    158166   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 
    159    INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1)  
     167   INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1) 
    160168 
    161169   !! 1D reference  vertical coordinate 
    … …  
    179187   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: top first wet T-, U-, V-, F-level           (ISF) 
    180188 
    181    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask             !: surface mask at T-,U-, V- and F-pts 
     189   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask, ssfmask    !: surface mask at T-,U-, V- and F-pts 
    182190   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
    183191   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
    … …  
    199207   INTEGER , PUBLIC ::   nsec_monday   !: seconds between 00h         of the last Monday   and half of the current time step 
    200208   INTEGER , PUBLIC ::   nsec_day      !: seconds between 00h         of the current   day and half of the current time step 
    201    REAL(wp), PUBLIC ::   fjulday       !: current julian day  
     209   REAL(wp), PUBLIC ::   fjulday       !: current julian day 
    202210   REAL(wp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days 
    203211   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation 
    … …  
    221229   !!---------------------------------------------------------------------- 
    222230   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    223    !! $Id$  
     231   !! $Id$ 
    224232   !! Software governed by the CeCILL license (see ./LICENSE) 
    225233   !!---------------------------------------------------------------------- 
    … …  
    235243 
    236244   CHARACTER(len=3) FUNCTION Agrif_CFixed() 
    237       Agrif_CFixed = '0'  
     245      Agrif_CFixed = '0' 
    238246   END FUNCTION Agrif_CFixed 
    239247#endif 
    … …  
    266274         ! 
    267275      ALLOCATE( e3t_0(jpi,jpj,jpk)     , e3u_0(jpi,jpj,jpk)     , e3v_0(jpi,jpj,jpk)     , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk)     ,   & 
    268          &      e3t  (jpi,jpj,jpk,jpt) , e3u  (jpi,jpj,jpk,jpt) , e3v  (jpi,jpj,jpk,jpt) , e3f  (jpi,jpj,jpk) , e3w  (jpi,jpj,jpk,jpt) ,   &  
     276         &      e3t  (jpi,jpj,jpk,jpt) , e3u  (jpi,jpj,jpk,jpt) , e3v  (jpi,jpj,jpk,jpt) , e3f  (jpi,jpj,jpk) , e3w  (jpi,jpj,jpk,jpt) ,   & 
    269277         &      e3uw_0(jpi,jpj,jpk)     , e3vw_0(jpi,jpj,jpk)     ,         & 
    270          &      e3uw  (jpi,jpj,jpk,jpt) , e3vw  (jpi,jpj,jpk,jpt) ,    STAT=ierr(5) )                        
    271          ! 
    272       ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj)    , hv_0(jpi,jpj)     ,                                             & 
    273          &      ht  (jpi,jpj) , hu(  jpi,jpj,jpt), hv(  jpi,jpj,jpt) , r1_hu(jpi,jpj,jpt) , r1_hv(jpi,jpj,jpt) ,   & 
    274          &                      STAT=ierr(6)  ) 
     278         &      e3uw  (jpi,jpj,jpk,jpt) , e3vw  (jpi,jpj,jpk,jpt) ,         & 
     279         &      r3t  (jpi,jpj,jpt)     , r3u  (jpi,jpj,jpt)     , r3v  (jpi,jpj,jpt)     , r3f  (jpi,jpj) ,  & 
     280         &      r3t_f(jpi,jpj)         , r3u_f(jpi,jpj)         , r3v_f(jpi,jpj)                          ,  STAT=ierr(5) ) 
     281         ! 
     282      ALLOCATE( ht_0(jpi,jpj) ,    hu_0(jpi,jpj)    ,    hv_0(jpi,jpj)     , hf_0(jpi,jpj)     ,   & 
     283         &      ht  (jpi,jpj) ,    hu  (jpi,jpj,jpt),    hv  (jpi,jpj,jpt) ,                       & 
     284         &                      r1_hu  (jpi,jpj,jpt), r1_hv  (jpi,jpj,jpt) ,                       & 
     285         &   r1_ht_0(jpi,jpj) , r1_hu_0(jpi,jpj) ,    r1_hv_0(jpi,jpj),   r1_hf_0(jpi,jpj)     ,   STAT=ierr(6)  ) 
    275286         ! 
    276287      ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(7)  )  
    … …  
    278289      ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(8) ) 
    279290         ! 
    280       ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                        &  
    281          &      ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) ,     & 
     291      ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                        & 
     292         &      ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) ,    & 
    282293         &      mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) ) 
    283294         ! 
    284295      ALLOCATE( mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj), mikf(jpi,jpj), STAT=ierr(10) ) 
    285296         ! 
    286       ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) ,     &  
     297      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) ,     & 
    287298         &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk) , STAT=ierr(11) ) 
    288299         ! 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domain.F90

    r12377 r12482  
    66   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code 
    77   !!                 !  1992-01  (M. Imbard) insert time step initialization 
    8    !!                 !  1996-06  (G. Madec) generalized vertical coordinate  
     8   !!                 !  1996-06  (G. Madec) generalized vertical coordinate 
    99   !!                 !  1997-02  (G. Madec) creation of domwri.F 
    1010   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea 
    … …  
    1515   !!            3.7  !  2015-11  (G. Madec, A. Coward)  time varying zgr by default 
    1616   !!            4.0  !  2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
     17   !!            4.x  ! 2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio 
    1718   !!---------------------------------------------------------------------- 
    18     
     19 
    1920   !!---------------------------------------------------------------------- 
    2021   !!   dom_init      : initialize the space and time domain 
    … …  
    6162      !!---------------------------------------------------------------------- 
    6263      !!                  ***  ROUTINE dom_init  *** 
    63       !!                     
    64       !! ** Purpose :   Domain initialization. Call the routines that are  
    65       !!              required to create the arrays which define the space  
     64      !! 
     65      !! ** Purpose :   Domain initialization. Call the routines that are 
     66      !!              required to create the arrays which define the space 
    6667      !!              and time domain of the ocean model. 
    6768      !! 
    … …  
    7879      INTEGER ::   ji, jj, jk, ik   ! dummy loop indices 
    7980      INTEGER ::   iconf = 0    ! local integers 
    80       CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))"  
     81      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
    8182      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level 
    8283      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0 
    … …  
    147148      hu_0(:,:) = 0._wp 
    148149      hv_0(:,:) = 0._wp 
     150      hf_0(:,:) = 0._wp 
    149151      DO jk = 1, jpk 
    150152         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 
    151153         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) 
    152154         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk) 
     155         hf_0(:,:) = hf_0(:,:) + e3f_0(:,:,jk) * fmask(:,:,jk) 
    153156      END DO 
     157      ! 
     158      r1_ht_0(:,:) = ssmask (:,:) / ( ht_0(:,:) + 1._wp -  ssmask (:,:) ) 
     159      r1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp -  ssumask(:,:) ) 
     160      r1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp -  ssvmask(:,:) ) 
     161      r1_hf_0(:,:) = ssfmask(:,:) / ( hf_0(:,:) + 1._wp -  ssfmask(:,:) ) 
    154162      ! 
    155163      !           !==  time varying part of coordinate system  ==! 
    … …  
    160168            gdept(:,:,:,Kbb) = gdept_0  ;   gdept(:,:,:,Kmm) = gdept_0   ;   gdept(:,:,:,Kaa) = gdept_0   ! depth of grid-points 
    161169            gdepw(:,:,:,Kbb) = gdepw_0  ;   gdepw(:,:,:,Kmm) = gdepw_0   ;   gdepw(:,:,:,Kaa) = gdepw_0   ! 
    162                                    gde3w = gde3w_0   !        ---          ! 
    163          !                                                                   
     170                                            gde3w            = gde3w_0   !        ---          ! 
     171         ! 
    164172              e3t(:,:,:,Kbb) =   e3t_0  ;     e3t(:,:,:,Kmm) =   e3t_0   ;   e3t(:,:,:,Kaa) =  e3t_0    ! scale factors 
    165173              e3u(:,:,:,Kbb) =   e3u_0  ;     e3u(:,:,:,Kmm) =   e3u_0   ;   e3u(:,:,:,Kaa) =  e3u_0    ! 
    166174              e3v(:,:,:,Kbb) =   e3v_0  ;     e3v(:,:,:,Kmm) =   e3v_0   ;   e3v(:,:,:,Kaa) =  e3v_0    ! 
    167175                                     e3f =   e3f_0   !        ---          ! 
    168               e3w(:,:,:,Kbb) =   e3w_0  ;     e3w(:,:,:,Kmm) =   e3w_0   ;    e3w(:,:,:,Kaa) =   e3w_0   !  
    169              e3uw(:,:,:,Kbb) =  e3uw_0  ;    e3uw(:,:,:,Kmm) =  e3uw_0   ;   e3uw(:,:,:,Kaa) =  e3uw_0   !   
     176              e3w(:,:,:,Kbb) =   e3w_0  ;     e3w(:,:,:,Kmm) =   e3w_0   ;    e3w(:,:,:,Kaa) =   e3w_0   ! 
     177             e3uw(:,:,:,Kbb) =  e3uw_0  ;    e3uw(:,:,:,Kmm) =  e3uw_0   ;   e3uw(:,:,:,Kaa) =  e3uw_0   ! 
    170178             e3vw(:,:,:,Kbb) =  e3vw_0  ;    e3vw(:,:,:,Kmm) =  e3vw_0   ;   e3vw(:,:,:,Kaa) =  e3vw_0   ! 
    171179         ! 
    172          z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF 
    173          z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) ) 
     180! !!st new variable h1_hu_0 h1_hv_0 
     181!          z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF 
     182!          z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) ) 
    174183         ! 
    175184         !        before       !          now          !       after         ! 
    176185                                      ht =    ht_0   !                     ! water column thickness 
    177                hu(:,:,Kbb) =    hu_0  ;      hu(:,:,Kmm) =    hu_0   ;    hu(:,:,Kaa) =    hu_0   !  
     186               hu(:,:,Kbb) =    hu_0  ;      hu(:,:,Kmm) =    hu_0   ;    hu(:,:,Kaa) =    hu_0   ! 
    178187               hv(:,:,Kbb) =    hv_0  ;      hv(:,:,Kmm) =    hv_0   ;    hv(:,:,Kaa) =    hv_0   ! 
    179             r1_hu(:,:,Kbb) = z1_hu_0  ;   r1_hu(:,:,Kmm) = z1_hu_0   ; r1_hu(:,:,Kaa) = z1_hu_0   ! inverse of water column thickness 
    180             r1_hv(:,:,Kbb) = z1_hv_0  ;   r1_hv(:,:,Kmm) = z1_hv_0   ; r1_hv(:,:,Kaa) = z1_hv_0   ! 
     188            r1_hu(:,:,Kbb) = r1_hu_0  ;   r1_hu(:,:,Kmm) = r1_hu_0   ; r1_hu(:,:,Kaa) = r1_hu_0   ! inverse of water column thickness 
     189            r1_hv(:,:,Kbb) = r1_hv_0  ;   r1_hv(:,:,Kmm) = r1_hv_0   ; r1_hv(:,:,Kaa) = r1_hv_0   ! 
    181190         ! 
    182191         ! 
    … …  
    198207         WRITE(numout,*) 'dom_init :   ==>>>   END of domain initialization' 
    199208         WRITE(numout,*) '~~~~~~~~' 
    200          WRITE(numout,*)  
     209         WRITE(numout,*) 
    201210      ENDIF 
    202211      ! 
    … …  
    210219      !! ** Purpose :   initialization of global domain <--> local domain indices 
    211220      !! 
    212       !! ** Method  :    
     221      !! ** Method  : 
    213222      !! 
    214223      !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices 
    … …  
    226235      END DO 
    227236      !                              ! global domain indices ==> local domain indices 
    228       !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the  
    229       !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.  
     237      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 
     238      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 
    230239      DO ji = 1, jpiglo 
    231240        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) ) 
    … …  
    273282      !!---------------------------------------------------------------------- 
    274283      !!                     ***  ROUTINE dom_nam  *** 
    275       !!                     
     284      !! 
    276285      !! ** Purpose :   read domaine namelists and print the variables. 
    277286      !! 
    … …  
    355364      neuler = nn_euler 
    356365      IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN 
    357          IF(lwp) WRITE(numout,*)   
     366         IF(lwp) WRITE(numout,*) 
    358367         IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)' 
    359          IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : nn_euler is forced to 0 '    
     368         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : nn_euler is forced to 0 ' 
    360369         neuler = 0 
    361370      ENDIF 
    … …  
    383392      IF(lwp) WRITE(numout,*) 
    384393      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    385       CASE (  1 )  
     394      CASE (  1 ) 
    386395         CALL ioconf_calendar('gregorian') 
    387396         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year' 
    … …  
    419428      IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
    420429         lrxios = ln_xios_read.AND.ln_rstart 
    421 !set output file type for XIOS based on NEMO namelist  
    422          IF (nn_wxios > 0) lwxios = .TRUE.  
     430!set output file type for XIOS based on NEMO namelist 
     431         IF (nn_wxios > 0) lwxios = .TRUE. 
    423432         nxioso = nn_wxios 
    424433      ENDIF 
    … …  
    463472      !!---------------------------------------------------------------------- 
    464473      INTEGER, DIMENSION(2) ::   imi1, imi2, ima1, ima2 
    465       INTEGER, DIMENSION(2) ::   iloc   !  
     474      INTEGER, DIMENSION(2) ::   iloc   ! 
    466475      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max 
    467476      !!---------------------------------------------------------------------- 
    … …  
    473482         CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 ) 
    474483      ELSE 
    475          ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )     
    476          ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )     
    477          ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )     
    478          ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )     
     484         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 
     485         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 
     486         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 
     487         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 
    479488         ! 
    480489         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 
    … …  
    507516      !!---------------------------------------------------------------------- 
    508517      !!                     ***  ROUTINE dom_nam  *** 
    509       !!                     
     518      !! 
    510519      !! ** Purpose :   read the domain size in domain configuration file 
    511520      !! 
    … …  
    514523      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name 
    515524      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution 
    516       INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes  
    517       INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.  
     525      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
     526      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c. 
    518527      ! 
    519528      INTEGER ::   inum   ! local integer 
    … …  
    547556         cd_cfg = 'UNKNOWN' 
    548557         kk_cfg = -9999999 
    549                                           !- or they may be present as global attributes  
    550                                           !- (netcdf only)   
     558                                          !- or they may be present as global attributes 
     559                                          !- (netcdf only) 
    551560         CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found 
    552561         CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found 
    … …  
    570579         WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio 
    571580      ENDIF 
    572       !         
     581      ! 
    573582   END SUBROUTINE domain_cfg 
    574     
    575     
     583 
     584 
    576585   SUBROUTINE cfg_write 
    577586      !!---------------------------------------------------------------------- 
    578587      !!                  ***  ROUTINE cfg_write  *** 
    579       !!                    
    580       !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which  
    581       !!              contains all the ocean domain informations required to  
     588      !! 
     589      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which 
     590      !!              contains all the ocean domain informations required to 
    582591      !!              define an ocean configuration. 
    583592      !! 
    … …  
    585594      !!              ocean configuration. 
    586595      !! 
    587       !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal  
     596      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal 
    588597      !!                       mesh, Coriolis parameter, and vertical scale factors 
    589598      !!                    NB: also contain ORCA family information 
    … …  
    603612      !                       !  create 'domcfg_out.nc' file  ! 
    604613      !                       ! ============================= ! 
    605       !          
     614      ! 
    606615      clnam = cn_domcfg_out  ! filename (configuration information) 
    607616      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 
    608        
     617 
    609618      ! 
    610619      !                             !==  ORCA family specificities  ==! 
    611620      IF( cn_cfg == "ORCA" ) THEN 
    612621         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 ) 
    613          CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )          
     622         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 ) 
    614623      ENDIF 
    615624      ! 
    … …  
    643652      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 ) 
    644653      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 ) 
    645       !                                 
     654      ! 
    646655      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude 
    647656      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 ) 
    648657      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 ) 
    649658      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 ) 
    650       !                                 
     659      ! 
    651660      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.) 
    652661      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 ) 
    … …  
    663672      ! 
    664673      !                             !==  vertical mesh  ==! 
    665       !                                                      
     674      ! 
    666675      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate 
    667676      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 ) 
    … …  
    674683      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 ) 
    675684      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 ) 
    676       !                                          
     685      ! 
    677686      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask) 
    678687      ! 
    … …  
    694703      ! 
    695704      !                                ! ============================ 
    696       !                                !        close the files  
     705      !                                !        close the files 
    697706      !                                ! ============================ 
    698707      CALL iom_close( inum ) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/dommsk.F90

    r12377 r12482  
    22   !!====================================================================== 
    33   !!                       ***  MODULE dommsk   *** 
    4    !! Ocean initialization : domain land/sea mask  
     4   !! Ocean initialization : domain land/sea mask 
    55   !!====================================================================== 
    66   !! History :  OPA  ! 1987-07  (G. Madec)  Original code 
    … …  
    1818   !!            3.6  ! 2015-05  (P. Mathiot) ISF: add wmask,wumask and wvmask 
    1919   !!            4.0  ! 2016-06  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
     20   !!            4.x  ! 2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio 
    2021   !!---------------------------------------------------------------------- 
    2122 
    … …  
    4041   !                            !!* Namelist namlbc : lateral boundary condition * 
    4142   REAL(wp)        :: rn_shlat   ! type of lateral boundary condition on velocity 
    42    LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition  
     43   LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition 
    4344   !                                            with analytical eqs. 
    4445 
    … …  
    4748   !!---------------------------------------------------------------------- 
    4849   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    49    !! $Id$  
     50   !! $Id$ 
    5051   !! Software governed by the CeCILL license (see ./LICENSE) 
    5152   !!---------------------------------------------------------------------- 
    … …  
    5960      !!      zontal velocity points (u & v), vorticity points (f) points. 
    6061      !! 
    61       !! ** Method  :   The ocean/land mask  at t-point is deduced from ko_top  
    62       !!      and ko_bot, the indices of the fist and last ocean t-levels which  
     62      !! ** Method  :   The ocean/land mask  at t-point is deduced from ko_top 
     63      !!      and ko_bot, the indices of the fist and last ocean t-levels which 
    6364      !!      are either defined in usrdef_zgr or read in zgr_read. 
    64       !!                The velocity masks (umask, vmask, wmask, wumask, wvmask)  
     65      !!                The velocity masks (umask, vmask, wmask, wumask, wvmask) 
    6566      !!      are deduced from a product of the two neighboring tmask. 
    6667      !!                The vorticity mask (fmask) is deduced from tmask taking 
    … …  
    7778      !!                due to cyclic or North Fold boundaries as well as MPP halos. 
    7879      !! 
    79       !! ** Action :   tmask, umask, vmask, wmask, wumask, wvmask : land/ocean mask  
     80      !! ** Action :   tmask, umask, vmask, wmask, wumask, wvmask : land/ocean mask 
    8081      !!                         at t-, u-, v- w, wu-, and wv-points (=0. or 1.) 
    81       !!               fmask   : land/ocean mask at f-point (=0., or =1., or  
     82      !!               fmask   : land/ocean mask at f-point (=0., or =1., or 
    8283      !!                         =rn_shlat along lateral boundaries) 
    83       !!               tmask_i : interior ocean mask  
     84      !!               tmask_i : interior ocean mask 
    8485      !!               tmask_h : halo mask 
    8586      !!               ssmask , ssumask, ssvmask, ssfmask : 2D ocean mask 
    … …  
    108109902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlbc in configuration namelist' ) 
    109110      IF(lwm) WRITE ( numond, namlbc ) 
    110        
     111 
    111112      IF(lwp) THEN                  ! control print 
    112113         WRITE(numout,*) 
    … …  
    115116         WRITE(numout,*) '   Namelist namlbc' 
    116117         WRITE(numout,*) '      lateral momentum boundary cond.    rn_shlat  = ',rn_shlat 
    117          WRITE(numout,*) '      consistency with analytical form   ln_vorlat = ',ln_vorlat  
     118         WRITE(numout,*) '      consistency with analytical form   ln_vorlat = ',ln_vorlat 
    118119      ENDIF 
    119120      ! 
    … …  
    140141      ! 
    141142      ! the following call is mandatory 
    142       ! it masks boundaries (bathy=0) where needed depending on the configuration (closed, periodic...)   
     143      ! it masks boundaries (bathy=0) where needed depending on the configuration (closed, periodic...) 
    143144      CALL lbc_lnk( 'dommsk', tmask  , 'T', 1._wp )      ! Lateral boundary conditions 
    144145 
    … …  
    157158         END_3D 
    158159      ENDIF 
    159           
     160 
    160161      !  Ocean/land mask at u-, v-, and f-points   (computed from tmask) 
    161162      ! ---------------------------------------- 
    … …  
    174175      END DO 
    175176      CALL lbc_lnk_multi( 'dommsk', umask, 'U', 1., vmask, 'V', 1., fmask, 'F', 1. )      ! Lateral boundary conditions 
    176   
     177 
    177178      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask) 
    178179      !----------------------------------------- 
    … …  
    182183      DO jk = 2, jpk                   ! interior values 
    183184         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 
    184          wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)    
     185         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1) 
    185186         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 
    186187      END DO 
    … …  
    192193      ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 ) 
    193194      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 ) 
     195      ssfmask(:,:) = MAXVAL( fmask(:,:,:), DIM=3 ) 
    194196 
    195197 
    … …  
    201203      ! 
    202204      !                          ! halo mask : 0 on the halo and 1 elsewhere 
    203       tmask_h(:,:) = 1._wp                   
     205      tmask_h(:,:) = 1._wp 
    204206      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns 
    205207      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns) 
    … …  
    208210      ! 
    209211      !                          ! north fold mask 
    210       tpol(1:jpiglo) = 1._wp  
     212      tpol(1:jpiglo) = 1._wp 
    211213      fpol(1:jpiglo) = 1._wp 
    212214      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot 
    … …  
    225227      ENDIF 
    226228      ! 
    227       !                          ! interior mask : 2D ocean mask x halo mask  
     229      !                          ! interior mask : 2D ocean mask x halo mask 
    228230      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:) 
    229231 
    230232 
    231233      ! Lateral boundary conditions on velocity (modify fmask) 
    232       ! ---------------------------------------   
     234      ! --------------------------------------- 
    233235      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition 
    234236         ! 
    … …  
    236238         ! 
    237239         DO jk = 1, jpk 
    238             zwf(:,:) = fmask(:,:,jk)          
     240            zwf(:,:) = fmask(:,:,jk) 
    239241            DO_2D_00_00 
    240242               IF( fmask(ji,jj,jk) == 0._wp ) THEN 
    … …  
    250252                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
    251253               ENDIF 
    252             END DO          
     254            END DO 
    253255            DO ji = 2, jpim1 
    254256               IF( fmask(ji,1,jk) == 0._wp ) THEN 
    … …  
    259261               ENDIF 
    260262            END DO 
    261 #if defined key_agrif  
    262             IF( .NOT. AGRIF_Root() ) THEN  
    263                IF ((nbondi ==  1).OR.(nbondi == 2)) fmask(nlci-1 , :     ,jk) = 0.e0      ! east  
    264                IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1      , :     ,jk) = 0.e0      ! west  
    265                IF ((nbondj ==  1).OR.(nbondj == 2)) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north  
    266                IF ((nbondj == -1).OR.(nbondj == 2)) fmask(:      ,1      ,jk) = 0.e0      ! south  
    267             ENDIF  
    268 #endif  
     263#if defined key_agrif 
     264            IF( .NOT. AGRIF_Root() ) THEN 
     265               IF ((nbondi ==  1).OR.(nbondi == 2)) fmask(nlci-1 , :     ,jk) = 0.e0      ! east 
     266               IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1      , :     ,jk) = 0.e0      ! west 
     267               IF ((nbondj ==  1).OR.(nbondj == 2)) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north 
     268               IF ((nbondj == -1).OR.(nbondj == 2)) fmask(:      ,1      ,jk) = 0.e0      ! south 
     269            ENDIF 
     270#endif 
    269271         END DO 
    270272         ! 
    … …  
    276278         ! 
    277279      ENDIF 
    278        
     280 
    279281      ! User defined alteration of fmask (use to reduce ocean transport in specified straits) 
    280       ! --------------------------------  
     282      ! -------------------------------- 
    281283      ! 
    282284      CALL usr_def_fmask( cn_cfg, nn_cfg, fmask ) 
    283285      ! 
    284286   END SUBROUTINE dom_msk 
    285     
     287 
    286288   !!====================================================================== 
    287289END MODULE dommsk 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domvvl.F90

    r12377 r12482  
    22   !!====================================================================== 
    33   !!                       ***  MODULE domvvl   *** 
    4    !! Ocean :  
     4   !! Ocean : 
    55   !!====================================================================== 
    66   !! History :  2.0  !  2006-06  (B. Levier, L. Marie)  original code 
    … …  
    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 
    … …  
    9899      !!---------------------------------------------------------------------- 
    99100      !!                ***  ROUTINE dom_vvl_init  *** 
    100       !!                    
     101      !! 
    101102      !! ** Purpose :  Initialization of all scale factors, depths 
    102103      !!               and water column heights 
    … …  
    107108      !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b) 
    108109      !!              - Regrid: e3[u/v](:,:,:,Kmm) 
    109       !!                        e3[u/v](:,:,:,Kmm)        
    110       !!                        e3w(:,:,:,Kmm)            
     110      !!                        e3[u/v](:,:,:,Kmm) 
     111      !!                        e3w(:,:,:,Kmm) 
    111112      !!                        e3[u/v]w_b 
    112       !!                        e3[u/v]w_n       
     113      !!                        e3[u/v]w_n 
    113114      !!                        gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 
    114115      !!              - h(t/u/v)_0 
    … …  
    139140      !!---------------------------------------------------------------------- 
    140141      !!                ***  ROUTINE dom_vvl_init  *** 
    141       !!                    
    142       !! ** Purpose :  Interpolation of all scale factors,  
     142      !! 
     143      !! ** Purpose :  Interpolation of all scale factors, 
    143144      !!               depths and water column heights 
    144145      !! 
    … …  
    147148      !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b) 
    148149      !!              - Regrid: e3(u/v)_n 
    149       !!                        e3(u/v)_b        
    150       !!                        e3w_n            
    151       !!                        e3(u/v)w_b       
    152       !!                        e3(u/v)w_n       
     150      !!                        e3(u/v)_b 
     151      !!                        e3w_n 
     152      !!                        e3(u/v)w_b 
     153      !!                        e3(u/v)w_n 
    153154      !!                        gdept_n, gdepw_n and gde3w_n 
    154155      !!              - h(t/u/v)_0 
    … …  
    168169      CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' )    ! from T to U 
    169170      CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 
    170       CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' )    ! from T to V  
     171      CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' )    ! from T to V 
    171172      CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 
    172173      CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' )    ! from U to F 
    173       !                                ! Vertical interpolation of e3t,u,v  
     174      !                                ! Vertical interpolation of e3t,u,v 
    174175      CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  )  ! from T to W 
    175176      CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3w (:,:,:,Kbb), 'W'  ) 
    … …  
    193194         !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    194195         !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
    195          !                             ! 0.5 where jk = mikt      
     196         !                             ! 0.5 where jk = mikt 
    196197!!gm ???????   BUG ?  gdept(:,:,:,Kmm) as well as gde3w  does not include the thickness of ISF ?? 
    197198         zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 
    198199         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
    199200         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            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm)) 
    201202         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
    202203         gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 
    203204         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            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb)) 
    205206      END_3D 
    206207      ! 
    … …  
    261262            IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
    262263               IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
    263                   ii0 = 103   ;   ii1 = 111        
    264                   ij0 = 128   ;   ij1 = 135   ;    
     264                  ii0 = 103   ;   ii1 = 111 
     265                  ij0 = 128   ;   ij1 = 135   ; 
    265266                  frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
    266267                  frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rdt 
    … …  
    280281            CALL iom_set_rstw_var_active('tilde_e3t_n') 
    281282         END IF 
    282          !                                           ! -------------!     
     283         !                                           ! -------------! 
    283284         IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    284285            !                                        ! ------------ ! 
    … …  
    291292 
    292293 
    293    SUBROUTINE dom_vvl_sf_nxt( kt, Kbb, Kmm, Kaa, kcall )  
     294   SUBROUTINE dom_vvl_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 
    294295      !!---------------------------------------------------------------------- 
    295296      !!                ***  ROUTINE dom_vvl_sf_nxt  *** 
    296       !!                    
     297      !! 
    297298      !! ** Purpose :  - compute the after scale factors used in tra_zdf, dynnxt, 
    298299      !!                 tranxt and dynspg routines 
    299300      !! 
    300301      !! ** Method  :  - z_star case:  Repartition of ssh INCREMENT proportionnaly to the level thickness. 
    301       !!               - z_tilde_case: after scale factor increment =  
     302      !!               - z_tilde_case: after scale factor increment = 
    302303      !!                                    high frequency part of horizontal divergence 
    303304      !!                                  + retsoring towards the background grid 
    … …  
    307308      !! 
    308309      !! ** Action  :  - hdiv_lf    : restoring towards full baroclinic divergence in z_tilde case 
    309       !!               - tilde_e3t_a: after increment of vertical scale factor  
     310      !!               - tilde_e3t_a: after increment of vertical scale factor 
    310311      !!                              in z_tilde case 
    311312      !!               - e3(t/u/v)_a 
    … …  
    410411            un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           & 
    411412               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
    412             vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           &  
     413            vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           & 
    413414               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) ) 
    414415            zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 
    … …  
    467468               WRITE(numout, *) 'at i, j, k=', ijk_max 
    468469               WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 
    469                WRITE(numout, *) 'at i, j, k=', ijk_min             
     470               WRITE(numout, *) 'at i, j, k=', ijk_min 
    470471               CALL ctl_stop( 'STOP', 'MAX( ABS( tilde_e3t_a(:,:,: ) ) / e3t_0(:,:,:) ) too high') 
    471472            ENDIF 
    … …  
    582583      !!---------------------------------------------------------------------- 
    583584      !!                ***  ROUTINE dom_vvl_sf_update  *** 
    584       !!                    
    585       !! ** Purpose :  for z tilde case: compute time filter and swap of scale factors  
     585      !! 
     586      !! ** Purpose :  for z tilde case: compute time filter and swap of scale factors 
    586587      !!               compute all depths and related variables for next time step 
    587588      !!               write outputs and restart file 
    … …  
    593594      !! ** Action  :  - tilde_e3t_(b/n) ready for next time step 
    594595      !!               - Recompute: 
    595       !!                    e3(u/v)_b        
    596       !!                    e3w(:,:,:,Kmm)            
    597       !!                    e3(u/v)w_b       
    598       !!                    e3(u/v)w_n       
     596      !!                    e3(u/v)_b 
     597      !!                    e3w(:,:,:,Kmm) 
     598      !!                    e3(u/v)w_b 
     599      !!                    e3(u/v)w_n 
    599600      !!                    gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm)  and gde3w 
    600601      !!                    h(u/v) and h(u/v)r 
    … …  
    627628            tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 
    628629         ELSE 
    629             tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) &  
     630            tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 
    630631            &         + atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 
    631632         ENDIF 
    … …  
    639640      ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 
    640641      ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 
    641        
     642 
    642643      CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F'  ) 
    643        
     644 
    644645      ! Vertical scale factor interpolations 
    645646      CALL dom_vvl_interpol( e3t(:,:,:,Kmm),  e3w(:,:,:,Kmm), 'W'  ) 
    … …  
    660661         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
    661662         gdept(ji,jj,jk,Kmm) =    zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) )  & 
    662              &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) )  
     663             &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) ) 
    663664         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
    664665      END_3D 
    … …  
    779780      !!--------------------------------------------------------------------- 
    780781      !!                   ***  ROUTINE dom_vvl_rst  *** 
    781       !!                      
     782      !! 
    782783      !! ** Purpose :   Read or write VVL file in restart file 
    783784      !! 
    … …  
    796797      !!---------------------------------------------------------------------- 
    797798      ! 
    798       IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
     799      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
    799800         !                                   ! =============== 
    800801         IF( ln_rstart ) THEN                   !* Read the restart file 
    … …  
    815816               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    816817               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
    817                ! needed to restart if land processor not computed  
     818               ! needed to restart if land processor not computed 
    818819               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    819                WHERE ( tmask(:,:,:) == 0.0_wp )  
     820               WHERE ( tmask(:,:,:) == 0.0_wp ) 
    820821                  e3t(:,:,:,Kmm) = e3t_0(:,:,:) 
    821822                  e3t(:,:,:,Kbb) = e3t_0(:,:,:) 
    … …  
    880881            ! 
    881882 
    882             IF( ll_wd ) THEN   ! MJB ll_wd edits start here - these are essential  
     883            IF( ll_wd ) THEN   ! MJB ll_wd edits start here - these are essential 
    883884               ! 
    884885               IF( cn_cfg == 'wad' ) THEN 
    … …  
    915916                       CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 
    916917                     ENDIF 
    917                   END DO  
    918                END DO  
     918                  END DO 
     919               END DO 
    919920               ! 
    920921            ELSE 
    … …  
    957958            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lwxios) 
    958959         END IF 
    959          !                                           ! -------------!     
     960         !                                           ! -------------! 
    960961         IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    961962            !                                        ! ------------ ! 
    … …  
    972973      !!--------------------------------------------------------------------- 
    973974      !!                  ***  ROUTINE dom_vvl_ctl  *** 
    974       !!                 
     975      !! 
    975976      !! ** Purpose :   Control the consistency between namelist options 
    976977      !!                for vertical coordinate 
    … …  
    981982         &              ln_vvl_zstar_at_eqtor      , rn_ahe3     , rn_rst_e3t            , & 
    982983         &              rn_lf_cutoff               , rn_zdef_max , ln_vvl_dbg                ! not yet implemented: ln_vvl_kepe 
    983       !!----------------------------------------------------------------------  
     984      !!---------------------------------------------------------------------- 
    984985      ! 
    985986      READ  ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/nemogcm.F90

    r12377 r12482  
    2929   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    3030   !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE 
    31    !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening  
     31   !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
    3232   !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla) 
    3333   !!            4.0  ! 2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
    … …  
    5353   USE ldftra         ! lateral diffusivity setting    (ldftra_init routine) 
    5454   USE trdini         ! dyn/tra trends initialization     (trd_init routine) 
    55    USE asminc         ! assimilation increments      
     55   USE asminc         ! assimilation increments 
    5656   USE asmbkg         ! writing out state trajectory 
    5757   USE diaptr         ! poleward transports           (dia_ptr_init routine) 
    … …  
    6060   USE diacfl         ! CFL diagnostics               (dia_cfl_init routine) 
    6161   USE diamlr         ! IOM context management for multiple-linear-regression analysis 
    62    USE step           ! NEMO time-stepping                 (stp     routine) 
     62   USE steplf         ! NEMO time-stepping               (stplf     routine) 
    6363   USE isfstp         ! ice shelf                     (isf_stp_init routine) 
    6464   USE icbini         ! handle bergs, initialisation 
    … …  
    8686   USE lib_mpp        ! distributed memory computing 
    8787   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    88    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges  
     88   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
    8989   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    9090#if defined key_iomput 
    … …  
    124124      !! 
    125125      !! ** Method  : - model general initialization 
    126       !!              - launch the time-stepping (stp routine) 
     126      !!              - launch the time-stepping (stplf routine) 
    127127      !!              - finalize the run by closing files and communications 
    128128      !! 
    … …  
    143143      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    144144      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
    145       CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
     145      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA 
    146146# if defined key_top 
    147147      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
    … …  
    178178      ! 
    179179      DO WHILE( istp <= nitend .AND. nstop == 0 ) 
    180          CALL stp 
     180         CALL stplf 
    181181         istp = istp + 1 
    182182      END DO 
    … …  
    201201               IF ( istp ==         nitend ) elapsed_time = zstptiming - elapsed_time 
    202202            ENDIF 
    203              
    204             CALL stp        ( istp )  
     203 
     204            CALL stplf        ( istp ) 
    205205            istp = istp + 1 
    206206 
    … …  
    212212         ! 
    213213         DO WHILE( istp <= nitend .AND. nstop == 0 ) 
    214             CALL stp_diurnal( istp )   ! time step only the diurnal SST  
     214            CALL stp_diurnal( istp )   ! time step only the diurnal SST 
    215215            istp = istp + 1 
    216216         END DO 
    … …  
    384384903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 
    385385      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    386 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )    
     386904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' ) 
    387387      ! 
    388388      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
    … …  
    420420                           CALL     wad_init        ! Wetting and drying options 
    421421                           CALL     dom_init( Nbb, Nnn, Naa, "OPA") ! Domain 
    422       IF( ln_crs       )   CALL     crs_init(      Nnn )       ! coarsened grid: domain initialization  
     422      IF( ln_crs       )   CALL     crs_init(      Nnn )       ! coarsened grid: domain initialization 
    423423      IF( sn_cfctl%l_prtctl )   & 
    424424         &                 CALL prt_ctl_init        ! Print control 
    425        
     425 
    426426                           CALL diurnal_sst_bulk_init       ! diurnal sst 
    427       IF( ln_diurnal   )   CALL diurnal_sst_coolskin_init   ! cool skin    
    428       !                             
     427      IF( ln_diurnal   )   CALL diurnal_sst_coolskin_init   ! cool skin 
     428      ! 
    429429      IF( ln_diurnal_only ) THEN                    ! diurnal only: a subset of the initialisation routines 
    430430         CALL  istate_init( Nbb, Nnn, Naa )         ! ocean initial state (Dynamics and tracers) 
    … …  
    434434            CALL dia_obs_init( Nnn )                ! Initialize observational data 
    435435            CALL dia_obs( nit000 - 1, Nnn )         ! Observation operator for restart 
    436          ENDIF      
     436         ENDIF 
    437437         IF( lk_asminc )   CALL asm_inc_init( Nbb, Nnn, Nrhs )   ! Assimilation increments 
    438438         ! 
    … …  
    440440      ENDIF 
    441441      ! 
    442        
     442 
    443443                           CALL  istate_init( Nbb, Nnn, Naa )    ! ocean initial state (Dynamics and tracers) 
    444444 
    445       !                                      ! external forcing  
     445      !                                      ! external forcing 
    446446                           CALL    tide_init                     ! tidal harmonics 
    447447                           CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice) 
    … …  
    450450      !                                      ! Ocean physics 
    451451                           CALL zdf_phy_init( Nnn )    ! Vertical physics 
    452                                       
     452 
    453453      !                                         ! Lateral physics 
    454454                           CALL ldf_tra_init      ! Lateral ocean tracer physics 
    … …  
    487487                           CALL sto_par_init    ! Stochastic parametrization 
    488488      IF( ln_sto_eos   )   CALL sto_pts_init    ! RRandom T/S fluctuations 
    489       
     489 
    490490      !                                      ! Diagnostics 
    491491                           CALL     flo_init( Nnn )    ! drifting Floats 
    … …  
    535535         WRITE(numout,*) '                              sn_cfctl%l_prttrc  = ', sn_cfctl%l_prttrc 
    536536         WRITE(numout,*) '                              sn_cfctl%l_oasout  = ', sn_cfctl%l_oasout 
    537          WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin   
    538          WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax   
    539          WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    540          WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
     537         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin 
     538         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax 
     539         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
     540         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
    541541         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    542542         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    … …  
    662662      !!---------------------------------------------------------------------- 
    663663      ! 
    664       ierr =        oce_alloc    ()    ! ocean  
     664      ierr =        oce_alloc    ()    ! ocean 
    665665      ierr = ierr + dia_wri_alloc() 
    666666      ierr = ierr + dom_oce_alloc()    ! ocean domain 
    … …  
    674674   END SUBROUTINE nemo_alloc 
    675675 
    676     
     676 
    677677   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
    678678      !!---------------------------------------------------------------------- 
    … …  
    705705   !!====================================================================== 
    706706END MODULE nemogcm 
    707  
Note: See TracChangeset for help on using the changeset viewer.