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 13899 for NEMO/branches/2020/tickets_icb_1900/src/SWE/domain.F90 – NEMO

Ignore:
Timestamp:
2020-11-27T17:26:33+01:00 (4 years ago)
Author:
mathiot
Message:

ticket #1900: update branch to trunk and add ICB test case

Location:
NEMO/branches/2020/tickets_icb_1900
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/tickets_icb_1900

    • Property svn:externals

      •  

        old new  
        22^/utils/build/makenemo@HEAD   makenemo 
        33^/utils/build/mk@HEAD         mk 
        4 ^/utils/tools/@HEAD           tools 
         4^/utils/tools@HEAD            tools 
        55^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        … …  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@12931        sette 
         10^/utils/CI/sette@13559        sette 

  • NEMO/branches/2020/tickets_icb_1900/src/SWE/domain.F90

    r12983 r13899  
    169169!!anhf hf_0 = mean(ht_0*tmask) so hf = mimj( ht0 + ssht) 
    170170! ne pas combiner avec an45 tout de suite 
    171 !      DO_2D_10_10 
     171!      DO_2D( 1, 0, 1, 0 ) 
    172172!         hf_0(ji,jj) = 0.25_wp * (   ht_0(ji,jj+1) * tmask(ji,jj+1,1) + ht_0(ji+1,jj+1) * tmask(ji+1,jj+1,1)   & 
    173173!            &                      + ht_0(ji,jj  ) * tmask(ji,jj  ,1) + ht_0(ji+1,jj  ) * tmask(ji+1,jj  ,1)   ) 
    … …  
    183183!!an45 Ligne de cote a 45deg : e1e2t *= ( mi(umask) + mj(vmask) ) /2 
    184184!!                             idem pour e1e2f 
    185 !      DO_2D_10_10 
     185!      DO_2D( 1, 0, 1, 0 ) 
    186186!      zcoeff = 0.25_wp * (   umask(ji,jj+1,1) + umask(ji+1,jj+1,1)   & 
    187187!         &                 + vmask(ji,jj  ,1) + vmask(ji+1,jj  ,1)   ) 
    … …  
    245245      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point 
    246246      ! 
     247 
     248#if defined key_agrif 
     249      IF( .NOT. Agrif_Root() ) CALL Agrif_Init_Domain( Kbb, Kmm, Kaa ) 
     250#endif 
    247251      IF( ln_meshmask    )   CALL dom_wri       ! Create a domain file 
    248  
    249252      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control 
    250253      ! 
    … …  
    269272      !! ** Method  :    
    270273      !! 
    271       !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices 
     274      !! ** Action  : - mig , mjg : local  domain indices ==> global domain, including halos, indices 
     275      !!              - mig0, mjg0: local  domain indices ==> global domain, excluding halos, indices 
    272276      !!              - mi0 , mi1 : global domain indices ==> local  domain indices 
    273       !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 
     277      !!              - mj0 , mj1   (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 
    274278      !!---------------------------------------------------------------------- 
    275279      INTEGER ::   ji, jj   ! dummy loop argument 
    276280      !!---------------------------------------------------------------------- 
    277281      ! 
    278       DO ji = 1, jpi                 ! local domain indices ==> global domain indices 
     282      DO ji = 1, jpi                 ! local domain indices ==> global domain indices, including halos 
    279283        mig(ji) = ji + nimpp - 1 
    280284      END DO 
    … …  
    282286        mjg(jj) = jj + njmpp - 1 
    283287      END DO 
    284       !                              ! global domain indices ==> local domain indices 
     288      !                              ! local domain indices ==> global domain indices, excluding halos 
     289      ! 
     290      mig0(:) = mig(:) - nn_hls 
     291      mjg0(:) = mjg(:) - nn_hls   
     292      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,  
     293      ! we must define mig0 and mjg0 as bellow. 
     294      ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as: 
     295      mig0_oldcmp(:) = mig0(:) + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 
     296      mjg0_oldcmp(:) = mjg0(:) + COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) 
     297      ! 
     298      !                              ! global domain, including halos, indices ==> local domain indices 
    285299      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the  
    286300      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.  
    … …  
    300314         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk 
    301315         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,/) ) 
     316      ENDIF 
    325317      ! 
    326318   END SUBROUTINE dom_glo 
    … …  
    364356902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist' ) 
    365357      IF(lwm) WRITE ( numond, namrun ) 
     358 
     359#if defined key_agrif 
     360      IF( .NOT. Agrif_Root() ) THEN 
     361            nn_it000 = (Agrif_Parent(nn_it000)-1)*Agrif_IRhot() + 1 
     362            nn_itend =  Agrif_Parent(nn_itend)   *Agrif_IRhot() 
     363      ENDIF 
     364#endif 
    366365      ! 
    367366      IF(lwp) THEN                  ! control print 
    … …  
    435434#endif 
    436435 
    437 #if defined key_agrif 
    438436      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 
     437         IF(lwp) WRITE(numout,*) 
     438         SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
     439         CASE (  1 )  
     440            CALL ioconf_calendar('gregorian') 
     441            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year' 
     442         CASE (  0 ) 
     443            CALL ioconf_calendar('noleap') 
     444            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year' 
     445         CASE ( 30 ) 
     446            CALL ioconf_calendar('360d') 
     447            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
     448         END SELECT 
     449      ENDIF 
    455450 
    456451      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 
    … …  
    459454904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist' ) 
    460455      IF(lwm) WRITE( numond, namdom ) 
     456      ! 
     457#if defined key_agrif 
     458      IF( .NOT. Agrif_Root() ) THEN 
     459            rn_Dt = Agrif_Parent(rn_Dt) / Agrif_Rhot() 
     460      ENDIF 
     461#endif 
    461462      ! 
    462463      IF(lwp) THEN 
    … …  
    519520      !! ** Method  :   compute and print extrema of masked scale factors 
    520521      !!---------------------------------------------------------------------- 
    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 
     522      LOGICAL, DIMENSION(jpi,jpj) ::   llmsk 
     523      INTEGER, DIMENSION(2)       ::   imil, imip, imi1, imi2, imal, imap, ima1, ima2 
     524      REAL(wp)                    ::   zglmin, zglmax, zgpmin, zgpmax, ze1min, ze1max, ze2min, ze2max 
     525      !!---------------------------------------------------------------------- 
     526      ! 
     527      llmsk = tmask_h(:,:) == 1._wp 
     528      ! 
     529      CALL mpp_minloc( 'domain', glamt(:,:), llmsk, zglmin, imil ) 
     530      CALL mpp_minloc( 'domain', gphit(:,:), llmsk, zgpmin, imip ) 
     531      CALL mpp_minloc( 'domain',   e1t(:,:), llmsk, ze1min, imi1 ) 
     532      CALL mpp_minloc( 'domain',   e2t(:,:), llmsk, ze2min, imi2 ) 
     533      CALL mpp_maxloc( 'domain', glamt(:,:), llmsk, zglmax, imal ) 
     534      CALL mpp_maxloc( 'domain', gphit(:,:), llmsk, zgpmax, imap ) 
     535      CALL mpp_maxloc( 'domain',   e1t(:,:), llmsk, ze1max, ima1 ) 
     536      CALL mpp_maxloc( 'domain',   e2t(:,:), llmsk, ze2max, ima2 ) 
     537      ! 
    550538      IF(lwp) THEN 
    551539         WRITE(numout,*) 
    552540         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 
    553541         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) 
     542         WRITE(numout,"(14x,'glamt mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmin, imil(1), imil(2) 
     543         WRITE(numout,"(14x,'glamt maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmax, imal(1), imal(2) 
     544         WRITE(numout,"(14x,'gphit mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmin, imip(1), imip(2) 
     545         WRITE(numout,"(14x,'gphit maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmax, imap(1), imap(2) 
     546         WRITE(numout,"(14x,'  e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2) 
     547         WRITE(numout,"(14x,'  e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2) 
     548         WRITE(numout,"(14x,'  e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2) 
     549         WRITE(numout,"(14x,'  e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2) 
    558550      ENDIF 
    559551      ! 
    … …  
    622614      IF(lwp) THEN 
    623615         WRITE(numout,*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg 
    624          WRITE(numout,*) '      jpiglo = ', kpi 
    625          WRITE(numout,*) '      jpjglo = ', kpj 
     616         WRITE(numout,*) '      Ni0glo = ', kpi 
     617         WRITE(numout,*) '      Nj0glo = ', kpj 
    626618         WRITE(numout,*) '      jpkglo = ', kpk 
    627619         WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio 
    … …  
    662654      !          
    663655      clnam = cn_domcfg_out  ! filename (configuration information) 
    664       CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 
    665        
     656      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )      
    666657      ! 
    667658      !                             !==  ORCA family specificities  ==! 
    668       IF( cn_cfg == "ORCA" ) THEN 
     659      IF( TRIM(cn_cfg) == "orca" .OR. TRIM(cn_cfg) == "ORCA" ) THEN 
    669660         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 ) 
    670661         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )          
    671662      ENDIF 
    672663      ! 
    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       ! 
    679664      !                             !==  domain characteristics  ==! 
    680665      ! 
    … …  
    683668      ! 
    684669      !                                   ! 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 ) 
     670      CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), wp), ktype = jp_i4 ) 
     671      CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), wp), ktype = jp_i4 ) 
     672      CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), wp), ktype = jp_i4 ) 
    691673      ! 
    692674      !                                   ! 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 ) 
     675      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), wp), ktype = jp_i4 ) 
    695676      ! 
    696677      !                             !==  horizontal mesh  ! 
Note: See TracChangeset for help on using the changeset viewer.