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/SWE/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/SWE/domain.F90

    r13295 r14037  
    6666CONTAINS 
    6767 
    68    SUBROUTINE dom_init( Kbb, Kmm, Kaa, cdstr ) 
     68   SUBROUTINE dom_init( Kbb, Kmm, Kaa ) 
    6969      !!---------------------------------------------------------------------- 
    7070      !!                  ***  ROUTINE dom_init  *** 
    … …  
    8282      !!---------------------------------------------------------------------- 
    8383      INTEGER          , INTENT(in) :: Kbb, Kmm, Kaa          ! ocean time level indices 
    84       CHARACTER (len=*), INTENT(in) :: cdstr                  ! model: NEMO or SAS. Determines core restart variables 
    8584      ! 
    8685!!st6 
    … …  
    135134      CALL dom_nam                     ! read namelist ( namrun, namdom ) 
    136135      ! 
    137       IF( lwxios ) THEN 
    138 !define names for restart write and set core output (restart.F90) 
    139          CALL iom_set_rst_vars(rst_wfields) 
    140          CALL iom_set_rstw_core(cdstr) 
    141       ENDIF 
    142 !reset namelist for SAS 
    143       IF(cdstr == 'SAS') THEN 
    144          IF(lrxios) THEN 
    145                IF(lwp) write(numout,*) 'Disable reading restart file using XIOS for SAS' 
    146                lrxios = .FALSE. 
    147          ENDIF 
    148       ENDIF 
    149       ! 
    150136      CALL dom_hgr                      ! Horizontal mesh 
    151137 
    … …  
    245231      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point 
    246232      ! 
     233 
     234#if defined key_agrif 
     235      IF( .NOT. Agrif_Root() ) CALL Agrif_Init_Domain( Kbb, Kmm, Kaa ) 
     236#endif 
    247237      IF( ln_meshmask    )   CALL dom_wri       ! Create a domain file 
    248  
    249238      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control 
    250239      ! 
    … …  
    269258      !! ** Method  :    
    270259      !! 
    271       !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices 
     260      !! ** Action  : - mig , mjg : local  domain indices ==> global domain, including halos, indices 
     261      !!              - mig0, mjg0: local  domain indices ==> global domain, excluding halos, indices 
    272262      !!              - mi0 , mi1 : global domain indices ==> local  domain indices 
    273       !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 
     263      !!              - mj0 , mj1   (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 
    274264      !!---------------------------------------------------------------------- 
    275265      INTEGER ::   ji, jj   ! dummy loop argument 
    276266      !!---------------------------------------------------------------------- 
    277267      ! 
    278       DO ji = 1, jpi                 ! local domain indices ==> global domain indices 
     268      DO ji = 1, jpi                 ! local domain indices ==> global domain indices, including halos 
    279269        mig(ji) = ji + nimpp - 1 
    280270      END DO 
    … …  
    282272        mjg(jj) = jj + njmpp - 1 
    283273      END DO 
    284       !                              ! global domain indices ==> local domain indices 
     274      !                              ! local domain indices ==> global domain indices, excluding halos 
     275      ! 
     276      mig0(:) = mig(:) - nn_hls 
     277      mjg0(:) = mjg(:) - nn_hls   
     278      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,  
     279      ! we must define mig0 and mjg0 as bellow. 
     280      ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as: 
     281      mig0_oldcmp(:) = mig0(:) + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 
     282      mjg0_oldcmp(:) = mjg0(:) + COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) 
     283      ! 
     284      !                              ! global domain, including halos, indices ==> local domain indices 
    285285      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the  
    286286      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.  
    … …  
    300300         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk 
    301301         WRITE(numout,*) 
    302          WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done' 
    303          IF( nn_print >= 1 ) THEN 
    304             WRITE(numout,*) 
    305             WRITE(numout,*) '          conversion local  ==> global i-index domain (mig)' 
    306             WRITE(numout,25)              (mig(ji),ji = 1,jpi) 
    307             WRITE(numout,*) 
    308             WRITE(numout,*) '          conversion global ==> local  i-index domain' 
    309             WRITE(numout,*) '             starting index (mi0)' 
    310             WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo) 
    311             WRITE(numout,*) '             ending index (mi1)' 
    312             WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo) 
    313             WRITE(numout,*) 
    314             WRITE(numout,*) '          conversion local  ==> global j-index domain (mjg)' 
    315             WRITE(numout,25)              (mjg(jj),jj = 1,jpj) 
    316             WRITE(numout,*) 
    317             WRITE(numout,*) '          conversion global ==> local  j-index domain' 
    318             WRITE(numout,*) '             starting index (mj0)' 
    319             WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo) 
    320             WRITE(numout,*) '             ending index (mj1)' 
    321             WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo) 
    322          ENDIF 
    323       ENDIF 
    324  25   FORMAT( 100(10x,19i4,/) ) 
     302      ENDIF 
    325303      ! 
    326304   END SUBROUTINE dom_glo 
    … …  
    364342902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist' ) 
    365343      IF(lwm) WRITE ( numond, namrun ) 
     344 
     345#if defined key_agrif 
     346      IF( .NOT. Agrif_Root() ) THEN 
     347            nn_it000 = (Agrif_Parent(nn_it000)-1)*Agrif_IRhot() + 1 
     348            nn_itend =  Agrif_Parent(nn_itend)   *Agrif_IRhot() 
     349      ENDIF 
     350#endif 
    366351      ! 
    367352      IF(lwp) THEN                  ! control print 
    … …  
    435420#endif 
    436421 
    437 #if defined key_agrif 
    438422      IF( Agrif_Root() ) THEN 
    439 #endif 
    440       IF(lwp) WRITE(numout,*) 
    441       SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    442       CASE (  1 )  
    443          CALL ioconf_calendar('gregorian') 
    444          IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year' 
    445       CASE (  0 ) 
    446          CALL ioconf_calendar('noleap') 
    447          IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year' 
    448       CASE ( 30 ) 
    449          CALL ioconf_calendar('360d') 
    450          IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
    451       END SELECT 
    452 #if defined key_agrif 
    453       ENDIF 
    454 #endif 
     423         IF(lwp) WRITE(numout,*) 
     424         SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
     425         CASE (  1 )  
     426            CALL ioconf_calendar('gregorian') 
     427            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year' 
     428         CASE (  0 ) 
     429            CALL ioconf_calendar('noleap') 
     430            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year' 
     431         CASE ( 30 ) 
     432            CALL ioconf_calendar('360d') 
     433            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
     434         END SELECT 
     435      ENDIF 
    455436 
    456437      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 
    … …  
    459440904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist' ) 
    460441      IF(lwm) WRITE( numond, namdom ) 
     442      ! 
     443#if defined key_agrif 
     444      IF( .NOT. Agrif_Root() ) THEN 
     445            rn_Dt = Agrif_Parent(rn_Dt) / Agrif_Rhot() 
     446      ENDIF 
     447#endif 
    461448      ! 
    462449      IF(lwp) THEN 
    … …  
    519506      !! ** Method  :   compute and print extrema of masked scale factors 
    520507      !!---------------------------------------------------------------------- 
    521       INTEGER, DIMENSION(2) ::   imi1, imi2, ima1, ima2 
    522       INTEGER, DIMENSION(2) ::   iloc   !  
    523       REAL(wp) ::   ze1min, ze1max, ze2min, ze2max 
    524       !!---------------------------------------------------------------------- 
    525       ! 
    526       IF(lk_mpp) THEN 
    527          CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 ) 
    528          CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 ) 
    529          CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 ) 
    530          CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 ) 
    531       ELSE 
    532          ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )     
    533          ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )     
    534          ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )     
    535          ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )     
    536          ! 
    537          iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 
    538          imi1(1) = iloc(1) + nimpp - 1 
    539          imi1(2) = iloc(2) + njmpp - 1 
    540          iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 
    541          imi2(1) = iloc(1) + nimpp - 1 
    542          imi2(2) = iloc(2) + njmpp - 1 
    543          iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 
    544          ima1(1) = iloc(1) + nimpp - 1 
    545          ima1(2) = iloc(2) + njmpp - 1 
    546          iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 
    547          ima2(1) = iloc(1) + nimpp - 1 
    548          ima2(2) = iloc(2) + njmpp - 1 
    549       ENDIF 
     508      LOGICAL, DIMENSION(jpi,jpj) ::   llmsk 
     509      INTEGER, DIMENSION(2)       ::   imil, imip, imi1, imi2, imal, imap, ima1, ima2 
     510      REAL(wp)                    ::   zglmin, zglmax, zgpmin, zgpmax, ze1min, ze1max, ze2min, ze2max 
     511      !!---------------------------------------------------------------------- 
     512      ! 
     513      llmsk = tmask_h(:,:) == 1._wp 
     514      ! 
     515      CALL mpp_minloc( 'domain', glamt(:,:), llmsk, zglmin, imil ) 
     516      CALL mpp_minloc( 'domain', gphit(:,:), llmsk, zgpmin, imip ) 
     517      CALL mpp_minloc( 'domain',   e1t(:,:), llmsk, ze1min, imi1 ) 
     518      CALL mpp_minloc( 'domain',   e2t(:,:), llmsk, ze2min, imi2 ) 
     519      CALL mpp_maxloc( 'domain', glamt(:,:), llmsk, zglmax, imal ) 
     520      CALL mpp_maxloc( 'domain', gphit(:,:), llmsk, zgpmax, imap ) 
     521      CALL mpp_maxloc( 'domain',   e1t(:,:), llmsk, ze1max, ima1 ) 
     522      CALL mpp_maxloc( 'domain',   e2t(:,:), llmsk, ze2max, ima2 ) 
     523      ! 
    550524      IF(lwp) THEN 
    551525         WRITE(numout,*) 
    552526         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 
    553527         WRITE(numout,*) '~~~~~~~' 
    554          WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2) 
    555          WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2) 
    556          WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2) 
    557          WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2) 
     528         WRITE(numout,"(14x,'glamt mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmin, imil(1), imil(2) 
     529         WRITE(numout,"(14x,'glamt maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmax, imal(1), imal(2) 
     530         WRITE(numout,"(14x,'gphit mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmin, imip(1), imip(2) 
     531         WRITE(numout,"(14x,'gphit maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmax, imap(1), imap(2) 
     532         WRITE(numout,"(14x,'  e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2) 
     533         WRITE(numout,"(14x,'  e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2) 
     534         WRITE(numout,"(14x,'  e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2) 
     535         WRITE(numout,"(14x,'  e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2) 
    558536      ENDIF 
    559537      ! 
    … …  
    622600      IF(lwp) THEN 
    623601         WRITE(numout,*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg 
    624          WRITE(numout,*) '      jpiglo = ', kpi 
    625          WRITE(numout,*) '      jpjglo = ', kpj 
     602         WRITE(numout,*) '      Ni0glo = ', kpi 
     603         WRITE(numout,*) '      Nj0glo = ', kpj 
    626604         WRITE(numout,*) '      jpkglo = ', kpk 
    627605         WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio 
    … …  
    662640      !          
    663641      clnam = cn_domcfg_out  ! filename (configuration information) 
    664       CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 
    665        
     642      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )      
    666643      ! 
    667644      !                             !==  ORCA family specificities  ==! 
    668       IF( cn_cfg == "ORCA" ) THEN 
     645      IF( TRIM(cn_cfg) == "orca" .OR. TRIM(cn_cfg) == "ORCA" ) THEN 
    669646         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 ) 
    670647         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )          
    671648      ENDIF 
    672649      ! 
    673       !                             !==  global domain size  ==! 
    674       ! 
    675       CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 ) 
    676       CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 ) 
    677       CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 ) 
    678       ! 
    679650      !                             !==  domain characteristics  ==! 
    680651      ! 
    … …  
    683654      ! 
    684655      !                                   ! type of vertical coordinate 
    685       IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF 
    686       IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF 
    687       IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF 
    688       CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 ) 
    689       CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 ) 
    690       CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 ) 
     656      CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), wp), ktype = jp_i4 ) 
     657      CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), wp), ktype = jp_i4 ) 
     658      CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), wp), ktype = jp_i4 ) 
    691659      ! 
    692660      !                                   ! ocean cavities under iceshelves 
    693       IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF 
    694       CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 ) 
     661      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), wp), ktype = jp_i4 ) 
    695662      ! 
    696663      !                             !==  horizontal mesh  ! 
Note: See TracChangeset for help on using the changeset viewer.