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 14037 for NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/DOM/domain.F90 – NEMO

Ignore:
Timestamp:
2020-12-03T12:20:38+01:00 (3 years ago)
Author:
ayoung
Message:

Updated to trunk at 14020. Sette tests passed with change of results for configurations with non-linear ssh. Ticket #2506.

Location:
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG

    • Property svn:externals

      •  

        old new  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@13292        sette 
         10^/utils/CI/sette_wave@13990         sette 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/DOM/domain.F90

    r13286 r14037  
    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  *** 
    … …  
    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 
    … …  
    120121         WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg 
    121122      ENDIF 
    122       lwxios = .FALSE. 
     123      nn_wxios = 0 
    123124      ln_xios_read = .FALSE. 
    124125      ! 
    125126      !           !==  Reference coordinate system  ==! 
    126127      ! 
    127       CALL dom_glo                     ! global domain versus local domain 
    128       CALL dom_nam                     ! read namelist ( namrun, namdom ) 
    129       ! 
    130       IF( lwxios ) THEN 
    131 !define names for restart write and set core output (restart.F90) 
    132          CALL iom_set_rst_vars(rst_wfields) 
    133          CALL iom_set_rstw_core(cdstr) 
    134       ENDIF 
    135 !reset namelist for SAS 
    136       IF(cdstr == 'SAS') THEN 
    137          IF(lrxios) THEN 
    138                IF(lwp) write(numout,*) 'Disable reading restart file using XIOS for SAS' 
    139                lrxios = .FALSE. 
    140          ENDIF 
    141       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 
    142132      ! 
    143133      CALL dom_hgr                      ! Horizontal mesh 
    … …  
    177167      ! 
    178168      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all 
    179       ! 
     169         ! 
    180170         DO jt = 1, jpt                         ! depth of t- and w-grid-points 
    181171            gdept(:,:,:,jt) = gdept_0(:,:,:) 
    … …  
    204194      ELSE                       != time varying : initialize before/now/after variables 
    205195         ! 
    206          IF( .NOT.l_offline )  CALL dom_vvl_init( Kbb, Kmm, Kaa ) 
     196         IF( .NOT.l_offline )   CALL dom_vvl_init( Kbb, Kmm, Kaa ) 
    207197         ! 
    208198      ENDIF 
    … …  
    248238      !!---------------------------------------------------------------------- 
    249239      ! 
    250       DO ji = 1, jpi                 ! local domain indices ==> global domain, including halos, indices 
     240      DO ji = 1, jpi                 ! local domain indices ==> global domain indices, including halos 
    251241        mig(ji) = ji + nimpp - 1 
    252242      END DO 
    … …  
    254244        mjg(jj) = jj + njmpp - 1 
    255245      END DO 
    256       !                              ! local domain indices ==> global domain, excluding halos, indices 
     246      !                              ! local domain indices ==> global domain indices, excluding halos 
    257247      ! 
    258248      mig0(:) = mig(:) - nn_hls 
    … …  
    287277 
    288278 
     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 
    289362   SUBROUTINE dom_nam 
    290363      !!---------------------------------------------------------------------- 
    … …  
    295368      !! ** input   : - namrun namelist 
    296369      !!              - namdom namelist 
     370      !!              - namtile namelist 
    297371      !!              - namnc4 namelist   ! "key_netcdf4" only 
    298372      !!---------------------------------------------------------------------- 
    … …  
    307381         &             ln_cfmeta, ln_xios_read, nn_wxios 
    308382      NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_meshmask 
     383      NAMELIST/namtile/ ln_tile, nn_ltile_i, nn_ltile_j 
    309384#if defined key_netcdf4 
    310385      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 
    … …  
    443518      r1_Dt = 1._wp / rDt 
    444519 
     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 
    445540      IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
    446541         lrxios = ln_xios_read.AND.ln_rstart 
    … …  
    493588      !!---------------------------------------------------------------------- 
    494589      ! 
    495       IF(lk_mpp) THEN 
    496          CALL mpp_minloc( 'domain', glamt(:,:), tmask_i(:,:), zglmin, imil ) 
    497          CALL mpp_minloc( 'domain', gphit(:,:), tmask_i(:,:), zgpmin, imip ) 
    498          CALL mpp_minloc( 'domain',   e1t(:,:), tmask_i(:,:), ze1min, imi1 ) 
    499          CALL mpp_minloc( 'domain',   e2t(:,:), tmask_i(:,:), ze2min, imi2 ) 
    500          CALL mpp_maxloc( 'domain', glamt(:,:), tmask_i(:,:), zglmax, imal ) 
    501          CALL mpp_maxloc( 'domain', gphit(:,:), tmask_i(:,:), zgpmax, imap ) 
    502          CALL mpp_maxloc( 'domain',   e1t(:,:), tmask_i(:,:), ze1max, ima1 ) 
    503          CALL mpp_maxloc( 'domain',   e2t(:,:), tmask_i(:,:), ze2max, ima2 ) 
    504       ELSE 
    505          llmsk = tmask_i(:,:) == 1._wp 
    506          zglmin = MINVAL( glamt(:,:), mask = llmsk )     
    507          zgpmin = MINVAL( gphit(:,:), mask = llmsk )     
    508          ze1min = MINVAL(   e1t(:,:), mask = llmsk )     
    509          ze2min = MINVAL(   e2t(:,:), mask = llmsk )     
    510          zglmin = MAXVAL( glamt(:,:), mask = llmsk )     
    511          zgpmin = MAXVAL( gphit(:,:), mask = llmsk )     
    512          ze1max = MAXVAL(   e1t(:,:), mask = llmsk )     
    513          ze2max = MAXVAL(   e2t(:,:), mask = llmsk )     
    514          ! 
    515          imil   = MINLOC( glamt(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    516          imip   = MINLOC( gphit(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    517          imi1   = MINLOC(   e1t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    518          imi2   = MINLOC(   e2t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    519          imal   = MAXLOC( glamt(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    520          imap   = MAXLOC( gphit(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    521          ima1   = MAXLOC(   e1t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    522          ima2   = MAXLOC(   e2t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    523       ENDIF 
     590      llmsk = tmask_h(:,:) == 1._wp 
     591      ! 
     592      CALL mpp_minloc( 'domain', glamt(:,:), llmsk, zglmin, imil ) 
     593      CALL mpp_minloc( 'domain', gphit(:,:), llmsk, zgpmin, imip ) 
     594      CALL mpp_minloc( 'domain',   e1t(:,:), llmsk, ze1min, imi1 ) 
     595      CALL mpp_minloc( 'domain',   e2t(:,:), llmsk, ze2min, imi2 ) 
     596      CALL mpp_maxloc( 'domain', glamt(:,:), llmsk, zglmax, imal ) 
     597      CALL mpp_maxloc( 'domain', gphit(:,:), llmsk, zgpmax, imap ) 
     598      CALL mpp_maxloc( 'domain',   e1t(:,:), llmsk, ze1max, ima1 ) 
     599      CALL mpp_maxloc( 'domain',   e2t(:,:), llmsk, ze2max, ima2 ) 
    524600      ! 
    525601      IF(lwp) THEN 
    … …  
    643719      ! 
    644720      !                             !==  ORCA family specificities  ==! 
    645       IF( cn_cfg == "ORCA" ) THEN 
     721      IF( TRIM(cn_cfg) == "orca" .OR. TRIM(cn_cfg) == "ORCA" ) THEN 
    646722         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 ) 
    647723         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )          
Note: See TracChangeset for help on using the changeset viewer.