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 5630 for branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90 – NEMO

Ignore:
Timestamp:
2015-07-23T18:05:51+02:00 (9 years ago)
Author:
dancopsey
Message:

Merged in revision 5518 of the trunk.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r5500 r5630  
    2222   USE phycst         ! physical constants 
    2323   USE dom_oce        ! ocean space and time domain variables 
    24    USE oce     , ONLY : fraqsr_1lev  
    2524   USE ice            ! LIM: sea-ice variables 
    2625   USE sbc_oce        ! Surface boundary condition: ocean fields 
     
    2827   USE thd_ice        ! LIM thermodynamic sea-ice variables 
    2928   USE dom_ice        ! LIM sea-ice domain 
    30    USE domvvl         ! domain: variable volume level 
    3129   USE limthd_dif     ! LIM: thermodynamics, vertical diffusion 
    3230   USE limthd_dh      ! LIM: thermodynamics, ice and snow thickness variation 
     
    5048   PRIVATE 
    5149 
    52    PUBLIC   lim_thd        ! called by limstp module 
    53    PUBLIC   lim_thd_init   ! called by sbc_lim_init 
     50   PUBLIC   lim_thd         ! called by limstp module 
     51   PUBLIC   lim_thd_init    ! called by sbc_lim_init 
    5452 
    5553   !! * Substitutions 
     
    9290      REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient 
    9391      ! 
    94       REAL(wp), POINTER, DIMENSION(:,:) ::  zqsr, zqns 
    9592      !!------------------------------------------------------------------- 
    96       CALL wrk_alloc( jpi,jpj, zqsr, zqns ) 
    9793 
    9894      IF( nn_timing == 1 )  CALL timing_start('limthd') 
     
    136132      ! 2) Partial computation of forcing for the thermodynamic sea ice model.      ! 
    137133      !-----------------------------------------------------------------------------! 
    138  
    139       !--- Ocean solar and non solar fluxes to be used in zqld 
    140       IF ( .NOT. lk_cpl ) THEN   ! --- forced case, fluxes to the lead are the same as over the ocean 
    141          ! 
    142          zqsr(:,:) = qsr(:,:)      ; zqns(:,:) = qns(:,:) 
    143          ! 
    144       ELSE                       ! --- coupled case, fluxes to the lead are total - intercepted 
    145          ! 
    146          zqsr(:,:) = qsr_tot(:,:)  ; zqns(:,:) = qns_tot(:,:) 
    147          ! 
    148          DO jl = 1, jpl 
    149             DO jj = 1, jpj 
    150                DO ji = 1, jpi 
    151                   zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * a_i_b(ji,jj,jl) 
    152                   zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * a_i_b(ji,jj,jl) 
    153                END DO 
    154             END DO 
    155          END DO 
    156          ! 
    157       ENDIF 
    158  
    159134      DO jj = 1, jpj 
    160135         DO ji = 1, jpi 
     
    167142            !           !  temperature and turbulent mixing (McPhee, 1992) 
    168143            ! 
    169  
    170144            ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 
    171             ! REMARK valid at least in forced mode from clem 
    172             ! precip is included in qns but not in qns_ice 
    173             IF ( lk_cpl ) THEN 
    174                zqld =  tmask(ji,jj,1) * rdt_ice *  & 
    175                   &    (   zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj)               &   ! pfrld already included in coupled mode 
    176                   &    + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *     &   ! heat content of precip 
    177                   &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus )   & 
    178                   &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) ) 
    179             ELSE 
    180                zqld =  tmask(ji,jj,1) * rdt_ice *  & 
    181                   &      ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) )    & 
    182                   &    + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *             &  ! heat content of precip 
    183                   &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus )           & 
    184                   &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) ) 
    185             ENDIF 
     145            zqld =  tmask(ji,jj,1) * rdt_ice *  & 
     146               &    ( pfrld(ji,jj) * qsr_oce(ji,jj) * frq_m(ji,jj) + pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 
    186147 
    187148            ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
     
    210171            ! Net heat flux on top of ice-ocean [W.m-2] 
    211172            ! ----------------------------------------- 
    212             !     heat flux at the ocean surface + precip 
    213             !   + heat flux at the ice   surface  
    214             hfx_in(ji,jj) = hfx_in(ji,jj)                                                                                         &  
    215                ! heat flux above the ocean 
    216                &    +             pfrld(ji,jj)   * ( zqns(ji,jj) + zqsr(ji,jj) )                                                  & 
    217                ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
    218                &    +   ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus )  & 
    219                &    +   ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 )          & 
    220                ! heat flux above the ice 
    221                &    +   SUM(    a_i_b(ji,jj,:)   * ( qns_ice(ji,jj,:) + qsr_ice(ji,jj,:) ) ) 
     173            hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)  
    222174 
    223175            ! ----------------------------------------------------------------------------- 
    224             ! Net heat flux that is retroceded to the ocean or taken from the ocean [W.m-2] 
     176            ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 
    225177            ! ----------------------------------------------------------------------------- 
    226178            !     First  step here              :  non solar + precip - qlead - qturb 
    227179            !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema)  
    228180            !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar 
    229             hfx_out(ji,jj) = hfx_out(ji,jj)                                                                                       &  
    230                ! Non solar heat flux received by the ocean 
    231                &    +        pfrld(ji,jj) * zqns(ji,jj)                                                                            & 
    232                ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
    233                &    +      ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj)       & 
    234                &         * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus )  & 
    235                &    +      ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 )       & 
    236                ! heat flux taken from the ocean where there is open water ice formation 
    237                &    -      qlead(ji,jj) * r1_rdtice                                                                               & 
    238                ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth) 
    239                &    -      at_i(ji,jj) * fhtur(ji,jj)                                                                             & 
    240                &    -      at_i(ji,jj) *  fhld(ji,jj) 
    241  
     181            hfx_out(ji,jj) =   pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj)  &  ! Non solar heat flux received by the ocean                
     182               &             - qlead(ji,jj) * r1_rdtice                         &  ! heat flux taken from the ocean where there is open water ice formation 
     183               &             - at_i(ji,jj) * fhtur(ji,jj)                       &  ! heat flux taken by turbulence 
     184               &             - at_i(ji,jj) *  fhld(ji,jj)                          ! heat flux taken during bottom growth/melt  
     185                                                                                   !    (fhld should be 0 while bott growth) 
    242186         END DO 
    243187      END DO 
     
    412356      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    413357 
    414       CALL wrk_dealloc( jpi,jpj, zqsr, zqns ) 
    415  
    416358      !------------------------------------------------------------------------------| 
    417359      !  6) Transport of ice between thickness categories.                           | 
     
    472414   END SUBROUTINE lim_thd  
    473415 
     416  
    474417   SUBROUTINE lim_thd_temp( kideb, kiut ) 
    475418      !!----------------------------------------------------------------------- 
     
    570513         END DO 
    571514          
    572          CALL tab_2d_1d( nbpb, tatm_ice_1d(1:nbpb), tatm_ice(:,:)  , jpi, jpj, npb(1:nbpb) ) 
     515         CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 
    573516         CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    574517         CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) ) 
     
    576519         CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    577520         CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    578          IF( .NOT. lk_cpl ) THEN 
    579             CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    580             CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    581          ENDIF 
     521         CALL tab_2d_1d( nbpb, evap_ice_1d (1:nbpb), evap_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    582522         CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    583523         CALL tab_2d_1d( nbpb, t_bo_1d     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) ) 
     
    670610         CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 
    671611         CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 
    672                    
     612         !          
    673613      END SELECT 
    674614 
Note: See TracChangeset for help on using the changeset viewer.