- Timestamp:
- 2015-06-05T11:53:44+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r5357 r5362 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 39 #elif defined key_lim2 40 40 USE ice_2 41 USE sbc_ice ! Surface boundary condition: ice fields 41 42 #endif 42 43 … … 45 46 46 47 PUBLIC sbc_blk_clio ! routine called by sbcmod.F90 47 PUBLIC blk_ice_clio ! routine called by sbcice_lim.F90 48 #if defined key_lim2 || defined key_lim3 48 49 PUBLIC blk_ice_clio_tau ! routine called by sbcice_lim.F90 49 50 PUBLIC blk_ice_clio_flx ! routine called by sbcice_lim.F90 51 #endif 50 52 51 53 INTEGER , PARAMETER :: jpfld = 7 ! maximum number of files to read … … 380 382 & + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec ! add precip. heat content at Tair in Celcius 381 383 qns(:,:) = qns(:,:) * tmask(:,:,1) 384 #if defined key_lim3 385 qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) 386 qsr_oce(:,:) = qsr(:,:) 387 #endif 382 388 ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio) 383 389 … … 401 407 END SUBROUTINE blk_oce_clio 402 408 403 SUBROUTINE blk_ice_clio( pst , palb_cs, palb_os, palb, & 404 & p_taui, p_tauj, p_qns , p_qsr, & 405 & p_qla , p_dqns, p_dqla, & 406 & p_tpr , p_spr , & 407 & p_fr1 , p_fr2 , cd_grid, pdim ) 408 409 !!--------------------------------------------------------------------------- 410 !! *** ROUTINE blk_ice_clio *** 411 !! 412 !! ** Purpose : Computation of the heat fluxes at ocean and snow/ice 413 !! surface the solar heat at ocean and snow/ice surfaces and the 414 !! sensitivity of total heat fluxes to the SST variations 415 !! 416 !! ** Action : Call of blk_ice_clio_tau and blk_ice_clio_flx 417 !! 418 !!---------------------------------------------------------------------- 419 420 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pst ! ice surface temperature [Kelvin] 421 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [-] 422 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_os ! ice albedo (overcast sky) (alb_ice_os) [-] 423 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb ! ice albedo (actual value) [-] 424 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_taui ! surface ice stress at I-point (i-component) [N/m2] 425 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tauj ! surface ice stress at I-point (j-component) [N/m2] 426 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qns ! non solar heat flux over ice (T-point) [W/m2] 427 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qsr ! solar heat flux over ice (T-point) [W/m2] 428 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qla ! latent heat flux over ice (T-point) [W/m2] 429 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqns ! non solar heat sensistivity (T-point) [W/m2] 430 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqla ! latent heat sensistivity (T-point) [W/m2] 431 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tpr ! total precipitation (T-point) [Kg/m2/s] 432 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_spr ! solid precipitation (T-point) [Kg/m2/s] 433 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr1 ! 1sr fraction of qsr penetration in ice [-] 434 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr2 ! 2nd fraction of qsr penetration in ice [-] 435 CHARACTER(len=1), INTENT(in ) :: cd_grid ! type of sea-ice grid ("C" or "B" grid) 436 INTEGER, INTENT(in ) :: pdim ! number of ice categories 437 438 CALL blk_ice_clio_tau( p_taui, p_tauj, cd_grid ) 439 CALL blk_ice_clio_flx( pst , palb_cs, palb_os, palb, & 440 & p_qns , p_qsr, p_qla , p_dqns, p_dqla, & 441 & p_tpr , p_spr ,p_fr1 , p_fr2 , pdim ) 442 443 END SUBROUTINE blk_ice_clio 444 445 SUBROUTINE blk_ice_clio_tau( p_taui, p_tauj, cd_grid ) 409 # if defined key_lim2 || defined key_lim3 410 SUBROUTINE blk_ice_clio_tau 446 411 !!--------------------------------------------------------------------------- 447 412 !! *** ROUTINE blk_ice_clio_tau *** … … 452 417 !! 453 418 !!---------------------------------------------------------------------- 454 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_taui ! surface ice stress at I-point (i-component) [N/m2]455 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tauj ! surface ice stress at I-point (j-component) [N/m2]456 CHARACTER(len=1), INTENT(in ) :: cd_grid ! type of sea-ice grid ("C" or "B" grid)457 !!458 INTEGER :: ji, jj ! dummy loop indices459 419 REAL(wp) :: zcoef 460 !!420 INTEGER :: ji, jj ! dummy loop indices 461 421 !!--------------------------------------------------------------------- 462 422 ! 463 464 423 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio_tau') 465 424 466 SELECT CASE( c d_grid)425 SELECT CASE( cp_ice_msh ) 467 426 468 427 CASE( 'C' ) ! C-grid ice dynamics 469 428 470 429 zcoef = cai / cao ! Change from air-sea stress to air-ice stress 471 p_taui(:,:) = zcoef * utau(:,:)472 p_tauj(:,:) = zcoef * vtau(:,:)430 utau_ice(:,:) = zcoef * utau(:,:) 431 vtau_ice(:,:) = zcoef * vtau(:,:) 473 432 474 433 CASE( 'I' ) ! I-grid ice dynamics: I-point (i.e. F-point lower-left corner) … … 477 436 DO jj = 2, jpj ! stress from ocean U- and V-points to ice U,V point 478 437 DO ji = 2, jpi ! I-grid : no vector opt. 479 p_taui(ji,jj) = zcoef * ( utau(ji-1,jj ) + utau(ji-1,jj-1) )480 p_tauj(ji,jj) = zcoef * ( vtau(ji ,jj-1) + vtau(ji-1,jj-1) )438 utau_ice(ji,jj) = zcoef * ( utau(ji-1,jj ) + utau(ji-1,jj-1) ) 439 vtau_ice(ji,jj) = zcoef * ( vtau(ji ,jj-1) + vtau(ji-1,jj-1) ) 481 440 END DO 482 441 END DO 483 442 484 CALL lbc_lnk( p_taui(:,:), 'I', -1. ) ; CALL lbc_lnk( p_tauj(:,:), 'I', -1. ) ! I-point443 CALL lbc_lnk( utau_ice(:,:), 'I', -1. ) ; CALL lbc_lnk( vtau_ice(:,:), 'I', -1. ) ! I-point 485 444 486 445 END SELECT 487 446 488 447 IF(ln_ctl) THEN 489 CALL prt_ctl(tab2d_1= p_taui , clinfo1=' blk_ice_clio: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj: ')448 CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_clio: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ') 490 449 ENDIF 491 450 … … 493 452 494 453 END SUBROUTINE blk_ice_clio_tau 495 496 SUBROUTINE blk_ice_clio_flx( pst , palb_cs, palb_os, palb, & 497 & p_qns , p_qsr, p_qla , p_dqns, p_dqla, & 498 & p_tpr , p_spr ,p_fr1 , p_fr2 , pdim)454 #endif 455 456 # if defined key_lim2 || defined key_lim3 457 SUBROUTINE blk_ice_clio_flx( ptsu , palb_cs, palb_os, palb ) 499 458 !!--------------------------------------------------------------------------- 500 459 !! *** ROUTINE blk_ice_clio_flx *** … … 520 479 !! to take into account solid precip latent heat flux 521 480 !!---------------------------------------------------------------------- 522 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: p st! ice surface temperature [Kelvin]481 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ptsu ! ice surface temperature [Kelvin] 523 482 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [-] 524 483 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_os ! ice albedo (overcast sky) (alb_ice_os) [-] 525 484 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb ! ice albedo (actual value) [-] 526 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qns ! non solar heat flux over ice (T-point) [W/m2]527 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qsr ! solar heat flux over ice (T-point) [W/m2]528 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qla ! latent heat flux over ice (T-point) [W/m2]529 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqns ! non solar heat sensistivity (T-point) [W/m2]530 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqla ! latent heat sensistivity (T-point) [W/m2]531 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tpr ! total precipitation (T-point) [Kg/m2/s]532 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_spr ! solid precipitation (T-point) [Kg/m2/s]533 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr1 ! 1sr fraction of qsr penetration in ice [-]534 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr2 ! 2nd fraction of qsr penetration in ice [-]535 INTEGER, INTENT(in ) :: pdim ! number of ice categories536 485 !! 537 486 INTEGER :: ji, jj, jl ! dummy loop indices 538 INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays)539 487 !! 540 488 REAL(wp) :: zmt1, zmt2, zmt3, ztatm3 ! temporary scalars … … 544 492 REAL(wp) :: zcshi, zclei, zrhovaclei, zrhovacshi ! - - 545 493 REAL(wp) :: ztice3, zticemb, zticemb2, zdqlw, zdqsb ! - - 494 REAL(wp) :: z1_lsub ! - - 546 495 !! 547 496 REAL(wp), DIMENSION(:,:) , POINTER :: ztatm ! Tair in Kelvin … … 550 499 REAL(wp), DIMENSION(:,:) , POINTER :: zrhoa ! air density 551 500 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw, z_qsb 501 REAL(wp), DIMENSION(:,:) , POINTER :: zevap, zsnw 552 502 !!--------------------------------------------------------------------- 553 503 ! … … 555 505 ! 556 506 CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 557 CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb ) 558 559 ijpl = pdim ! number of ice categories 507 CALL wrk_alloc( jpi,jpj, jpl, z_qlw, z_qsb ) 508 560 509 zpatm = 101000. ! atmospheric pressure (assumed constant here) 561 562 510 !-------------------------------------------------------------------------------- 563 511 ! Determine cloud optical depths as a function of latitude (Chou et al., 1981). … … 591 539 zmt2 = ( 272.0 - ztatm(ji,jj) ) / 38.0 ; zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) ) 592 540 zmt3 = ( 281.0 - ztatm(ji,jj) ) / 18.0 ; zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) ) 593 p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday & ! rday = converte mm/day to kg/m2/s541 sprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday & ! rday = converte mm/day to kg/m2/s 594 542 & * ( zind1 & ! solid (snow) precipitation [kg/m2/s] 595 543 & + ( 1.0 - zind1 ) * ( zind2 * ( 0.5 + zmt2 ) & … … 601 549 ! fraction of qsr_ice which is NOT absorbed in the thin surface layer 602 550 ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 603 p_fr1(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1)604 p_fr2(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1)605 END DO 606 END DO 607 CALL iom_put( 'snowpre', p_spr) ! Snow precipitation551 fr1_i0(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1) 552 fr2_i0(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1) 553 END DO 554 END DO 555 CALL iom_put( 'snowpre', sprecip ) ! Snow precipitation 608 556 609 557 !-----------------------------------------------------------! 610 558 ! snow/ice Shortwave radiation (abedo already computed) ! 611 559 !-----------------------------------------------------------! 612 CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr)613 614 DO jl = 1, ijpl560 CALL blk_clio_qsr_ice( palb_cs, palb_os, qsr_ice ) 561 562 DO jl = 1, jpl 615 563 palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(:,:,1) ) & 616 564 & + palb_os(:,:,jl) * sf(jp_ccov)%fnow(:,:,1) ) … … 618 566 619 567 ! ! ========================== ! 620 DO jl = 1, ijpl ! Loop over ice categories !568 DO jl = 1, jpl ! Loop over ice categories ! 621 569 ! ! ========================== ! 622 570 !CDIR NOVERRCHK … … 632 580 ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) ) 633 581 ! 634 z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( p st(ji,jj,jl) - ztatm(ji,jj) ) )582 z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) ) 635 583 636 584 !---------------------------------------- … … 639 587 640 588 ! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential) 641 zesi = 611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( p st(ji,jj,jl) - rtt )/ ( pst(ji,jj,jl) - 7.66 ) )589 zesi = 611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( ptsu(ji,jj,jl) - rtt )/ ( ptsu(ji,jj,jl) - 7.66 ) ) 642 590 ! humidity close to the ice surface (at saturation) 643 591 zqsati = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi ) 644 592 645 593 ! computation of intermediate values 646 zticemb = p st(ji,jj,jl) - 7.66594 zticemb = ptsu(ji,jj,jl) - 7.66 647 595 zticemb2 = zticemb * zticemb 648 ztice3 = p st(ji,jj,jl) * pst(ji,jj,jl) * pst(ji,jj,jl)596 ztice3 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) * ptsu(ji,jj,jl) 649 597 zdesidt = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 ) / zticemb2 ) 650 598 … … 659 607 660 608 ! sensible heat flux 661 z_qsb(ji,jj,jl) = zrhovacshi * ( p st(ji,jj,jl) - ztatm(ji,jj) )609 z_qsb(ji,jj,jl) = zrhovacshi * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) 662 610 663 611 ! latent heat flux 664 p_qla(ji,jj,jl) = MAX( 0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) ) )612 qla_ice(ji,jj,jl) = MAX( 0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) ) ) 665 613 666 614 ! sensitivity of non solar fluxes (dQ/dT) (long-wave, sensible and latent fluxes) … … 669 617 zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) ) 670 618 ! 671 p_dqla(ji,jj,jl) = zdqla ! latent flux sensitivity672 p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla ) ! total non solar sensitivity619 dqla_ice(ji,jj,jl) = zdqla ! latent flux sensitivity 620 dqns_ice(ji,jj,jl) = -( zdqlw + zdqsb + zdqla ) ! total non solar sensitivity 673 621 END DO 674 622 ! … … 682 630 ! 683 631 !CDIR COLLAPSE 684 p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla(:,:,:) ! Downward Non Solar flux685 !CDIR COLLAPSE 686 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s]632 qns_ice(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - qla_ice (:,:,:) ! Downward Non Solar flux 633 !CDIR COLLAPSE 634 tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s] 687 635 ! 688 636 ! ----------------------------------------------------------------------------- ! … … 691 639 !CDIR COLLAPSE 692 640 qns(:,:) = qns(:,:) & ! update the non-solar heat flux with: 693 & - p_spr(:,:) * lfus & ! remove melting solid precip 694 & + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic & ! add solid P at least below melting 695 & - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1) * rcp ! remove solid precip. at Tair 696 ! 641 & - sprecip(:,:) * lfus & ! remove melting solid precip 642 & + sprecip(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic & ! add solid P at least below melting 643 & - sprecip(:,:) * sf(jp_tair)%fnow(:,:,1) * rcp ! remove solid precip. at Tair 644 645 #if defined key_lim3 646 ! ----------------------------------------------------------------------------- ! 647 ! Distribute evapo, precip & associated heat over ice and ocean 648 ! ---------------=====--------------------------------------------------------- ! 649 CALL wrk_alloc( jpi,jpj, zevap, zsnw ) 650 651 ! --- evaporation --- ! 652 z1_lsub = 1._wp / Lsub 653 evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation 654 devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub 655 zevap (:,:) = emp(:,:) + tprecip(:,:) ! evaporation over ocean 656 657 ! --- evaporation minus precipitation --- ! 658 CALL lim_thd_snwblow( pfrld, zsnw ) ! snow redistribution by wind 659 emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * ( 1._wp - zsnw ) 660 emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 661 emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 662 663 ! --- heat flux associated with emp --- ! 664 qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp & ! evap 665 & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip 666 & + sprecip(:,:) * ( 1._wp - zsnw ) * & ! solid precip 667 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 668 qemp_ice(:,:) = sprecip(:,:) * zsnw * & ! solid precip (only) 669 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 670 671 ! --- total solar and non solar fluxes --- ! 672 qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 673 qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 674 675 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 676 qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 677 678 CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 679 #endif 680 697 681 !!gm : not necessary as all input data are lbc_lnk... 698 CALL lbc_lnk( p_fr1(:,:) , 'T', 1. )699 CALL lbc_lnk( p_fr2(:,:) , 'T', 1. )700 DO jl = 1, ijpl701 CALL lbc_lnk( p_qns(:,:,jl) , 'T', 1. )702 CALL lbc_lnk( p_dqns(:,:,jl) , 'T', 1. )703 CALL lbc_lnk( p_qla(:,:,jl) , 'T', 1. )704 CALL lbc_lnk( p_dqla(:,:,jl) , 'T', 1. )682 CALL lbc_lnk( fr1_i0 (:,:) , 'T', 1. ) 683 CALL lbc_lnk( fr2_i0 (:,:) , 'T', 1. ) 684 DO jl = 1, jpl 685 CALL lbc_lnk( qns_ice (:,:,jl) , 'T', 1. ) 686 CALL lbc_lnk( dqns_ice(:,:,jl) , 'T', 1. ) 687 CALL lbc_lnk( qla_ice (:,:,jl) , 'T', 1. ) 688 CALL lbc_lnk( dqla_ice(:,:,jl) , 'T', 1. ) 705 689 END DO 706 690 707 691 !!gm : mask is not required on forcing 708 DO jl = 1, ijpl 709 p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1) 710 p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1) 711 p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask(:,:,1) 712 p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask(:,:,1) 713 END DO 692 DO jl = 1, jpl 693 qns_ice (:,:,jl) = qns_ice (:,:,jl) * tmask(:,:,1) 694 qla_ice (:,:,jl) = qla_ice (:,:,jl) * tmask(:,:,1) 695 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * tmask(:,:,1) 696 dqla_ice(:,:,jl) = dqla_ice(:,:,jl) * tmask(:,:,1) 697 END DO 698 699 CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 700 CALL wrk_dealloc( jpi,jpj, jpl , z_qlw, z_qsb ) 714 701 715 702 IF(ln_ctl) THEN 716 CALL prt_ctl(tab3d_1=z_qsb , clinfo1=' blk_ice_clio: z_qsb : ', tab3d_2=z_qlw , clinfo2=' z_qlw : ', kdim= ijpl)717 CALL prt_ctl(tab3d_1= p_qla , clinfo1=' blk_ice_clio: z_qla : ', tab3d_2=p_qsr , clinfo2=' p_qsr : ', kdim=ijpl)718 CALL prt_ctl(tab3d_1= p_dqns , clinfo1=' blk_ice_clio: p_dqns : ', tab3d_2=p_qns , clinfo2=' p_qns : ', kdim=ijpl)719 CALL prt_ctl(tab3d_1= p_dqla , clinfo1=' blk_ice_clio: p_dqla : ', tab3d_2=pst , clinfo2=' pst : ', kdim=ijpl)720 CALL prt_ctl(tab2d_1= p_tpr , clinfo1=' blk_ice_clio: p_tpr : ', tab2d_2=p_spr , clinfo2=' p_spr: ')703 CALL prt_ctl(tab3d_1=z_qsb , clinfo1=' blk_ice_clio: z_qsb : ', tab3d_2=z_qlw , clinfo2=' z_qlw : ', kdim=jpl) 704 CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice_clio: z_qla : ', tab3d_2=qsr_ice , clinfo2=' qsr_ice : ', kdim=jpl) 705 CALL prt_ctl(tab3d_1=dqns_ice , clinfo1=' blk_ice_clio: dqns_ice : ', tab3d_2=qns_ice , clinfo2=' qns_ice : ', kdim=jpl) 706 CALL prt_ctl(tab3d_1=dqla_ice , clinfo1=' blk_ice_clio: dqla_ice : ', tab3d_2=ptsu , clinfo2=' ptsu : ', kdim=jpl) 707 CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice_clio: tprecip : ', tab2d_2=sprecip , clinfo2=' sprecip : ') 721 708 ENDIF 722 709 723 CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa )724 CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb )725 !726 710 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio_flx') 727 711 ! 728 712 END SUBROUTINE blk_ice_clio_flx 713 714 #endif 729 715 730 716 SUBROUTINE blk_clio_qsr_oce( pqsr_oce ) -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r5357 r5362 162 162 !! IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 163 163 !! & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 164 CALL blk_ice_clio_tau ( utau_ice, vtau_ice, cp_ice_msh )164 CALL blk_ice_clio_tau 165 165 166 166 CASE( jp_core ) ! CORE bulk formulation … … 238 238 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 239 239 ! (zalb_ice) is computed within the bulk routine 240 CALL blk_ice_clio_flx( t_su , zalb_cs, zalb_os , zalb_ice, qns_ice , qsr_ice , & 241 & qla_ice, dqns_ice , dqla_ice , tprecip, sprecip , & 242 & fr1_i0 , fr2_i0 , jpl ) 243 ! 240 ! CALL blk_ice_clio_flx( t_su , zalb_cs, zalb_os , zalb_ice, qns_ice , qsr_ice , & 241 ! & qla_ice, dqns_ice , dqla_ice , tprecip, sprecip , & 242 ! & fr1_i0 , fr2_i0 , jpl ) 243 ! ! 244 CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, zalb_ice ) 244 245 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 245 246 & dqns_ice, evap_ice, devap_ice, nn_limflx ) -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r5357 r5362 185 185 SELECT CASE( ksbc ) 186 186 CASE( jp_clio ) ! CLIO bulk formulation 187 CALL blk_ice_clio( zsist, zalb_cs , zalb_os , zalb_ice , & 188 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 189 & qla_ice , dqns_ice , dqla_ice , & 190 & tprecip , sprecip , & 191 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 187 ! CALL blk_ice_clio( zsist, zalb_cs , zalb_os , zalb_ice , & 188 ! & utau_ice , vtau_ice , qns_ice , qsr_ice, & 189 ! & qla_ice , dqns_ice , dqla_ice , & 190 ! & tprecip , sprecip , & 191 ! & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 192 CALL blk_ice_clio_tau 193 CALL blk_ice_clio_flx( zsist, zalb_cs, zalb_os, zalb_ice ) 192 194 193 195 CASE( jp_core ) ! CORE bulk formulation
Note: See TracChangeset
for help on using the changeset viewer.