New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 9910 – NEMO

Changeset 9910


Ignore:
Timestamp:
2018-07-10T12:33:32+02:00 (6 years ago)
Author:
clem
Message:

cosmetics mostly

Location:
NEMO/trunk/src
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/ICE/ice.F90

    r9604 r9910  
    270270 
    271271   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d     !: maximum ice concentration 2d array 
    272    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice        !: transmitted solar radiation under ice 
     272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_ice_bot    !: transmitted solar radiation under ice 
    273273   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t1_ice         !: temperature of the first layer (Jules coupling) [K] 
    274274   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   cnd_ice        !: effective conductivity at the top of ice/snow (Jules coupling) [W.m-2.K-1] 
     
    405405      ! * Ice global state variables 
    406406      ii = ii + 1 
    407       ALLOCATE( ftr_ice(jpi,jpj,jpl) , cnd_ice(jpi,jpj,jpl) , t1_ice(jpi,jpj,jpl) ,  & 
    408          &      h_i    (jpi,jpj,jpl) , a_i    (jpi,jpj,jpl) , v_i   (jpi,jpj,jpl) ,  & 
    409          &      v_s    (jpi,jpj,jpl) , h_s    (jpi,jpj,jpl) , t_su  (jpi,jpj,jpl) ,  & 
    410          &      s_i    (jpi,jpj,jpl) , sv_i   (jpi,jpj,jpl) , o_i   (jpi,jpj,jpl) ,  & 
    411          &      oa_i   (jpi,jpj,jpl) , bv_i   (jpi,jpj,jpl) , STAT=ierr(ii) ) 
     407      ALLOCATE( qtr_ice_bot(jpi,jpj,jpl) , cnd_ice(jpi,jpj,jpl) , t1_ice(jpi,jpj,jpl) ,  & 
     408         &      h_i        (jpi,jpj,jpl) , a_i    (jpi,jpj,jpl) , v_i   (jpi,jpj,jpl) ,  & 
     409         &      v_s        (jpi,jpj,jpl) , h_s    (jpi,jpj,jpl) , t_su  (jpi,jpj,jpl) ,  & 
     410         &      s_i        (jpi,jpj,jpl) , sv_i   (jpi,jpj,jpl) , o_i   (jpi,jpj,jpl) ,  & 
     411         &      oa_i       (jpi,jpj,jpl) , bv_i   (jpi,jpj,jpl) , STAT=ierr(ii) ) 
    412412 
    413413      ii = ii + 1 
  • NEMO/trunk/src/ICE/ice1d.F90

    r9750 r9910  
    3232 
    3333   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d      
    34    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftr_ice_1d    
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qtr_ice_bot_1d    
    3535   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d   
    3636   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qns_ice_1d   
     
    4040   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qml_ice_1d     !: heat available for snow / ice surface melting [W/m2]  
    4141   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qcn_ice_1d     !: heat available for snow / ice surface sublimation [W/m2]  
    42    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_tr_1d !: solar flux transmitted below the ice surface [W/m2]  
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qtr_ice_top_1d !: solar flux transmitted below the ice surface [W/m2]  
    4343   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t1_ice_1d      !: temperature of the 1st layer (Jules coupling) [K] 
    4444   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   cnd_ice_1d     !: conductivity at the top of ice/snow (Jules coupling) [W/K/m2] 
     
    182182      ii = 1 
    183183      ALLOCATE( nptidx    (jpij) ,   & 
    184          &      qlead_1d  (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d(jpij) ,   & 
    185          &      qns_ice_1d(jpij) , qml_ice_1d(jpij) , qcn_ice_1d(jpij) , qsr_ice_tr_1d(jpij) , & 
    186          &      cnd_ice_1d(jpij) , t1_ice_1d (jpij) , t_bo_1d   (jpij) ,   & 
    187          &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) , hfx_bog_1d(jpij) ,   &  
    188          &      hfx_dif_1d(jpij) , hfx_opw_1d(jpij) , hfx_dyn_1d(jpij) ,   & 
    189          &      rn_amax_1d(jpij) ,                                         & 
    190          &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) ,                      & 
    191          &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) ,                      & 
     184         &      qlead_1d  (jpij) , qtr_ice_bot_1d(jpij) , qsr_ice_1d(jpij) ,   & 
     185         &      qns_ice_1d(jpij) , qml_ice_1d    (jpij) , qcn_ice_1d(jpij) , qtr_ice_top_1d(jpij) , & 
     186         &      cnd_ice_1d(jpij) , t1_ice_1d     (jpij) , t_bo_1d   (jpij) ,   & 
     187         &      hfx_sum_1d(jpij) , hfx_bom_1d    (jpij) , hfx_bog_1d(jpij) ,   &  
     188         &      hfx_dif_1d(jpij) , hfx_opw_1d    (jpij) , hfx_dyn_1d(jpij) ,   & 
     189         &      rn_amax_1d(jpij) ,                                             & 
     190         &      hfx_thd_1d(jpij) , hfx_spr_1d    (jpij) ,                      & 
     191         &      hfx_snw_1d(jpij) , hfx_sub_1d    (jpij) ,                      & 
    192192         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , hfx_out_1d(jpij), STAT=ierr(ii) ) 
    193193      ! 
  • NEMO/trunk/src/ICE/icealb.F90

    r9604 r9910  
    1616   USE ice, ONLY: jpl ! sea-ice: number of categories 
    1717   USE phycst         ! physical constants 
     18   USE dom_oce        ! domain: ocean 
    1819   ! 
    1920   USE in_out_manager ! I/O manager 
     
    160161               ENDIF 
    161162               !                       !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions 
    162                palb_os(ji,jj,jl) = zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice 
     163               palb_os(ji,jj,jl) = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 
     164               ! 
     165               palb_cs(ji,jj,jl) = palb_os(ji,jj,jl)  & 
     166                  &                - ( - 0.1010 * palb_os(ji,jj,jl) * palb_os(ji,jj,jl)  & 
     167                  &                    + 0.1933 * palb_os(ji,jj,jl) - 0.0148 ) * tmask(ji,jj,1) 
    163168               ! 
    164169            END DO 
     
    166171      END DO 
    167172      ! 
    168       palb_cs(:,:,:) = palb_os(:,:,:) - ( - 0.1010 * palb_os(:,:,:) * palb_os(:,:,:) + 0.1933 * palb_os(:,:,:) - 0.0148 ) 
    169173      ! 
    170174      IF( ln_timing )   CALL timing_stop('icealb') 
  • NEMO/trunk/src/ICE/icethd.F90

    r9750 r9910  
    2020   USE sbc_oce , ONLY : sss_m, sst_m, e3t_m, utau, vtau, ssu_m, ssv_m, frq_m, qns_tot, qsr_tot, sprecip, ln_cpl 
    2121   USE sbc_ice , ONLY : qsr_oce, qns_oce, qemp_oce, qsr_ice, qns_ice, dqns_ice, evap_ice, qprec_ice, qevap_ice, & 
    22       &                 qml_ice, qcn_ice, qsr_ice_tr 
     22      &                 qml_ice, qcn_ice, qtr_ice_top 
    2323   USE ice1D          ! sea-ice: thermodynamics variables 
    2424   USE icethd_zdf     ! sea-ice: vertical heat diffusion 
     
    128128      CALL lbc_lnk( zfric, 'T',  1. ) 
    129129      ! 
    130       ftr_ice(:,:,:) = 0._wp  ! initialization (part of solar radiation transmitted through the ice) 
     130      qtr_ice_bot(:,:,:) = 0._wp  ! initialization (part of solar radiation transmitted through the ice) 
    131131 
    132132      !--------------------------------------------------------------------! 
     
    377377         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) ) 
    378378         ! 
    379          CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d(1:npti), qprec_ice        ) 
    380          CALL tab_2d_1d( npti, nptidx(1:npti), qsr_ice_1d  (1:npti), qsr_ice (:,:,kl) ) 
    381          CALL tab_2d_1d( npti, nptidx(1:npti), qns_ice_1d  (1:npti), qns_ice (:,:,kl) ) 
    382          CALL tab_2d_1d( npti, nptidx(1:npti), ftr_ice_1d  (1:npti), ftr_ice (:,:,kl) ) 
    383          CALL tab_2d_1d( npti, nptidx(1:npti), evap_ice_1d (1:npti), evap_ice(:,:,kl) ) 
    384          CALL tab_2d_1d( npti, nptidx(1:npti), dqns_ice_1d (1:npti), dqns_ice(:,:,kl) ) 
    385          CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d     (1:npti), t_bo             ) 
    386          CALL tab_2d_1d( npti, nptidx(1:npti), sprecip_1d  (1:npti), sprecip          )  
    387          CALL tab_2d_1d( npti, nptidx(1:npti), fhtur_1d    (1:npti), fhtur            ) 
    388          CALL tab_2d_1d( npti, nptidx(1:npti), fhld_1d     (1:npti), fhld             ) 
     379         CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d  (1:npti), qprec_ice            ) 
     380         CALL tab_2d_1d( npti, nptidx(1:npti), qsr_ice_1d    (1:npti), qsr_ice (:,:,kl)    ) 
     381         CALL tab_2d_1d( npti, nptidx(1:npti), qns_ice_1d    (1:npti), qns_ice (:,:,kl)    ) 
     382         CALL tab_2d_1d( npti, nptidx(1:npti), qtr_ice_bot_1d(1:npti), qtr_ice_bot (:,:,kl) ) 
     383         CALL tab_2d_1d( npti, nptidx(1:npti), evap_ice_1d   (1:npti), evap_ice(:,:,kl)    ) 
     384         CALL tab_2d_1d( npti, nptidx(1:npti), dqns_ice_1d   (1:npti), dqns_ice(:,:,kl)    ) 
     385         CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d       (1:npti), t_bo                 ) 
     386         CALL tab_2d_1d( npti, nptidx(1:npti), sprecip_1d    (1:npti), sprecip              )  
     387         CALL tab_2d_1d( npti, nptidx(1:npti), fhtur_1d      (1:npti), fhtur                ) 
     388         CALL tab_2d_1d( npti, nptidx(1:npti), fhld_1d       (1:npti), fhld                 ) 
    389389          
    390          CALL tab_2d_1d( npti, nptidx(1:npti), qml_ice_1d   (1:npti), qml_ice      (:,:,kl) ) 
    391          CALL tab_2d_1d( npti, nptidx(1:npti), qcn_ice_1d   (1:npti), qcn_ice      (:,:,kl) ) 
    392          CALL tab_2d_1d( npti, nptidx(1:npti), qsr_ice_tr_1d(1:npti), qsr_ice_tr   (:,:,kl) ) 
     390         CALL tab_2d_1d( npti, nptidx(1:npti), qml_ice_1d    (1:npti), qml_ice    (:,:,kl) ) 
     391         CALL tab_2d_1d( npti, nptidx(1:npti), qcn_ice_1d    (1:npti), qcn_ice    (:,:,kl) ) 
     392         CALL tab_2d_1d( npti, nptidx(1:npti), qtr_ice_top_1d(1:npti), qtr_ice_top(:,:,kl) ) 
    393393         ! 
    394394         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni   ) 
     
    417417         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_lam_1d (1:npti), sfx_lam          ) 
    418418         ! 
    419          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_thd_1d (1:npti), hfx_thd          ) 
    420          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_spr_1d (1:npti), hfx_spr          ) 
    421          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_sum_1d (1:npti), hfx_sum          ) 
    422          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_bom_1d (1:npti), hfx_bom          ) 
    423          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_bog_1d (1:npti), hfx_bog          ) 
    424          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_dif_1d (1:npti), hfx_dif          ) 
    425          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_opw_1d (1:npti), hfx_opw          ) 
    426          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_snw_1d (1:npti), hfx_snw          ) 
    427          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_sub_1d (1:npti), hfx_sub          ) 
    428          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_res_1d (1:npti), hfx_res          ) 
     419         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_thd_1d    (1:npti), hfx_thd       ) 
     420         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_spr_1d    (1:npti), hfx_spr       ) 
     421         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_sum_1d    (1:npti), hfx_sum       ) 
     422         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_bom_1d    (1:npti), hfx_bom       ) 
     423         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_bog_1d    (1:npti), hfx_bog       ) 
     424         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_dif_1d    (1:npti), hfx_dif       ) 
     425         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_opw_1d    (1:npti), hfx_opw       ) 
     426         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_snw_1d    (1:npti), hfx_snw       ) 
     427         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_sub_1d    (1:npti), hfx_sub       ) 
     428         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_res_1d    (1:npti), hfx_res       ) 
    429429         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif   ) 
    430430         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem   ) 
    431          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_out_1d (1:npti), hfx_out          ) 
     431         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_out_1d    (1:npti), hfx_out       ) 
    432432         ! 
    433433         ! SIMIP diagnostics 
    434          CALL tab_2d_1d( npti, nptidx(1:npti), diag_fc_bo_1d(1:npti), diag_fc_bo   ) 
    435          CALL tab_2d_1d( npti, nptidx(1:npti), diag_fc_su_1d(1:npti), diag_fc_su   ) 
     434         CALL tab_2d_1d( npti, nptidx(1:npti), diag_fc_bo_1d(1:npti), diag_fc_bo ) 
     435         CALL tab_2d_1d( npti, nptidx(1:npti), diag_fc_su_1d(1:npti), diag_fc_su ) 
    436436         ! ocean surface fields 
    437437         CALL tab_2d_1d( npti, nptidx(1:npti), sst_1d(1:npti), sst_m ) 
     
    521521         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_out_1d (1:npti), hfx_out        ) 
    522522         ! 
    523          CALL tab_1d_2d( npti, nptidx(1:npti), qns_ice_1d(1:npti), qns_ice(:,:,kl) ) 
    524          CALL tab_1d_2d( npti, nptidx(1:npti), ftr_ice_1d(1:npti), ftr_ice(:,:,kl) ) 
     523         CALL tab_1d_2d( npti, nptidx(1:npti), qns_ice_1d    (1:npti), qns_ice    (:,:,kl) ) 
     524         CALL tab_1d_2d( npti, nptidx(1:npti), qtr_ice_bot_1d(1:npti), qtr_ice_bot(:,:,kl) ) 
    525525         ! effective conductivity and 1st layer temperature (for Jules coupling) 
    526526         CALL tab_1d_2d( npti, nptidx(1:npti), cnd_ice_1d(1:npti), cnd_ice(:,:,kl) ) 
  • NEMO/trunk/src/ICE/icethd_dh.F90

    r9767 r9910  
    137137         ! 
    138138         DO ji = 1, npti 
    139             zdum           = qns_ice_1d(ji) + qsr_ice_1d(ji) - qsr_ice_tr_1d(ji) - fc_su(ji) 
     139            zdum           = qns_ice_1d(ji) + qsr_ice_1d(ji) - qtr_ice_top_1d(ji) - fc_su(ji) 
    140140            qml_ice_1d(ji) = zdum * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) ) 
    141141            zq_su(ji)      = MAX( 0._wp, qml_ice_1d(ji) * rdt_ice ) 
     
    145145         ! 
    146146         DO ji = 1, npti 
    147             zdum           = qns_ice_1d(ji) + qsr_ice_1d(ji) - qsr_ice_tr_1d(ji) - fc_su(ji)  
     147            zdum           = qns_ice_1d(ji) + qsr_ice_1d(ji) - qtr_ice_top_1d(ji) - fc_su(ji)  
    148148            qml_ice_1d(ji) = zdum * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) ) 
    149149            zq_su(ji)      = MAX( 0._wp, qml_ice_1d(ji) * rdt_ice ) 
  • NEMO/trunk/src/ICE/icethd_zdf_bl99.F90

    r9656 r9910  
    178178      !------------- 
    179179      ! --- Transmission/absorption of solar radiation in the ice --- ! 
    180       zradtr_s(1:npti,0) = qsr_ice_tr_1d(1:npti) 
     180      zradtr_s(1:npti,0) = qtr_ice_top_1d(1:npti) 
    181181      DO jk = 1, nlay_s 
    182182         DO ji = 1, npti 
     
    188188      END DO 
    189189      ! 
    190       zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * isnow(1:npti) + qsr_ice_tr_1d(1:npti) * ( 1._wp - isnow(1:npti) ) 
     190      zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * isnow(1:npti) + qtr_ice_top_1d(1:npti) * ( 1._wp - isnow(1:npti) ) 
    191191      DO jk = 1, nlay_i  
    192192         DO ji = 1, npti 
     
    198198      END DO 
    199199      ! 
    200       ftr_ice_1d(1:npti) = zradtr_i(1:npti,nlay_i)   ! record radiation transmitted below the ice 
     200      qtr_ice_bot_1d(1:npti) = zradtr_i(1:npti,nlay_i)   ! record radiation transmitted below the ice 
    201201      ! 
    202202      iconv    = 0          ! number of iterations 
     
    330330 
    331331            DO ji = 1, npti 
    332                zfnet(ji) = qsr_ice_1d(ji) - qsr_ice_tr_1d(ji) + qns_ice_1d(ji) ! net heat flux = net - transmitted solar + non solar 
     332               zfnet(ji) = qsr_ice_1d(ji) - qtr_ice_top_1d(ji) + qns_ice_1d(ji) ! net heat flux = net - transmitted solar + non solar 
    333333            END DO 
    334334            ! 
     
    770770                
    771771               IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC 
    772                   zhfx_err = ( qns_ice_1d(ji) + qsr_ice_1d(ji)    - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice )*a_i_1d(ji) 
     772                  zhfx_err = (qns_ice_1d(ji) + qsr_ice_1d(ji)     - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice)*a_i_1d(ji) 
    773773               ELSE                          ! case T_su = 0degC 
    774                   zhfx_err = ( fc_su(ji)      + qsr_ice_tr_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice )*a_i_1d(ji) 
     774                  zhfx_err = (fc_su(ji)      + qtr_ice_top_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice)*a_i_1d(ji) 
    775775               ENDIF 
    776776                
    777777            ELSEIF( k_jules == np_jules_ACTIVE ) THEN 
    778778             
    779                zhfx_err = ( fc_su(ji) + qsr_ice_tr_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice ) * a_i_1d(ji) 
     779               zhfx_err = ( fc_su(ji) + qtr_ice_top_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice ) * a_i_1d(ji) 
    780780             
    781781            ENDIF 
  • NEMO/trunk/src/ICE/iceupdate.F90

    r9784 r9910  
    107107      ! --- case we bypass ice thermodynamics --- ! 
    108108      IF( .NOT. ln_icethd ) THEN   ! we suppose ice is impermeable => ocean is isolated from atmosphere 
    109          hfx_in   (:,:)   = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 
    110          hfx_out  (:,:)   = ( 1._wp - at_i_b(:,:) ) *   qns_oce(:,:)                  + qemp_oce(:,:) 
    111          ftr_ice  (:,:,:) = 0._wp 
    112          emp_ice  (:,:)   = 0._wp 
    113          qemp_ice (:,:)   = 0._wp 
    114          qevap_ice(:,:,:) = 0._wp 
     109         hfx_in     (:,:)   = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 
     110         hfx_out    (:,:)   = ( 1._wp - at_i_b(:,:) ) *   qns_oce(:,:)                  + qemp_oce(:,:) 
     111         qtr_ice_bot(:,:,:) = 0._wp 
     112         emp_ice    (:,:)   = 0._wp 
     113         qemp_ice   (:,:)   = 0._wp 
     114         qevap_ice  (:,:,:) = 0._wp 
    115115      ENDIF 
    116116       
     
    120120            ! Solar heat flux reaching the ocean = zqsr (W.m-2)  
    121121            !--------------------------------------------------- 
    122             zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - ftr_ice(ji,jj,:) ) ) 
     122            zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) ) 
    123123 
    124124            ! Total heat flux reaching the ocean = hfx_out (W.m-2)  
     
    250250      IF( iom_use('qsr_ice'    ) )   CALL iom_put( "qsr_ice"    , SUM( qsr_ice * a_i_b, dim=3 )                              )   !     solar flux at ice surface 
    251251      IF( iom_use('qns_ice'    ) )   CALL iom_put( "qns_ice"    , SUM( qns_ice * a_i_b, dim=3 ) + qemp_ice                   )   ! non-solar flux at ice surface 
    252       IF( iom_use('qtr_ice_bot') )   CALL iom_put( "qtr_ice_bot", SUM( ftr_ice * a_i_b, dim=3 )                              )   !     solar flux transmitted thru ice 
    253       IF( iom_use('qtr_ice_top') )   CALL iom_put( "qtr_ice_top", SUM( qsr_ice_tr * a_i_b, dim=3 )                           )   !     solar flux transmitted thru ice surface 
     252      IF( iom_use('qtr_ice_bot') )   CALL iom_put( "qtr_ice_bot", SUM( qtr_ice_bot * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice 
     253      IF( iom_use('qtr_ice_top') )   CALL iom_put( "qtr_ice_top", SUM( qtr_ice_top * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice surface 
    254254      IF( iom_use('qt_oce'     ) )   CALL iom_put( "qt_oce"     ,      ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce ) 
    255255      IF( iom_use('qt_ice'     ) )   CALL iom_put( "qt_ice"     , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 )     + qemp_ice ) 
  • NEMO/trunk/src/OCE/SBC/sbc_ice.F90

    r9767 r9910  
    4949   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qml_ice        !: heat available for snow / ice surface melting     [W/m2]  
    5050   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice        !: heat conduction flux in the layer below surface   [W/m2]  
    51    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice_tr     !: solar flux transmitted below the ice surface      [W/m2] 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_ice_top    !: solar flux transmitted below the ice surface      [W/m2] 
    5252 
    5353   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   utau_ice       !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
     
    126126      ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice  (jpi,jpj,jpl) ,     & 
    127127         &      qla_ice (jpi,jpj,jpl) , dqla_ice (jpi,jpj,jpl) ,     & 
    128          &      dqns_ice(jpi,jpj,jpl) , tn_ice   (jpi,jpj,jpl) , alb_ice   (jpi,jpj,jpl) ,   & 
    129          &      qml_ice (jpi,jpj,jpl) , qcn_ice  (jpi,jpj,jpl) , qsr_ice_tr(jpi,jpj,jpl) ,   & 
    130          &      utau_ice(jpi,jpj)     , vtau_ice (jpi,jpj)     , wndm_ice  (jpi,jpj)     ,   & 
    131          &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice (jpi,jpj)     ,   & 
    132          &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce  (jpi,jpj)     ,   & 
    133          &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce   (jpi,jpj)     ,   & 
    134          &      emp_ice (jpi,jpj)     , tsfc_ice (jpi,jpj,jpl) , sstfrz    (jpi,jpj)     , STAT= ierr(2) ) 
     128         &      dqns_ice(jpi,jpj,jpl) , tn_ice   (jpi,jpj,jpl) , alb_ice    (jpi,jpj,jpl) ,   & 
     129         &      qml_ice (jpi,jpj,jpl) , qcn_ice  (jpi,jpj,jpl) , qtr_ice_top(jpi,jpj,jpl) ,   & 
     130         &      utau_ice(jpi,jpj)     , vtau_ice (jpi,jpj)     , wndm_ice   (jpi,jpj)     ,   & 
     131         &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice  (jpi,jpj)     ,   & 
     132         &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce   (jpi,jpj)     ,   & 
     133         &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce    (jpi,jpj)     ,   & 
     134         &      emp_ice (jpi,jpj)     , tsfc_ice (jpi,jpj,jpl) , sstfrz     (jpi,jpj)     , STAT= ierr(2) ) 
    135135#endif 
    136136 
  • NEMO/trunk/src/OCE/SBC/sbcblk.F90

    r9767 r9910  
    907907      ! 
    908908      WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
    909          qsr_ice_tr(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
     909         qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    910910      ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm 
    911          qsr_ice_tr(:,:,:) = qsr_ice(:,:,:) * zfr1 
     911         qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 
    912912      ELSEWHERE                                                         ! zero when hs>0 
    913          qsr_ice_tr(:,:,:) = 0._wp  
     913         qtr_ice_top(:,:,:) = 0._wp  
    914914      END WHERE 
    915915      ! 
     
    10001000               ztsu    = ptsu(ji,jj,jl)                                                ! Store current iteration temperature 
    10011001               ztsu0   = ptsu(ji,jj,jl)                                                ! Store initial surface temperature 
    1002                zqa0    = qsr_ice(ji,jj,jl) - qsr_ice_tr(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux 
     1002               zqa0    = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux 
    10031003               ! 
    10041004               DO iter = 1, nit     ! --- Iterative loop 
     
    10111011               qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) ) 
    10121012               qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) 
    1013                qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qsr_ice_tr(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) )   & 
     1013               qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) )  & 
    10141014                             &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) ) 
    10151015 
  • NEMO/trunk/src/OCE/SBC/sbccpl.F90

    r9872 r9910  
    20122012         ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice    ! surface transmission parameter (Grenfell Maykut 77) 
    20132013         ! 
    2014          qsr_ice_tr(:,:,:) = ztri * qsr_ice(:,:,:) 
    2015          WHERE( phs(:,:,:) >= 0.0_wp )   qsr_ice_tr(:,:,:) = 0._wp            ! snow fully opaque 
    2016          WHERE( phi(:,:,:) <= 0.1_wp )   qsr_ice_tr(:,:,:) = qsr_ice(:,:,:)   ! thin ice transmits all solar radiation 
     2014         qtr_ice_top(:,:,:) = ztri * qsr_ice(:,:,:) 
     2015         WHERE( phs(:,:,:) >= 0.0_wp )   qtr_ice_top(:,:,:) = 0._wp            ! snow fully opaque 
     2016         WHERE( phi(:,:,:) <= 0.1_wp )   qtr_ice_top(:,:,:) = qsr_ice(:,:,:)   ! thin ice transmits all solar radiation 
    20172017         !      
    20182018      CASE( np_jules_ACTIVE )       !==  Jules coupler is active  ==! 
    20192019         ! 
    2020          !                    ! ===> here we must receive the qsr_ice_tr array from the coupler 
     2020         !                    ! ===> here we must receive the qtr_ice_top array from the coupler 
    20212021         !                           for now just assume zero (fully opaque ice) 
    2022          qsr_ice_tr(:,:,:) = 0._wp 
     2022         qtr_ice_top(:,:,:) = 0._wp 
    20232023         ! 
    20242024      END SELECT 
Note: See TracChangeset for help on using the changeset viewer.