Changeset 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r4624 r6225 34 34 USE albedo 35 35 USE prtctl ! Print control 36 #if defined key_lim3 36 #if defined key_lim3 37 37 USE ice 38 38 USE sbc_ice ! Surface boundary condition: ice fields 39 USE limthd_dh ! for CALL lim_thd_snwblow 39 40 #elif defined key_lim2 40 41 USE ice_2 42 USE sbc_ice ! Surface boundary condition: ice fields 43 USE par_ice_2 ! Surface boundary condition: ice fields 41 44 #endif 42 45 … … 45 48 46 49 PUBLIC sbc_blk_clio ! routine called by sbcmod.F90 47 PUBLIC blk_ice_clio ! routine called by sbcice_lim.F90 50 #if defined key_lim2 || defined key_lim3 51 PUBLIC blk_ice_clio_tau ! routine called by sbcice_lim.F90 52 PUBLIC blk_ice_clio_flx ! routine called by sbcice_lim.F90 53 #endif 48 54 49 55 INTEGER , PARAMETER :: jpfld = 7 ! maximum number of files to read … … 62 68 LOGICAL :: lbulk_init = .TRUE. ! flag, bulk initialization done or not) 63 69 64 #if ! defined key_lim365 ! in namicerun with LIM366 70 REAL(wp) :: cai = 1.40e-3 ! best estimate of atm drag in order to get correct FS export in ORCA2-LIM 67 71 REAL(wp) :: cao = 1.00e-3 ! chosen by default ==> should depends on many things... !!gmto be updated 68 #endif69 72 70 73 REAL(wp) :: rdtbs2 !: … … 114 117 !! - utau, vtau i- and j-component of the wind stress 115 118 !! - taum wind stress module at T-point 116 !! - wndm 10m wind module at T-point 119 !! - wndm 10m wind module at T-point over free ocean or leads in presence of sea-ice 117 120 !! - qns non-solar heat flux including latent heat of solid 118 121 !! precip. melting and emp heat content … … 204 207 !! - utau, vtau i- and j-component of the wind stress 205 208 !! - taum wind stress module at T-point 206 !! - wndm 10m wind module at T-point 209 !! - wndm 10m wind module at T-point over free ocean or leads in presence of sea-ice 207 210 !! - qns non-solar heat flux including latent heat of solid 208 211 !! precip. melting and emp heat content … … 240 243 ! momentum fluxes (utau, vtau ) ! 241 244 !------------------------------------! 242 !CDIR COLLAPSE243 245 utau(:,:) = sf(jp_utau)%fnow(:,:,1) 244 !CDIR COLLAPSE245 246 vtau(:,:) = sf(jp_vtau)%fnow(:,:,1) 246 247 … … 248 249 ! wind stress module (taum ) ! 249 250 !------------------------------------! 250 !CDIR NOVERRCHK251 251 DO jj = 2, jpjm1 252 !CDIR NOVERRCHK253 252 DO ji = fs_2, fs_jpim1 ! vector opt. 254 253 ztx2 = utau(ji-1,jj ) + utau(ji,jj) … … 257 256 END DO 258 257 END DO 258 utau(:,:) = utau(:,:) * umask(:,:,1) 259 vtau(:,:) = vtau(:,:) * vmask(:,:,1) 260 taum(:,:) = taum(:,:) * tmask(:,:,1) 259 261 CALL lbc_lnk( taum, 'T', 1. ) 260 262 … … 262 264 ! store the wind speed (wndm ) ! 263 265 !------------------------------------! 264 !CDIR COLLAPSE265 266 wndm(:,:) = sf(jp_wndm)%fnow(:,:,1) 267 wndm(:,:) = wndm(:,:) * tmask(:,:,1) 266 268 267 269 !------------------------------------------------! … … 270 272 271 273 CALL blk_clio_qsr_oce( qsr ) 272 274 qsr(:,:) = qsr(:,:) * tmask(:,:,1) ! no shortwave radiation into the ocean beneath ice shelf 273 275 !------------------------! 274 276 ! Other ocean fluxes ! 275 277 !------------------------! 276 !CDIR NOVERRCHK277 !CDIR COLLAPSE278 278 DO jj = 1, jpj 279 !CDIR NOVERRCHK280 279 DO ji = 1, jpi 281 280 ! … … 368 367 zcprec = rcp / rday ! convert prec ( mm/day ==> m/s) ==> W/m2 369 368 370 !CDIR COLLAPSE371 369 emp(:,:) = zqla(:,:) / cevap & ! freshwater flux 372 370 & - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1) 373 371 ! 374 !CDIR COLLAPSE375 372 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar flux 376 373 & - zqla(:,:) * pst(:,:) * zcevap & ! remove evap. heat content at SST in Celcius 377 374 & + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec ! add precip. heat content at Tair in Celcius 375 qns(:,:) = qns(:,:) * tmask(:,:,1) 376 #if defined key_lim3 377 qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) 378 qsr_oce(:,:) = qsr(:,:) 379 #endif 378 380 ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio) 379 381 380 CALL iom_put( "qlw_oce", zqlw ) ! output downward longwave heat over the ocean 381 CALL iom_put( "qsb_oce", - zqsb ) ! output downward sensible heat over the ocean 382 CALL iom_put( "qla_oce", - zqla ) ! output downward latent heat over the ocean 383 CALL iom_put( "qns_oce", qns ) ! output downward non solar heat over the ocean 382 IF ( nn_ice == 0 ) THEN 383 CALL iom_put( "qlw_oce" , zqlw ) ! output downward longwave heat over the ocean 384 CALL iom_put( "qsb_oce" , - zqsb ) ! output downward sensible heat over the ocean 385 CALL iom_put( "qla_oce" , - zqla ) ! output downward latent heat over the ocean 386 CALL iom_put( "qemp_oce", qns-zqlw+zqsb+zqla ) ! output downward heat content of E-P over the ocean 387 CALL iom_put( "qns_oce" , qns ) ! output downward non solar heat over the ocean 388 CALL iom_put( "qsr_oce" , qsr ) ! output downward solar heat over the ocean 389 CALL iom_put( "qt_oce" , qns+qsr ) ! output total downward heat over the ocean 390 ENDIF 384 391 385 392 IF(ln_ctl) THEN … … 397 404 END SUBROUTINE blk_oce_clio 398 405 399 400 SUBROUTINE blk_ice_clio( pst , palb_cs, palb_os , & 401 & p_taui, p_tauj, p_qns , p_qsr, & 402 & p_qla , p_dqns, p_dqla, & 403 & p_tpr , p_spr , & 404 & p_fr1 , p_fr2 , cd_grid, pdim ) 406 # if defined key_lim2 || defined key_lim3 407 408 SUBROUTINE blk_ice_clio_tau 405 409 !!--------------------------------------------------------------------------- 406 !! *** ROUTINE blk_ice_clio *** 410 !! *** ROUTINE blk_ice_clio_tau *** 411 !! 412 !! ** Purpose : Computation momentum flux at the ice-atm interface 413 !! 414 !! ** Method : Read utau from a forcing file. Rearrange if C-grid 415 !! 416 !!---------------------------------------------------------------------- 417 REAL(wp) :: zcoef 418 INTEGER :: ji, jj ! dummy loop indices 419 !!--------------------------------------------------------------------- 420 ! 421 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio_tau') 422 ! 423 SELECT CASE( cp_ice_msh ) 424 ! 425 CASE( 'C' ) ! C-grid ice dynamics 426 ! 427 zcoef = cai / cao ! Change from air-sea stress to air-ice stress 428 utau_ice(:,:) = zcoef * utau(:,:) 429 vtau_ice(:,:) = zcoef * vtau(:,:) 430 ! 431 CASE( 'I' ) ! I-grid ice dynamics: I-point (i.e. F-point lower-left corner) 432 ! 433 zcoef = 0.5_wp * cai / cao ! Change from air-sea stress to air-ice stress 434 DO jj = 2, jpj ! stress from ocean U- and V-points to ice U,V point 435 DO ji = 2, jpi ! I-grid : no vector opt. 436 utau_ice(ji,jj) = zcoef * ( utau(ji-1,jj ) + utau(ji-1,jj-1) ) 437 vtau_ice(ji,jj) = zcoef * ( vtau(ji ,jj-1) + vtau(ji-1,jj-1) ) 438 END DO 439 END DO 440 ! 441 CALL lbc_lnk( utau_ice(:,:), 'I', -1. ) ; CALL lbc_lnk( vtau_ice(:,:), 'I', -1. ) ! I-point 442 ! 443 END SELECT 444 ! 445 IF(ln_ctl) THEN 446 CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_clio: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ') 447 ENDIF 448 ! 449 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio_tau') 450 ! 451 END SUBROUTINE blk_ice_clio_tau 452 453 #endif 454 455 # if defined key_lim2 || defined key_lim3 456 457 SUBROUTINE blk_ice_clio_flx( ptsu , palb_cs, palb_os, palb ) 458 !!--------------------------------------------------------------------------- 459 !! *** ROUTINE blk_ice_clio_flx *** 407 460 !! 408 461 !! ** Purpose : Computation of the heat fluxes at ocean and snow/ice … … 426 479 !! to take into account solid precip latent heat flux 427 480 !!---------------------------------------------------------------------- 428 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pst ! ice surface temperature [Kelvin] 429 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [%] 430 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_os ! ice albedo (overcast sky) (alb_ice_os) [%] 431 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_taui ! surface ice stress at I-point (i-component) [N/m2] 432 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tauj ! surface ice stress at I-point (j-component) [N/m2] 433 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qns ! non solar heat flux over ice (T-point) [W/m2] 434 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qsr ! solar heat flux over ice (T-point) [W/m2] 435 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qla ! latent heat flux over ice (T-point) [W/m2] 436 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqns ! non solar heat sensistivity (T-point) [W/m2] 437 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqla ! latent heat sensistivity (T-point) [W/m2] 438 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tpr ! total precipitation (T-point) [Kg/m2/s] 439 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_spr ! solid precipitation (T-point) [Kg/m2/s] 440 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr1 ! 1sr fraction of qsr penetration in ice [%] 441 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr2 ! 2nd fraction of qsr penetration in ice [%] 442 CHARACTER(len=1), INTENT(in ) :: cd_grid ! type of sea-ice grid ("C" or "B" grid) 443 INTEGER, INTENT(in ) :: pdim ! number of ice categories 481 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ptsu ! ice surface temperature [Kelvin] 482 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [-] 483 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_os ! ice albedo (overcast sky) (alb_ice_os) [-] 484 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb ! ice albedo (actual value) [-] 444 485 !! 445 486 INTEGER :: ji, jj, jl ! dummy loop indices 446 INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays) 447 !! 448 REAL(wp) :: zcoef, zmt1, zmt2, zmt3, ztatm3 ! temporary scalars 487 !! 488 REAL(wp) :: zmt1, zmt2, zmt3, ztatm3 ! temporary scalars 449 489 REAL(wp) :: ztaevbk, zind1, zind2, zind3, ztamr ! - - 450 490 REAL(wp) :: zesi, zqsati, zdesidt ! - - … … 452 492 REAL(wp) :: zcshi, zclei, zrhovaclei, zrhovacshi ! - - 453 493 REAL(wp) :: ztice3, zticemb, zticemb2, zdqlw, zdqsb ! - - 494 REAL(wp) :: z1_lsub ! - - 454 495 !! 455 496 REAL(wp), DIMENSION(:,:) , POINTER :: ztatm ! Tair in Kelvin … … 458 499 REAL(wp), DIMENSION(:,:) , POINTER :: zrhoa ! air density 459 500 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw, z_qsb 501 REAL(wp), DIMENSION(:,:) , POINTER :: zevap, zsnw 460 502 !!--------------------------------------------------------------------- 461 503 ! 462 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio ')504 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio_flx') 463 505 ! 464 506 CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 465 CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb ) 466 467 ijpl = pdim ! number of ice categories 507 CALL wrk_alloc( jpi,jpj, jpl, z_qlw, z_qsb ) 508 468 509 zpatm = 101000. ! atmospheric pressure (assumed constant here) 469 470 #if defined key_lim3 471 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init 472 #endif 473 ! ! surface ocean fluxes computed with CLIO bulk formulea 474 !------------------------------------! 475 ! momentum fluxes (utau, vtau ) ! 476 !------------------------------------! 477 478 SELECT CASE( cd_grid ) 479 CASE( 'C' ) ! C-grid ice dynamics 480 zcoef = cai / cao ! Change from air-sea stress to air-ice stress 481 p_taui(:,:) = zcoef * utau(:,:) 482 p_tauj(:,:) = zcoef * vtau(:,:) 483 CASE( 'I' ) ! I-grid ice dynamics: I-point (i.e. F-point lower-left corner) 484 zcoef = 0.5_wp * cai / cao ! Change from air-sea stress to air-ice stress 485 DO jj = 2, jpj ! stress from ocean U- and V-points to ice U,V point 486 DO ji = 2, jpi ! I-grid : no vector opt. 487 p_taui(ji,jj) = zcoef * ( utau(ji-1,jj ) + utau(ji-1,jj-1) ) 488 p_tauj(ji,jj) = zcoef * ( vtau(ji ,jj-1) + vtau(ji-1,jj-1) ) 489 END DO 490 END DO 491 CALL lbc_lnk( p_taui(:,:), 'I', -1. ) ; CALL lbc_lnk( p_tauj(:,:), 'I', -1. ) ! I-point 492 END SELECT 493 494 510 !-------------------------------------------------------------------------------- 495 511 ! Determine cloud optical depths as a function of latitude (Chou et al., 1981). 496 512 ! and the correction factor for taking into account the effect of clouds 497 !------------------------------------------------------ 498 !CDIR NOVERRCHK 499 !CDIR COLLAPSE 513 !-------------------------------------------------------------------------------- 514 500 515 DO jj = 1, jpj 501 !CDIR NOVERRCHK502 516 DO ji = 1, jpi 503 517 ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj,1) ! air temperature in Kelvins … … 522 536 zmt2 = ( 272.0 - ztatm(ji,jj) ) / 38.0 ; zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) ) 523 537 zmt3 = ( 281.0 - ztatm(ji,jj) ) / 18.0 ; zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) ) 524 p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday & ! rday = converte mm/day to kg/m2/s538 sprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday & ! rday = converte mm/day to kg/m2/s 525 539 & * ( zind1 & ! solid (snow) precipitation [kg/m2/s] 526 540 & + ( 1.0 - zind1 ) * ( zind2 * ( 0.5 + zmt2 ) & … … 532 546 ! fraction of qsr_ice which is NOT absorbed in the thin surface layer 533 547 ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 534 p_fr1(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1)535 p_fr2(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1)536 END DO 537 END DO 538 CALL iom_put( 'snowpre', p_spr) ! Snow precipitation548 fr1_i0(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1) 549 fr2_i0(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1) 550 END DO 551 END DO 552 CALL iom_put( 'snowpre', sprecip ) ! Snow precipitation 539 553 540 554 !-----------------------------------------------------------! 541 555 ! snow/ice Shortwave radiation (abedo already computed) ! 542 556 !-----------------------------------------------------------! 543 CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr ) 557 CALL blk_clio_qsr_ice( palb_cs, palb_os, qsr_ice ) 558 559 DO jl = 1, jpl 560 palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(:,:,1) ) & 561 & + palb_os(:,:,jl) * sf(jp_ccov)%fnow(:,:,1) ) 562 END DO 544 563 545 564 ! ! ========================== ! 546 DO jl = 1, ijpl! Loop over ice categories !565 DO jl = 1, jpl ! Loop over ice categories ! 547 566 ! ! ========================== ! 548 !CDIR NOVERRCHK549 !CDIR COLLAPSE550 567 DO jj = 1 , jpj 551 !CDIR NOVERRCHK552 568 DO ji = 1, jpi 553 569 !-------------------------------------------! … … 558 574 ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) ) 559 575 ! 560 z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( p st(ji,jj,jl) - ztatm(ji,jj) ) )576 z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) ) 561 577 562 578 !---------------------------------------- … … 565 581 566 582 ! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential) 567 zesi = 611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( p st(ji,jj,jl) - rtt )/ ( pst(ji,jj,jl) - 7.66 ) )583 zesi = 611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( ptsu(ji,jj,jl) - rtt )/ ( ptsu(ji,jj,jl) - 7.66 ) ) 568 584 ! humidity close to the ice surface (at saturation) 569 585 zqsati = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi ) 570 586 571 587 ! computation of intermediate values 572 zticemb = p st(ji,jj,jl) - 7.66588 zticemb = ptsu(ji,jj,jl) - 7.66 573 589 zticemb2 = zticemb * zticemb 574 ztice3 = p st(ji,jj,jl) * pst(ji,jj,jl) * pst(ji,jj,jl)590 ztice3 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) * ptsu(ji,jj,jl) 575 591 zdesidt = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 ) / zticemb2 ) 576 592 … … 585 601 586 602 ! sensible heat flux 587 z_qsb(ji,jj,jl) = zrhovacshi * ( p st(ji,jj,jl) - ztatm(ji,jj) )603 z_qsb(ji,jj,jl) = zrhovacshi * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) 588 604 589 605 ! latent heat flux 590 p_qla(ji,jj,jl) = MAX( 0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) ) )606 qla_ice(ji,jj,jl) = MAX( 0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) ) ) 591 607 592 608 ! sensitivity of non solar fluxes (dQ/dT) (long-wave, sensible and latent fluxes) … … 595 611 zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) ) 596 612 ! 597 p_dqla(ji,jj,jl) = zdqla ! latent flux sensitivity598 p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla ) ! total non solar sensitivity613 dqla_ice(ji,jj,jl) = zdqla ! latent flux sensitivity 614 dqns_ice(ji,jj,jl) = -( zdqlw + zdqsb + zdqla ) ! total non solar sensitivity 599 615 END DO 600 616 ! … … 607 623 ! ----------------------------------------------------------------------------- ! 608 624 ! 609 !CDIR COLLAPSE 610 p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:) ! Downward Non Solar flux 611 !CDIR COLLAPSE 612 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s] 625 qns_ice(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - qla_ice (:,:,:) ! Downward Non Solar flux 626 tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s] 613 627 ! 614 628 ! ----------------------------------------------------------------------------- ! 615 629 ! Correct the OCEAN non solar flux with the existence of solid precipitation ! 616 630 ! ---------------=====--------------------------------------------------------- ! 617 !CDIR COLLAPSE618 631 qns(:,:) = qns(:,:) & ! update the non-solar heat flux with: 619 & - p_spr(:,:) * lfus & ! remove melting solid precip 620 & + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic & ! add solid P at least below melting 621 & - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1) * rcp ! remove solid precip. at Tair 622 ! 632 & - sprecip(:,:) * lfus & ! remove melting solid precip 633 & + sprecip(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic & ! add solid P at least below melting 634 & - sprecip(:,:) * sf(jp_tair)%fnow(:,:,1) * rcp ! remove solid precip. at Tair 635 636 #if defined key_lim3 637 ! ----------------------------------------------------------------------------- ! 638 ! Distribute evapo, precip & associated heat over ice and ocean 639 ! ---------------=====--------------------------------------------------------- ! 640 CALL wrk_alloc( jpi,jpj, zevap, zsnw ) 641 642 ! --- evaporation --- ! 643 z1_lsub = 1._wp / Lsub 644 evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation 645 devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub 646 zevap (:,:) = emp(:,:) + tprecip(:,:) ! evaporation over ocean 647 648 ! --- evaporation minus precipitation --- ! 649 zsnw(:,:) = 0._wp 650 CALL lim_thd_snwblow( pfrld, zsnw ) ! snow redistribution by wind 651 emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * ( 1._wp - zsnw ) 652 emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 653 emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 654 655 ! --- heat flux associated with emp --- ! 656 qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp & ! evap 657 & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip 658 & + sprecip(:,:) * ( 1._wp - zsnw ) * & ! solid precip 659 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 660 qemp_ice(:,:) = sprecip(:,:) * zsnw * & ! solid precip (only) 661 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 662 663 ! --- total solar and non solar fluxes --- ! 664 qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 665 qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 666 667 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 668 qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 669 670 CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 671 #endif 672 623 673 !!gm : not necessary as all input data are lbc_lnk... 624 CALL lbc_lnk( p_fr1(:,:) , 'T', 1. )625 CALL lbc_lnk( p_fr2(:,:) , 'T', 1. )626 DO jl = 1, ijpl627 CALL lbc_lnk( p_qns(:,:,jl) , 'T', 1. )628 CALL lbc_lnk( p_dqns(:,:,jl) , 'T', 1. )629 CALL lbc_lnk( p_qla(:,:,jl) , 'T', 1. )630 CALL lbc_lnk( p_dqla(:,:,jl) , 'T', 1. )674 CALL lbc_lnk( fr1_i0 (:,:) , 'T', 1. ) 675 CALL lbc_lnk( fr2_i0 (:,:) , 'T', 1. ) 676 DO jl = 1, jpl 677 CALL lbc_lnk( qns_ice (:,:,jl) , 'T', 1. ) 678 CALL lbc_lnk( dqns_ice(:,:,jl) , 'T', 1. ) 679 CALL lbc_lnk( qla_ice (:,:,jl) , 'T', 1. ) 680 CALL lbc_lnk( dqla_ice(:,:,jl) , 'T', 1. ) 631 681 END DO 632 682 633 683 !!gm : mask is not required on forcing 634 DO jl = 1, ijpl 635 p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1) 636 p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1) 637 p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask(:,:,1) 638 p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask(:,:,1) 639 END DO 684 DO jl = 1, jpl 685 qns_ice (:,:,jl) = qns_ice (:,:,jl) * tmask(:,:,1) 686 qla_ice (:,:,jl) = qla_ice (:,:,jl) * tmask(:,:,1) 687 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * tmask(:,:,1) 688 dqla_ice(:,:,jl) = dqla_ice(:,:,jl) * tmask(:,:,1) 689 END DO 690 691 CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 692 CALL wrk_dealloc( jpi,jpj, jpl , z_qlw, z_qsb ) 640 693 641 694 IF(ln_ctl) THEN 642 CALL prt_ctl(tab3d_1=z_qsb , clinfo1=' blk_ice_clio: z_qsb : ', tab3d_2=z_qlw , clinfo2=' z_qlw : ', kdim=ijpl) 643 CALL prt_ctl(tab3d_1=p_qla , clinfo1=' blk_ice_clio: z_qla : ', tab3d_2=p_qsr , clinfo2=' p_qsr : ', kdim=ijpl) 644 CALL prt_ctl(tab3d_1=p_dqns , clinfo1=' blk_ice_clio: p_dqns : ', tab3d_2=p_qns , clinfo2=' p_qns : ', kdim=ijpl) 645 CALL prt_ctl(tab3d_1=p_dqla , clinfo1=' blk_ice_clio: p_dqla : ', tab3d_2=pst , clinfo2=' pst : ', kdim=ijpl) 646 CALL prt_ctl(tab2d_1=p_tpr , clinfo1=' blk_ice_clio: p_tpr : ', tab2d_2=p_spr , clinfo2=' p_spr : ') 647 CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_clio: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ') 695 CALL prt_ctl(tab3d_1=z_qsb , clinfo1=' blk_ice_clio: z_qsb : ', tab3d_2=z_qlw , clinfo2=' z_qlw : ', kdim=jpl) 696 CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice_clio: z_qla : ', tab3d_2=qsr_ice , clinfo2=' qsr_ice : ', kdim=jpl) 697 CALL prt_ctl(tab3d_1=dqns_ice , clinfo1=' blk_ice_clio: dqns_ice : ', tab3d_2=qns_ice , clinfo2=' qns_ice : ', kdim=jpl) 698 CALL prt_ctl(tab3d_1=dqla_ice , clinfo1=' blk_ice_clio: dqla_ice : ', tab3d_2=ptsu , clinfo2=' ptsu : ', kdim=jpl) 699 CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice_clio: tprecip : ', tab2d_2=sprecip , clinfo2=' sprecip : ') 648 700 ENDIF 649 701 650 CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 651 CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb ) 652 ! 653 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio') 654 ! 655 END SUBROUTINE blk_ice_clio 656 702 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio_flx') 703 ! 704 END SUBROUTINE blk_ice_clio_flx 705 706 #endif 657 707 658 708 SUBROUTINE blk_clio_qsr_oce( pqsr_oce ) … … 716 766 ! Saturated water vapour and vapour pressure 717 767 ! ------------------------------------------ 718 !CDIR NOVERRCHK719 !CDIR COLLAPSE720 768 DO jj = 1, jpj 721 !CDIR NOVERRCHK722 769 DO ji = 1, jpi 723 770 ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt … … 748 795 zdaycor = 1.0 + 0.0013 * SIN( zdist ) + 0.0342 * COS( zdist ) 749 796 750 !CDIR NOVERRCHK751 797 DO jj = 1, jpj 752 !CDIR NOVERRCHK753 798 DO ji = 1, jpi 754 799 ! product of sine (cosine) of latitude and sine (cosine) of solar declination … … 771 816 772 817 ! compute and sum ocean qsr over the daylight (i.e. between sunrise and sunset) 773 !CDIR NOVERRCHK774 818 DO jt = 1, jp24 775 819 zcoef = FLOAT( jt ) - 0.5 776 !CDIR NOVERRCHK777 !CDIR COLLAPSE778 820 DO jj = 1, jpj 779 !CDIR NOVERRCHK780 821 DO ji = 1, jpi 781 822 zlha = COS( zlsrise(ji,jj) - zcoef * zdlha(ji,jj) ) ! local hour angle … … 796 837 ! Taking into account the ellipsity of the earth orbit, the clouds AND masked if sea-ice cover > 0% 797 838 zcoef1 = srgamma * zdaycor / ( 2. * rpi ) 798 !CDIR COLLAPSE799 839 DO jj = 1, jpj 800 840 DO ji = 1, jpi … … 854 894 ! Saturated water vapour and vapour pressure 855 895 ! ------------------------------------------ 856 !CDIR NOVERRCHK857 !CDIR COLLAPSE858 896 DO jj = 1, jpj 859 !CDIR NOVERRCHK860 897 DO ji = 1, jpi 861 898 ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt … … 886 923 zdaycor = 1.0 + 0.0013 * SIN( zdist ) + 0.0342 * COS( zdist ) 887 924 888 !CDIR NOVERRCHK889 925 DO jj = 1, jpj 890 !CDIR NOVERRCHK891 926 DO ji = 1, jpi 892 927 ! product of sine (cosine) of latitude and sine (cosine) of solar declination … … 913 948 DO jl = 1, ijpl ! loop over ice categories ! 914 949 ! !----------------------------! 915 !CDIR NOVERRCHK916 950 DO jt = 1, jp24 917 951 zcoef = FLOAT( jt ) - 0.5 918 !CDIR NOVERRCHK919 !CDIR COLLAPSE920 952 DO jj = 1, jpj 921 !CDIR NOVERRCHK922 953 DO ji = 1, jpi 923 954 zlha = COS( zlsrise(ji,jj) - zcoef * zdlha(ji,jj) ) ! local hour angle
Note: See TracChangeset
for help on using the changeset viewer.
