Changeset 10904

Timestamp:

2019-04-26T14:52:01+02:00 (5 years ago)

Author:

davestorkey

Message:

UKMO/NEMO_4.0_GO8_package : include shlat2d option.

File:

• NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/DOM/dommsk.F90 (modified) (5 diffs)

NEMO/branches/UKMO/NEMO_4.0_GO8_package/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
@@ -92 +94 @@
       INTEGER  ::   iktop, ikbot   !   -       -
       INTEGER  ::   ios, inum
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zwf   ! 2D workspace
-      !!
-      NAMELIST/namlbc/ rn_shlat, ln_vorlat
+      !!
+      INTEGER  :: inum             !  logical unit for shlat2d
+      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,     &
@@ -122 +129 @@
       !
       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
 
@@ -241 +257 @@
       ! Lateral boundary conditions on velocity (modify fmask)
       ! ---------------------------------------  
-      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition
-         !
-         ALLOCATE( zwf(jpi,jpj) )
+      IF( rn_shlat /= 0 .or. ln_shlat2d ) THEN      ! Not free-slip lateral boundary condition everywhere
          !
          DO jk = 1, jpk
-            zwf(:,:) = fmask(:,:,jk)         
-            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( zwf(ji+1,jj), zwf(ji,jj+1),   &
-                        &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  )
-                  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
-                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )
+                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(2,jj,jk), umask(1,jj+1,jk), umask(1,jj,jk) ) )
                ENDIF
                IF( fmask(jpi,jj,jk) == 0._wp ) THEN
-                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )
+                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(jpi,jj+1,jk), vmask(jpim1,jj,jk), umask(jpi,jj-1,jk) ) )
                ENDIF
             END DO         
             DO ji = 2, jpim1
                IF( fmask(ji,1,jk) == 0._wp ) THEN
-                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )
+                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,1,jk), umask(ji,2,jk), vmask(ji,1,jk) ) )
                ENDIF
                IF( fmask(ji,jpj,jk) == 0._wp ) THEN
-                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )
+                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,jk), vmask(ji-1,jpj,jk), umask(ji,jpjm1,jk) ) )
                ENDIF
             END DO
@@ -281 +305 @@
          END DO
          !
-         DEALLOCATE( zwf )
+         IF( ln_shlat2d ) DEALLOCATE( zshlat2d )
          !
          CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask