- Timestamp:
- 2016-06-06T07:57:00+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90
r6152 r6667 1 2 1 MODULE wet_dry 3 2 !!============================================================================== … … 7 6 !! only effects if wetting/drying is on (ln_wd == .true.) 8 7 !!============================================================================== 9 !! History : 10 !! NEMO 3.6 ! 2014-09 ((H.Liu) Original code 8 !! History : 3.6 ! 2014-09 ((H.Liu) Original code 11 9 !! ! will add the runoff and periodic BC case later 12 10 !!---------------------------------------------------------------------- … … 84 82 WRITE(numout,*) ' land elevation threshold rn_wdld = ', rn_wdld 85 83 WRITE(numout,*) ' Max iteration for W/D limiter nn_wdit = ', nn_wdit 86 87 84 ENDIF 85 ! 88 86 IF(ln_wd) THEN 89 87 ALLOCATE( wduflt(jpi,jpj), wdvflt(jpi,jpj), wdmask(jpi,jpj), STAT=ierr ) 90 88 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'wad_init : Array allocation error') 91 89 ENDIF 90 ! 92 91 END SUBROUTINE wad_init 92 93 93 94 94 SUBROUTINE wad_lmt( sshb1, sshemp, z2dt ) … … 116 116 REAL(wp), POINTER, DIMENSION(:,:) :: zflxu, zflxv ! local 2D workspace 117 117 REAL(wp), POINTER, DIMENSION(:,:) :: zflxu1, zflxv1 ! local 2D workspace 118 119 118 !!---------------------------------------------------------------------- 120 119 ! … … 124 123 IF(ln_wd) THEN 125 124 126 CALL wrk_alloc( jpi, jpj,zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 )127 CALL wrk_alloc( jpi, jpj,zwdlmtu, zwdlmtv)125 CALL wrk_alloc( jpi,jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 ) 126 CALL wrk_alloc( jpi,jpj, zwdlmtu, zwdlmtv) 128 127 ! 129 128 … … 156 155 zflxv(:,:) = zflxv(:,:) * e1v(:,:) 157 156 158 DO jj = 2, jpjm1157 DO jj = 2, jpjm1 159 158 DO ji = 2, jpim1 160 159 161 IF( tmask(ji, jj, 1) < 0.5_wp)CYCLE ! we don't care about land cells162 IF( bathy(ji,jj) > zdepwd) CYCLE! and cells which will unlikely go dried out160 IF( tmask(ji,jj,1) == 0._wp ) CYCLE ! we don't care about land cells 161 IF( ht_0 (ji,jj) > zdepwd ) CYCLE ! and cells which will unlikely go dried out 163 162 164 163 zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj), 0._wp) + & … … 167 166 & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji, jj-1), 0._wp) 168 167 169 zdep2 = bathy(ji,jj) + sshb1(ji,jj) - rn_wdmin1168 zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 170 169 IF(zdep2 < 0._wp) THEN !add more safty, but not necessary 171 170 !zdep2 = 0._wp 172 sshb1(ji,jj) = rn_wdmin1 - bathy(ji,jj)171 sshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 173 172 END IF 174 173 ENDDO … … 187 186 188 187 wdmask(ji,jj) = 0 189 IF( tmask(ji, jj,1) < 0.5_wp) CYCLE190 IF( bathy(ji,jj) > zdepwd) CYCLE188 IF( tmask(ji,jj,1) < 0.5_wp) CYCLE 189 IF( ht_0(ji,jj) > zdepwd) CYCLE 191 190 192 191 ztmp = e1e2t(ji,jj) … … 198 197 199 198 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 200 zdep2 = bathy(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj) ! this one can be moved out of the loop199 zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj) ! this one can be moved out of the loop 201 200 202 201 IF(zdep1 > zdep2) THEN … … 240 239 CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 ) 241 240 CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv) 242 !243 END 244 241 ! 242 ENDIF 243 ! 245 244 IF( nn_timing == 1 ) CALL timing_stop('wad_lmt') 245 ! 246 246 END SUBROUTINE wad_lmt 247 247 248 248 249 SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rdtbt ) … … 267 268 REAL(wp) :: ztmp ! local scalars 268 269 REAL(wp), POINTER, DIMENSION(:,:) :: zwdlmtu, zwdlmtv !: W/D flux limiters 269 REAL(wp), POINTER, DIMENSION(:,:) :: zflxp, zflxn ! local 2D workspace 270 REAL(wp), POINTER, DIMENSION(:,:) :: zflxu1, zflxv1 ! local 2D workspace 271 272 !!---------------------------------------------------------------------- 273 ! 274 270 REAL(wp), POINTER, DIMENSION(:,:) :: zflxp, zflxn ! 2D workspace 271 REAL(wp), POINTER, DIMENSION(:,:) :: zflxu1, zflxv1 ! 2D workspace 272 !!---------------------------------------------------------------------- 273 ! 275 274 IF( nn_timing == 1 ) CALL timing_start('wad_lmt_bt') 276 275 … … 305 304 DO ji = 2, jpim1 306 305 307 IF(tmask(ji, jj,1) < 0.5_wp) CYCLE ! we don't care about land cells308 IF( bathy(ji,jj)> zdepwd) CYCLE ! and cells which will unlikely go dried out306 IF(tmask(ji,jj,1) < 0.5_wp) CYCLE ! we don't care about land cells 307 IF(ht_0 (ji,jj) > zdepwd) CYCLE ! and cells which will unlikely go dried out 309 308 310 309 zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj), 0._wp) + & … … 313 312 & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji, jj-1), 0._wp) 314 313 315 zdep2 = bathy(ji,jj) + sshn_e(ji,jj) - rn_wdmin1314 zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 316 315 IF(zdep2 < 0._wp) THEN !add more safty, but not necessary 317 316 !zdep2 = 0._wp 318 sshn_e(ji,jj) = rn_wdmin1 - bathy(ji,jj)317 sshn_e(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 319 318 END IF 320 319 ENDDO … … 333 332 334 333 wdmask(ji,jj) = 0 335 IF(tmask(ji, jj,1) < 0.5_wp) CYCLE336 IF( bathy(ji,jj)> zdepwd) CYCLE334 IF(tmask(ji,jj,1) < 0.5_wp) CYCLE 335 IF(ht_0 (ji,jj) > zdepwd) CYCLE 337 336 338 337 ztmp = e1e2t(ji,jj) … … 344 343 345 344 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 346 zdep2 = bathy(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 ! this one can be moved out of the loop345 zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 ! this one can be moved out of the loop 347 346 zdep2 = zdep2 - z2dt * zssh_frc(ji,jj) 348 347 … … 385 384 CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 ) 386 385 CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv) 387 !386 ! 388 387 END IF 389 388 ! 390 389 IF( nn_timing == 1 ) CALL timing_stop('wad_lmt') 390 ! 391 391 END SUBROUTINE wad_lmt_bt 392 393 !!============================================================================== 392 394 END MODULE wet_dry
Note: See TracChangeset
for help on using the changeset viewer.
