Changeset 10847 for NEMO/branches/UKMO/dev_r10037_GPU/src/OCE/DOM/dommsk.F90

Timestamp:

2019-04-05T16:51:46+02:00 (6 years ago)

Author:

andmirek

Message:

ticket #2197 merge dev_r10037_shlat2d: for use for ORCA1

File:

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

NEMO/branches/UKMO/dev_r10037_GPU/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,     &
@@ -128 +135 @@
       ELSE
          CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' )
+      ENDIF
+
+      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)
       ENDIF
 
@@ -241 +256 @@
       ! 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 +304 @@
          END DO
          !
-         DEALLOCATE( zwf )
+         IF( ln_shlat2d ) DEALLOCATE( zshlat2d )
          !
          CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask