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