Changeset 10904


Ignore:
Timestamp:
2019-04-26T14:52:01+02:00 (18 months ago)
Author:
davestorkey
Message:

UKMO/NEMO_4.0_GO8_package : include shlat2d option.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/DOM/dommsk.F90

    r10888 r10904  
    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 
     
    9294      INTEGER  ::   iktop, ikbot   !   -       - 
    9395      INTEGER  ::   ios, inum 
    94       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zwf   ! 2D workspace 
    95       !! 
    96       NAMELIST/namlbc/ rn_shlat, ln_vorlat 
     96      !! 
     97      INTEGER  :: inum             !  logical unit for shlat2d 
     98      REAL(wp) :: zshlat           !: locally modified shlat for some strait 
     99      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zshlat2d 
     100      LOGICAL                         :: ln_shlat2d 
     101      CHARACTER(len = 256)            :: cn_shlat2d_file, cn_shlat2d_var   
     102      !! 
     103      NAMELIST/namlbc/ rn_shlat, ln_vorlat, ln_shlat2d, cn_shlat2d_file, cn_shlat2d_var 
    97104      NAMELIST/nambdy/ ln_bdy ,nb_bdy, ln_coords_file, cn_coords_file,         & 
    98105         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     & 
     
    122129      ! 
    123130      IF(lwp) WRITE(numout,*) 
    124       IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  free-slip' 
    125       ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  no-slip' 
    126       ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  partial-slip' 
    127       ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  strong-slip' 
     131 
     132      IF ( ln_shlat2d ) THEN 
     133         IF(lwp) WRITE(numout,*) '         READ shlat as a 2D coefficient in a file ' 
     134         ALLOCATE( zshlat2d(jpi,jpj) ) 
     135         CALL iom_open(TRIM(cn_shlat2d_file), inum) 
     136         CALL iom_get (inum, jpdom_data, TRIM(cn_shlat2d_var), zshlat2d, 1) ! 
     137         CALL iom_close(inum) 
    128138      ELSE 
    129          CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' ) 
     139         IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  free-slip' 
     140         ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  no-slip' 
     141         ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  partial-slip' 
     142         ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  strong-slip' 
     143         ELSE 
     144            CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' ) 
     145         ENDIF 
    130146      ENDIF 
    131147 
     
    241257      ! Lateral boundary conditions on velocity (modify fmask) 
    242258      ! ---------------------------------------   
    243       IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition 
    244          ! 
    245          ALLOCATE( zwf(jpi,jpj) ) 
     259      IF( rn_shlat /= 0 .or. ln_shlat2d ) THEN      ! Not free-slip lateral boundary condition everywhere 
    246260         ! 
    247261         DO jk = 1, jpk 
    248             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 
     262            IF (  ln_shlat2d ) THEN 
     263               DO jj = 2, jpjm1 
     264                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     265                     IF( fmask(ji,jj,jk) == 0._wp ) THEN 
     266                        fmask(ji,jj,jk) = zshlat2d(ji,jj) * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk),   & 
     267                           &                                                  vmask(ji,jj,jk), vmask(ji+1,jj,jk)  )  ) 
     268                     ENDIF 
     269                  END DO 
    255270               END DO 
    256             END DO 
     271            ELSE 
     272               DO jj = 2, jpjm1 
     273                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     274                     IF( fmask(ji,jj,jk) == 0._wp ) THEN 
     275                        fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk),   & 
     276                           &                                           vmask(ji,jj,jk), vmask(ji+1,jj,jk)   )  ) 
     277                     ENDIF 
     278                  END DO 
     279               END DO 
     280            ENDIF 
    257281            DO jj = 2, jpjm1 
    258282               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) ) ) 
     283                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(2,jj,jk), umask(1,jj+1,jk), umask(1,jj,jk) ) ) 
    260284               ENDIF 
    261285               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) ) ) 
     286                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(jpi,jj+1,jk), vmask(jpim1,jj,jk), umask(jpi,jj-1,jk) ) ) 
    263287               ENDIF 
    264288            END DO          
    265289            DO ji = 2, jpim1 
    266290               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) ) ) 
     291                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,1,jk), umask(ji,2,jk), vmask(ji,1,jk) ) ) 
    268292               ENDIF 
    269293               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) ) ) 
     294                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,jk), vmask(ji-1,jpj,jk), umask(ji,jpjm1,jk) ) ) 
    271295               ENDIF 
    272296            END DO 
     
    281305         END DO 
    282306         ! 
    283          DEALLOCATE( zwf ) 
     307         IF( ln_shlat2d ) DEALLOCATE( zshlat2d ) 
    284308         ! 
    285309         CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
Note: See TracChangeset for help on using the changeset viewer.