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/OCE/DOM/dommsk.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/OCE/DOM/dommsk.F90

    r13237 r13899  
    2626   USE oce            ! ocean dynamics and tracers 
    2727   USE dom_oce        ! ocean space and time domain 
     28   USE domutl         !  
    2829   USE usrdef_fmask   ! user defined fmask 
    2930   USE bdy_oce        ! open boundary 
    … …  
    8990      ! 
    9091      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
    91       INTEGER  ::   iif, iil       ! local integers 
    92       INTEGER  ::   ijf, ijl       !   -       - 
    9392      INTEGER  ::   iktop, ikbot   !   -       - 
    9493      INTEGER  ::   ios, inum 
    95       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zwf   ! 2D workspace 
    9694      !! 
    9795      NAMELIST/namlbc/ rn_shlat, ln_vorlat 
    … …  
    132130      ! 
    133131      tmask(:,:,:) = 0._wp 
    134       DO_2D_11_11 
     132      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    135133         iktop = k_top(ji,jj) 
    136134         ikbot = k_bot(ji,jj) 
    137135         IF( iktop /= 0 ) THEN       ! water in the column 
    138             tmask(ji,jj,iktop:ikbot  ) = 1._wp 
     136            tmask(ji,jj,iktop:ikbot) = 1._wp 
    139137         ENDIF 
    140138      END_2D 
    141139      ! 
    142       ! the following call is mandatory 
    143       ! it masks boundaries (bathy=0) where needed depending on the configuration (closed, periodic...)   
    144       CALL lbc_lnk( 'dommsk', tmask  , 'T', 1._wp )      ! Lateral boundary conditions 
    145  
    146      ! Mask corrections for bdy (read in mppini2) 
     140      ! Mask corrections for bdy (read in mppini2) 
    147141      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) 
    148142903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist' ) 
    … …  
    152146      IF ( ln_bdy .AND. ln_mask_file ) THEN 
    153147         CALL iom_open( cn_mask_file, inum ) 
    154          CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) ) 
     148         CALL iom_get ( inum, jpdom_global, 'bdy_msk', bdytmask(:,:) ) 
    155149         CALL iom_close( inum ) 
    156          DO_3D_11_11( 1, jpkm1 ) 
     150         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    157151            tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj) 
    158152         END_3D 
    … …  
    162156      ! ---------------------------------------- 
    163157      ! NB: at this point, fmask is designed for free slip lateral boundary condition 
    164       DO jk = 1, jpk 
    165          DO jj = 1, jpjm1 
    166             DO ji = 1, jpim1   ! vector loop 
    167                umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk) 
    168                vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk) 
    169             END DO 
    170             DO ji = 1, jpim1      ! NO vector opt. 
    171                fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   & 
    172                   &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk) 
    173             END DO 
    174          END DO 
    175       END DO 
     158      DO_3D( 0, 0, 0, 0, 1, jpk ) 
     159         umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk) 
     160         vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk) 
     161         fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   & 
     162            &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk) 
     163      END_3D 
    176164      CALL lbc_lnk_multi( 'dommsk', umask, 'U', 1.0_wp, vmask, 'V', 1.0_wp, fmask, 'F', 1.0_wp )      ! Lateral boundary conditions 
    177165  
    … …  
    187175      END DO 
    188176 
    189  
    190177      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical) 
    191178      ! ---------------------------------------------- 
    … …  
    195182      ssfmask(:,:) = MAXVAL( fmask(:,:,:), DIM=3 ) 
    196183 
    197  
    198184      ! Interior domain mask  (used for global sum) 
    199185      ! -------------------- 
    200186      ! 
    201       iif = nn_hls   ;   iil = nlci - nn_hls + 1 
    202       ijf = nn_hls   ;   ijl = nlcj - nn_hls + 1 
    203       ! 
    204       !                          ! halo mask : 0 on the halo and 1 elsewhere 
    205       tmask_h(:,:) = 1._wp                   
    206       tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns 
    207       tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns) 
    208       tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows 
    209       tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows) 
    210       ! 
    211       !                          ! north fold mask 
    212       tpol(1:jpiglo) = 1._wp  
    213       fpol(1:jpiglo) = 1._wp 
    214       IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot 
    215          tpol(jpiglo/2+1:jpiglo) = 0._wp 
    216          fpol(     1    :jpiglo) = 0._wp 
    217          IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row for tmask_h 
    218             DO ji = iif+1, iil-1 
    219                tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji)) 
    220             END DO 
    221          ENDIF 
    222       ENDIF 
    223       ! 
    224       IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot 
    225          tpol(     1    :jpiglo) = 0._wp 
    226          fpol(jpiglo/2+1:jpiglo) = 0._wp 
    227       ENDIF 
     187      CALL dom_uniq( tmask_h, 'T' ) 
    228188      ! 
    229189      !                          ! interior mask : 2D ocean mask x halo mask  
    230190      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:) 
    231  
    232191 
    233192      ! Lateral boundary conditions on velocity (modify fmask) 
    … …  
    235194      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition 
    236195         ! 
    237          ALLOCATE( zwf(jpi,jpj) ) 
    238          ! 
    239196         DO jk = 1, jpk 
    240             zwf(:,:) = fmask(:,:,jk)          
    241             DO_2D_00_00 
     197            DO_2D( 0, 0, 0, 0 ) 
    242198               IF( fmask(ji,jj,jk) == 0._wp ) THEN 
    243                   fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),  & 
    244                      &                                           zwf(ji-1,jj), zwf(ji,jj-1)  ) ) 
     199                  fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk), & 
     200                     &                                           vmask(ji,jj,jk), vmask(ji+1,jj,jk) ) ) 
    245201               ENDIF 
    246202            END_2D 
    247203            DO jj = 2, jpjm1 
    248204               IF( fmask(1,jj,jk) == 0._wp ) THEN 
    249                   fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
     205                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(2,jj,jk), umask(1,jj+1,jk), umask(1,jj,jk) ) ) 
    250206               ENDIF 
    251207               IF( fmask(jpi,jj,jk) == 0._wp ) THEN 
    252                   fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
     208                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(jpi,jj+1,jk), vmask(jpim1,jj,jk), umask(jpi,jj-1,jk) ) ) 
    253209               ENDIF 
    254210            END DO          
    255211            DO ji = 2, jpim1 
    256212               IF( fmask(ji,1,jk) == 0._wp ) THEN 
    257                   fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
     213                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,1,jk), umask(ji,2,jk), vmask(ji,1,jk) ) ) 
    258214               ENDIF 
    259215               IF( fmask(ji,jpj,jk) == 0._wp ) THEN 
    260                   fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
     216                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,jk), vmask(ji-1,jpj,jk), umask(ji,jpjm1,jk) ) ) 
    261217               ENDIF 
    262218            END DO 
    263219         END DO 
    264          ! 
    265          DEALLOCATE( zwf ) 
    266220         ! 
    267221         CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
Note: See TracChangeset for help on using the changeset viewer.