- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DYN/wet_dry.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/wet_dry.F90
r10499 r13463 31 31 PRIVATE 32 32 33 !! * Substitutions 34 # include "do_loop_substitute.h90" 35 # include "domzgr_substitute.h90" 33 36 !!---------------------------------------------------------------------- 34 37 !! critical depths,filters, limiters,and masks for Wetting and Drying … … 61 64 62 65 !! * Substitutions 63 # include "vectopt_loop_substitute.h90"64 66 !!---------------------------------------------------------------------- 65 67 CONTAINS … … 79 81 !!---------------------------------------------------------------------- 80 82 ! 81 REWIND( numnam_ref ) ! Namelist namwad in reference namelist : Parameters for Wetting/Drying82 83 READ ( numnam_ref, namwad, IOSTAT = ios, ERR = 905) 83 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in reference namelist', .TRUE.) 84 REWIND( numnam_cfg ) ! Namelist namwad in configuration namelist : Parameters for Wetting/Drying 84 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in reference namelist' ) 85 85 READ ( numnam_cfg, namwad, IOSTAT = ios, ERR = 906) 86 906 IF( ios > 0 ) CALL ctl_nam ( ios , 'namwad in configuration namelist' , .TRUE.)86 906 IF( ios > 0 ) CALL ctl_nam ( ios , 'namwad in configuration namelist' ) 87 87 IF(lwm) WRITE ( numond, namwad ) 88 88 ! … … 122 122 123 123 124 SUBROUTINE wad_lmt( sshb1, sshemp, z2dt)124 SUBROUTINE wad_lmt( psshb1, psshemp, z2dt, Kmm, puu, pvv ) 125 125 !!---------------------------------------------------------------------- 126 126 !! *** ROUTINE wad_lmt *** … … 132 132 !! ** Action : - calculate flux limiter and W/D flag 133 133 !!---------------------------------------------------------------------- 134 REAL(wp), DIMENSION(:,:), INTENT(inout) :: sshb1 !!gm DOCTOR names: should start with p ! 135 REAL(wp), DIMENSION(:,:), INTENT(in ) :: sshemp 136 REAL(wp) , INTENT(in ) :: z2dt 134 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: psshb1 135 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: psshemp 136 REAL(wp) , INTENT(in ) :: z2dt 137 INTEGER , INTENT(in ) :: Kmm ! time level index 138 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! velocity arrays 137 139 ! 138 140 INTEGER :: ji, jj, jk, jk1 ! dummy loop indices … … 150 152 ! 151 153 DO jk = 1, jpkm1 152 un(:,:,jk) = un(:,:,jk) * zwdlmtu(:,:)153 vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:,:)154 puu(:,:,jk,Kmm) = puu(:,:,jk,Kmm) * zwdlmtu(:,:) 155 pvv(:,:,jk,Kmm) = pvv(:,:,jk,Kmm) * zwdlmtv(:,:) 154 156 END DO 155 157 jflag = 0 … … 165 167 ! 166 168 DO jk = 1, jpkm1 ! Horizontal Flux in u and v direction 167 zflxu(:,:) = zflxu(:,:) + e3u _n(:,:,jk) * un(:,:,jk) * umask(:,:,jk)168 zflxv(:,:) = zflxv(:,:) + e3v _n(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk)169 zflxu(:,:) = zflxu(:,:) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 170 zflxv(:,:) = zflxv(:,:) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 169 171 END DO 170 172 zflxu(:,:) = zflxu(:,:) * e2u(:,:) … … 172 174 ! 173 175 wdmask(:,:) = 1._wp 174 DO jj = 2, jpj 175 DO ji = 2, jpi 176 ! 177 IF( tmask(ji,jj,1) < 0.5_wp ) CYCLE ! we don't care about land cells 178 IF( ht_0(ji,jj) - ssh_ref > zdepwd ) CYCLE ! and cells which are unlikely to dry 179 ! 180 zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj ) , 0._wp ) & 181 & + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji, jj-1) , 0._wp ) 182 zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj ) , 0._wp ) & 183 & + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji, jj-1) , 0._wp ) 184 ! 185 zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 186 IF( zdep2 <= 0._wp ) THEN ! add more safty, but not necessary 187 sshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 188 IF(zflxu(ji, jj) > 0._wp) zwdlmtu(ji ,jj) = 0._wp 189 IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp 190 IF(zflxv(ji, jj) > 0._wp) zwdlmtv(ji ,jj) = 0._wp 191 IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp 192 wdmask(ji,jj) = 0._wp 193 END IF 194 END DO 195 END DO 176 DO_2D( 0, 1, 0, 1 ) 177 ! 178 IF( tmask(ji,jj,1) < 0.5_wp ) CYCLE ! we don't care about land cells 179 IF( ht_0(ji,jj) - ssh_ref > zdepwd ) CYCLE ! and cells which are unlikely to dry 180 ! 181 zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj ) , 0._wp ) & 182 & + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji, jj-1) , 0._wp ) 183 zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj ) , 0._wp ) & 184 & + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji, jj-1) , 0._wp ) 185 ! 186 zdep2 = ht_0(ji,jj) + psshb1(ji,jj) - rn_wdmin1 187 IF( zdep2 <= 0._wp ) THEN ! add more safty, but not necessary 188 psshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 189 IF(zflxu(ji, jj) > 0._wp) zwdlmtu(ji ,jj) = 0._wp 190 IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp 191 IF(zflxv(ji, jj) > 0._wp) zwdlmtv(ji ,jj) = 0._wp 192 IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp 193 wdmask(ji,jj) = 0._wp 194 END IF 195 END_2D 196 196 ! 197 197 ! ! HPG limiter from jholt 198 wdramp(:,:) = min((ht_0(:,:) + sshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp)198 wdramp(:,:) = min((ht_0(:,:) + psshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp) 199 199 !jth assume don't need a lbc_lnk here 200 DO jj = 1, jpjm1 201 DO ji = 1, jpim1 202 wdrampu(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji+1,jj) ) 203 wdrampv(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji,jj+1) ) 204 END DO 205 END DO 200 DO_2D( 1, 0, 1, 0 ) 201 wdrampu(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji+1,jj) ) 202 wdrampv(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji,jj+1) ) 203 END_2D 206 204 ! ! end HPG limiter 207 205 ! … … 213 211 jflag = 0 ! flag indicating if any further iterations are needed 214 212 ! 215 DO jj = 2, jpj 216 DO ji = 2, jpi 217 IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE 218 IF( ht_0(ji,jj) > zdepwd ) CYCLE 219 ! 220 ztmp = e1e2t(ji,jj) 221 ! 222 zzflxp = MAX( zflxu1(ji,jj) , 0._wp ) - MIN( zflxu1(ji-1,jj ) , 0._wp) & 223 & + MAX( zflxv1(ji,jj) , 0._wp ) - MIN( zflxv1(ji, jj-1) , 0._wp) 224 zzflxn = MIN( zflxu1(ji,jj) , 0._wp ) - MAX( zflxu1(ji-1,jj ) , 0._wp) & 225 & + MIN( zflxv1(ji,jj) , 0._wp ) - MAX( zflxv1(ji, jj-1) , 0._wp) 226 ! 227 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 228 zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj) 229 ! 230 IF( zdep1 > zdep2 ) THEN 231 wdmask(ji, jj) = 0._wp 232 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 233 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 234 ! flag if the limiter has been used but stop flagging if the only 235 ! changes have zeroed the coefficient since further iterations will 236 ! not change anything 237 IF( zcoef > 0._wp ) THEN ; jflag = 1 238 ELSE ; zcoef = 0._wp 239 ENDIF 240 IF( jk1 > nn_wdit ) zcoef = 0._wp 241 IF( zflxu1(ji ,jj ) > 0._wp ) zwdlmtu(ji ,jj ) = zcoef 242 IF( zflxu1(ji-1,jj ) < 0._wp ) zwdlmtu(ji-1,jj ) = zcoef 243 IF( zflxv1(ji ,jj ) > 0._wp ) zwdlmtv(ji ,jj ) = zcoef 244 IF( zflxv1(ji ,jj-1) < 0._wp ) zwdlmtv(ji ,jj-1) = zcoef 213 DO_2D( 0, 1, 0, 1 ) 214 IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE 215 IF( ht_0(ji,jj) > zdepwd ) CYCLE 216 ! 217 ztmp = e1e2t(ji,jj) 218 ! 219 zzflxp = MAX( zflxu1(ji,jj) , 0._wp ) - MIN( zflxu1(ji-1,jj ) , 0._wp) & 220 & + MAX( zflxv1(ji,jj) , 0._wp ) - MIN( zflxv1(ji, jj-1) , 0._wp) 221 zzflxn = MIN( zflxu1(ji,jj) , 0._wp ) - MAX( zflxu1(ji-1,jj ) , 0._wp) & 222 & + MIN( zflxv1(ji,jj) , 0._wp ) - MAX( zflxv1(ji, jj-1) , 0._wp) 223 ! 224 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 225 zdep2 = ht_0(ji,jj) + psshb1(ji,jj) - rn_wdmin1 - z2dt * psshemp(ji,jj) 226 ! 227 IF( zdep1 > zdep2 ) THEN 228 wdmask(ji, jj) = 0._wp 229 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 230 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 231 ! flag if the limiter has been used but stop flagging if the only 232 ! changes have zeroed the coefficient since further iterations will 233 ! not change anything 234 IF( zcoef > 0._wp ) THEN ; jflag = 1 235 ELSE ; zcoef = 0._wp 245 236 ENDIF 246 END DO 247 END DO 248 CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1., zwdlmtv, 'V', 1. ) 237 IF( jk1 > nn_wdit ) zcoef = 0._wp 238 IF( zflxu1(ji ,jj ) > 0._wp ) zwdlmtu(ji ,jj ) = zcoef 239 IF( zflxu1(ji-1,jj ) < 0._wp ) zwdlmtu(ji-1,jj ) = zcoef 240 IF( zflxv1(ji ,jj ) > 0._wp ) zwdlmtv(ji ,jj ) = zcoef 241 IF( zflxv1(ji ,jj-1) < 0._wp ) zwdlmtv(ji ,jj-1) = zcoef 242 ENDIF 243 END_2D 244 CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1.0_wp, zwdlmtv, 'V', 1.0_wp ) 249 245 ! 250 246 CALL mpp_max('wet_dry', jflag) !max over the global domain … … 255 251 ! 256 252 DO jk = 1, jpkm1 257 un(:,:,jk) = un(:,:,jk) * zwdlmtu(:,:)258 vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:,:)253 puu(:,:,jk,Kmm) = puu(:,:,jk,Kmm) * zwdlmtu(:,:) 254 pvv(:,:,jk,Kmm) = pvv(:,:,jk,Kmm) * zwdlmtv(:,:) 259 255 END DO 260 u n_b(:,:) = un_b(:,:) * zwdlmtu(:, :)261 v n_b(:,:) = vn_b(:,:) * zwdlmtv(:, :)256 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * zwdlmtu(:, :) 257 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * zwdlmtv(:, :) 262 258 ! 263 259 !!gm TO BE SUPPRESSED ? these lbc_lnk are useless since zwdlmtu and zwdlmtv are defined everywhere ! 264 CALL lbc_lnk_multi( 'wet_dry', un , 'U', -1., vn , 'V', -1.)265 CALL lbc_lnk_multi( 'wet_dry', u n_b, 'U', -1., vn_b, 'V', -1.)260 CALL lbc_lnk_multi( 'wet_dry', puu(:,:,:,Kmm) , 'U', -1.0_wp, pvv(:,:,:,Kmm) , 'V', -1.0_wp ) 261 CALL lbc_lnk_multi( 'wet_dry', uu_b(:,:,Kmm), 'U', -1.0_wp, vv_b(:,:,Kmm), 'V', -1.0_wp ) 266 262 !!gm 267 263 ! 268 264 IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!' 269 265 ! 270 !IF( ln_rnf ) CALL sbc_rnf_div( hdiv n ) ! runoffs (update hdivnfield)266 !IF( ln_rnf ) CALL sbc_rnf_div( hdiv ) ! runoffs (update hdiv field) 271 267 ! 272 268 IF( ln_timing ) CALL timing_stop('wad_lmt') ! … … 275 271 276 272 277 SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, r dtbt)273 SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rDt_e ) 278 274 !!---------------------------------------------------------------------- 279 275 !! *** ROUTINE wad_lmt *** … … 285 281 !! ** Action : - calculate flux limiter and W/D flag 286 282 !!---------------------------------------------------------------------- 287 REAL(wp) , INTENT(in ) :: r dtbt! ocean time-step index283 REAL(wp) , INTENT(in ) :: rDt_e ! ocean time-step index 288 284 REAL(wp), DIMENSION(:,:), INTENT(inout) :: zflxu, zflxv, sshn_e, zssh_frc 289 285 ! … … 304 300 zdepwd = 50._wp ! maximum depth that ocean cells can have W/D processes 305 301 ! 306 z2dt = r dtbt302 z2dt = rDt_e 307 303 ! 308 304 zflxp(:,:) = 0._wp … … 311 307 zwdlmtv(:,:) = 1._wp 312 308 ! 313 DO jj = 2, jpj ! Horizontal Flux in u and v direction 314 DO ji = 2, jpi 315 ! 316 IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE ! we don't care about land cells 317 IF( ht_0(ji,jj) > zdepwd ) CYCLE ! and cells which are unlikely to dry 318 ! 319 zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj ) , 0._wp ) & 320 & + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji, jj-1) , 0._wp ) 321 zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj ) , 0._wp ) & 322 & + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji, jj-1) , 0._wp ) 323 ! 324 zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 325 IF( zdep2 <= 0._wp ) THEN !add more safety, but not necessary 326 sshn_e(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 327 IF( zflxu(ji ,jj ) > 0._wp) zwdlmtu(ji ,jj ) = 0._wp 328 IF( zflxu(ji-1,jj ) < 0._wp) zwdlmtu(ji-1,jj ) = 0._wp 329 IF( zflxv(ji ,jj ) > 0._wp) zwdlmtv(ji ,jj ) = 0._wp 330 IF( zflxv(ji ,jj-1) < 0._wp) zwdlmtv(ji ,jj-1) = 0._wp 331 ENDIF 332 END DO 333 END DO 309 DO_2D( 0, 1, 0, 1 ) 310 ! 311 IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE ! we don't care about land cells 312 IF( ht_0(ji,jj) > zdepwd ) CYCLE ! and cells which are unlikely to dry 313 ! 314 zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj ) , 0._wp ) & 315 & + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji, jj-1) , 0._wp ) 316 zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj ) , 0._wp ) & 317 & + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji, jj-1) , 0._wp ) 318 ! 319 zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 320 IF( zdep2 <= 0._wp ) THEN !add more safety, but not necessary 321 sshn_e(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 322 IF( zflxu(ji ,jj ) > 0._wp) zwdlmtu(ji ,jj ) = 0._wp 323 IF( zflxu(ji-1,jj ) < 0._wp) zwdlmtu(ji-1,jj ) = 0._wp 324 IF( zflxv(ji ,jj ) > 0._wp) zwdlmtv(ji ,jj ) = 0._wp 325 IF( zflxv(ji ,jj-1) < 0._wp) zwdlmtv(ji ,jj-1) = 0._wp 326 ENDIF 327 END_2D 334 328 ! 335 329 DO jk1 = 1, nn_wdit + 1 !! start limiter iterations … … 339 333 jflag = 0 ! flag indicating if any further iterations are needed 340 334 ! 341 DO jj = 2, jpj 342 DO ji = 2, jpi 343 ! 344 IF( tmask(ji, jj, 1 ) < 0.5_wp ) CYCLE 345 IF( ht_0(ji,jj) > zdepwd ) CYCLE 346 ! 347 ztmp = e1e2t(ji,jj) 348 ! 349 zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj), 0._wp) & 350 & + max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji, jj-1), 0._wp) 351 zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj), 0._wp) & 352 & + min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji, jj-1), 0._wp) 353 354 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 355 zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj) 356 357 IF(zdep1 > zdep2) THEN 358 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 359 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 360 ! flag if the limiter has been used but stop flagging if the only 361 ! changes have zeroed the coefficient since further iterations will 362 ! not change anything 363 IF( zcoef > 0._wp ) THEN 364 jflag = 1 365 ELSE 366 zcoef = 0._wp 367 ENDIF 368 IF(jk1 > nn_wdit) zcoef = 0._wp 369 IF(zflxu1(ji, jj) > 0._wp) zwdlmtu(ji ,jj) = zcoef 370 IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef 371 IF(zflxv1(ji, jj) > 0._wp) zwdlmtv(ji ,jj) = zcoef 372 IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef 373 END IF 374 END DO ! ji loop 375 END DO ! jj loop 376 ! 377 CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1., zwdlmtv, 'V', 1. ) 335 DO_2D( 0, 1, 0, 1 ) 336 ! 337 IF( tmask(ji, jj, 1 ) < 0.5_wp ) CYCLE 338 IF( ht_0(ji,jj) > zdepwd ) CYCLE 339 ! 340 ztmp = e1e2t(ji,jj) 341 ! 342 zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj), 0._wp) & 343 & + max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji, jj-1), 0._wp) 344 zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj), 0._wp) & 345 & + min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji, jj-1), 0._wp) 346 347 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 348 zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj) 349 350 IF(zdep1 > zdep2) THEN 351 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 352 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 353 ! flag if the limiter has been used but stop flagging if the only 354 ! changes have zeroed the coefficient since further iterations will 355 ! not change anything 356 IF( zcoef > 0._wp ) THEN 357 jflag = 1 358 ELSE 359 zcoef = 0._wp 360 ENDIF 361 IF(jk1 > nn_wdit) zcoef = 0._wp 362 IF(zflxu1(ji, jj) > 0._wp) zwdlmtu(ji ,jj) = zcoef 363 IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef 364 IF(zflxv1(ji, jj) > 0._wp) zwdlmtv(ji ,jj) = zcoef 365 IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef 366 END IF 367 END_2D 368 ! 369 CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1.0_wp, zwdlmtv, 'V', 1.0_wp ) 378 370 ! 379 371 CALL mpp_max('wet_dry', jflag) !max over the global domain … … 387 379 ! 388 380 !!gm THIS lbc_lnk is useless since it is already done at the end of the jk1-loop 389 CALL lbc_lnk_multi( 'wet_dry', zflxu, 'U', -1. , zflxv, 'V', -1.)381 CALL lbc_lnk_multi( 'wet_dry', zflxu, 'U', -1.0_wp, zflxv, 'V', -1.0_wp ) 390 382 !!gm end 391 383 ! 392 384 IF( jflag == 1 .AND. lwp ) WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!' 393 385 ! 394 !IF( ln_rnf ) CALL sbc_rnf_div( hdiv n ) ! runoffs (update hdivnfield)386 !IF( ln_rnf ) CALL sbc_rnf_div( hdiv ) ! runoffs (update hdiv field) 395 387 ! 396 388 IF( ln_timing ) CALL timing_stop('wad_lmt_bt') !
Note: See TracChangeset
for help on using the changeset viewer.
