- Timestamp:
- 2015-07-21T13:25:36+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r5126 r5621 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 … … 378 384 & + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec ! add precip. heat content at Tair in Celcius 379 385 qns(:,:) = qns(:,:) * tmask(:,:,1) 386 #if defined key_lim3 387 qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) 388 qsr_oce(:,:) = qsr(:,:) 389 #endif 380 390 ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio) 381 391 382 CALL iom_put( "qlw_oce", zqlw ) ! output downward longwave heat over the ocean 383 CALL iom_put( "qsb_oce", - zqsb ) ! output downward sensible heat over the ocean 384 CALL iom_put( "qla_oce", - zqla ) ! output downward latent heat over the ocean 385 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 386 401 387 402 IF(ln_ctl) THEN … … 399 414 END SUBROUTINE blk_oce_clio 400 415 401 402 SUBROUTINE blk_ice_clio( pst , palb_cs, palb_os, palb, & 403 & p_taui, p_tauj, p_qns , p_qsr, & 404 & p_qla , p_dqns, p_dqla, & 405 & p_tpr , p_spr , & 406 & p_fr1 , p_fr2 , cd_grid, pdim ) 416 # if defined key_lim2 || defined key_lim3 417 SUBROUTINE blk_ice_clio_tau 407 418 !!--------------------------------------------------------------------------- 408 !! *** 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 *** 409 467 !! 410 468 !! ** Purpose : Computation of the heat fluxes at ocean and snow/ice … … 428 486 !! to take into account solid precip latent heat flux 429 487 !!---------------------------------------------------------------------- 430 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: p st! ice surface temperature [Kelvin]488 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ptsu ! ice surface temperature [Kelvin] 431 489 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [-] 432 490 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_os ! ice albedo (overcast sky) (alb_ice_os) [-] 433 491 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb ! ice albedo (actual value) [-] 434 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_taui ! surface ice stress at I-point (i-component) [N/m2]435 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tauj ! surface ice stress at I-point (j-component) [N/m2]436 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qns ! non solar heat flux over ice (T-point) [W/m2]437 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qsr ! solar heat flux over ice (T-point) [W/m2]438 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qla ! latent heat flux over ice (T-point) [W/m2]439 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqns ! non solar heat sensistivity (T-point) [W/m2]440 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqla ! latent heat sensistivity (T-point) [W/m2]441 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tpr ! total precipitation (T-point) [Kg/m2/s]442 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_spr ! solid precipitation (T-point) [Kg/m2/s]443 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr1 ! 1sr fraction of qsr penetration in ice [-]444 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr2 ! 2nd fraction of qsr penetration in ice [-]445 CHARACTER(len=1), INTENT(in ) :: cd_grid ! type of sea-ice grid ("C" or "B" grid)446 INTEGER, INTENT(in ) :: pdim ! number of ice categories447 492 !! 448 493 INTEGER :: ji, jj, jl ! dummy loop indices 449 INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays) 450 !! 451 REAL(wp) :: zcoef, zmt1, zmt2, zmt3, ztatm3 ! temporary scalars 494 !! 495 REAL(wp) :: zmt1, zmt2, zmt3, ztatm3 ! temporary scalars 452 496 REAL(wp) :: ztaevbk, zind1, zind2, zind3, ztamr ! - - 453 497 REAL(wp) :: zesi, zqsati, zdesidt ! - - … … 455 499 REAL(wp) :: zcshi, zclei, zrhovaclei, zrhovacshi ! - - 456 500 REAL(wp) :: ztice3, zticemb, zticemb2, zdqlw, zdqsb ! - - 501 REAL(wp) :: z1_lsub ! - - 457 502 !! 458 503 REAL(wp), DIMENSION(:,:) , POINTER :: ztatm ! Tair in Kelvin … … 461 506 REAL(wp), DIMENSION(:,:) , POINTER :: zrhoa ! air density 462 507 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw, z_qsb 508 REAL(wp), DIMENSION(:,:) , POINTER :: zevap, zsnw 463 509 !!--------------------------------------------------------------------- 464 510 ! 465 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio ')511 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio_flx') 466 512 ! 467 513 CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 468 CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb ) 469 470 ijpl = pdim ! number of ice categories 514 CALL wrk_alloc( jpi,jpj, jpl, z_qlw, z_qsb ) 515 471 516 zpatm = 101000. ! atmospheric pressure (assumed constant here) 472 473 #if defined key_lim3 474 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init 475 #endif 476 ! ! surface ocean fluxes computed with CLIO bulk formulea 477 !------------------------------------! 478 ! momentum fluxes (utau, vtau ) ! 479 !------------------------------------! 480 481 SELECT CASE( cd_grid ) 482 CASE( 'C' ) ! C-grid ice dynamics 483 zcoef = cai / cao ! Change from air-sea stress to air-ice stress 484 p_taui(:,:) = zcoef * utau(:,:) 485 p_tauj(:,:) = zcoef * vtau(:,:) 486 CASE( 'I' ) ! I-grid ice dynamics: I-point (i.e. F-point lower-left corner) 487 zcoef = 0.5_wp * cai / cao ! Change from air-sea stress to air-ice stress 488 DO jj = 2, jpj ! stress from ocean U- and V-points to ice U,V point 489 DO ji = 2, jpi ! I-grid : no vector opt. 490 p_taui(ji,jj) = zcoef * ( utau(ji-1,jj ) + utau(ji-1,jj-1) ) 491 p_tauj(ji,jj) = zcoef * ( vtau(ji ,jj-1) + vtau(ji-1,jj-1) ) 492 END DO 493 END DO 494 CALL lbc_lnk( p_taui(:,:), 'I', -1. ) ; CALL lbc_lnk( p_tauj(:,:), 'I', -1. ) ! I-point 495 END SELECT 496 497 517 !-------------------------------------------------------------------------------- 498 518 ! Determine cloud optical depths as a function of latitude (Chou et al., 1981). 499 519 ! and the correction factor for taking into account the effect of clouds 500 !------------------------------------------------------ 520 !-------------------------------------------------------------------------------- 521 501 522 !CDIR NOVERRCHK 502 523 !CDIR COLLAPSE … … 525 546 zmt2 = ( 272.0 - ztatm(ji,jj) ) / 38.0 ; zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) ) 526 547 zmt3 = ( 281.0 - ztatm(ji,jj) ) / 18.0 ; zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) ) 527 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 528 549 & * ( zind1 & ! solid (snow) precipitation [kg/m2/s] 529 550 & + ( 1.0 - zind1 ) * ( zind2 * ( 0.5 + zmt2 ) & … … 535 556 ! fraction of qsr_ice which is NOT absorbed in the thin surface layer 536 557 ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 537 p_fr1(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1)538 p_fr2(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1)539 END DO 540 END DO 541 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 542 563 543 564 !-----------------------------------------------------------! 544 565 ! snow/ice Shortwave radiation (abedo already computed) ! 545 566 !-----------------------------------------------------------! 546 CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr)547 548 DO jl = 1, ijpl567 CALL blk_clio_qsr_ice( palb_cs, palb_os, qsr_ice ) 568 569 DO jl = 1, jpl 549 570 palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(:,:,1) ) & 550 571 & + palb_os(:,:,jl) * sf(jp_ccov)%fnow(:,:,1) ) … … 552 573 553 574 ! ! ========================== ! 554 DO jl = 1, ijpl ! Loop over ice categories !575 DO jl = 1, jpl ! Loop over ice categories ! 555 576 ! ! ========================== ! 556 577 !CDIR NOVERRCHK … … 566 587 ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) ) 567 588 ! 568 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) ) ) 569 590 570 591 !---------------------------------------- … … 573 594 574 595 ! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential) 575 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 ) ) 576 597 ! humidity close to the ice surface (at saturation) 577 598 zqsati = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi ) 578 599 579 600 ! computation of intermediate values 580 zticemb = p st(ji,jj,jl) - 7.66601 zticemb = ptsu(ji,jj,jl) - 7.66 581 602 zticemb2 = zticemb * zticemb 582 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) 583 604 zdesidt = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 ) / zticemb2 ) 584 605 … … 593 614 594 615 ! sensible heat flux 595 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) ) 596 617 597 618 ! latent heat flux 598 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) ) ) 599 620 600 621 ! sensitivity of non solar fluxes (dQ/dT) (long-wave, sensible and latent fluxes) … … 603 624 zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) ) 604 625 ! 605 p_dqla(ji,jj,jl) = zdqla ! latent flux sensitivity606 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 607 628 END DO 608 629 ! … … 616 637 ! 617 638 !CDIR COLLAPSE 618 p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla(:,:,:) ! Downward Non Solar flux619 !CDIR COLLAPSE 620 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] 621 642 ! 622 643 ! ----------------------------------------------------------------------------- ! … … 625 646 !CDIR COLLAPSE 626 647 qns(:,:) = qns(:,:) & ! update the non-solar heat flux with: 627 & - p_spr(:,:) * lfus & ! remove melting solid precip 628 & + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic & ! add solid P at least below melting 629 & - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1) * rcp ! remove solid precip. at Tair 630 ! 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 631 689 !!gm : not necessary as all input data are lbc_lnk... 632 CALL lbc_lnk( p_fr1(:,:) , 'T', 1. )633 CALL lbc_lnk( p_fr2(:,:) , 'T', 1. )634 DO jl = 1, ijpl635 CALL lbc_lnk( p_qns(:,:,jl) , 'T', 1. )636 CALL lbc_lnk( p_dqns(:,:,jl) , 'T', 1. )637 CALL lbc_lnk( p_qla(:,:,jl) , 'T', 1. )638 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. ) 639 697 END DO 640 698 641 699 !!gm : mask is not required on forcing 642 DO jl = 1, ijpl 643 p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1) 644 p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1) 645 p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask(:,:,1) 646 p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask(:,:,1) 647 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 ) 648 709 649 710 IF(ln_ctl) THEN 650 CALL prt_ctl(tab3d_1=z_qsb , clinfo1=' blk_ice_clio: z_qsb : ', tab3d_2=z_qlw , clinfo2=' z_qlw : ', kdim=ijpl) 651 CALL prt_ctl(tab3d_1=p_qla , clinfo1=' blk_ice_clio: z_qla : ', tab3d_2=p_qsr , clinfo2=' p_qsr : ', kdim=ijpl) 652 CALL prt_ctl(tab3d_1=p_dqns , clinfo1=' blk_ice_clio: p_dqns : ', tab3d_2=p_qns , clinfo2=' p_qns : ', kdim=ijpl) 653 CALL prt_ctl(tab3d_1=p_dqla , clinfo1=' blk_ice_clio: p_dqla : ', tab3d_2=pst , clinfo2=' pst : ', kdim=ijpl) 654 CALL prt_ctl(tab2d_1=p_tpr , clinfo1=' blk_ice_clio: p_tpr : ', tab2d_2=p_spr , clinfo2=' p_spr : ') 655 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 : ') 656 716 ENDIF 657 717 658 CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 659 CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb ) 660 ! 661 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio') 662 ! 663 END SUBROUTINE blk_ice_clio 664 718 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio_flx') 719 ! 720 END SUBROUTINE blk_ice_clio_flx 721 722 #endif 665 723 666 724 SUBROUTINE blk_clio_qsr_oce( pqsr_oce )
Note: See TracChangeset
for help on using the changeset viewer.
