Changeset 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
- Timestamp:
- 2015-12-01T16:35:30+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r4624 r5965 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 … … 257 260 END DO 258 261 END DO 262 utau(:,:) = utau(:,:) * umask(:,:,1) 263 vtau(:,:) = vtau(:,:) * vmask(:,:,1) 264 taum(:,:) = taum(:,:) * tmask(:,:,1) 259 265 CALL lbc_lnk( taum, 'T', 1. ) 260 266 … … 264 270 !CDIR COLLAPSE 265 271 wndm(:,:) = sf(jp_wndm)%fnow(:,:,1) 272 wndm(:,:) = wndm(:,:) * tmask(:,:,1) 266 273 267 274 !------------------------------------------------! … … 270 277 271 278 CALL blk_clio_qsr_oce( qsr ) 272 279 qsr(:,:) = qsr(:,:) * tmask(:,:,1) ! no shortwave radiation into the ocean beneath ice shelf 273 280 !------------------------! 274 281 ! Other ocean fluxes ! … … 376 383 & - zqla(:,:) * pst(:,:) * zcevap & ! remove evap. heat content at SST in Celcius 377 384 & + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec ! add precip. heat content at Tair in Celcius 385 qns(:,:) = qns(:,:) * tmask(:,:,1) 386 #if defined key_lim3 387 qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) 388 qsr_oce(:,:) = qsr(:,:) 389 #endif 378 390 ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio) 379 391 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 392 IF ( nn_ice == 0 ) THEN 393 CALL iom_put( "qlw_oce" , zqlw ) ! output downward longwave heat over the ocean 394 CALL iom_put( "qsb_oce" , - zqsb ) ! output downward sensible heat over the ocean 395 CALL iom_put( "qla_oce" , - zqla ) ! output downward latent heat over the ocean 396 CALL iom_put( "qemp_oce", qns-zqlw+zqsb+zqla ) ! output downward heat content of E-P over the ocean 397 CALL iom_put( "qns_oce" , qns ) ! output downward non solar heat over the ocean 398 CALL iom_put( "qsr_oce" , qsr ) ! output downward solar heat over the ocean 399 CALL iom_put( "qt_oce" , qns+qsr ) ! output total downward heat over the ocean 400 ENDIF 384 401 385 402 IF(ln_ctl) THEN … … 397 414 END SUBROUTINE blk_oce_clio 398 415 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 ) 416 # if defined key_lim2 || defined key_lim3 417 SUBROUTINE blk_ice_clio_tau 405 418 !!--------------------------------------------------------------------------- 406 !! *** ROUTINE blk_ice_clio *** 419 !! *** ROUTINE blk_ice_clio_tau *** 420 !! 421 !! ** Purpose : Computation momentum flux at the ice-atm interface 422 !! 423 !! ** Method : Read utau from a forcing file. Rearrange if C-grid 424 !! 425 !!---------------------------------------------------------------------- 426 REAL(wp) :: zcoef 427 INTEGER :: ji, jj ! dummy loop indices 428 !!--------------------------------------------------------------------- 429 ! 430 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio_tau') 431 432 SELECT CASE( cp_ice_msh ) 433 434 CASE( 'C' ) ! C-grid ice dynamics 435 436 zcoef = cai / cao ! Change from air-sea stress to air-ice stress 437 utau_ice(:,:) = zcoef * utau(:,:) 438 vtau_ice(:,:) = zcoef * vtau(:,:) 439 440 CASE( 'I' ) ! I-grid ice dynamics: I-point (i.e. F-point lower-left corner) 441 442 zcoef = 0.5_wp * cai / cao ! Change from air-sea stress to air-ice stress 443 DO jj = 2, jpj ! stress from ocean U- and V-points to ice U,V point 444 DO ji = 2, jpi ! I-grid : no vector opt. 445 utau_ice(ji,jj) = zcoef * ( utau(ji-1,jj ) + utau(ji-1,jj-1) ) 446 vtau_ice(ji,jj) = zcoef * ( vtau(ji ,jj-1) + vtau(ji-1,jj-1) ) 447 END DO 448 END DO 449 450 CALL lbc_lnk( utau_ice(:,:), 'I', -1. ) ; CALL lbc_lnk( vtau_ice(:,:), 'I', -1. ) ! I-point 451 452 END SELECT 453 454 IF(ln_ctl) THEN 455 CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_clio: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ') 456 ENDIF 457 458 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio_tau') 459 460 END SUBROUTINE blk_ice_clio_tau 461 #endif 462 463 # if defined key_lim2 || defined key_lim3 464 SUBROUTINE blk_ice_clio_flx( ptsu , palb_cs, palb_os, palb ) 465 !!--------------------------------------------------------------------------- 466 !! *** ROUTINE blk_ice_clio_flx *** 407 467 !! 408 468 !! ** Purpose : Computation of the heat fluxes at ocean and snow/ice … … 426 486 !! to take into account solid precip latent heat flux 427 487 !!---------------------------------------------------------------------- 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 488 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ptsu ! ice surface temperature [Kelvin] 489 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [-] 490 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_os ! ice albedo (overcast sky) (alb_ice_os) [-] 491 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb ! ice albedo (actual value) [-] 444 492 !! 445 493 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 494 !! 495 REAL(wp) :: zmt1, zmt2, zmt3, ztatm3 ! temporary scalars 449 496 REAL(wp) :: ztaevbk, zind1, zind2, zind3, ztamr ! - - 450 497 REAL(wp) :: zesi, zqsati, zdesidt ! - - … … 452 499 REAL(wp) :: zcshi, zclei, zrhovaclei, zrhovacshi ! - - 453 500 REAL(wp) :: ztice3, zticemb, zticemb2, zdqlw, zdqsb ! - - 501 REAL(wp) :: z1_lsub ! - - 454 502 !! 455 503 REAL(wp), DIMENSION(:,:) , POINTER :: ztatm ! Tair in Kelvin … … 458 506 REAL(wp), DIMENSION(:,:) , POINTER :: zrhoa ! air density 459 507 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw, z_qsb 508 REAL(wp), DIMENSION(:,:) , POINTER :: zevap, zsnw 460 509 !!--------------------------------------------------------------------- 461 510 ! 462 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio ')511 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio_flx') 463 512 ! 464 513 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 514 CALL wrk_alloc( jpi,jpj, jpl, z_qlw, z_qsb ) 515 468 516 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 517 !-------------------------------------------------------------------------------- 495 518 ! Determine cloud optical depths as a function of latitude (Chou et al., 1981). 496 519 ! and the correction factor for taking into account the effect of clouds 497 !------------------------------------------------------ 520 !-------------------------------------------------------------------------------- 521 498 522 !CDIR NOVERRCHK 499 523 !CDIR COLLAPSE … … 522 546 zmt2 = ( 272.0 - ztatm(ji,jj) ) / 38.0 ; zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) ) 523 547 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/s548 sprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday & ! rday = converte mm/day to kg/m2/s 525 549 & * ( zind1 & ! solid (snow) precipitation [kg/m2/s] 526 550 & + ( 1.0 - zind1 ) * ( zind2 * ( 0.5 + zmt2 ) & … … 532 556 ! fraction of qsr_ice which is NOT absorbed in the thin surface layer 533 557 ! 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 precipitation558 fr1_i0(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1) 559 fr2_i0(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1) 560 END DO 561 END DO 562 CALL iom_put( 'snowpre', sprecip ) ! Snow precipitation 539 563 540 564 !-----------------------------------------------------------! 541 565 ! snow/ice Shortwave radiation (abedo already computed) ! 542 566 !-----------------------------------------------------------! 543 CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr ) 567 CALL blk_clio_qsr_ice( palb_cs, palb_os, qsr_ice ) 568 569 DO jl = 1, jpl 570 palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(:,:,1) ) & 571 & + palb_os(:,:,jl) * sf(jp_ccov)%fnow(:,:,1) ) 572 END DO 544 573 545 574 ! ! ========================== ! 546 DO jl = 1, ijpl ! Loop over ice categories !575 DO jl = 1, jpl ! Loop over ice categories ! 547 576 ! ! ========================== ! 548 577 !CDIR NOVERRCHK … … 558 587 ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) ) 559 588 ! 560 z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( p st(ji,jj,jl) - ztatm(ji,jj) ) )589 z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) ) 561 590 562 591 !---------------------------------------- … … 565 594 566 595 ! 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 ) )596 zesi = 611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( ptsu(ji,jj,jl) - rtt )/ ( ptsu(ji,jj,jl) - 7.66 ) ) 568 597 ! humidity close to the ice surface (at saturation) 569 598 zqsati = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi ) 570 599 571 600 ! computation of intermediate values 572 zticemb = p st(ji,jj,jl) - 7.66601 zticemb = ptsu(ji,jj,jl) - 7.66 573 602 zticemb2 = zticemb * zticemb 574 ztice3 = p st(ji,jj,jl) * pst(ji,jj,jl) * pst(ji,jj,jl)603 ztice3 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) * ptsu(ji,jj,jl) 575 604 zdesidt = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 ) / zticemb2 ) 576 605 … … 585 614 586 615 ! sensible heat flux 587 z_qsb(ji,jj,jl) = zrhovacshi * ( p st(ji,jj,jl) - ztatm(ji,jj) )616 z_qsb(ji,jj,jl) = zrhovacshi * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) 588 617 589 618 ! latent heat flux 590 p_qla(ji,jj,jl) = MAX( 0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) ) )619 qla_ice(ji,jj,jl) = MAX( 0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) ) ) 591 620 592 621 ! sensitivity of non solar fluxes (dQ/dT) (long-wave, sensible and latent fluxes) … … 595 624 zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) ) 596 625 ! 597 p_dqla(ji,jj,jl) = zdqla ! latent flux sensitivity598 p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla ) ! total non solar sensitivity626 dqla_ice(ji,jj,jl) = zdqla ! latent flux sensitivity 627 dqns_ice(ji,jj,jl) = -( zdqlw + zdqsb + zdqla ) ! total non solar sensitivity 599 628 END DO 600 629 ! … … 608 637 ! 609 638 !CDIR COLLAPSE 610 p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla(:,:,:) ! Downward Non Solar flux611 !CDIR COLLAPSE 612 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s]639 qns_ice(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - qla_ice (:,:,:) ! Downward Non Solar flux 640 !CDIR COLLAPSE 641 tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s] 613 642 ! 614 643 ! ----------------------------------------------------------------------------- ! … … 617 646 !CDIR COLLAPSE 618 647 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 ! 648 & - sprecip(:,:) * lfus & ! remove melting solid precip 649 & + sprecip(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic & ! add solid P at least below melting 650 & - sprecip(:,:) * sf(jp_tair)%fnow(:,:,1) * rcp ! remove solid precip. at Tair 651 652 #if defined key_lim3 653 ! ----------------------------------------------------------------------------- ! 654 ! Distribute evapo, precip & associated heat over ice and ocean 655 ! ---------------=====--------------------------------------------------------- ! 656 CALL wrk_alloc( jpi,jpj, zevap, zsnw ) 657 658 ! --- evaporation --- ! 659 z1_lsub = 1._wp / Lsub 660 evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation 661 devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub 662 zevap (:,:) = emp(:,:) + tprecip(:,:) ! evaporation over ocean 663 664 ! --- evaporation minus precipitation --- ! 665 zsnw(:,:) = 0._wp 666 CALL lim_thd_snwblow( pfrld, zsnw ) ! snow redistribution by wind 667 emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * ( 1._wp - zsnw ) 668 emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 669 emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 670 671 ! --- heat flux associated with emp --- ! 672 qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp & ! evap 673 & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip 674 & + sprecip(:,:) * ( 1._wp - zsnw ) * & ! solid precip 675 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 676 qemp_ice(:,:) = sprecip(:,:) * zsnw * & ! solid precip (only) 677 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 678 679 ! --- total solar and non solar fluxes --- ! 680 qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 681 qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 682 683 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 684 qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 685 686 CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 687 #endif 688 623 689 !!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. )690 CALL lbc_lnk( fr1_i0 (:,:) , 'T', 1. ) 691 CALL lbc_lnk( fr2_i0 (:,:) , 'T', 1. ) 692 DO jl = 1, jpl 693 CALL lbc_lnk( qns_ice (:,:,jl) , 'T', 1. ) 694 CALL lbc_lnk( dqns_ice(:,:,jl) , 'T', 1. ) 695 CALL lbc_lnk( qla_ice (:,:,jl) , 'T', 1. ) 696 CALL lbc_lnk( dqla_ice(:,:,jl) , 'T', 1. ) 631 697 END DO 632 698 633 699 !!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 700 DO jl = 1, jpl 701 qns_ice (:,:,jl) = qns_ice (:,:,jl) * tmask(:,:,1) 702 qla_ice (:,:,jl) = qla_ice (:,:,jl) * tmask(:,:,1) 703 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * tmask(:,:,1) 704 dqla_ice(:,:,jl) = dqla_ice(:,:,jl) * tmask(:,:,1) 705 END DO 706 707 CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 708 CALL wrk_dealloc( jpi,jpj, jpl , z_qlw, z_qsb ) 640 709 641 710 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 : ') 711 CALL prt_ctl(tab3d_1=z_qsb , clinfo1=' blk_ice_clio: z_qsb : ', tab3d_2=z_qlw , clinfo2=' z_qlw : ', kdim=jpl) 712 CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice_clio: z_qla : ', tab3d_2=qsr_ice , clinfo2=' qsr_ice : ', kdim=jpl) 713 CALL prt_ctl(tab3d_1=dqns_ice , clinfo1=' blk_ice_clio: dqns_ice : ', tab3d_2=qns_ice , clinfo2=' qns_ice : ', kdim=jpl) 714 CALL prt_ctl(tab3d_1=dqla_ice , clinfo1=' blk_ice_clio: dqla_ice : ', tab3d_2=ptsu , clinfo2=' ptsu : ', kdim=jpl) 715 CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice_clio: tprecip : ', tab2d_2=sprecip , clinfo2=' sprecip : ') 648 716 ENDIF 649 717 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 718 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio_flx') 719 ! 720 END SUBROUTINE blk_ice_clio_flx 721 722 #endif 657 723 658 724 SUBROUTINE blk_clio_qsr_oce( pqsr_oce )
Note: See TracChangeset
for help on using the changeset viewer.
