Changeset 6827 for branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
- Timestamp:
- 2016-08-01T15:37:15+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
r5836 r6827 21 21 USE phycst ! physical constants 22 22 USE in_out_manager ! I/O manager 23 USE sbc_oce ! ocean surface boundary conditions24 23 USE lib_fortran, ONLY: glob_sum, DDPDD 25 24 USE lbclnk ! lateral boundary condition - MPP exchanges … … 31 30 32 31 PUBLIC dom_clo ! routine called by domain module 33 PUBLIC sbc_clo ! routine called by step module34 PUBLIC clo_rnf ! routine called by sbcrnf module35 PUBLIC clo_ups ! routine called in traadv_cen2(_jki) module36 32 PUBLIC clo_bat ! routine called in domzgr module 37 33 … … 185 181 186 182 187 SUBROUTINE sbc_clo( kt )188 !!---------------------------------------------------------------------189 !! *** ROUTINE sbc_clo ***190 !!191 !! ** Purpose : Special handling of closed seas192 !!193 !! ** Method : Water flux is forced to zero over closed sea194 !! Excess is shared between remaining ocean, or195 !! put as run-off in open ocean.196 !!197 !! ** Action : emp updated surface freshwater fluxes and associated heat content at kt198 !!----------------------------------------------------------------------199 INTEGER, INTENT(in) :: kt ! ocean model time step200 !201 INTEGER :: ji, jj, jc, jn ! dummy loop indices202 REAL(wp), PARAMETER :: rsmall = 1.e-20_wp ! Closed sea correction epsilon203 REAL(wp) :: zze2, ztmp, zcorr !204 REAL(wp) :: zcoef, zcoef1 !205 COMPLEX(wp) :: ctmp206 REAL(wp), DIMENSION(jpncs) :: zfwf ! 1D workspace207 !!----------------------------------------------------------------------208 !209 IF( nn_timing == 1 ) CALL timing_start('sbc_clo')210 ! !------------------!211 IF( kt == nit000 ) THEN ! Initialisation !212 ! !------------------!213 IF(lwp) WRITE(numout,*)214 IF(lwp) WRITE(numout,*)'sbc_clo : closed seas '215 IF(lwp) WRITE(numout,*)'~~~~~~~'216 217 surf(:) = 0.e0_wp218 !219 surf(jpncs+1) = glob_sum( e1e2t(:,:) ) ! surface of the global ocean220 !221 ! ! surface of closed seas222 IF( lk_mpp_rep ) THEN ! MPP reproductible calculation223 DO jc = 1, jpncs224 ctmp = CMPLX( 0.e0, 0.e0, wp )225 DO jj = ncsj1(jc), ncsj2(jc)226 DO ji = ncsi1(jc), ncsi2(jc)227 ztmp = e1e2t(ji,jj) * tmask_i(ji,jj)228 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )229 END DO230 END DO231 IF( lk_mpp ) CALL mpp_sum( ctmp )232 surf(jc) = REAL(ctmp,wp)233 END DO234 ELSE ! Standard calculation235 DO jc = 1, jpncs236 DO jj = ncsj1(jc), ncsj2(jc)237 DO ji = ncsi1(jc), ncsi2(jc)238 surf(jc) = surf(jc) + e1e2t(ji,jj) * tmask_i(ji,jj) ! surface of closed seas239 END DO240 END DO241 END DO242 IF( lk_mpp ) CALL mpp_sum ( surf, jpncs ) ! mpp: sum over all the global domain243 ENDIF244 245 IF(lwp) WRITE(numout,*)' Closed sea surfaces'246 DO jc = 1, jpncs247 IF(lwp)WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc)248 END DO249 250 ! jpncs+1 : surface of sea, closed seas excluded251 DO jc = 1, jpncs252 surf(jpncs+1) = surf(jpncs+1) - surf(jc)253 END DO254 !255 ENDIF256 ! !--------------------!257 ! ! update emp !258 zfwf = 0.e0_wp !--------------------!259 IF( lk_mpp_rep ) THEN ! MPP reproductible calculation260 DO jc = 1, jpncs261 ctmp = CMPLX( 0.e0, 0.e0, wp )262 DO jj = ncsj1(jc), ncsj2(jc)263 DO ji = ncsi1(jc), ncsi2(jc)264 ztmp = e1e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj)265 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )266 END DO267 END DO268 IF( lk_mpp ) CALL mpp_sum( ctmp )269 zfwf(jc) = REAL(ctmp,wp)270 END DO271 ELSE ! Standard calculation272 DO jc = 1, jpncs273 DO jj = ncsj1(jc), ncsj2(jc)274 DO ji = ncsi1(jc), ncsi2(jc)275 zfwf(jc) = zfwf(jc) + e1e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj)276 END DO277 END DO278 END DO279 IF( lk_mpp ) CALL mpp_sum ( zfwf(:) , jpncs ) ! mpp: sum over all the global domain280 ENDIF281 282 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! Black Sea case for ORCA_R2 configuration283 zze2 = ( zfwf(3) + zfwf(4) ) * 0.5_wp284 zfwf(3) = zze2285 zfwf(4) = zze2286 ENDIF287 288 zcorr = 0._wp289 290 DO jc = 1, jpncs291 !292 ! The following if avoids the redistribution of the round off293 IF ( ABS(zfwf(jc) / surf(jpncs+1) ) > rsmall) THEN294 !295 IF( ncstt(jc) == 0 ) THEN ! water/evap excess is shared by all open ocean296 zcoef = zfwf(jc) / surf(jpncs+1)297 zcoef1 = rcp * zcoef298 emp(:,:) = emp(:,:) + zcoef299 qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)300 ! accumulate closed seas correction301 zcorr = zcorr + zcoef302 !303 ELSEIF( ncstt(jc) == 1 ) THEN ! Excess water in open sea, at outflow location, excess evap shared304 IF ( zfwf(jc) <= 0.e0_wp ) THEN305 DO jn = 1, ncsnr(jc)306 ji = mi0(ncsir(jc,jn))307 jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean308 IF ( ji > 1 .AND. ji < jpi &309 .AND. jj > 1 .AND. jj < jpj ) THEN310 zcoef = zfwf(jc) / ( REAL(ncsnr(jc)) * e1e2t(ji,jj) )311 zcoef1 = rcp * zcoef312 emp(ji,jj) = emp(ji,jj) + zcoef313 qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj)314 ENDIF315 END DO316 ELSE317 zcoef = zfwf(jc) / surf(jpncs+1)318 zcoef1 = rcp * zcoef319 emp(:,:) = emp(:,:) + zcoef320 qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)321 ! accumulate closed seas correction322 zcorr = zcorr + zcoef323 ENDIF324 ELSEIF( ncstt(jc) == 2 ) THEN ! Excess e-p-r (either sign) goes to open ocean, at outflow location325 DO jn = 1, ncsnr(jc)326 ji = mi0(ncsir(jc,jn))327 jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean328 IF( ji > 1 .AND. ji < jpi &329 .AND. jj > 1 .AND. jj < jpj ) THEN330 zcoef = zfwf(jc) / ( REAL(ncsnr(jc)) * e1e2t(ji,jj) )331 zcoef1 = rcp * zcoef332 emp(ji,jj) = emp(ji,jj) + zcoef333 qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj)334 ENDIF335 END DO336 ENDIF337 !338 DO jj = ncsj1(jc), ncsj2(jc)339 DO ji = ncsi1(jc), ncsi2(jc)340 zcoef = zfwf(jc) / surf(jc)341 zcoef1 = rcp * zcoef342 emp(ji,jj) = emp(ji,jj) - zcoef343 qns(ji,jj) = qns(ji,jj) + zcoef1 * sst_m(ji,jj)344 END DO345 END DO346 !347 END IF348 END DO349 350 IF ( ABS(zcorr) > rsmall ) THEN ! remove the global correction from the closed seas351 DO jc = 1, jpncs ! only if it is large enough352 DO jj = ncsj1(jc), ncsj2(jc)353 DO ji = ncsi1(jc), ncsi2(jc)354 emp(ji,jj) = emp(ji,jj) - zcorr355 qns(ji,jj) = qns(ji,jj) + rcp * zcorr * sst_m(ji,jj)356 END DO357 END DO358 END DO359 ENDIF360 !361 emp (:,:) = emp (:,:) * tmask(:,:,1)362 !363 CALL lbc_lnk( emp , 'T', 1._wp )364 !365 IF( nn_timing == 1 ) CALL timing_stop('sbc_clo')366 !367 END SUBROUTINE sbc_clo368 369 370 SUBROUTINE clo_rnf( p_rnfmsk )371 !!---------------------------------------------------------------------372 !! *** ROUTINE sbc_rnf ***373 !!374 !! ** Purpose : allow the treatment of closed sea outflow grid-points375 !! to be the same as river mouth grid-points376 !!377 !! ** Method : set to 1 the runoff mask (mskrnf, see sbcrnf module)378 !! at the closed sea outflow grid-point.379 !!380 !! ** Action : update (p_)mskrnf (set 1 at closed sea outflow)381 !!----------------------------------------------------------------------382 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: p_rnfmsk ! river runoff mask (rnfmsk array)383 !384 INTEGER :: jc, jn, ji, jj ! dummy loop indices385 !!----------------------------------------------------------------------386 !387 DO jc = 1, jpncs388 IF( ncstt(jc) >= 1 ) THEN ! runoff mask set to 1 at closed sea outflows389 DO jn = 1, 4390 DO jj = mj0( ncsjr(jc,jn) ), mj1( ncsjr(jc,jn) )391 DO ji = mi0( ncsir(jc,jn) ), mi1( ncsir(jc,jn) )392 p_rnfmsk(ji,jj) = MAX( p_rnfmsk(ji,jj), 1.0_wp )393 END DO394 END DO395 END DO396 ENDIF397 END DO398 !399 END SUBROUTINE clo_rnf400 401 402 SUBROUTINE clo_ups( p_upsmsk )403 !!---------------------------------------------------------------------404 !! *** ROUTINE sbc_rnf ***405 !!406 !! ** Purpose : allow the treatment of closed sea outflow grid-points407 !! to be the same as river mouth grid-points408 !!409 !! ** Method : set to 0.5 the upstream mask (upsmsk, see traadv_cen2410 !! module) over the closed seas.411 !!412 !! ** Action : update (p_)upsmsk (set 0.5 over closed seas)413 !!----------------------------------------------------------------------414 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: p_upsmsk ! upstream mask (upsmsk array)415 !416 INTEGER :: jc, ji, jj ! dummy loop indices417 !!----------------------------------------------------------------------418 !419 DO jc = 1, jpncs420 DO jj = ncsj1(jc), ncsj2(jc)421 DO ji = ncsi1(jc), ncsi2(jc)422 p_upsmsk(ji,jj) = 0.5_wp ! mixed upstream/centered scheme over closed seas423 END DO424 END DO425 END DO426 !427 END SUBROUTINE clo_ups428 429 430 183 SUBROUTINE clo_bat( pbat, kbat ) 431 184 !!---------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
