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

Changeset 12482 for NEMO


Ignore:
Timestamp:
2020-02-28T11:26:52+01:00 (4 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.