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

Changeset 10648


Ignore:
Timestamp:
2019-02-07T16:57:16+01:00 (5 years ago)
Author:
davestorkey
Message:

UKMO dev_r10037_shlat2d branch: bug fix - make sure modified shlat values are applied to single-point channels. (This fix relates to ticket #2237).

File:
1 edited

Legend:

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

    r10642 r10648  
    9494      INTEGER  ::   iktop, ikbot   !   -       - 
    9595      INTEGER  ::   ios, inum 
    96       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zwf   ! 2D workspace 
    9796      !! 
    9897      INTEGER  :: inum             !  logical unit for shlat2d 
     
    259258      IF( rn_shlat /= 0 .or. ln_shlat2d ) THEN      ! Not free-slip lateral boundary condition everywhere 
    260259         ! 
    261          ALLOCATE( zwf(jpi,jpj) ) 
    262          ! 
    263260         DO jk = 1, jpk 
    264             zwf(:,:) = fmask(:,:,jk)          
    265261            IF (  ln_shlat2d ) THEN 
    266262               DO jj = 2, jpjm1 
    267263                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    268264                     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)  )  ) 
     265                        fmask(ji,jj,jk) = zshlat2d(ji,jj) * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk),   & 
     266                           &                                                  vmask(ji,jj,jk), vmask(ji+1,jj,jk)  )  ) 
    271267                     ENDIF 
    272268                  END DO 
     
    276272                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    277273                     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)  )  ) 
     274                        fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk),   & 
     275                           &                                           vmask(ji,jj,jk), vmask(ji+1,jj,jk)   )  ) 
    280276                     ENDIF 
    281277                  END DO 
     
    284280            DO jj = 2, jpjm1 
    285281               IF( fmask(1,jj,jk) == 0._wp ) THEN 
    286                   fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
     282                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(2,jj,jk), umask(1,jj+1,jk), umask(1,jj,jk) ) ) 
    287283               ENDIF 
    288284               IF( fmask(jpi,jj,jk) == 0._wp ) THEN 
    289                   fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
     285                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(jpi,jj+1,jk), vmask(jpim1,jj,jk), umask(jpi,jj-1,jk) ) ) 
    290286               ENDIF 
    291287            END DO          
    292288            DO ji = 2, jpim1 
    293289               IF( fmask(ji,1,jk) == 0._wp ) THEN 
    294                   fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
     290                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,1,jk), umask(ji,2,jk), vmask(ji,1,jk) ) ) 
    295291               ENDIF 
    296292               IF( fmask(ji,jpj,jk) == 0._wp ) THEN 
    297                   fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
     293                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,jk), vmask(ji-1,jpj,jk), umask(ji,jpjm1,jk) ) ) 
    298294               ENDIF 
    299295            END DO 
     
    308304         END DO 
    309305         ! 
    310          DEALLOCATE( zwf ) 
    311306         IF( ln_shlat2d ) DEALLOCATE( zshlat2d ) 
    312307         ! 
Note: See TracChangeset for help on using the changeset viewer.