ecearth3/sources/nemo-3.6/NEMO/LIM_SRC_3/thd_ice.F90

MODULE thd_ice
   !!======================================================================
   !!                       ***  MODULE thd_ice  ***
   !! LIM sea-ice :   Ice thermodynamics in 1D
   !!=====================================================================
   !! History :  3.0  !  2002-11  (C. Ethe)  F90: Free form and module
   !!----------------------------------------------------------------------
   USE in_out_manager ! I/O manager
   USE lib_mpp        ! MPP library
   USE ice, ONLY :   nlay_i, nlay_s

   IMPLICIT NONE
   PRIVATE

   PUBLIC thd_ice_alloc ! Routine called by nemogcm.F90

   !!---------------------------
   !! * Share Module variables
   !!---------------------------
   !                               !!! ** ice-thermo namelist (namicethd) **
   REAL(wp), PUBLIC ::   rn_himin    !: minimum ice thickness
   REAL(wp), PUBLIC ::   rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom
   REAL(wp), PUBLIC ::   rn_vfrazb   !: threshold drift speed for collection of bottom frazil ice
   REAL(wp), PUBLIC ::   rn_Cfrazb   !: squeezing coefficient for collection of bottom frazil ice
   REAL(wp), PUBLIC ::   rn_hnewice  !: thickness for new ice formation (m)

   LOGICAL , PUBLIC ::   ln_frazil   !: use of frazil ice collection as function of wind (T) or not (F)

   !!-----------------------------
   !! * Share 1D Module variables
   !!-----------------------------
   !: In ice thermodynamics, to spare memory, the vectors are folded
   !: from 1D to 2D vectors. The following variables, with ending _1d
   !: are the variables corresponding to 2d vectors

   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npb    !: address vector for 1d vertical thermo computations
   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nplm   !: address vector for mono-category lateral melting
   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: address vector for new ice formation

   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d     
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftr_ice_1d   
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d  
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d   
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d   
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qns_ice_1d  
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_1d     
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rn_amax_1d

   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sum_1d
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_bom_1d
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_bog_1d
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_dif_1d
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_opw_1d
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_snw_1d
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_1d
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_dif_1d

   ! heat flux associated with ice-atmosphere mass exchange
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sub_1d
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_spr_1d

   ! heat flux associated with ice-ocean mass exchange
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_thd_1d
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_res_1d

   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_snw_1d 
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sub_1d

   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bog_1d    
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bom_1d   
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sum_1d  
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sni_1d 
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_opw_1d
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_res_1d 
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_spr_1d

   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bog_1d    
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bom_1d    
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sum_1d    
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sni_1d    
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_opw_1d   
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_res_1d  

   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sub_1d

   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d    !: <==> the 2D  sprecip
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   frld_1d       !: <==> the 2D  frld
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_1d        !: <==> the 2D  at_i
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhtur_1d      !: <==> the 2D  fhtur
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhld_1d       !: <==> the 2D  fhld
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   evap_ice_1d   !: <==> the 2D  evap_ice
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qprec_ice_1d  !: <==> the 2D  qprec_ice
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qevap_ice_1d  !: <==> the 3D  qevap_ice
   !                                                     ! to reintegrate longwave flux inside the ice thermodynamics
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_fl_1d   !: Ice salinity variations due to flushing
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_gd_1d   !: Ice salinity variations due to gravity drainage
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_se_1d   !: Ice salinity variations due to basal salt entrapment
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_si_1d   !: Ice salinity variations due to lateral accretion    
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hicol_1d      !: Ice collection thickness accumulated in leads

   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_1d       !: <==> the 2D  t_su
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_1d        !: <==> the 2D  a_i
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_i_1d       !: <==> the 2D  ht_s
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_s_1d       !: <==> the 2D  ht_i
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_su         !: Surface Conduction flux 
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_bo_i       !: Bottom  Conduction flux 
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot      !: Snow accretion/ablation        [m]
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf     !: Ice surface accretion/ablation [m]
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_sub      !: Ice surface sublimation [m]
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott     !: Ice bottom accretion/ablation  [m]
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice    !: Snow ice formation             [m of ice]
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sm_i_1d       !: Ice bulk salinity [ppt]
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new       !: Salinity of new ice at the bottom

   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_1d   !: corresponding to the 2D var  t_s
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_1d   !: corresponding to the 2D var  t_i
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s_i_1d   !: profiled ice salinity
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_1d   !:    Ice  enthalpy per unit volume
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_s_1d   !:    Snow enthalpy per unit volume

   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qh_i_old !: ice heat content (q*h, J.m-2)
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_old  !: ice thickness layer (m)

   INTEGER , PUBLIC ::   jiindex_1d   ! 1D index of debugging point

   !!----------------------------------------------------------------------
   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
   !! $Id: thd_ice.F90 4990 2014-12-15 16:42:49Z timgraham $
   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
   !!----------------------------------------------------------------------
