Changeset 5362


Ignore:
Timestamp:
2015-06-05T11:53:44+02:00 (5 years ago)
Author:
vancop
Message:

update CLIO forcing to match with new standards

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  
    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 
    3939#elif defined key_lim2 
    4040   USE ice_2 
     41   USE sbc_ice         ! Surface boundary condition: ice fields 
    4142#endif 
    4243 
     
    4546 
    4647   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 
    4849   PUBLIC blk_ice_clio_tau    ! routine called by sbcice_lim.F90  
    4950   PUBLIC blk_ice_clio_flx    ! routine called by sbcice_lim.F90  
     51#endif 
    5052 
    5153   INTEGER , PARAMETER ::   jpfld   = 7           ! maximum number of files to read  
     
    380382         &     + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec   ! add    precip. heat content at Tair in Celcius 
    381383      qns(:,:) = qns(:,:) * tmask(:,:,1) 
     384#if defined key_lim3 
     385      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) 
     386      qsr_oce(:,:) = qsr(:,:) 
     387#endif 
    382388      ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio) 
    383389 
     
    401407   END SUBROUTINE blk_oce_clio 
    402408 
    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 
    446411      !!--------------------------------------------------------------------------- 
    447412      !!                     ***  ROUTINE blk_ice_clio_tau  *** 
     
    452417      !! 
    453418      !!---------------------------------------------------------------------- 
    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 indices 
    459419      REAL(wp) ::   zcoef 
    460       !! 
     420      INTEGER  ::   ji, jj   ! dummy loop indices 
    461421      !!--------------------------------------------------------------------- 
    462422      ! 
    463  
    464423      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio_tau') 
    465424 
    466       SELECT CASE( cd_grid ) 
     425      SELECT CASE( cp_ice_msh ) 
    467426 
    468427      CASE( 'C' )                          ! C-grid ice dynamics 
    469428 
    470429         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(:,:) 
    473432 
    474433      CASE( 'I' )                          ! I-grid ice dynamics:  I-point (i.e. F-point lower-left corner) 
     
    477436         DO jj = 2, jpj         ! stress from ocean U- and V-points to ice U,V point 
    478437            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) ) 
    481440            END DO 
    482441         END DO 
    483442 
    484          CALL lbc_lnk( p_taui(:,:), 'I', -1. )   ;   CALL lbc_lnk( p_tauj(:,:), 'I', -1. )   ! I-point 
     443         CALL lbc_lnk( utau_ice(:,:), 'I', -1. )   ;   CALL lbc_lnk( vtau_ice(:,:), 'I', -1. )   ! I-point 
    485444 
    486445      END SELECT 
    487446 
    488447      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 : ') 
    490449      ENDIF 
    491450 
     
    493452 
    494453   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 ) 
    499458      !!--------------------------------------------------------------------------- 
    500459      !!                     ***  ROUTINE blk_ice_clio_flx *** 
     
    520479      !!                         to take into account solid precip latent heat flux 
    521480      !!---------------------------------------------------------------------- 
    522       REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin] 
     481      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   ptsu      ! ice surface temperature                   [Kelvin] 
    523482      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [-] 
    524483      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [-] 
    525484      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 categories 
    536485      !! 
    537486      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    538       INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
    539487      !! 
    540488      REAL(wp) ::   zmt1, zmt2, zmt3, ztatm3                    ! temporary scalars 
     
    544492      REAL(wp) ::   zcshi, zclei, zrhovaclei, zrhovacshi        !    -         - 
    545493      REAL(wp) ::   ztice3, zticemb, zticemb2, zdqlw, zdqsb     !    -         - 
     494      REAL(wp) ::   z1_lsub                                     !    -         - 
    546495      !! 
    547496      REAL(wp), DIMENSION(:,:)  , POINTER ::   ztatm   ! Tair in Kelvin 
     
    550499      REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa   ! air density 
    551500      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw, z_qsb 
     501      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw 
    552502      !!--------------------------------------------------------------------- 
    553503      ! 
     
    555505      ! 
    556506      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 
    560509      zpatm = 101000.                        ! atmospheric pressure  (assumed constant  here) 
    561  
    562510      !-------------------------------------------------------------------------------- 
    563511      !  Determine cloud optical depths as a function of latitude (Chou et al., 1981). 
     
    591539            zmt2  = ( 272.0 - ztatm(ji,jj) ) / 38.0   ;   zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) ) 
    592540            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/s 
     541            sprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s 
    594542               &         * (          zind1      &                   ! solid  (snow) precipitation [kg/m2/s] 
    595543               &            + ( 1.0 - zind1 ) * (          zind2   * ( 0.5 + zmt2 )   & 
     
    601549            ! fraction of qsr_ice which is NOT absorbed in the thin surface layer 
    602550            ! 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 precipitation  
     551            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  
    608556       
    609557      !-----------------------------------------------------------! 
    610558      !  snow/ice Shortwave radiation   (abedo already computed)  ! 
    611559      !-----------------------------------------------------------! 
    612       CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr ) 
    613        
    614       DO jl = 1, ijpl 
     560      CALL blk_clio_qsr_ice( palb_cs, palb_os, qsr_ice ) 
     561       
     562      DO jl = 1, jpl 
    615563         palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(:,:,1) )   & 
    616564            &         +   palb_os(:,:,jl) * sf(jp_ccov)%fnow(:,:,1) ) 
     
    618566 
    619567      !                                     ! ========================== ! 
    620       DO jl = 1, ijpl                       !  Loop over ice categories  ! 
     568      DO jl = 1, jpl                       !  Loop over ice categories  ! 
    621569         !                                  ! ========================== ! 
    622570!CDIR NOVERRCHK 
     
    632580               ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) )  
    633581               ! 
    634                z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( pst(ji,jj,jl) - ztatm(ji,jj) ) )  
     582               z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) )  
    635583 
    636584               !---------------------------------------- 
     
    639587 
    640588               ! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential) 
    641                zesi =  611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( pst(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 ) ) 
    642590               ! humidity close to the ice surface (at saturation) 
    643591               zqsati   = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi ) 
    644592                
    645593               !  computation of intermediate values 
    646                zticemb  = pst(ji,jj,jl) - 7.66 
     594               zticemb  = ptsu(ji,jj,jl) - 7.66 
    647595               zticemb2 = zticemb * zticemb   
    648                ztice3   = pst(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) 
    649597               zdesidt  = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 )  / zticemb2 ) 
    650598                
     
    659607             
    660608               !  sensible heat flux 
    661                z_qsb(ji,jj,jl) = zrhovacshi * ( pst(ji,jj,jl) - ztatm(ji,jj) ) 
     609               z_qsb(ji,jj,jl) = zrhovacshi * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) 
    662610             
    663611               !  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) )  ) 
    665613               
    666614               !  sensitivity of non solar fluxes (dQ/dT) (long-wave, sensible and latent fluxes) 
     
    669617               zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) )    
    670618               ! 
    671                p_dqla(ji,jj,jl) = zdqla                           ! latent flux sensitivity 
    672                p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity 
     619               dqla_ice(ji,jj,jl) = zdqla                           ! latent flux sensitivity 
     620               dqns_ice(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity 
    673621            END DO 
    674622            ! 
     
    682630      ! 
    683631!CDIR COLLAPSE 
    684       p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:)      ! Downward Non Solar flux 
    685 !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] 
    687635      ! 
    688636      ! ----------------------------------------------------------------------------- ! 
     
    691639!CDIR COLLAPSE 
    692640      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 
    697681!!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, ijpl 
    701          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. ) 
    705689      END DO 
    706690 
    707691!!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 ) 
    714701 
    715702      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  : ') 
    721708      ENDIF 
    722709 
    723       CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 
    724       CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb ) 
    725       ! 
    726710      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio_flx') 
    727711      ! 
    728712   END SUBROUTINE blk_ice_clio_flx 
     713 
     714#endif 
    729715 
    730716   SUBROUTINE blk_clio_qsr_oce( pqsr_oce ) 
  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r5357 r5362  
    162162!!            IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
    163163!!               &                                           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 
    165165 
    166166         CASE( jp_core )                                       ! CORE bulk formulation 
     
    238238            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
    239239            ! (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 ) 
    244245            IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
    245246               &                                           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  
    185185         SELECT CASE( ksbc ) 
    186186         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 ) 
    192194 
    193195         CASE( jp_core )           ! CORE bulk formulation 
Note: See TracChangeset for help on using the changeset viewer.