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 13270 for NEMO/releases/r4.0/r4.0-HEAD/src – NEMO

Ignore:
Timestamp:
2020-07-08T16:41:20+02:00 (4 years ago)
Author:
clem
Message:

should solve ticket #2237

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/releases/r4.0/r4.0-HEAD/src/OCE/DOM/dommsk.F90

    r12737 r13270  
    9292      INTEGER  ::   iktop, ikbot   !   -       - 
    9393      INTEGER  ::   ios, inum 
    94       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zwf   ! 2D workspace 
    9594      !! 
    9695      NAMELIST/namlbc/ rn_shlat, ln_vorlat 
     
    243242      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition 
    244243         ! 
    245          ALLOCATE( zwf(jpi,jpj) ) 
    246          ! 
    247244         DO jk = 1, jpk 
    248             zwf(:,:) = fmask(:,:,jk)          
    249245            DO jj = 2, jpjm1 
    250246               DO ji = fs_2, fs_jpim1   ! vector opt. 
    251247                  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)  ) ) 
     248                     fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk), & 
     249                        &                                           vmask(ji,jj,jk), vmask(ji+1,jj,jk) ) ) 
    254250                  ENDIF 
    255251               END DO 
     
    257253            DO jj = 2, jpjm1 
    258254               IF( fmask(1,jj,jk) == 0._wp ) THEN 
    259                   fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
     255                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(2,jj,jk), umask(1,jj+1,jk), umask(1,jj,jk) ) ) 
    260256               ENDIF 
    261257               IF( fmask(jpi,jj,jk) == 0._wp ) THEN 
    262                   fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
     258                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(jpi,jj+1,jk), vmask(jpim1,jj,jk), umask(jpi,jj-1,jk) ) ) 
    263259               ENDIF 
    264260            END DO          
    265261            DO ji = 2, jpim1 
    266262               IF( fmask(ji,1,jk) == 0._wp ) THEN 
    267                   fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
     263                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,1,jk), umask(ji,2,jk), vmask(ji,1,jk) ) ) 
    268264               ENDIF 
    269265               IF( fmask(ji,jpj,jk) == 0._wp ) THEN 
    270                   fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
     266                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,jk), vmask(ji-1,jpj,jk), umask(ji,jpjm1,jk) ) ) 
    271267               ENDIF 
    272268            END DO 
     
    281277         END DO 
    282278         ! 
    283          DEALLOCATE( zwf ) 
    284          ! 
    285279         CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
    286280         ! 
Note: See TracChangeset for help on using the changeset viewer.