CONTAINS

   FUNCTION thd_ice_alloc()
      !!---------------------------------------------------------------------!
      !!                ***  ROUTINE thd_ice_alloc ***
      !!---------------------------------------------------------------------!
      INTEGER ::   thd_ice_alloc   ! return value
      INTEGER ::   ierr(3)
      !!---------------------------------------------------------------------!

      ALLOCATE( npb      (jpij) , nplm      (jpij) , npac       (jpij) ,   &
         &      qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) ,   &
         &      fr1_i0_1d(jpij) , fr2_i0_1d (jpij) , qns_ice_1d(jpij)  ,   &
         &      t_bo_1d   (jpij) ,                                         &
         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,    & 
         &      hfx_dif_1d(jpij) , hfx_opw_1d(jpij) ,                      &
         &      rn_amax_1d(jpij) ,                                         &
         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) ,                      &
         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) ,   &
         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(1) )
#if defined key_init_alloc_zero
      npb = 0
      nplm = 0
      npac = 0
      qlead_1d = 0
      ftr_ice_1d = 0
      qsr_ice_1d = 0
      fr1_i0_1d = 0
      fr2_i0_1d = 0
      qns_ice_1d = 0
      t_bo_1d = 0
      hfx_sum_1d = 0
      hfx_bom_1d = 0
      hfx_bog_1d = 0
      hfx_dif_1d = 0
      hfx_opw_1d = 0
      rn_amax_1d = 0
      hfx_thd_1d = 0
      hfx_spr_1d = 0
      hfx_snw_1d = 0
      hfx_sub_1d = 0
      hfx_err_1d = 0
      hfx_res_1d = 0
      hfx_err_rem_1d = 0
      hfx_err_dif_1d = 0
#elif defined key_init_alloc_huge
      npb = HUGE(npb)
      nplm = HUGE(nplm)
      npac = HUGE(npac)
      qlead_1d = HUGE(qlead_1d)
      ftr_ice_1d = HUGE(ftr_ice_1d)
      qsr_ice_1d = HUGE(qsr_ice_1d)
      fr1_i0_1d = HUGE(fr1_i0_1d)
      fr2_i0_1d = HUGE(fr2_i0_1d)
      qns_ice_1d = HUGE(qns_ice_1d)
      t_bo_1d = HUGE(t_bo_1d)
      hfx_sum_1d = HUGE(hfx_sum_1d)
      hfx_bom_1d = HUGE(hfx_bom_1d)
      hfx_bog_1d = HUGE(hfx_bog_1d)
      hfx_dif_1d = HUGE(hfx_dif_1d)
      hfx_opw_1d = HUGE(hfx_opw_1d)
      rn_amax_1d = HUGE(rn_amax_1d)
      hfx_thd_1d = HUGE(hfx_thd_1d)
      hfx_spr_1d = HUGE(hfx_spr_1d)
      hfx_snw_1d = HUGE(hfx_snw_1d)
      hfx_sub_1d = HUGE(hfx_sub_1d)
      hfx_err_1d = HUGE(hfx_err_1d)
      hfx_res_1d = HUGE(hfx_res_1d)
      hfx_err_rem_1d = HUGE(hfx_err_rem_1d)
      hfx_err_dif_1d = HUGE(hfx_err_dif_1d)
#endif
      !
      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_1d    (jpij) ,                     &
         &      fhtur_1d   (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,                     &
         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d(jpij) ,  &
         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) ,  &
         &      dqns_ice_1d(jpij) , evap_ice_1d (jpij),                                         &
         &      qprec_ice_1d(jpij), qevap_ice_1d(jpij), i0         (jpij) ,                     &  
         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij),  &
         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , sfx_sub_1d (jpij),  &
         &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,                     &     
         &      dsm_i_si_1d(jpij) , hicol_1d    (jpij)                     , STAT=ierr(2) )
#if defined key_init_alloc_zero
      sprecip_1d = 0
      frld_1d = 0
      at_i_1d = 0
      fhtur_1d = 0
      wfx_snw_1d = 0
      wfx_spr_1d = 0
      fhld_1d = 0
      wfx_sub_1d = 0
      wfx_bog_1d = 0
      wfx_bom_1d = 0
      wfx_sum_1d = 0
      wfx_sni_1d = 0
      wfx_opw_1d = 0
      wfx_res_1d = 0
      dqns_ice_1d = 0
      evap_ice_1d = 0
      qprec_ice_1d = 0
      qevap_ice_1d = 0
      i0 = 0
      sfx_bri_1d = 0
      sfx_bog_1d = 0
      sfx_bom_1d = 0
      sfx_sum_1d = 0
      sfx_sni_1d = 0
      sfx_opw_1d = 0
      sfx_res_1d = 0
      sfx_sub_1d = 0
      dsm_i_fl_1d = 0
      dsm_i_gd_1d = 0
      dsm_i_se_1d = 0
      dsm_i_si_1d = 0
      hicol_1d = 0
