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 8977 for branches/UKMO – NEMO

Changeset 8977 for branches/UKMO


Ignore:
Timestamp:
2017-12-11T14:51:28+01:00 (6 years ago)
Author:
deazer
Message:

Addresses several issues in the review except for rn_ssh_ref in the TEST cases

Builds and runs ok , little extra bracket dealt with in stpctl also

Location:
branches/UKMO/ROMS_WAD_7832/NEMOGCM
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_zgr.F90

    r8956 r8977  
    235235               
    236236! increase the depth of the bathymetry by rn_ssh_ref and rn_ht_0    
    237       !zht(:,:) = zht(:,:) + rn_ssh_ref + rn_ht_0   
    238237      !zht(:,:) = zht(:,:) + rn_ssh_ref + rn_ht_0   
    239238 

  • branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r8956 r8977  
    190190      z1_2  = 0.5_wp      
    191191      zraur = 1._wp / rau0 
    192       zwdramp = 1._wp / rn_wdmin1               ! simplest ramp  
     192      zwdramp = r_rn_wdmin1               ! simplest ramp  
    193193!     zwdramp = 1._wp / (rn_wdmin2 - rn_wdmin1) ! more general ramp 
    194194      !                                         ! reciprocal of baroclinic time step  
    … …  
    693693                           ztwdmask(ji,jj) = 1._wp 
    694694                        ELSE IF ( zsshp2_e(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN 
    695                            ztwdmask(ji,jj) = (tanh(50._wp*( ( zsshp2_e(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 )/rn_wdmin1)) )  
     695                           ztwdmask(ji,jj) = (tanh(50._wp*( ( zsshp2_e(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 )*r_rn_wdmin1)) )  
    696696                        ELSE  
    697697                           ztwdmask(ji,jj) = 0._wp 

  • branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90

    r8956 r8977  
    4141   REAL(wp), PUBLIC  ::   rn_wdmin0   !: depth at which wetting/drying starts 
    4242   REAL(wp), PUBLIC  ::   rn_wdmin1   !: minimum water depth on dried cells 
     43   REAL(wp), PUBLIC  ::   r_rn_wdmin1 !: 1/minimum water depth on dried cells  
    4344   REAL(wp), PUBLIC  ::   rn_wdmin2   !: tolerance of minimum water depth on dried cells 
    4445   REAL(wp), PUBLIC  ::   rn_wdld     !: land elevation below which wetting/drying will be considered 
    … …  
    101102         WRITE(numout,*) '      the height (z) at which ht_0=0:  rn_ht_0      = ', rn_ht_0   
    102103      ENDIF 
    103       ! 
     104      r_rn_wdmin1=1/rn_wdmin1 
    104105      ll_wd = .FALSE. 
    105106      IF(ln_wd_il .OR. ln_wd_dl) THEN 
    … …  
    142143      IF( nn_timing == 1 )  CALL timing_start('wad_lmt') 
    143144 
    144       IF( ln_wd_il ) THEN 
    145  
    146         CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 ) 
    147         CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv) 
    148         ! 
    149         
    150         jflag  = 0 
    151         zdepwd = 50._wp   !maximum depth on which that W/D could possibly happen 
    152  
    153         
    154         zflxp(:,:)   = 0._wp 
    155         zflxn(:,:)   = 0._wp 
    156         zflxu(:,:)   = 0._wp 
    157         zflxv(:,:)   = 0._wp 
    158  
    159         zwdlmtu(:,:)  = 1._wp 
    160         zwdlmtv(:,:)  = 1._wp 
    161         
    162         ! Horizontal Flux in u and v direction 
    163         DO jk = 1, jpkm1   
    164            DO jj = 1, jpj 
    165               DO ji = 1, jpi 
    166                  zflxu(ji,jj) = zflxu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
    167                  zflxv(ji,jj) = zflxv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
    168               END DO   
    169            END DO   
    170         END DO 
    171         
    172         zflxu(:,:) = zflxu(:,:) * e2u(:,:) 
    173         zflxv(:,:) = zflxv(:,:) * e1v(:,:) 
    174         
    175         wdmask(:,:) = 1 
    176         DO jj = 2, jpj 
    177            DO ji = 2, jpi  
    178  
    179               IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE              ! we don't care about land cells 
    180               IF( ht_0(ji,jj) - rn_ssh_ref > zdepwd ) CYCLE   ! and cells which are unlikely to dry 
    181  
    182               zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + & 
    183                            & max(zflxv(ji,jj), 0._wp) - min(zflxv(ji,  jj-1), 0._wp)  
    184               zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj),   0._wp) + & 
    185                            & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp)  
    186  
    187               zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 
    188               IF(zdep2 .le. 0._wp) THEN  !add more safty, but not necessary 
    189                  sshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 
    190                  IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp 
    191                  IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp 
    192                  IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp 
    193                  IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp  
    194                  wdmask(ji,jj) = 0._wp 
    195               END IF 
    196            ENDDO 
    197         END DO 
     145 
     146      CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 ) 
     147      CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv) 
     148      ! 
     149        
     150      jflag  = 0 
     151      zdepwd = 50._wp   !maximum depth on which that W/D could possibly happen 
     152 
     153        
     154      zflxp(:,:)   = 0._wp 
     155      zflxn(:,:)   = 0._wp 
     156      zflxu(:,:)   = 0._wp 
     157      zflxv(:,:)   = 0._wp 
     158 
     159      zwdlmtu(:,:)  = 1._wp 
     160      zwdlmtv(:,:)  = 1._wp 
     161        
     162      ! Horizontal Flux in u and v direction 
     163      DO jk = 1, jpkm1   
     164         DO jj = 1, jpj 
     165            DO ji = 1, jpi 
     166               zflxu(ji,jj) = zflxu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
     167               zflxv(ji,jj) = zflxv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
     168            END DO   
     169         END DO   
     170      END DO 
     171        
     172      zflxu(:,:) = zflxu(:,:) * e2u(:,:) 
     173      zflxv(:,:) = zflxv(:,:) * e1v(:,:) 
     174        
     175      wdmask(:,:) = 1 
     176      DO jj = 2, jpj 
     177         DO ji = 2, jpi  
     178 
     179            IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE              ! we don't care about land cells 
     180            IF( ht_0(ji,jj) - rn_ssh_ref > zdepwd ) CYCLE   ! and cells which are unlikely to dry 
     181 
     182            zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + & 
     183                         & max(zflxv(ji,jj), 0._wp) - min(zflxv(ji,  jj-1), 0._wp)  
     184            zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj),   0._wp) + & 
     185                         & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp)  
     186 
     187            zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 
     188            IF(zdep2 .le. 0._wp) THEN  !add more safty, but not necessary 
     189               sshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 
     190               IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp 
     191               IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp 
     192               IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp 
     193               IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp  
     194               wdmask(ji,jj) = 0._wp 
     195            END IF 
     196         ENDDO 
     197      END DO 
    198198 
    199199 
    200200! HPG limiter from jholt 
    201         wdramp(:,:) = min((ht_0(:,:) + sshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp) 
     201      wdramp(:,:) = min((ht_0(:,:) + sshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp) 
    202202!jth assume don't need a lbc_lnk here 
    203         DO jj = 1, jpjm1 
    204            DO ji = 1, jpim1 
    205               wdrampu(ji,jj) = min(wdramp(ji,jj),wdramp(ji+1,jj)) 
    206               wdrampv(ji,jj) = min(wdramp(ji,jj),wdramp(ji,jj+1)) 
    207            END DO 
    208         END DO 
     203      DO jj = 1, jpjm1 
     204         DO ji = 1, jpim1 
     205            wdrampu(ji,jj) = min(wdramp(ji,jj),wdramp(ji+1,jj)) 
     206            wdrampv(ji,jj) = min(wdramp(ji,jj),wdramp(ji,jj+1)) 
     207         END DO 
     208      END DO 
    209209! end HPG limiter 
    210210 
    … …  
    212212       
    213213        !! start limiter iterations  
    214         DO jk1 = 1, nn_wdit + 1 
    215         
    216            
    217            zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:) 
    218            zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 
    219            jflag = 0     ! flag indicating if any further iterations are needed 
    220            
    221            DO jj = 2, jpj 
    222               DO ji = 2, jpi  
     214      DO jk1 = 1, nn_wdit + 1 
     215        
     216           
     217         zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:) 
     218         zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 
     219         jflag = 0     ! flag indicating if any further iterations are needed 
     220           
     221         DO jj = 2, jpj 
     222            DO ji = 2, jpi  
    223223         
    224                  IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE  
    225                  IF( ht_0(ji,jj) > zdepwd )      CYCLE 
     224               IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE  
     225               IF( ht_0(ji,jj) > zdepwd )      CYCLE 
    226226         
    227                  ztmp = e1e2t(ji,jj) 
    228  
    229                  zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp) + & 
    230                         & max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp)  
    231                  zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp) + & 
    232                         & min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp)  
    233            
    234                  zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
    235                  zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj) 
    236            
    237                  IF( zdep1 > zdep2 ) THEN 
    238                     wdmask(ji, jj) = 0 
    239                     zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 
    240                     !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 
    241                     ! flag if the limiter has been used but stop flagging if the only 
    242                     ! changes have zeroed the coefficient since further iterations will 
    243                     ! not change anything 
    244                     IF( zcoef > 0._wp ) THEN 
    245                        jflag = 1  
    246                     ELSE 
    247                        zcoef = 0._wp 
    248                     ENDIF 
    249                     IF(jk1 > nn_wdit) zcoef = 0._wp 
    250                     IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef 
    251                     IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef 
    252                     IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef 
    253                     IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef 
    254                  END IF 
    255               END DO ! ji loop 
    256            END DO  ! jj loop 
    257  
    258            CALL lbc_lnk( zwdlmtu, 'U', 1. ) 
    259            CALL lbc_lnk( zwdlmtv, 'V', 1. ) 
    260  
    261            IF(lk_mpp) CALL mpp_max(jflag)   !max over the global domain 
    262  
    263            IF(jflag == 0) EXIT 
    264            
    265         END DO  ! jk1 loop 
    266         
    267         DO jk = 1, jpkm1 
    268            un(:,:,jk) = un(:,:,jk) * zwdlmtu(:, :)  
    269            vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:, :)  
    270         END DO 
    271  
    272         CALL lbc_lnk( un, 'U', -1. ) 
    273         CALL lbc_lnk( vn, 'V', -1. ) 
     227               ztmp = e1e2t(ji,jj) 
     228 
     229               zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp) + & 
     230                      & max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp)  
     231               zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp) + & 
     232                      & min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp)  
     233           
     234               zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
     235               zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj) 
     236           
     237               IF( zdep1 > zdep2 ) THEN 
     238                  wdmask(ji, jj) = 0 
     239                  zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 
     240                  !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 
     241                  ! flag if the limiter has been used but stop flagging if the only 
     242                  ! changes have zeroed the coefficient since further iterations will 
     243                  ! not change anything 
     244                  IF( zcoef > 0._wp ) THEN 
     245                     jflag = 1  
     246                  ELSE 
     247                     zcoef = 0._wp 
     248                  ENDIF 
     249                  IF(jk1 > nn_wdit) zcoef = 0._wp 
     250                  IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef 
     251                  IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef 
     252                  IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef 
     253                  IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef 
     254               END IF 
     255            END DO ! ji loop 
     256         END DO  ! jj loop 
     257 
     258         CALL lbc_lnk( zwdlmtu, 'U', 1. ) 
     259         CALL lbc_lnk( zwdlmtv, 'V', 1. ) 
     260 
     261         IF(lk_mpp) CALL mpp_max(jflag)   !max over the global domain 
     262 
     263         IF(jflag == 0) EXIT 
     264           
     265      END DO  ! jk1 loop 
     266        
     267      DO jk = 1, jpkm1 
     268         un(:,:,jk) = un(:,:,jk) * zwdlmtu(:, :)  
     269         vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:, :)  
     270      END DO 
     271 
     272      CALL lbc_lnk( un, 'U', -1. ) 
     273      CALL lbc_lnk( vn, 'V', -1. ) 
    274274        ! 
    275         un_b(:,:) = un_b(:,:) * zwdlmtu(:, :) 
    276         vn_b(:,:) = vn_b(:,:) * zwdlmtv(:, :) 
    277         CALL lbc_lnk( un_b, 'U', -1. ) 
    278         CALL lbc_lnk( vn_b, 'V', -1. ) 
    279         
    280         IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!' 
    281         
    282         !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
    283         !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
    284         ! 
    285         ! 
    286         CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 ) 
    287         CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv) 
    288         ! 
    289       ENDIF 
     275      un_b(:,:) = un_b(:,:) * zwdlmtu(:, :) 
     276      vn_b(:,:) = vn_b(:,:) * zwdlmtv(:, :) 
     277      CALL lbc_lnk( un_b, 'U', -1. ) 
     278      CALL lbc_lnk( vn_b, 'V', -1. ) 
     279        
     280      IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!' 
     281        
     282      !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
     283      !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
     284      ! 
     285      ! 
     286      CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 ) 
     287      CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv) 
     288      ! 
    290289      ! 
    291290      IF( nn_timing == 1 )  CALL timing_stop('wad_lmt') 
    … …  
    321320      IF( nn_timing == 1 )  CALL timing_start('wad_lmt_bt') 
    322321 
    323       IF( ln_wd_il ) THEN 
    324  
    325         CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 ) 
    326         CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv) 
    327         ! 
    328         
    329         !IF(lwp) WRITE(numout,*) 
    330         !IF(lwp) WRITE(numout,*) 'wad_lmt_bt : wetting/drying limiters and velocity limiting' 
    331         
    332         jflag  = 0 
    333         zdepwd = 50._wp   !maximum depth that ocean cells can have W/D processes 
    334  
    335         z2dt = rdtbt    
    336         
    337         zflxp(:,:)   = 0._wp 
    338         zflxn(:,:)   = 0._wp 
    339  
    340         zwdlmtu(:,:)  = 1._wp 
    341         zwdlmtv(:,:)  = 1._wp 
     322 
     323      CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 ) 
     324      CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv) 
     325      ! 
     326        
     327      !IF(lwp) WRITE(numout,*) 
     328      !IF(lwp) WRITE(numout,*) 'wad_lmt_bt : wetting/drying limiters and velocity limiting' 
     329        
     330      jflag  = 0 
     331      zdepwd = 50._wp   !maximum depth that ocean cells can have W/D processes 
     332 
     333      z2dt = rdtbt    
     334        
     335      zflxp(:,:)   = 0._wp 
     336      zflxn(:,:)   = 0._wp 
     337 
     338      zwdlmtu(:,:)  = 1._wp 
     339      zwdlmtv(:,:)  = 1._wp 
    342340        
    343341        ! Horizontal Flux in u and v direction 
    344342        
    345         DO jj = 2, jpj 
    346            DO ji = 2, jpi  
    347  
    348              IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE   ! we don't care about land cells 
    349              IF( ht_0(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry 
    350  
    351               zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + & 
    352                            & max(zflxv(ji,jj), 0._wp) - min(zflxv(ji,  jj-1), 0._wp)  
    353               zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj),   0._wp) + & 
    354                            & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp)  
    355  
    356               zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 
    357               IF(zdep2 .le. 0._wp) THEN  !add more safety, but not necessary 
    358                 sshn_e(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 
    359                 IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp 
    360                 IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp 
    361                 IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp 
    362                 IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp  
    363               END IF 
    364            ENDDO 
    365         END DO 
     343      DO jj = 2, jpj 
     344         DO ji = 2, jpi  
     345 
     346           IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE   ! we don't care about land cells 
     347           IF( ht_0(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry 
     348 
     349            zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + & 
     350                         & max(zflxv(ji,jj), 0._wp) - min(zflxv(ji,  jj-1), 0._wp)  
     351            zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj),   0._wp) + & 
     352                         & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp)  
     353 
     354            zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 
     355            IF(zdep2 .le. 0._wp) THEN  !add more safety, but not necessary 
     356              sshn_e(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 
     357              IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp 
     358              IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp 
     359              IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp 
     360              IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp  
     361            END IF 
     362         ENDDO 
     363      END DO 
    366364 
    367365       
    368         !! start limiter iterations  
    369         DO jk1 = 1, nn_wdit + 1 
    370         
    371            
    372            zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:) 
    373            zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 
    374            jflag = 0     ! flag indicating if any further iterations are needed 
    375            
    376            DO jj = 2, jpj 
    377               DO ji = 2, jpi  
     366      !! start limiter iterations  
     367      DO jk1 = 1, nn_wdit + 1 
     368        
     369           
     370         zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:) 
     371         zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 
     372         jflag = 0     ! flag indicating if any further iterations are needed 
     373           
     374         DO jj = 2, jpj 
     375            DO ji = 2, jpi  
    378376         
    379                  IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE  
    380                  IF( ht_0(ji,jj) > zdepwd )      CYCLE 
     377               IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE  
     378               IF( ht_0(ji,jj) > zdepwd )      CYCLE 
    381379         
    382                  ztmp = e1e2t(ji,jj) 
    383  
    384                  zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp) + & 
    385                         & max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp)  
    386                  zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp) + & 
    387                         & min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp)  
    388            
    389                  zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
    390                  zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj) 
    391            
    392                  IF(zdep1 > zdep2) THEN 
    393                    zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 
    394                    !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 
    395                    ! flag if the limiter has been used but stop flagging if the only 
    396                    ! changes have zeroed the coefficient since further iterations will 
    397                    ! not change anything 
    398                    IF( zcoef > 0._wp ) THEN 
    399                       jflag = 1  
    400                    ELSE 
    401                       zcoef = 0._wp 
    402                    ENDIF 
    403                    IF(jk1 > nn_wdit) zcoef = 0._wp 
    404                    IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef 
    405                    IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef 
    406                    IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef 
    407                    IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef 
    408                  END IF 
    409               END DO ! ji loop 
    410            END DO  ! jj loop 
    411  
    412            CALL lbc_lnk( zwdlmtu, 'U', 1. ) 
    413            CALL lbc_lnk( zwdlmtv, 'V', 1. ) 
    414  
    415            IF(lk_mpp) CALL mpp_max(jflag)   !max over the global domain 
    416  
    417            IF(jflag == 0) EXIT 
    418            
    419         END DO  ! jk1 loop 
    420         
    421         zflxu(:,:) = zflxu(:,:) * zwdlmtu(:, :)  
    422         zflxv(:,:) = zflxv(:,:) * zwdlmtv(:, :)  
    423  
    424         CALL lbc_lnk( zflxu, 'U', -1. ) 
    425         CALL lbc_lnk( zflxv, 'V', -1. ) 
    426         
    427         IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!' 
    428         
    429         !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
    430         !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
    431         ! 
    432         ! 
    433         CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 ) 
    434         CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv) 
    435         ! 
    436       END IF 
     380               ztmp = e1e2t(ji,jj) 
     381 
     382               zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp) + & 
     383                      & max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp)  
     384               zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp) + & 
     385                      & min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp)  
     386           
     387               zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
     388               zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj) 
     389           
     390               IF(zdep1 > zdep2) THEN 
     391                 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 
     392                 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 
     393                 ! flag if the limiter has been used but stop flagging if the only 
     394                 ! changes have zeroed the coefficient since further iterations will 
     395                 ! not change anything 
     396                 IF( zcoef > 0._wp ) THEN 
     397                    jflag = 1  
     398                 ELSE 
     399                    zcoef = 0._wp 
     400                 ENDIF 
     401                 IF(jk1 > nn_wdit) zcoef = 0._wp 
     402                 IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef 
     403                 IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef 
     404                 IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef 
     405                 IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef 
     406               END IF 
     407            END DO ! ji loop 
     408         END DO  ! jj loop 
     409 
     410         CALL lbc_lnk( zwdlmtu, 'U', 1. ) 
     411         CALL lbc_lnk( zwdlmtv, 'V', 1. ) 
     412 
     413         IF(lk_mpp) CALL mpp_max(jflag)   !max over the global domain 
     414 
     415         IF(jflag == 0) EXIT 
     416           
     417      END DO  ! jk1 loop 
     418        
     419      zflxu(:,:) = zflxu(:,:) * zwdlmtu(:, :)  
     420      zflxv(:,:) = zflxv(:,:) * zwdlmtv(:, :)  
     421 
     422      CALL lbc_lnk( zflxu, 'U', -1. ) 
     423      CALL lbc_lnk( zflxv, 'V', -1. ) 
     424        
     425      IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!' 
     426        
     427      !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
     428      !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
     429      ! 
     430      ! 
     431      CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 ) 
     432      CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv) 
     433      ! 
    437434 
    438435      IF( nn_timing == 1 )  CALL timing_stop('wad_lmt') 

  • branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r8956 r8977  
    323323                     ! Rivers are not just at the surface must go down to nk_rnf(ji,jj) 
    324324                     IF( mikt(ji,jj) <=jk .and. jk <= nk_rnf(ji,jj)  ) THEN 
    325                         ! as we have sigma can do that here change later 
    326325                        ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj) - rnf(ji,jj)   )  ) & 
    327326                    &                            * ( e3t_n(ji,jj,jk) / h_rnf(ji,jj) )  

  • branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r8956 r8977  
    3434   USE wrk_nemo       ! Memory Allocation 
    3535   USE timing         ! Timing 
    36    USE wet_dry,  ONLY : ll_wd, rn_wdmin1  ! Wetting and drying 
     36   USE wet_dry,  ONLY : ll_wd, rn_wdmin1, r_rn_wdmin1 ! Wetting and drying 
    3737 
    3838   IMPLICIT NONE 
    … …  
    127127                  sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)   ! non solar heat flux 
    128128               ELSE IF ( sshn(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN 
    129                   sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj) * (tanh(5._wp*( ( sshn(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 )/rn_wdmin1)) ) 
     129                  sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj) * (tanh(5._wp*( ( sshn(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 )*r_rn_wdmin1)) ) 
    130130               ELSE 
    131131                  sbc_tsc(ji,jj,jp_tem) = 0._wp 

  • branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

    r8956 r8977  
    151151      DO jj = 1, jpj 
    152152         DO ji = 1, jpi 
    153             IF( (ll_wd ) THEN 
     153            IF( ll_wd ) THEN 
    154154               IF( tmask(ji,jj,1) == 1) zsshmax = MAX( zsshmax, ABS(sshn(ji,jj)+rn_ssh_ref) ) 
    155155            ELSE 
Note: See TracChangeset for help on using the changeset viewer.