Ignore:
Timestamp:
2015-06-19T17:18:00+02:00 (5 years ago)
Author:
davestorkey
Message:

Update 2015/dev_r5021_UKMO1_CICE_coupling branch to revision 5442 of the trunk.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r5234 r5443  
    3434   USE albedo 
    3535   USE prtctl          ! Print control 
    36 #if defined key_lim3 
     36#if defined key_lim3  
    3737   USE ice 
    3838   USE sbc_ice         ! Surface boundary condition: ice fields 
     39   USE limthd_dh       ! for CALL lim_thd_snwblow 
    3940#elif defined key_lim2 
    4041   USE ice_2 
     42   USE sbc_ice         ! Surface boundary condition: ice fields 
     43   USE par_ice_2       ! Surface boundary condition: ice fields 
    4144#endif 
    4245 
     
    4548 
    4649   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 
    4854 
    4955   INTEGER , PARAMETER ::   jpfld   = 7           ! maximum number of files to read  
     
    6268   LOGICAL ::   lbulk_init = .TRUE.               ! flag, bulk initialization done or not) 
    6369 
    64 #if ! defined key_lim3                           
    65    ! in namicerun with LIM3 
    6670   REAL(wp) ::   cai = 1.40e-3 ! best estimate of atm drag in order to get correct FS export in ORCA2-LIM 
    6771   REAL(wp) ::   cao = 1.00e-3 ! chosen by default  ==> should depends on many things...  !!gmto be updated 
    68 #endif 
    6972 
    7073   REAL(wp) ::   rdtbs2      !:    
     
    381384         &     + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec   ! add    precip. heat content at Tair in Celcius 
    382385      qns(:,:) = qns(:,:) * tmask(:,:,1) 
     386#if defined key_lim3 
     387      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) 
     388      qsr_oce(:,:) = qsr(:,:) 
     389#endif 
    383390      ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio) 
    384391 
    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 
    389401 
    390402      IF(ln_ctl) THEN 
     
    402414   END SUBROUTINE blk_oce_clio 
    403415 
    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 
    410418      !!--------------------------------------------------------------------------- 
    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 *** 
    412467      !!                  
    413468      !!  ** Purpose :   Computation of the heat fluxes at ocean and snow/ice 
     
    431486      !!                         to take into account solid precip latent heat flux 
    432487      !!---------------------------------------------------------------------- 
    433       REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin] 
     488      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   ptsu      ! ice surface temperature                   [Kelvin] 
    434489      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [-] 
    435490      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [-] 
    436491      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 categories 
    450492      !! 
    451493      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 
    455496      REAL(wp) ::   ztaevbk, zind1, zind2, zind3, ztamr         !    -         - 
    456497      REAL(wp) ::   zesi, zqsati, zdesidt                       !    -         - 
     
    458499      REAL(wp) ::   zcshi, zclei, zrhovaclei, zrhovacshi        !    -         - 
    459500      REAL(wp) ::   ztice3, zticemb, zticemb2, zdqlw, zdqsb     !    -         - 
     501      REAL(wp) ::   z1_lsub                                     !    -         - 
    460502      !! 
    461503      REAL(wp), DIMENSION(:,:)  , POINTER ::   ztatm   ! Tair in Kelvin 
     
    464506      REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa   ! air density 
    465507      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw, z_qsb 
     508      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw 
    466509      !!--------------------------------------------------------------------- 
    467510      ! 
    468       IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio') 
     511      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio_flx') 
    469512      ! 
    470513      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 
    474516      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      !-------------------------------------------------------------------------------- 
    501518      !  Determine cloud optical depths as a function of latitude (Chou et al., 1981). 
    502519      !  and the correction factor for taking into account  the effect of clouds  
    503       !------------------------------------------------------ 
     520      !-------------------------------------------------------------------------------- 
     521 
    504522!CDIR NOVERRCHK 
    505523!CDIR COLLAPSE 
     
    528546            zmt2  = ( 272.0 - ztatm(ji,jj) ) / 38.0   ;   zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) ) 
    529547            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/s 
     548            sprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s 
    531549               &         * (          zind1      &                   ! solid  (snow) precipitation [kg/m2/s] 
    532550               &            + ( 1.0 - zind1 ) * (          zind2   * ( 0.5 + zmt2 )   & 
     
    538556            ! fraction of qsr_ice which is NOT absorbed in the thin surface layer 
    539557            ! 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 precipitation  
     558            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  
    545563       
    546564      !-----------------------------------------------------------! 
    547565      !  snow/ice Shortwave radiation   (abedo already computed)  ! 
    548566      !-----------------------------------------------------------! 
    549       CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr ) 
    550        
    551       DO jl = 1, ijpl 
     567      CALL blk_clio_qsr_ice( palb_cs, palb_os, qsr_ice ) 
     568       
     569      DO jl = 1, jpl 
    552570         palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(:,:,1) )   & 
    553571            &         +   palb_os(:,:,jl) * sf(jp_ccov)%fnow(:,:,1) ) 
     
    555573 
    556574      !                                     ! ========================== ! 
    557       DO jl = 1, ijpl                       !  Loop over ice categories  ! 
     575      DO jl = 1, jpl                       !  Loop over ice categories  ! 
    558576         !                                  ! ========================== ! 
    559577!CDIR NOVERRCHK 
     
    569587               ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) )  
    570588               ! 
    571                z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( pst(ji,jj,jl) - ztatm(ji,jj) ) )  
     589               z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) )  
    572590 
    573591               !---------------------------------------- 
     
    576594 
    577595               ! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential) 
    578                zesi =  611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( pst(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 ) ) 
    579597               ! humidity close to the ice surface (at saturation) 
    580598               zqsati   = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi ) 
    581599                
    582600               !  computation of intermediate values 
    583                zticemb  = pst(ji,jj,jl) - 7.66 
     601               zticemb  = ptsu(ji,jj,jl) - 7.66 
    584602               zticemb2 = zticemb * zticemb   
    585                ztice3   = pst(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) 
    586604               zdesidt  = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 )  / zticemb2 ) 
    587605                
     
    596614             
    597615               !  sensible heat flux 
    598                z_qsb(ji,jj,jl) = zrhovacshi * ( pst(ji,jj,jl) - ztatm(ji,jj) ) 
     616               z_qsb(ji,jj,jl) = zrhovacshi * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) 
    599617             
    600618               !  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) )  ) 
    602620               
    603621               !  sensitivity of non solar fluxes (dQ/dT) (long-wave, sensible and latent fluxes) 
     
    606624               zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) )    
    607625               ! 
    608                p_dqla(ji,jj,jl) = zdqla                           ! latent flux sensitivity 
    609                p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity 
     626               dqla_ice(ji,jj,jl) = zdqla                           ! latent flux sensitivity 
     627               dqns_ice(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity 
    610628            END DO 
    611629            ! 
     
    619637      ! 
    620638!CDIR COLLAPSE 
    621       p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:)      ! Downward Non Solar flux 
    622 !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] 
    624642      ! 
    625643      ! ----------------------------------------------------------------------------- ! 
     
    628646!CDIR COLLAPSE 
    629647      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 
    634688!!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, ijpl 
    638          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. ) 
    642696      END DO 
    643697 
    644698!!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 ) 
    651708 
    652709      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  : ') 
    659715      ENDIF 
    660716 
    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 
    668722 
    669723   SUBROUTINE blk_clio_qsr_oce( pqsr_oce ) 
Note: See TracChangeset for help on using the changeset viewer.