#elif defined key_init_alloc_huge
      sprecip_1d = HUGE(sprecip_1d)
      frld_1d = HUGE(frld_1d)
      at_i_1d = HUGE(at_i_1d)
      fhtur_1d = HUGE(fhtur_1d)
      wfx_snw_1d = HUGE(wfx_snw_1d)
      wfx_spr_1d = HUGE(wfx_spr_1d)
      fhld_1d = HUGE(fhld_1d)
      wfx_sub_1d = HUGE(wfx_sub_1d)
      wfx_bog_1d = HUGE(wfx_bog_1d)
      wfx_bom_1d = HUGE(wfx_bom_1d)
      wfx_sum_1d = HUGE(wfx_sum_1d)
      wfx_sni_1d = HUGE(wfx_sni_1d)
      wfx_opw_1d = HUGE(wfx_opw_1d)
      wfx_res_1d = HUGE(wfx_res_1d)
      dqns_ice_1d = HUGE(dqns_ice_1d)
      evap_ice_1d = HUGE(evap_ice_1d)
      qprec_ice_1d = HUGE(qprec_ice_1d)
      qevap_ice_1d = HUGE(qevap_ice_1d)
      i0 = HUGE(i0)
      sfx_bri_1d = HUGE(sfx_bri_1d)
      sfx_bog_1d = HUGE(sfx_bog_1d)
      sfx_bom_1d = HUGE(sfx_bom_1d)
      sfx_sum_1d = HUGE(sfx_sum_1d)
      sfx_sni_1d = HUGE(sfx_sni_1d)
      sfx_opw_1d = HUGE(sfx_opw_1d)
      sfx_res_1d = HUGE(sfx_res_1d)
      sfx_sub_1d = HUGE(sfx_sub_1d)
      dsm_i_fl_1d = HUGE(dsm_i_fl_1d)
      dsm_i_gd_1d = HUGE(dsm_i_gd_1d)
      dsm_i_se_1d = HUGE(dsm_i_se_1d)
      dsm_i_si_1d = HUGE(dsm_i_si_1d)
      hicol_1d = HUGE(hicol_1d)
#endif
      !
      ALLOCATE( t_su_1d   (jpij) , a_i_1d   (jpij) , ht_i_1d  (jpij) ,    &   
         &      ht_s_1d   (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &    
         &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_sub (jpij) ,    &    
         &      dh_i_bott (jpij) ,dh_snowice(jpij) , sm_i_1d  (jpij) , s_i_new  (jpij) ,    &
         &      t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) ,  &            
         &      q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) ,                        &
         &      qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3))
#if defined key_init_alloc_zero
      t_su_1d = 0
      a_i_1d = 0
      ht_i_1d = 0
      ht_s_1d = 0
      fc_su = 0
      fc_bo_i = 0
      dh_s_tot = 0
      dh_i_surf = 0
      dh_i_sub = 0
      dh_i_bott = 0
      dh_snowice = 0
      sm_i_1d = 0
      s_i_new = 0
      t_s_1d = 0
      t_i_1d = 0
      s_i_1d = 0
      q_i_1d = 0
      q_s_1d = 0
      qh_i_old = 0
      h_i_old = 0
#elif defined key_init_alloc_huge
      t_su_1d = HUGE(t_su_1d)
      a_i_1d = HUGE(a_i_1d)
      ht_i_1d = HUGE(ht_i_1d)
      ht_s_1d = HUGE(ht_s_1d)
      fc_su = HUGE(fc_su)
      fc_bo_i = HUGE(fc_bo_i)
      dh_s_tot = HUGE(dh_s_tot)
      dh_i_surf = HUGE(dh_i_surf)
      dh_i_sub = HUGE(dh_i_sub)
      dh_i_bott = HUGE(dh_i_bott)
      dh_snowice = HUGE(dh_snowice)
      sm_i_1d = HUGE(sm_i_1d)
      s_i_new = HUGE(s_i_new)
      t_s_1d = HUGE(t_s_1d)
      t_i_1d = HUGE(t_i_1d)
      s_i_1d = HUGE(s_i_1d)
      q_i_1d = HUGE(q_i_1d)
      q_s_1d = HUGE(q_s_1d)
      qh_i_old = HUGE(qh_i_old)
      h_i_old = HUGE(h_i_old)
#endif
      !
      thd_ice_alloc = MAXVAL( ierr )

      IF( thd_ice_alloc /= 0 )   CALL ctl_warn( 'thd_ice_alloc: failed to allocate arrays.' )
      !
   END FUNCTION thd_ice_alloc
   
   !!======================================================================
END MODULE thd_ice