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 14017 for NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DOM – NEMO

Ignore:
Timestamp:
2020-12-02T16:32:24+01:00 (4 years ago)
Author:
laurent
Message:

Keep up with trunk revision 13999

Location:
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DOM
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DOM/daymod.F90

    r13558 r14017  
    1919   !!                    ----------- WARNING ----------- 
    2020   !!                    ------------------------------- 
    21    !!   sbcmod assume that the time step is dividing the number of second of  
    22    !!   in a day, i.e. ===> MOD( rday, rn_Dt ) == 0  
     21   !!   sbcmod assume that the time step is dividing the number of second of 
     22   !!   in a day, i.e. ===> MOD( rday, rn_Dt ) == 0 
    2323   !!   except when user defined forcing is used (see sbcmod.F90) 
    2424   !!---------------------------------------------------------------------- 
    … …  
    8484      lrst_oce = .NOT. l_offline   ! force definition of offline 
    8585      IF( lrst_oce )   CALL day_rst( nit000, 'READ' ) 
    86        
     86 
    8787      ! set the calandar from ndastp (read in restart file and namelist) 
    8888      nyear   =   ndastp / 10000 
    … …  
    9494      isecrst = ( nhour * NINT(rhhmm) + nminute ) * NINT(rmmss) 
    9595 
    96       CALL ymds2ju( nyear, nmonth, nday, REAL(isecrst,wp), fjulday )   
     96      CALL ymds2ju( nyear, nmonth, nday, REAL(isecrst,wp), fjulday ) 
    9797      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error 
    9898      IF( nhour*NINT(rhhmm*rmmss) + nminute*NINT(rmmss) - ndt05 .LT. 0 ) fjulday = fjulday+1.       ! move back to the day at nit000 (and not at nit000 - 1) 
    … …  
    124124      IF( isecrst - ndt05 .GT. 0 ) THEN 
    125125         ! 1 timestep before current middle of first time step is still the same day 
    126          nsec_year  = (nday_year-1) * nsecd + isecrst - ndt05  
    127          nsec_month = (nday-1)      * nsecd + isecrst - ndt05     
     126         nsec_year  = (nday_year-1) * nsecd + isecrst - ndt05 
     127         nsec_month = (nday-1)      * nsecd + isecrst - ndt05 
    128128      ELSE 
    129          ! 1 time step before the middle of the first time step is the previous day  
    130          nsec_year  = nday_year     * nsecd + isecrst - ndt05  
    131          nsec_month = nday          * nsecd + isecrst - ndt05    
     129         ! 1 time step before the middle of the first time step is the previous day 
     130         nsec_year  = nday_year     * nsecd + isecrst - ndt05 
     131         nsec_month = nday          * nsecd + isecrst - ndt05 
    132132      ENDIF 
    133133      nsec_monday   = imonday       * nsecd + isecrst - ndt05 
    134       nsec_day      =                         isecrst - ndt05  
     134      nsec_day      =                         isecrst - ndt05 
    135135      IF( nsec_day    .LT. 0 ) nsec_day    = nsec_day    + nsecd 
    136136      IF( nsec_monday .LT. 0 ) nsec_monday = nsec_monday + nsecd*7 
    … …  
    144144      nsec000_1jan000 = nsec1jan000 + nsec_year + ndt05 
    145145      nsecend_1jan000 = nsec000_1jan000 + ndt * ( nitend - nit000 + 1 ) 
    146        
     146 
    147147      ! Up to now, calendar parameters are related to the end of previous run (nit000-1) 
    148148      ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init 
    149149      CALL day( nit000 ) 
    150150      ! 
    151       IF( lwxios ) THEN 
    152 ! define variables in restart file when writing with XIOS 
    153           CALL iom_set_rstw_var_active('kt') 
    154           CALL iom_set_rstw_var_active('ndastp') 
    155           CALL iom_set_rstw_var_active('adatrj') 
    156           CALL iom_set_rstw_var_active('ntime') 
    157       ENDIF 
    158  
    159151   END SUBROUTINE day_init 
    160152 
    … …  
    324316 
    325317      IF( TRIM(cdrw) == 'READ' ) THEN 
    326  
    327318         IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN 
    328319            ! Get Calendar informations 
    329             CALL iom_get( numror, 'kt', zkt, ldxios = lrxios )   ! last time-step of previous run 
     320            CALL iom_get( numror, 'kt', zkt )   ! last time-step of previous run 
    330321            IF(lwp) THEN 
    331322               WRITE(numout,*) ' *** Info read in restart : ' 
    … …  
    346337            IF ( nrstdt == 2 ) THEN 
    347338               ! read the parameters corresponding to nit000 - 1 (last time step of previous run) 
    348                CALL iom_get( numror, 'ndastp', zndastp, ldxios = lrxios ) 
     339               CALL iom_get( numror, 'ndastp', zndastp ) 
    349340               ndastp = NINT( zndastp ) 
    350                CALL iom_get( numror, 'adatrj', adatrj , ldxios = lrxios ) 
    351           CALL iom_get( numror, 'ntime' , ktime  , ldxios = lrxios ) 
     341               CALL iom_get( numror, 'adatrj', adatrj ) 
     342          CALL iom_get( numror, 'ntime' , ktime  ) 
    352343               nn_time0 = NINT(ktime) 
    353344               ! calculate start time in hours and minutes 
    354345               zdayfrac = adatrj - REAL(INT(adatrj), wp) 
    355           ksecs = NINT(zdayfrac * rday)          ! Nearest second to catch rounding errors in adatrj          
     346          ksecs = NINT(zdayfrac * rday)          ! Nearest second to catch rounding errors in adatrj 
    356347               ihour = ksecs / NINT( rhhmm*rmmss ) 
    357348          iminute = ksecs / NINT(rmmss) - ihour*NINT(rhhmm) 
    358             
     349 
    359350               ! Add to nn_time0 
    360351               nhour   =   nn_time0 / 100 
    361352               nminute = ( nn_time0 - nhour * 100 ) 
    362353          nminute = nminute + iminute 
    363            
     354 
    364355               IF( nminute >= NINT(rhhmm) ) THEN 
    365356             nminute = nminute - NINT(rhhmm) 
    … …  
    370361        nhour = nhour - NINT(rjjhh) 
    371362             adatrj = adatrj + 1. 
    372           ENDIF           
     363          ENDIF 
    373364          nn_time0 = nhour * 100 + nminute 
    374                adatrj = REAL(INT(adatrj), wp)                    ! adatrj set to integer as nn_time0 updated           
     365               adatrj = REAL(INT(adatrj), wp)                    ! adatrj set to integer as nn_time0 updated 
    375366            ELSE 
    376367               ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day) 
    … …  
    410401         ENDIF 
    411402         ! calendar control 
    412          IF( lwxios ) CALL iom_swap(      cwxios_context          ) 
    413          CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp)  , ldxios = lwxios )   ! time-step 
    414          CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp)  , ldxios = lwxios )   ! date 
    415          CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj             , ldxios = lwxios            )   ! number of elapsed days since 
     403         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp)   )   ! time-step 
     404         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp)   )   ! date 
     405         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj              )   ! number of elapsed days since 
    416406         !                                                                                                   ! the begining of the run [s] 
    417          CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp), ldxios = lwxios ) ! time 
    418          IF( lwxios ) CALL iom_swap(      cxios_context          ) 
     407         CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp) ) ! time 
    419408      ENDIF 
    420409      ! 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DOM/dom_oce.F90

    r13557 r14017  
    44   !! ** Purpose :   Define in memory all the ocean space domain variables 
    55   !!====================================================================== 
    6    !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate  
     6   !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate 
    77   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level 
    88   !!            3.4  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    … …  
    7272   !                                !  = 6 cyclic East-West AND North fold F-point pivot 
    7373   !                                !  = 7 bi-cyclic East-West AND North-South 
    74    LOGICAL, PUBLIC ::   l_Iperio, l_Jperio   !   should we explicitely take care I/J periodicity  
     74   LOGICAL, PUBLIC ::   l_Iperio, l_Jperio   !   should we explicitely take care I/J periodicity 
     75 
     76   ! Tiling namelist 
     77   LOGICAL, PUBLIC ::   ln_tile 
     78   INTEGER         ::   nn_ltile_i, nn_ltile_j 
     79 
     80   ! Domain tiling (all tiles) 
     81   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntsi_a       !: start of internal part of tile domain 
     82   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntsj_a       ! 
     83   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntei_a       !: end of internal part of tile domain 
     84   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntej_a       ! 
    7585 
    7686   !                             !: domain MPP decomposition parameters 
    … …  
    8191   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy(:)    !: mark i-direction local boundaries for BDY open boundaries 
    8292   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy(:)    !: mark j-direction local boundaries for BDY open boundaries 
    83    INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy_b(:)  !: mark i-direction of neighbours local boundaries for BDY open boundaries   
    84    INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy_b(:)  !: mark j-direction of neighbours local boundaries for BDY open boundaries   
     93   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy_b(:)  !: mark i-direction of neighbours local boundaries for BDY open boundaries 
     94   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy_b(:)  !: mark j-direction of neighbours local boundaries for BDY open boundaries 
    8595 
    8696   INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4) 
    8797   INTEGER, PUBLIC ::   noea, nowe        !: index of the local neighboring processors in 
    8898   INTEGER, PUBLIC ::   noso, nono        !: east, west, south and north directions 
     99   INTEGER, PUBLIC ::   nones, nonws        !: north-east, north-west directions for sending 
     100   INTEGER, PUBLIC ::   noses, nosws        !: south-east, south-west directions for sending 
     101   INTEGER, PUBLIC ::   noner, nonwr        !: north-east, north-west directions for receiving 
     102   INTEGER, PUBLIC ::   noser, noswr        !: south-east, south-west directions for receiving 
    89103   INTEGER, PUBLIC ::   nidom             !: ??? 
    90104 
    … …  
    128142   LOGICAL, PUBLIC ::   ln_zps       !: z-coordinate - partial step 
    129143   LOGICAL, PUBLIC ::   ln_sco       !: s-coordinate or hybrid z-s coordinate 
    130    LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF  
     144   LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF 
    131145   !                                                        !  reference scale factors 
    132146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0   !: t- vert. scale factor [m] 
    … …  
    152166   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0  !: w- depth (sum of e3w) [m] 
    153167   !                                                        !  time-dependent depths of cells 
    154    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  gdept, gdepw   
    155    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gde3w   
    156     
     168   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  gdept, gdepw 
     169   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gde3w 
     170 
    157171   !                                                        !  reference heights of ocean water column and its inverse 
    158172   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   ht_0, r1_ht_0   !: t-depth        [m] and [1/m] 
    … …  
    168182 
    169183   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 
    170    INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1)  
     184   INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1) 
    171185 
    172186   !! 1D reference  vertical coordinate 
    … …  
    208222   INTEGER , PUBLIC ::   nsec_monday   !: seconds between 00h         of the last Monday   and half of the current time step 
    209223   INTEGER , PUBLIC ::   nsec_day      !: seconds between 00h         of the current   day and half of the current time step 
    210    REAL(wp), PUBLIC ::   fjulday       !: current julian day  
     224   REAL(wp), PUBLIC ::   fjulday       !: current julian day 
    211225   REAL(wp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days 
    212226   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation 
    … …  
    236250   !!---------------------------------------------------------------------- 
    237251   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    238    !! $Id$  
     252   !! $Id$ 
    239253   !! Software governed by the CeCILL license (see ./LICENSE) 
    240254   !!---------------------------------------------------------------------- 
    … …  
    254268 
    255269   CHARACTER(len=3) FUNCTION Agrif_CFixed() 
    256       Agrif_CFixed = '0'  
     270      Agrif_CFixed = '0' 
    257271   END FUNCTION Agrif_CFixed 
    258272#endif 
    … …  
    296310      ALLOCATE( e3t(jpi,jpj,jpk,jpt) , e3u (jpi,jpj,jpk,jpt) , e3v (jpi,jpj,jpk,jpt) , e3f(jpi,jpj,jpk) ,      & 
    297311         &      e3w(jpi,jpj,jpk,jpt) , e3uw(jpi,jpj,jpk,jpt) , e3vw(jpi,jpj,jpk,jpt)                    ,  STAT=ierr(ii) ) 
    298 #endif   
     312#endif 
    299313         ! 
    300314      ii = ii+1 
    301315      ALLOCATE( r3t  (jpi,jpj,jpt)   , r3u  (jpi,jpj,jpt)    , r3v  (jpi,jpj,jpt)    , r3f  (jpi,jpj) ,  & 
    302          &      r3t_f(jpi,jpj)       , r3u_f(jpi,jpj)        , r3v_f(jpi,jpj)                         ,  STAT=ierr(ii) )        
     316         &      r3t_f(jpi,jpj)       , r3u_f(jpi,jpj)        , r3v_f(jpi,jpj)                         ,  STAT=ierr(ii) ) 
    303317         ! 
    304318      ii = ii+1 
    … …  
    317331         ! 
    318332      ii = ii+1 
    319       ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(ii)  )  
     333      ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(ii)  ) 
    320334         ! 
    321335      ii = ii+1 
    … …  
    323337         ! 
    324338      ii = ii+1 
    325       ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                        &  
     339      ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                        & 
    326340         &      ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) ,     & 
    327341         &      mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) ,                    STAT=ierr(ii) ) 
    … …  
    331345         ! 
    332346      ii = ii+1 
    333       ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) ,     &  
     347      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) ,     & 
    334348         &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk) , STAT=ierr(ii) ) 
    335349         ! 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DOM/domain.F90

    r13558 r14017  
    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 
    … …  
    1717   !!            4.x  ! 2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio 
    1818   !!---------------------------------------------------------------------- 
    19     
     19 
    2020   !!---------------------------------------------------------------------- 
    2121   !!   dom_init      : initialize the space and time domain 
    … …  
    4545   USE closea , ONLY : dom_clo ! closed seas 
    4646   ! 
     47   USE prtctl         ! Print control (prt_ctl_info routine) 
    4748   USE in_out_manager ! I/O manager 
    4849   USE iom            ! I/O library 
    … …  
    5556   PUBLIC   dom_init     ! called by nemogcm.F90 
    5657   PUBLIC   domain_cfg   ! called by nemogcm.F90 
     58   PUBLIC   dom_tile     ! called by step.F90 
    5759 
    5860   !!------------------------------------------------------------------------- 
    … …  
    6365CONTAINS 
    6466 
    65    SUBROUTINE dom_init( Kbb, Kmm, Kaa, cdstr ) 
     67   SUBROUTINE dom_init( Kbb, Kmm, Kaa ) 
    6668      !!---------------------------------------------------------------------- 
    6769      !!                  ***  ROUTINE dom_init  *** 
    68       !!                     
    69       !! ** Purpose :   Domain initialization. Call the routines that are  
    70       !!              required to create the arrays which define the space  
     70      !! 
     71      !! ** Purpose :   Domain initialization. Call the routines that are 
     72      !!              required to create the arrays which define the space 
    7173      !!              and time domain of the ocean model. 
    7274      !! 
    … …  
    7981      !!---------------------------------------------------------------------- 
    8082      INTEGER          , INTENT(in) :: Kbb, Kmm, Kaa          ! ocean time level indices 
    81       CHARACTER (len=*), INTENT(in) :: cdstr                  ! model: NEMO or SAS. Determines core restart variables 
    8283      ! 
    8384      INTEGER ::   ji, jj, jk, jt   ! dummy loop indices 
    8485      INTEGER ::   iconf = 0    ! local integers 
    85       CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))"  
     86      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
    8687      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level 
    8788      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0 
    … …  
    120121         WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg 
    121122      ENDIF 
     123      nn_wxios = 0 
     124      ln_xios_read = .FALSE. 
    122125      ! 
    123126      !           !==  Reference coordinate system  ==! 
    124127      ! 
    125       CALL dom_glo                     ! global domain versus local domain 
    126       CALL dom_nam                     ! read namelist ( namrun, namdom ) 
    127       ! 
    128       IF( lwxios ) THEN 
    129 !define names for restart write and set core output (restart.F90) 
    130          CALL iom_set_rst_vars(rst_wfields) 
    131          CALL iom_set_rstw_core(cdstr) 
    132       ENDIF 
    133 !reset namelist for SAS 
    134       IF(cdstr == 'SAS') THEN 
    135          IF(lrxios) THEN 
    136                IF(lwp) write(numout,*) 'Disable reading restart file using XIOS for SAS' 
    137                lrxios = .FALSE. 
    138          ENDIF 
    139       ENDIF 
     128      CALL dom_glo                            ! global domain versus local domain 
     129      CALL dom_nam                            ! read namelist ( namrun, namdom ) 
     130      CALL dom_tile( ntsi, ntsj, ntei, ntej ) ! Tile domain 
     131 
    140132      ! 
    141133      CALL dom_hgr                      ! Horizontal mesh 
    … …  
    224216         WRITE(numout,*) 'dom_init :   ==>>>   END of domain initialization' 
    225217         WRITE(numout,*) '~~~~~~~~' 
    226          WRITE(numout,*)  
     218         WRITE(numout,*) 
    227219      ENDIF 
    228220      ! 
    … …  
    236228      !! ** Purpose :   initialization of global domain <--> local domain indices 
    237229      !! 
    238       !! ** Method  :    
     230      !! ** Method  : 
    239231      !! 
    240232      !! ** Action  : - mig , mjg : local  domain indices ==> global domain, including halos, indices 
    … …  
    255247      ! 
    256248      mig0(:) = mig(:) - nn_hls 
    257       mjg0(:) = mjg(:) - nn_hls   
    258       ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,  
     249      mjg0(:) = mjg(:) - nn_hls 
     250      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data, 
    259251      ! we must define mig0 and mjg0 as bellow. 
    260252      ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as: 
    … …  
    263255      ! 
    264256      !                              ! global domain, including halos, indices ==> local domain indices 
    265       !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the  
    266       !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.  
     257      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 
     258      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 
    267259      DO ji = 1, jpiglo 
    268260        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) ) 
    … …  
    285277 
    286278 
     279   SUBROUTINE dom_tile( ktsi, ktsj, ktei, ktej, ktile ) 
     280      !!---------------------------------------------------------------------- 
     281      !!                     ***  ROUTINE dom_tile  *** 
     282      !! 
     283      !! ** Purpose :   Set tile domain variables 
     284      !! 
     285      !! ** Action  : - ktsi, ktsj     : start of internal part of domain 
     286      !!              - ktei, ktej     : end of internal part of domain 
     287      !!              - ntile          : current tile number 
     288      !!              - nijtile        : total number of tiles 
     289      !!---------------------------------------------------------------------- 
     290      INTEGER, INTENT(out) :: ktsi, ktsj, ktei, ktej      ! Tile domain indices 
     291      INTEGER, INTENT(in), OPTIONAL :: ktile              ! Tile number 
     292      INTEGER ::   jt                                     ! dummy loop argument 
     293      INTEGER ::   iitile, ijtile                         ! Local integers 
     294      CHARACTER (len=11) ::   charout 
     295      !!---------------------------------------------------------------------- 
     296      IF( PRESENT(ktile) .AND. ln_tile ) THEN 
     297         ntile = ktile                 ! Set domain indices for tile 
     298         ktsi = ntsi_a(ktile) 
     299         ktsj = ntsj_a(ktile) 
     300         ktei = ntei_a(ktile) 
     301         ktej = ntej_a(ktile) 
     302 
     303         IF(sn_cfctl%l_prtctl) THEN 
     304            WRITE(charout, FMT="('ntile =', I4)") ktile 
     305            CALL prt_ctl_info( charout ) 
     306         ENDIF 
     307      ELSE 
     308         ntile = 0                     ! Initialise to full domain 
     309         nijtile = 1 
     310         ktsi = Nis0 
     311         ktsj = Njs0 
     312         ktei = Nie0 
     313         ktej = Nje0 
     314 
     315         IF( ln_tile ) THEN            ! Calculate tile domain indices 
     316            iitile = Ni_0 / nn_ltile_i       ! Number of tiles 
     317            ijtile = Nj_0 / nn_ltile_j 
     318            IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1 
     319            IF( MOD( Nj_0, nn_ltile_j ) /= 0 ) ijtile = ijtile + 1 
     320 
     321            nijtile = iitile * ijtile 
     322            ALLOCATE( ntsi_a(0:nijtile), ntsj_a(0:nijtile), ntei_a(0:nijtile), ntej_a(0:nijtile) ) 
     323 
     324            ntsi_a(0) = ktsi                 ! Full domain 
     325            ntsj_a(0) = ktsj 
     326            ntei_a(0) = ktei 
     327            ntej_a(0) = ktej 
     328 
     329            DO jt = 1, nijtile               ! Tile domains 
     330               ntsi_a(jt) = Nis0 + nn_ltile_i * MOD(jt - 1, iitile) 
     331               ntsj_a(jt) = Njs0 + nn_ltile_j * ((jt - 1) / iitile) 
     332               ntei_a(jt) = MIN(ntsi_a(jt) + nn_ltile_i - 1, Nie0) 
     333               ntej_a(jt) = MIN(ntsj_a(jt) + nn_ltile_j - 1, Nje0) 
     334            ENDDO 
     335         ENDIF 
     336 
     337         IF(lwp) THEN                  ! control print 
     338            WRITE(numout,*) 
     339            WRITE(numout,*) 'dom_tile : Domain tiling decomposition' 
     340            WRITE(numout,*) '~~~~~~~~' 
     341            IF( ln_tile ) THEN 
     342               WRITE(numout,*) iitile, 'tiles in i' 
     343               WRITE(numout,*) '    Starting indices' 
     344               WRITE(numout,*) '        ', (ntsi_a(jt), jt=1, iitile) 
     345               WRITE(numout,*) '    Ending indices' 
     346               WRITE(numout,*) '        ', (ntei_a(jt), jt=1, iitile) 
     347               WRITE(numout,*) ijtile, 'tiles in j' 
     348               WRITE(numout,*) '    Starting indices' 
     349               WRITE(numout,*) '        ', (ntsj_a(jt), jt=1, nijtile, iitile) 
     350               WRITE(numout,*) '    Ending indices' 
     351               WRITE(numout,*) '        ', (ntej_a(jt), jt=1, nijtile, iitile) 
     352            ELSE 
     353               WRITE(numout,*) 'No domain tiling' 
     354               WRITE(numout,*) '    i indices =', ktsi, ':', ktei 
     355               WRITE(numout,*) '    j indices =', ktsj, ':', ktej 
     356            ENDIF 
     357         ENDIF 
     358      ENDIF 
     359   END SUBROUTINE dom_tile 
     360 
     361 
    287362   SUBROUTINE dom_nam 
    288363      !!---------------------------------------------------------------------- 
    289364      !!                     ***  ROUTINE dom_nam  *** 
    290       !!                     
     365      !! 
    291366      !! ** Purpose :   read domaine namelists and print the variables. 
    292367      !! 
    293368      !! ** input   : - namrun namelist 
    294369      !!              - namdom namelist 
     370      !!              - namtile namelist 
    295371      !!              - namnc4 namelist   ! "key_netcdf4" only 
    296372      !!---------------------------------------------------------------------- 
    … …  
    305381         &             ln_cfmeta, ln_xios_read, nn_wxios 
    306382      NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_meshmask 
     383      NAMELIST/namtile/ ln_tile, nn_ltile_i, nn_ltile_j 
    307384#if defined key_netcdf4 
    308385      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 
    … …  
    377454      l_1st_euler = ln_1st_euler 
    378455      IF( .NOT. l_1st_euler .AND. .NOT. ln_rstart ) THEN 
    379          IF(lwp) WRITE(numout,*)   
     456         IF(lwp) WRITE(numout,*) 
    380457         IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)' 
    381          IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : l_1st_euler is forced to .true. '    
     458         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : l_1st_euler is forced to .true. ' 
    382459         l_1st_euler = .true. 
    383460      ENDIF 
    … …  
    403480         IF(lwp) WRITE(numout,*) 
    404481         SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    405          CASE (  1 )  
     482         CASE (  1 ) 
    406483            CALL ioconf_calendar('gregorian') 
    407484            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year' 
    … …  
    441518      r1_Dt = 1._wp / rDt 
    442519 
     520      READ  ( numnam_ref, namtile, IOSTAT = ios, ERR = 905 ) 
     521905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtile in reference namelist' ) 
     522      READ  ( numnam_cfg, namtile, IOSTAT = ios, ERR = 906 ) 
     523906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtile in configuration namelist' ) 
     524      IF(lwm) WRITE( numond, namtile ) 
     525 
     526      IF(lwp) THEN 
     527         WRITE(numout,*) 
     528         WRITE(numout,*)    '   Namelist : namtile   ---   Domain tiling decomposition' 
     529         WRITE(numout,*)    '      Tiling (T) or not (F)                ln_tile    = ', ln_tile 
     530         WRITE(numout,*)    '      Length of tile in i                  nn_ltile_i = ', nn_ltile_i 
     531         WRITE(numout,*)    '      Length of tile in j                  nn_ltile_j = ', nn_ltile_j 
     532         WRITE(numout,*) 
     533         IF( ln_tile ) THEN 
     534            WRITE(numout,*) '      The domain will be decomposed into tiles of size', nn_ltile_i, 'x', nn_ltile_j 
     535         ELSE 
     536            WRITE(numout,*) '      Domain tiling will NOT be used' 
     537         ENDIF 
     538      ENDIF 
     539 
    443540      IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
    444541         lrxios = ln_xios_read.AND.ln_rstart 
    445 !set output file type for XIOS based on NEMO namelist  
    446          IF (nn_wxios > 0) lwxios = .TRUE.  
     542!set output file type for XIOS based on NEMO namelist 
     543         IF (nn_wxios > 0) lwxios = .TRUE. 
    447544         nxioso = nn_wxios 
    448545      ENDIF 
    … …  
    522619      !!---------------------------------------------------------------------- 
    523620      !!                     ***  ROUTINE dom_nam  *** 
    524       !!                     
     621      !! 
    525622      !! ** Purpose :   read the domain size in domain configuration file 
    526623      !! 
    … …  
    529626      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name 
    530627      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution 
    531       INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes  
    532       INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.  
     628      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
     629      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c. 
    533630      ! 
    534631      INTEGER ::   inum   ! local integer 
    … …  
    562659         cd_cfg = 'UNKNOWN' 
    563660         kk_cfg = -9999999 
    564                                           !- or they may be present as global attributes  
    565                                           !- (netcdf only)   
     661                                          !- or they may be present as global attributes 
     662                                          !- (netcdf only) 
    566663         CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found 
    567664         CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found 
    … …  
    585682         WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio 
    586683      ENDIF 
    587       !         
     684      ! 
    588685   END SUBROUTINE domain_cfg 
    589     
    590     
     686 
     687 
    591688   SUBROUTINE cfg_write 
    592689      !!---------------------------------------------------------------------- 
    593690      !!                  ***  ROUTINE cfg_write  *** 
    594       !!                    
    595       !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which  
    596       !!              contains all the ocean domain informations required to  
     691      !! 
     692      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which 
     693      !!              contains all the ocean domain informations required to 
    597694      !!              define an ocean configuration. 
    598695      !! 
    … …  
    600697      !!              ocean configuration. 
    601698      !! 
    602       !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal  
     699      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal 
    603700      !!                       mesh, Coriolis parameter, and vertical scale factors 
    604701      !!                    NB: also contain ORCA family information 
    … …  
    617714      !                       !  create 'domcfg_out.nc' file  ! 
    618715      !                       ! ============================= ! 
    619       !          
     716      ! 
    620717      clnam = cn_domcfg_out  ! filename (configuration information) 
    621       CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )      
     718      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 
    622719      ! 
    623720      !                             !==  ORCA family specificities  ==! 
    624721      IF( TRIM(cn_cfg) == "orca" .OR. TRIM(cn_cfg) == "ORCA" ) THEN 
    625722         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 ) 
    626          CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )          
     723         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 ) 
    627724      ENDIF 
    628725      ! 
    … …  
    646743      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 ) 
    647744      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 ) 
    648       !                                 
     745      ! 
    649746      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude 
    650747      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 ) 
    651748      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 ) 
    652749      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 ) 
    653       !                                 
     750      ! 
    654751      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.) 
    655752      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 ) 
    … …  
    666763      ! 
    667764      !                             !==  vertical mesh  ==! 
    668       !                                                      
     765      ! 
    669766      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate 
    670767      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 ) 
    … …  
    677774      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 ) 
    678775      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 ) 
    679       !                                          
     776      ! 
    680777      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask) 
    681778      ! 
    … …  
    697794      ! 
    698795      !                                ! ============================ 
    699       !                                !        close the files  
     796      !                                !        close the files 
    700797      !                                ! ============================ 
    701798      CALL iom_close( inum ) 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DOM/domqco.F90

    r13295 r14017  
    9191      ! 
    9292      CALL dom_qco_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column 
    93       ! 
    94       ! IF(lwxios) THEN   ! define variables in restart file when writing with XIOS 
    95       !    CALL iom_set_rstw_var_active('e3t_b') 
    96       !    CALL iom_set_rstw_var_active('e3t_n') 
    97       ! ENDIF 
    9893      ! 
    9994   END SUBROUTINE dom_qco_init 
    … …  
    217212            ! 
    218213            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    219                CALL iom_get( numror, jpdom_auto, 'sshb'   , ssh(:,:,Kbb), ldxios = lrxios    ) 
    220                CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     214               CALL iom_get( numror, jpdom_auto, 'sshb'   , ssh(:,:,Kbb)    ) 
     215               CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm)    ) 
    221216               ! needed to restart if land processor not computed 
    222217               IF(lwp) write(numout,*) 'qe_rst_read : ssh(:,:,Kbb) and ssh(:,:,Kmm) found in restart files' 
    … …  
    232227               IF(lwp) write(numout,*) 'sshn set equal to sshb.' 
    233228               IF(lwp) write(numout,*) 'neuler is forced to 0' 
    234                CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb), ldxios = lrxios ) 
     229               CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb) ) 
    235230               ssh(:,:,Kmm) = ssh(:,:,Kbb) 
    236231               l_1st_euler = .TRUE. 
    … …  
    239234               IF(lwp) write(numout,*) 'sshb set equal to sshn.' 
    240235               IF(lwp) write(numout,*) 'neuler is forced to 0' 
    241                CALL iom_get( numror, jpdom_auto, 'sshn', ssh(:,:,Kmm), ldxios = lrxios ) 
     236               CALL iom_get( numror, jpdom_auto, 'sshn', ssh(:,:,Kmm) ) 
    242237               ssh(:,:,Kbb) = ssh(:,:,Kmm) 
    243238               l_1st_euler = .TRUE. 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DOM/domutl.F90

    r13458 r14017  
    2121   PRIVATE 
    2222 
     23   INTERFACE is_tile 
     24      MODULE PROCEDURE is_tile_2d, is_tile_3d, is_tile_4d 
     25   END INTERFACE is_tile 
     26 
    2327   PUBLIC dom_ngb    ! routine called in iom.F90 module 
    2428   PUBLIC dom_uniq   ! Called by dommsk and domwri 
     29   PUBLIC is_tile 
    2530 
    2631   !!---------------------------------------------------------------------- 
    2732   !! NEMO/OCE 4.2 , NEMO Consortium (2020) 
    28    !! $Id$  
     33   !! $Id$ 
    2934   !! Software governed by the CeCILL license (see ./LICENSE) 
    3035   !!---------------------------------------------------------------------- 
    … …  
    3742      !! ** Purpose :   find the closest grid point from a given lon/lat position 
    3843      !! 
    39       !! ** Method  :   look for minimum distance in cylindrical projection  
     44      !! ** Method  :   look for minimum distance in cylindrical projection 
    4045      !!                -> not good if located at too high latitude... 
    4146      !!---------------------------------------------------------------------- 
    … …  
    8186      !!---------------------------------------------------------------------- 
    8287      !!                  ***  ROUTINE dom_uniq  *** 
    83       !!                    
     88      !! 
    8489      !! ** Purpose :   identify unique point of a grid (TUVF) 
    8590      !! 
    … …  
    8792      !!                2) check which elements have been changed 
    8893      !!---------------------------------------------------------------------- 
    89       CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !  
    90       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !  
     94      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   ! 
     95      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   ! 
    9196      ! 
    9297      REAL(wp)                       ::  zshift   ! shift value link to the process number 
    … …  
    96101      !!---------------------------------------------------------------------- 
    97102      ! 
    98       ! build an array with different values for each element  
     103      ! build an array with different values for each element 
    99104      ! in mpp: make sure that these values are different even between process 
    100105      ! -> apply a shift value according to the process number 
    … …  
    104109      puniq(:,:) = ztstref(:,:)                    ! default definition 
    105110      CALL lbc_lnk( 'domwri', puniq, cdgrd, 1. )   ! apply boundary conditions 
    106       lluniq(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have not been changed  
     111      lluniq(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have not been changed 
    107112      ! 
    108113      puniq(:,:) = REAL( COUNT( lluniq(:,:,:), dim = 3 ), wp ) 
    109114      ! 
    110115   END SUBROUTINE dom_uniq 
    111     
     116 
     117 
     118   FUNCTION is_tile_2d( pt ) 
     119      !! 
     120      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pt 
     121      INTEGER :: is_tile_2d 
     122      !! 
     123      IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     124         is_tile_2d = 1 
     125      ELSE 
     126         is_tile_2d = 0 
     127      ENDIF 
     128   END FUNCTION is_tile_2d 
     129 
     130 
     131   FUNCTION is_tile_3d( pt ) 
     132      !! 
     133      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pt 
     134      INTEGER :: is_tile_3d 
     135      !! 
     136      IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     137         is_tile_3d = 1 
     138      ELSE 
     139         is_tile_3d = 0 
     140      ENDIF 
     141   END FUNCTION is_tile_3d 
     142 
     143 
     144   FUNCTION is_tile_4d( pt ) 
     145      !! 
     146      REAL(wp), DIMENSION(:,:,:,:), INTENT(in) ::   pt 
     147      INTEGER :: is_tile_4d 
     148      !! 
     149      IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     150         is_tile_4d = 1 
     151      ELSE 
     152         is_tile_4d = 0 
     153      ENDIF 
     154   END FUNCTION is_tile_4d 
     155 
    112156   !!====================================================================== 
    113157END MODULE domutl 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DOM/domvvl.F90

    r13497 r14017  
    22   !!====================================================================== 
    33   !!                       ***  MODULE domvvl   *** 
    4    !! Ocean :  
     4   !! Ocean : 
    55   !!====================================================================== 
    66   !! History :  2.0  !  2006-06  (B. Levier, L. Marie)  original code 
    … …  
    5858   !!   Default key      Old management of time varying vertical coordinate 
    5959   !!---------------------------------------------------------------------- 
    60     
     60 
    6161   !!---------------------------------------------------------------------- 
    6262   !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
    … …  
    7373   PUBLIC  dom_vvl_sf_update  ! called by step.F90 
    7474   PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
    75     
     75 
    7676   !! * Substitutions 
    7777#  include "do_loop_substitute.h90" 
    … …  
    109109      !!---------------------------------------------------------------------- 
    110110      !!                ***  ROUTINE dom_vvl_init  *** 
    111       !!                    
     111      !! 
    112112      !! ** Purpose :  Initialization of all scale factors, depths 
    113113      !!               and water column heights 
    … …  
    118118      !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b) 
    119119      !!              - Regrid: e3[u/v](:,:,:,Kmm) 
    120       !!                        e3[u/v](:,:,:,Kmm)        
    121       !!                        e3w(:,:,:,Kmm)            
     120      !!                        e3[u/v](:,:,:,Kmm) 
     121      !!                        e3w(:,:,:,Kmm) 
    122122      !!                        e3[u/v]w_b 
    123       !!                        e3[u/v]w_n       
     123      !!                        e3[u/v]w_n 
    124124      !!                        gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 
    125125      !!              - h(t/u/v)_0 
    … …  
    151151      !!---------------------------------------------------------------------- 
    152152      !!                ***  ROUTINE dom_vvl_init  *** 
    153       !!                    
    154       !! ** Purpose :  Interpolation of all scale factors,  
     153      !! 
     154      !! ** Purpose :  Interpolation of all scale factors, 
    155155      !!               depths and water column heights 
    156156      !! 
    … …  
    159159      !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b) 
    160160      !!              - Regrid: e3(u/v)_n 
    161       !!                        e3(u/v)_b        
    162       !!                        e3w_n            
    163       !!                        e3(u/v)w_b       
    164       !!                        e3(u/v)w_n       
     161      !!                        e3(u/v)_b 
     162      !!                        e3w_n 
     163      !!                        e3(u/v)w_b 
     164      !!                        e3(u/v)w_n 
    165165      !!                        gdept_n, gdepw_n and gde3w_n 
    166166      !!              - h(t/u/v)_0 
    … …  
    180180      CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' )    ! from T to U 
    181181      CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 
    182       CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' )    ! from T to V  
     182      CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' )    ! from T to V 
    183183      CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 
    184184      CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' )    ! from U to F 
    185       !                                ! Vertical interpolation of e3t,u,v  
     185      !                                ! Vertical interpolation of e3t,u,v 
    186186      CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  )  ! from T to W 
    187187      CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3w (:,:,:,Kbb), 'W'  ) 
    … …  
    205205         !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    206206         !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
    207          !                             ! 0.5 where jk = mikt      
     207         !                             ! 0.5 where jk = mikt 
    208208!!gm ???????   BUG ?  gdept(:,:,:,Kmm) as well as gde3w  does not include the thickness of ISF ?? 
    209209         zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 
    210210         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
    211211         gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  & 
    212             &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm))  
     212            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm)) 
    213213         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
    214214         gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 
    215215         gdept(ji,jj,jk,Kbb) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb))  & 
    216             &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb))  
     216            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb)) 
    217217      END_3D 
    218218      ! 
    … …  
    273273            IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
    274274               IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
    275                   ii0 = 103 + nn_hls - 1   ;   ii1 = 111 + nn_hls - 1       
     275                  ii0 = 103 + nn_hls - 1   ;   ii1 = 111 + nn_hls - 1 
    276276                  ij0 = 128 + nn_hls       ;   ij1 = 135 + nn_hls 
    277277                  frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
    … …  
    282282      ENDIF 
    283283      ! 
    284       IF(lwxios) THEN 
    285 ! define variables in restart file when writing with XIOS 
    286          CALL iom_set_rstw_var_active('e3t_b') 
    287          CALL iom_set_rstw_var_active('e3t_n') 
    288          !                                           ! ----------------------- ! 
    289          IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
    290             !                                        ! ----------------------- ! 
    291             CALL iom_set_rstw_var_active('tilde_e3t_b') 
    292             CALL iom_set_rstw_var_active('tilde_e3t_n') 
    293          END IF 
    294          !                                           ! -------------!     
    295          IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    296             !                                        ! ------------ ! 
    297             CALL iom_set_rstw_var_active('hdiv_lf') 
    298          ENDIF 
    299          ! 
    300       ENDIF 
    301       ! 
    302284   END SUBROUTINE dom_vvl_zgr 
    303285 
    304286 
    305    SUBROUTINE dom_vvl_sf_nxt( kt, Kbb, Kmm, Kaa, kcall )  
     287   SUBROUTINE dom_vvl_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 
    306288      !!---------------------------------------------------------------------- 
    307289      !!                ***  ROUTINE dom_vvl_sf_nxt  *** 
    308       !!                    
     290      !! 
    309291      !! ** Purpose :  - compute the after scale factors used in tra_zdf, dynnxt, 
    310292      !!                 tranxt and dynspg routines 
    311293      !! 
    312294      !! ** Method  :  - z_star case:  Repartition of ssh INCREMENT proportionnaly to the level thickness. 
    313       !!               - z_tilde_case: after scale factor increment =  
     295      !!               - z_tilde_case: after scale factor increment = 
    314296      !!                                    high frequency part of horizontal divergence 
    315297      !!                                  + retsoring towards the background grid 
    … …  
    319301      !! 
    320302      !! ** Action  :  - hdiv_lf    : restoring towards full baroclinic divergence in z_tilde case 
    321       !!               - tilde_e3t_a: after increment of vertical scale factor  
     303      !!               - tilde_e3t_a: after increment of vertical scale factor 
    322304      !!                              in z_tilde case 
    323305      !!               - e3(t/u/v)_a 
    … …  
    423405            un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           & 
    424406               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
    425             vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           &  
     407            vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           & 
    426408               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) ) 
    427409            zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 
    … …  
    440422         !                             (stored for tracer advction and continuity equation) 
    441423         CALL lbc_lnk_multi( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 
    442  
    443424         ! 4 - Time stepping of baroclinic scale factors 
    444425         ! --------------------------------------------- 
    … …  
    469450               WRITE(numout, *) 'at i, j, k=', ijk_max 
    470451               WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 
    471                WRITE(numout, *) 'at i, j, k=', ijk_min             
     452               WRITE(numout, *) 'at i, j, k=', ijk_min 
    472453               CALL ctl_stop( 'STOP', 'MAX( ABS( tilde_e3t_a(:,:,: ) ) / e3t_0(:,:,:) ) too high') 
    473454            ENDIF 
    … …  
    585566      !!---------------------------------------------------------------------- 
    586567      !!                ***  ROUTINE dom_vvl_sf_update  *** 
    587       !!                    
    588       !! ** Purpose :  for z tilde case: compute time filter and swap of scale factors  
     568      !! 
     569      !! ** Purpose :  for z tilde case: compute time filter and swap of scale factors 
    589570      !!               compute all depths and related variables for next time step 
    590571      !!               write outputs and restart file 
    … …  
    596577      !! ** Action  :  - tilde_e3t_(b/n) ready for next time step 
    597578      !!               - Recompute: 
    598       !!                    e3(u/v)_b        
    599       !!                    e3w(:,:,:,Kmm)            
    600       !!                    e3(u/v)w_b       
    601       !!                    e3(u/v)w_n       
     579      !!                    e3(u/v)_b 
     580      !!                    e3w(:,:,:,Kmm) 
     581      !!                    e3(u/v)w_b 
     582      !!                    e3(u/v)w_n 
    602583      !!                    gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm)  and gde3w 
    603584      !!                    h(u/v) and h(u/v)r 
    … …  
    630611            tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 
    631612         ELSE 
    632             tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) &  
     613            tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 
    633614            &         + rn_atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 
    634615         ENDIF 
    … …  
    642623      ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 
    643624      ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 
    644        
     625 
    645626      CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F'  ) 
    646        
     627 
    647628      ! Vertical scale factor interpolations 
    648629      CALL dom_vvl_interpol( e3t(:,:,:,Kmm),  e3w(:,:,:,Kmm), 'W'  ) 
    … …  
    663644         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
    664645         gdept(ji,jj,jk,Kmm) =    zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) )  & 
    665              &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) )  
     646             &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) ) 
    666647         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
    667648      END_3D 
    … …  
    782763      !!--------------------------------------------------------------------- 
    783764      !!                   ***  ROUTINE dom_vvl_rst  *** 
    784       !!                      
     765      !! 
    785766      !! ** Purpose :   Read or write VVL file in restart file 
    786767      !! 
    … …  
    799780      !!---------------------------------------------------------------------- 
    800781      ! 
    801       IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
     782      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
    802783         !                                   ! =============== 
    803784         IF( ln_rstart ) THEN                   !* Read the restart file 
    804785            CALL rst_read_open                  !  open the restart file if necessary 
    805             CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     786            CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm)    ) 
    806787            ! 
    807788            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    … …  
    816797            ! 
    817798            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    818                CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    819                CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
    820                ! needed to restart if land processor not computed  
     799               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
     800               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
     801               ! needed to restart if land processor not computed 
    821802               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    822                WHERE ( tmask(:,:,:) == 0.0_wp )  
     803               WHERE ( tmask(:,:,:) == 0.0_wp ) 
    823804                  e3t(:,:,:,Kmm) = e3t_0(:,:,:) 
    824805                  e3t(:,:,:,Kbb) = e3t_0(:,:,:) 
    … …  
    831812               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    832813               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    833                CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     814               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
    834815               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    835816               l_1st_euler = .true. 
    … …  
    838819               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    839820               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    840                CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     821               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    841822               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    842823               l_1st_euler = .true. 
    … …  
    863844               !                          ! ----------------------- ! 
    864845               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    865                   CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
    866                   CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
     846                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 
     847                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 
    867848               ELSE                            ! one at least array is missing 
    868849                  tilde_e3t_b(:,:,:) = 0.0_wp 
    … …  
    873854                  !                       ! ------------ ! 
    874855                  IF( id5 > 0 ) THEN  ! required array exists 
    875                      CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
     856                     CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 
    876857                  ELSE                ! array is missing 
    877858                     hdiv_lf(:,:,:) = 0.0_wp 
    … …  
    883864            ! 
    884865 
    885             IF( ll_wd ) THEN   ! MJB ll_wd edits start here - these are essential  
     866            IF( ll_wd ) THEN   ! MJB ll_wd edits start here - these are essential 
    886867               ! 
    887868               IF( cn_cfg == 'wad' ) THEN 
    … …  
    946927         !                                   ! =================== 
    947928         IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 
    948          IF( lwxios ) CALL iom_swap(      cwxios_context          ) 
    949929         !                                           ! --------- ! 
    950930         !                                           ! all cases ! 
    951931         !                                           ! --------- ! 
    952          CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lwxios ) 
    953          CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lwxios ) 
     932         CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) ) 
     933         CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) ) 
    954934         !                                           ! ----------------------- ! 
    955935         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
    956936            !                                        ! ----------------------- ! 
    957             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lwxios) 
    958             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lwxios) 
     937            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:)) 
     938            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 
    959939         END IF 
    960          !                                           ! -------------!     
     940         !                                           ! -------------! 
    961941         IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    962942            !                                        ! ------------ ! 
    963             CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lwxios) 
     943            CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:)) 
    964944         ENDIF 
    965945         ! 
    966          IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    967946      ENDIF 
    968947      ! 
    … …  
    973952      !!--------------------------------------------------------------------- 
    974953      !!                  ***  ROUTINE dom_vvl_ctl  *** 
    975       !!                 
     954      !! 
    976955      !! ** Purpose :   Control the consistency between namelist options 
    977956      !!                for vertical coordinate 
    … …  
    982961         &              ln_vvl_zstar_at_eqtor      , rn_ahe3     , rn_rst_e3t            , & 
    983962         &              rn_lf_cutoff               , rn_zdef_max , ln_vvl_dbg                ! not yet implemented: ln_vvl_kepe 
    984       !!----------------------------------------------------------------------  
     963      !!---------------------------------------------------------------------- 
    985964      ! 
    986965      READ  ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901) 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DOM/dtatsd.F90

    r13497 r14017  
    66   !! History :  OPA  ! 1991-03  ()  Original code 
    77   !!             -   ! 1992-07  (M. Imbard) 
    8    !!            8.0  ! 1999-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT  
    9    !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module  
     8   !!            8.0  ! 1999-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT 
     9   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
    1010   !!            3.3  ! 2010-10  (C. Bricaud, S. Masson)  use of fldread 
    1111   !!            3.4  ! 2010-11  (G. Madec, C. Ethe) Merge of dtatem and dtasal + remove CPP keys 
    … …  
    1818   USE phycst          ! physical constants 
    1919   USE dom_oce         ! ocean space and time domain 
     20   USE domain, ONLY : dom_tile 
    2021   USE fldread         ! read input fields 
    2122   ! 
    … …  
    3940   !!---------------------------------------------------------------------- 
    4041   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    41    !! $Id$  
     42   !! $Id$ 
    4243   !! Software governed by the CeCILL license (see ./LICENSE) 
    4344   !!---------------------------------------------------------------------- 
    … …  
    4748      !!---------------------------------------------------------------------- 
    4849      !!                   ***  ROUTINE dta_tsd_init  *** 
    49       !!                     
    50       !! ** Purpose :   initialisation of T & S input data  
    51       !!  
     50      !! 
     51      !! ** Purpose :   initialisation of T & S input data 
     52      !! 
    5253      !! ** Method  : - Read namtsd namelist 
    53       !!              - allocates T & S data structure  
     54      !!              - allocates T & S data structure 
    5455      !!---------------------------------------------------------------------- 
    5556      LOGICAL, INTENT(in), OPTIONAL ::   ld_tradmp   ! force the initialization when tradp is used 
    … …  
    7475 
    7576      IF( PRESENT( ld_tradmp ) )   ln_tsd_dmp = .TRUE.     ! forces the initialization when tradmp is used 
    76        
     77 
    7778      IF(lwp) THEN                  ! control print 
    7879         WRITE(numout,*) 
    … …  
    123124      !!---------------------------------------------------------------------- 
    124125      !!                   ***  ROUTINE dta_tsd  *** 
    125       !!                     
     126      !! 
    126127      !! ** Purpose :   provides T and S data at kt 
    127       !!  
     128      !! 
    128129      !! ** Method  : - call fldread routine 
    129       !!              - ORCA_R2: add some hand made alteration to read data   
     130      !!              - ORCA_R2: add some hand made alteration to read data 
    130131      !!              - 'key_orca_lev10' interpolates on 10 times more levels 
    131132      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh 
    … …  
    135136      !! ** Action  :   ptsd   T-S data on medl mesh and interpolated at time-step kt 
    136137      !!---------------------------------------------------------------------- 
    137       INTEGER                              , INTENT(in   ) ::   kt     ! ocean time-step 
    138       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data 
     138      INTEGER                          , INTENT(in   ) ::   kt     ! ocean time-step 
     139      REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data 
    139140      ! 
    140141      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 
    141142      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers 
     143      INTEGER ::   itile 
    142144      REAL(wp)::   zl, zi                             ! local scalars 
    143145      REAL(wp), DIMENSION(jpk) ::  ztp, zsp   ! 1D workspace 
    144146      !!---------------------------------------------------------------------- 
    145147      ! 
    146       CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==! 
     148      IF( ntile == 0 .OR. ntile == 1 )  THEN                                         ! Do only for the full domain 
     149         itile = ntile 
     150         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )            ! Use full domain 
     151            CALL fld_read( kt, 1, sf_tsd )   !==   read T & S data at kt time step   ==! 
    147152      ! 
    148153      ! 
    149154!!gm  This should be removed from the code   ===>>>>  T & S files has to be changed 
    150       ! 
    151       !                                   !==   ORCA_R2 configuration and T & S damping   ==!  
    152       IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
    153          IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN    ! some hand made alterations 
    154             ! 
    155             ij0 = 101 + nn_hls       ;   ij1 = 109 + nn_hls                       ! Reduced T & S in the Alboran Sea 
    156             ii0 = 141 + nn_hls - 1   ;   ii1 = 155 + nn_hls - 1 
    157             DO jj = mj0(ij0), mj1(ij1) 
    158                DO ji = mi0(ii0), mi1(ii1) 
    159                   sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp 
    160                   sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp 
    161                   sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp 
    162                   ! 
    163                   sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp 
    164                   sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp 
    165                   sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp 
    166                   sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp 
     155         ! 
     156         !                                   !==   ORCA_R2 configuration and T & S damping   ==! 
     157         IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
     158            IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN    ! some hand made alterations 
     159               ! 
     160               ij0 = 101 + nn_hls       ;   ij1 = 109 + nn_hls                       ! Reduced T & S in the Alboran Sea 
     161               ii0 = 141 + nn_hls - 1   ;   ii1 = 155 + nn_hls - 1 
     162               DO jj = mj0(ij0), mj1(ij1) 
     163                  DO ji = mi0(ii0), mi1(ii1) 
     164                     sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp 
     165                     sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp 
     166                     sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp 
     167                     ! 
     168                     sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp 
     169                     sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp 
     170                     sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp 
     171                     sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp 
     172                  END DO 
    167173               END DO 
    168             END DO 
    169             ij0 =  87 + nn_hls       ;   ij1 =  96 + nn_hls                       ! Reduced temperature in Red Sea 
    170             ii0 = 148 + nn_hls - 1   ;   ii1 = 160 + nn_hls - 1 
    171             sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp 
    172             sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp 
    173             sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 
    174          ENDIF 
    175       ENDIF 
     174               ij0 =  87 + nn_hls       ;   ij1 =  96 + nn_hls                       ! Reduced temperature in Red Sea 
     175               ii0 = 148 + nn_hls - 1   ;   ii1 = 160 + nn_hls - 1 
     176               sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp 
     177               sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp 
     178               sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 
     179            ENDIF 
     180         ENDIF 
    176181!!gm end 
    177       ! 
    178       ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)    ! NO mask 
    179       ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:)  
     182         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )            ! Revert to tile domain 
     183      ENDIF 
     184      ! 
     185      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
     186         ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jk)    ! NO mask 
     187         ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jk) 
     188      END_3D 
    180189      ! 
    181190      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
    182191         ! 
    183          IF( kt == nit000 .AND. lwp )THEN 
    184             WRITE(numout,*) 
    185             WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 
    186          ENDIF 
    187          ! 
    188          DO_2D( 1, 1, 1, 1 )                  ! vertical interpolation of T & S 
     192         IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     193            IF( kt == nit000 .AND. lwp )THEN 
     194               WRITE(numout,*) 
     195               WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 
     196            ENDIF 
     197         ENDIF 
     198         ! 
     199         ! NOTE: [tiling-comms-merge] This fix was necessary to take out tra_adv lbc_lnk statements in the zps case, but did not work in the zco case 
     200         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                  ! vertical interpolation of T & S 
    189201            DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    190202               zl = gdept_0(ji,jj,jk) 
    … …  
    199211                     IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
    200212                        zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
    201                         ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi  
     213                        ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 
    202214                        zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 
    203215                     ENDIF 
    … …  
    212224            ptsd(ji,jj,jpk,jp_sal) = 0._wp 
    213225         END_2D 
    214          !  
     226         ! 
    215227      ELSE                                !==   z- or zps- coordinate   ==! 
    216          !                              
    217          ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:)    ! Mask 
    218          ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 
     228         ! 
     229         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
     230            ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)    ! Mask 
     231            ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
     232         END_3D 
    219233         ! 
    220234         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
    221             DO_2D( 1, 1, 1, 1 ) 
    222                ik = mbkt(ji,jj)  
     235            ! NOTE: [tiling-comms-merge] This fix was necessary to take out tra_adv lbc_lnk statements in the zps case 
     236            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     237               ik = mbkt(ji,jj) 
    223238               IF( ik > 1 ) THEN 
    224239                  zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    … …  
    228243               ik = mikt(ji,jj) 
    229244               IF( ik > 1 ) THEN 
    230                   zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )  
     245                  zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
    231246                  ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem) 
    232247                  ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal) 
    … …  
    237252      ENDIF 
    238253      ! 
    239       IF( .NOT.ln_tsd_dmp ) THEN                   !==   deallocate T & S structure   ==!  
     254      IF( .NOT.ln_tsd_dmp ) THEN                   !==   deallocate T & S structure   ==! 
    240255         !                                              (data used only for initialisation) 
    241256         IF(lwp) WRITE(numout,*) 'dta_tsd: deallocte T & S arrays as they are only use to initialize the run' 
Note: See TracChangeset for help on using the changeset viewer.