- Timestamp:
- 2017-01-04T17:47:47+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r7508 r7525 282 282 zst(ji,jj) = pst(ji,jj) + rt0 ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 283 283 284 ! ... components ( U10m - U_oce ) at T-point (unmasked) 285 zwnd_i(ji,jj) = 0.e0 286 zwnd_j(ji,jj) = 0.e0 287 END DO 288 END DO 289 284 290 ! ----------------------------------------------------------------------------- ! 285 291 ! 0 Wind components and module at T-point relative to the moving ocean ! 286 292 ! ----------------------------------------------------------------------------- ! 287 293 288 ! ... components ( U10m - U_oce ) at T-point (unmasked)289 zwnd_i(ji,jj) = 0.e0290 zwnd_j(ji,jj) = 0.e0291 END DO292 END DO293 294 #if defined key_cyclone 294 295 CALL wnd_cyc( kt, zwnd_i, zwnd_j ) ! add analytical tropical cyclone (Vincent et al. JGR 2012) … … 325 326 ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle ! Short Wave 326 327 zztmp = 1. - albo 327 IF( ln_dm2dc ) THEN 328 qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 329 ELSE 330 qsr(:,:) = zztmp * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) 328 IF( ln_dm2dc ) THEN ; qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 329 ELSE ; qsr(:,:) = zztmp * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) 331 330 ENDIF 332 331 333 !$OMP PARALLEL DO schedule(static) private(jj, ji) 332 !$OMP PARALLEL 333 !$OMP DO schedule(static) private(jj, ji) 334 334 DO jj = 1, jpj 335 335 DO ji = 1, jpi 336 336 zqlw(ji,jj) = ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * zst(ji,jj)*zst(ji,jj)*zst(ji,jj)*zst(ji,jj) ) * tmask(ji,jj,1) ! Long Wave 337 END DO 338 END DO 339 !OMP END DO NOWAIT 337 340 ! ----------------------------------------------------------------------------- ! 338 341 ! II Turbulent FLUXES ! 339 342 ! ----------------------------------------------------------------------------- ! 340 343 344 !$OMP DO schedule(static) private(jj, ji) 345 DO jj = 1, jpj 346 DO ji = 1, jpi 341 347 ! ... specific humidity at SST and IST 342 348 zqsatw(ji,jj) = zcoef_qsatw * EXP( -5107.4 / zst(ji,jj) ) 343 344 END DO 345 END DO 349 END DO 350 END DO 351 !$OMP END PARALLEL 352 346 353 ! ... NCAR Bulk formulae, computation of Cd, Ch, Ce at T-point : 347 354 CALL turb_core_2z( rn_zqt, rn_zu, zst, sf(jp_tair)%fnow, zqsatw, sf(jp_humi)%fnow, wndm, & … … 388 395 ! Turbulent fluxes over ocean 389 396 ! ----------------------------- 397 IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN 398 !$OMP PARALLEL DO schedule(static) private(jj, ji) 399 DO jj = 1, jpj 400 DO ji = 1, jpi 401 !! q_air and t_air are (or "are almost") given at 10m (wind reference height) 402 zevap(ji,jj) = rn_efac*MAX( 0._wp, rhoa*Ce(ji,jj)*( zqsatw(ji,jj) - sf(jp_humi)%fnow(ji,jj,1) )*wndm(ji,jj) ) ! Evaporation 403 zqsb (ji,jj) = cpa*rhoa*Ch(ji,jj)*( zst (ji,jj) - sf(jp_tair)%fnow(ji,jj,1) )*wndm(ji,jj) ! Sensible Heat 404 END DO 405 END DO 406 ELSE 407 !$OMP PARALLEL DO schedule(static) private(jj, ji) 408 DO jj = 1, jpj 409 DO ji = 1, jpi 410 !! q_air and t_air are not given at 10m (wind reference height) 411 ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!! 412 zevap(ji,jj) = rn_efac*MAX( 0._wp, rhoa*Ce(ji,jj)*( zqsatw(ji,jj) - zq_zu(ji,jj) )*wndm(ji,jj) ) ! Evaporation 413 zqsb (ji,jj) = cpa*rhoa*Ch(ji,jj)*( zst (ji,jj) - zt_zu(ji,jj) )*wndm(ji,jj) ! Sensible Heat 414 END DO 415 END DO 416 ENDIF 390 417 !$OMP PARALLEL DO schedule(static) private(jj, ji) 391 418 DO jj = 1, jpj 392 419 DO ji = 1, jpi 393 IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN394 !! q_air and t_air are (or "are almost") given at 10m (wind reference height)395 zevap(ji,jj) = rn_efac*MAX( 0._wp, rhoa*Ce(ji,jj)*( zqsatw(ji,jj) - sf(jp_humi)%fnow(ji,jj,1) )*wndm(ji,jj) ) ! Evaporation396 zqsb (ji,jj) = cpa*rhoa*Ch(ji,jj)*( zst (ji,jj) - sf(jp_tair)%fnow(ji,jj,1) )*wndm(ji,jj) ! Sensible Heat397 ELSE398 !! q_air and t_air are not given at 10m (wind reference height)399 ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!!400 zevap(ji,jj) = rn_efac*MAX( 0._wp, rhoa*Ce(ji,jj)*( zqsatw(ji,jj) - zq_zu(ji,jj) )*wndm(ji,jj) ) ! Evaporation401 zqsb (ji,jj) = cpa*rhoa*Ch(ji,jj)*( zst (ji,jj) - zt_zu(ji,jj) )*wndm(ji,jj) ! Sensible Heat402 ENDIF403 420 zqla (ji,jj) = Lv * zevap(ji,jj) ! Latent Heat 404 421 END DO … … 422 439 DO jj = 1, jpj 423 440 DO ji = 1, jpi 424 emp (ji,jj) = ( zevap(ji,jj) & ! mass flux (evap. - precip.)425 & - sf(jp_prec)%fnow(ji,jj,1) * rn_pfac ) * tmask(ji,jj,1)426 !427 qns(ji,jj) = zqlw(ji,jj) - zqsb(ji,jj) - zqla(ji,jj) & ! Downward Non Solar428 & - sf(jp_snow)%fnow(ji,jj,1) * rn_pfac * lfus & ! remove latent melting heat for solid precip429 & - zevap(ji,jj) * pst(ji,jj) * rcp & ! remove evap heat content at SST430 & + ( sf(jp_prec)%fnow(ji,jj,1) - sf(jp_snow)%fnow(ji,jj,1) ) * rn_pfac & ! add liquid precip heat content at Tair431 & * ( sf(jp_tair)%fnow(ji,jj,1) - rt0 ) * rcp &432 & + sf(jp_snow)%fnow(ji,jj,1) * rn_pfac & ! add solid precip heat content at min(Tair,Tsnow)433 & * ( MIN( sf(jp_tair)%fnow(ji,jj,1), rt0_snow ) - rt0 ) * cpic * tmask(ji,jj,1)441 emp (ji,jj) = ( zevap(ji,jj) & ! mass flux (evap. - precip.) 442 & - sf(jp_prec)%fnow(ji,jj,1) * rn_pfac ) * tmask(ji,jj,1) 443 ! 444 qns(ji,jj) = zqlw(ji,jj) - zqsb(ji,jj) - zqla(ji,jj) & ! Downward Non Solar 445 & - sf(jp_snow)%fnow(ji,jj,1) * rn_pfac * lfus & ! remove latent melting heat for solid precip 446 & - zevap(ji,jj) * pst(ji,jj) * rcp & ! remove evap heat content at SST 447 & + ( sf(jp_prec)%fnow(ji,jj,1) - sf(jp_snow)%fnow(ji,jj,1) ) * rn_pfac & ! add liquid precip heat content at Tair 448 & * ( sf(jp_tair)%fnow(ji,jj,1) - rt0 ) * rcp & 449 & + sf(jp_snow)%fnow(ji,jj,1) * rn_pfac & ! add solid precip heat content at min(Tair,Tsnow) 450 & * ( MIN( sf(jp_tair)%fnow(ji,jj,1), rt0_snow ) - rt0 ) * cpic * tmask(ji,jj,1) 434 451 END DO 435 452 END DO … … 454 471 CALL iom_put( "qt_oce" , qns+qsr ) ! output total downward heat over the ocean 455 472 !$OMP PARALLEL DO schedule(static) private(jj, ji) 456 DO jj = 1, jpj457 DO ji = 1, jpi458 tprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) * rn_pfac ! output total precipitation [kg/m2/s]459 sprecip(ji,jj) = sf(jp_snow)%fnow(ji,jj,1) * rn_pfac ! output solid precipitation [kg/m2/s]460 END DO461 END DO473 DO jj = 1, jpj 474 DO ji = 1, jpi 475 tprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) * rn_pfac ! output total precipitation [kg/m2/s] 476 sprecip(ji,jj) = sf(jp_snow)%fnow(ji,jj,1) * rn_pfac ! output solid precipitation [kg/m2/s] 477 END DO 478 END DO 462 479 CALL iom_put( 'snowpre', sprecip * 86400. ) ! Snow 463 480 CALL iom_put( 'precip' , tprecip * 86400. ) ! Total precipitation … … 598 615 REAL(wp) :: zst2, zst3 599 616 REAL(wp) :: zcoef_dqlw, zcoef_dqla, zcoef_dqsb 600 REAL(wp) :: zztmp, z1_lsub 617 REAL(wp) :: zztmp, z1_lsub, ztmp1, ztmp2 ! temporary variable 601 618 !! 602 619 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw ! long wave heat flux over ice … … 706 723 !$OMP END PARALLEL 707 724 CALL lim_thd_snwblow( pfrld, zsnw ) ! snow distribution over ice after wind blowing 708 709 725 emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 710 726 emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw … … 712 728 713 729 ! --- heat flux associated with emp --- ! 714 qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp & ! evap at sst715 & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip at Tair716 & + sprecip(:,:) * ( 1._wp - zsnw ) *& ! solid precip at min(Tair,Tsnow)717 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )718 qemp_ice(:,:) = sprecip(:,:) * zsnw * & ! solid precip (only)719 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )730 qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp & ! evap at sst 731 & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip at Tair 732 & + sprecip(:,:) * ( 1._wp - zsnw ) * & ! solid precip at min(Tair,Tsnow) 733 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 734 qemp_ice(:,:) = sprecip(:,:) * zsnw * & ! solid precip (only) 735 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 720 736 721 737 ! --- total solar and non solar fluxes --- ! … … 723 739 qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 724 740 725 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) 726 ! --- ! 741 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 727 742 qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 728 743 … … 741 756 ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 742 757 ! 758 ztmp1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 759 ztmp2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 743 760 !$OMP PARALLEL DO schedule(static) private(jj, ji) 744 761 DO jj = 1, jpj 745 762 DO ji = 1, jpi 746 fr1_i0(ji,jj) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )747 fr2_i0(ji,jj) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )763 fr1_i0(ji,jj) = ztmp1 764 fr2_i0(ji,jj) = ztmp2 748 765 END DO 749 766 END DO
Note: See TracChangeset
for help on using the changeset viewer.
