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 10642 – NEMO

Changeset 10642


Ignore:
Timestamp:
2019-02-06T15:32:39+01:00 (5 years ago)
Author:
davestorkey
Message:

UKMO dev_r10037_shlat2d branch: commit code changes.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/dev_r10037_shlat2d/src/OCE/DOM/dommsk.F90

    r9950 r10642  
    3232   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    3333   USE lib_mpp        ! Massively Parallel Processing library 
     34   USE iom             ! For shlat2d 
     35   USE fldread         ! for sn_shlat2d 
    3436 
    3537   IMPLICIT NONE 
     
    9496      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zwf   ! 2D workspace 
    9597      !! 
    96       NAMELIST/namlbc/ rn_shlat, ln_vorlat 
     98      INTEGER  :: inum             !  logical unit for shlat2d 
     99      REAL(wp) :: zshlat           !: locally modified shlat for some strait 
     100      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zshlat2d 
     101      LOGICAL                         :: ln_shlat2d 
     102      CHARACTER(len = 256)            :: cn_shlat2d_file, cn_shlat2d_var   
     103      !! 
     104      NAMELIST/namlbc/ rn_shlat, ln_vorlat, ln_shlat2d, cn_shlat2d_file, cn_shlat2d_var 
    97105      NAMELIST/nambdy/ ln_bdy ,nb_bdy, ln_coords_file, cn_coords_file,         & 
    98106         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     & 
     
    128136      ELSE 
    129137         CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' ) 
     138      ENDIF 
     139 
     140      IF ( ln_shlat2d ) THEN 
     141         IF(lwp) WRITE(numout,*) '         READ shlat as a 2D coefficient in a file ' 
     142         ALLOCATE( zshlat2d(jpi,jpj) ) 
     143         CALL iom_open(TRIM(cn_shlat2d_file), inum) 
     144         CALL iom_get (inum, jpdom_data, TRIM(cn_shlat2d_var), zshlat2d, 1) ! 
     145         CALL iom_close(inum) 
    130146      ENDIF 
    131147 
     
    241257      ! Lateral boundary conditions on velocity (modify fmask) 
    242258      ! ---------------------------------------   
    243       IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition 
     259      IF( rn_shlat /= 0 .or. ln_shlat2d ) THEN      ! Not free-slip lateral boundary condition everywhere 
    244260         ! 
    245261         ALLOCATE( zwf(jpi,jpj) ) 
     
    247263         DO jk = 1, jpk 
    248264            zwf(:,:) = fmask(:,:,jk)          
    249             DO jj = 2, jpjm1 
    250                DO ji = fs_2, fs_jpim1   ! vector opt. 
    251                   IF( fmask(ji,jj,jk) == 0._wp ) THEN 
    252                      fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   & 
    253                         &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
    254                   ENDIF 
     265            IF (  ln_shlat2d ) THEN 
     266               DO jj = 2, jpjm1 
     267                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     268                     IF( fmask(ji,jj,jk) == 0._wp ) THEN 
     269                        fmask(ji,jj,jk) = zshlat2d(ji,jj) * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   & 
     270                           &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
     271                     ENDIF 
     272                  END DO 
    255273               END DO 
    256             END DO 
     274            ELSE 
     275               DO jj = 2, jpjm1 
     276                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     277                     IF( fmask(ji,jj,jk) == 0._wp ) THEN 
     278                        fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   & 
     279                           &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
     280                     ENDIF 
     281                  END DO 
     282               END DO 
     283            ENDIF 
    257284            DO jj = 2, jpjm1 
    258285               IF( fmask(1,jj,jk) == 0._wp ) THEN 
     
    282309         ! 
    283310         DEALLOCATE( zwf ) 
     311         IF( ln_shlat2d ) DEALLOCATE( zshlat2d ) 
    284312         ! 
    285313         CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
Note: See TracChangeset for help on using the changeset viewer.