Changeset 14671 for NEMO/branches/UKMO/NEMO_4.0.4_fix_topo_minor/src/OCE/DOM/dommsk.F90

Timestamp:

2021-04-01T13:34:55+02:00 (3 years ago)

Author:

dancopsey

Message:

Merged in up to revision 14474 of the GO8_package branch

File:

• NEMO/branches/UKMO/NEMO_4.0.4_fix_topo_minor/src/OCE/DOM/dommsk.F90 (modified) (6 diffs)

NEMO/branches/UKMO/NEMO_4.0.4_fix_topo_minor/src/OCE/DOM/dommsk.F90

@@ -32 +32 @@
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE lib_mpp        ! Massively Parallel Processing library
+   USE iom             ! For shlat2d
+   USE fldread         ! for sn_shlat2d
 
    IMPLICIT NONE
@@ -93 +95 @@
       INTEGER  ::   ios, inum
       !!
-      NAMELIST/namlbc/ rn_shlat, ln_vorlat
+      REAL(wp) :: zshlat           !: locally modified shlat for some strait
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zshlat2d
+      LOGICAL                         :: ln_shlat2d
+      CHARACTER(len = 256)            :: cn_shlat2d_file, cn_shlat2d_var  
+      !!
+      NAMELIST/namlbc/ rn_shlat, ln_vorlat, ln_shlat2d, cn_shlat2d_file, cn_shlat2d_var
       NAMELIST/nambdy/ ln_bdy ,nb_bdy, ln_coords_file, cn_coords_file,         &
          &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
@@ -120 +127 @@
       !
       IF(lwp) WRITE(numout,*)
-      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  free-slip'
-      ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  no-slip'
-      ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  partial-slip'
-      ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  strong-slip'
+
+      IF ( ln_shlat2d ) THEN
+         IF(lwp) WRITE(numout,*) '         READ shlat as a 2D coefficient in a file '
+         ALLOCATE( zshlat2d(jpi,jpj) )
+         CALL iom_open(TRIM(cn_shlat2d_file), inum)
+         CALL iom_get (inum, jpdom_data, TRIM(cn_shlat2d_var), zshlat2d, 1) !
+         CALL iom_close(inum)
       ELSE
-         CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' )
+         IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  free-slip'
+         ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  no-slip'
+         ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  partial-slip'
+         ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  strong-slip'
+         ELSE
+            CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' )
+         ENDIF
       ENDIF
 
@@ -240 +256 @@
       ! Lateral boundary conditions on velocity (modify fmask)
       ! ---------------------------------------  
-      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition
+      IF( rn_shlat /= 0 .or. ln_shlat2d ) THEN      ! Not free-slip lateral boundary condition everywhere
          !
          DO jk = 1, jpk
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF( fmask(ji,jj,jk) == 0._wp ) THEN
-                     fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk), &
-                        &                                           vmask(ji,jj,jk), vmask(ji+1,jj,jk) ) )
-                  ENDIF
+            IF (  ln_shlat2d ) THEN
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     IF( fmask(ji,jj,jk) == 0._wp ) THEN
+                        fmask(ji,jj,jk) = zshlat2d(ji,jj) * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk),   &
+                           &                                                  vmask(ji,jj,jk), vmask(ji+1,jj,jk)  )  )
+                     ENDIF
+                  END DO
                END DO
-            END DO
+            ELSE
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     IF( fmask(ji,jj,jk) == 0._wp ) THEN
+                        fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk),   &
+                           &                                           vmask(ji,jj,jk), vmask(ji+1,jj,jk)   )  )
+                     ENDIF
+                  END DO
+               END DO
+            ENDIF
             DO jj = 2, jpjm1
                IF( fmask(1,jj,jk) == 0._wp ) THEN
@@ -277 +304 @@
          END DO
          !
+         IF( ln_shlat2d ) DEALLOCATE( zshlat2d )
+         !
          CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
          !
@@ -284 +313 @@
       
       ! User defined alteration of fmask (use to reduce ocean transport in specified straits)
+      ! Only call if we are not using the shlat2d option.
       ! -------------------------------- 
       !
-      CALL usr_def_fmask( cn_cfg, nn_cfg, fmask )
+      IF ( .not. ln_shlat2d ) THEN      
+         CALL usr_def_fmask( cn_cfg, nn_cfg, fmask )
+      ENDIF
       !
    END SUBROUTINE dom_msk