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 9019 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90 – NEMO

Ignore:
Timestamp:
2017-12-13T15:58:53+01:00 (6 years ago)
Author:
timgraham
Message:

Merge of dev_CNRS_2017 into branch

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r6416 r9019  
    99   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option 
    1010   !!---------------------------------------------------------------------- 
    11 #if defined key_lim3 || defined key_lim2 || defined key_cice 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_lim2' or 'key_lim3' :             LIM-2 or LIM-3 sea-ice model 
     11#if defined key_lim3 || defined key_cice 
     12   !!---------------------------------------------------------------------- 
     13   !!   'key_lim3' or 'key_cice' :              LIM-3 or CICE sea-ice model 
    1414   !!---------------------------------------------------------------------- 
    1515   USE par_oce          ! ocean parameters 
    … …  
    1818   USE ice              ! LIM-3 parameters 
    1919# endif 
    20 # if defined key_lim2 
    21    USE par_ice_2        ! LIM-2 parameters 
    22    USE ice_2 
    23 # endif 
    2420# if defined key_cice 
    2521   USE ice_domain_size, only: ncat  
    … …  
    3127   PRIVATE 
    3228 
    33    PUBLIC sbc_ice_alloc ! called in iceini(_2).F90 
    34  
    35 # if defined  key_lim2 
    36    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .TRUE.   !: LIM-2 ice model 
    37    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 
    38    LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  
    39 #  if defined key_lim2_vp 
    40    CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'I'      !: VP : 'I'-grid ice-velocity (B-grid lower left corner) 
    41 #  else 
    42    CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'C'      !: EVP: 'C'-grid ice-velocity 
    43 #  endif 
    44 # endif 
     29   PUBLIC   sbc_ice_alloc   ! called in sbcmod.F90 or sbcice_cice.F90 
     30 
    4531# if defined  key_lim3 
    46    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 
    4732   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .TRUE.   !: LIM-3 ice model 
    4833   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  
    … …  
    5035# endif 
    5136# if defined  key_cice 
    52    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 
    5337   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 
    5438   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .TRUE.   !: CICE ice model 
    … …  
    6448   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   alb_ice        !: ice albedo                                       [-] 
    6549 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qml_ice        !: heat available for snow / ice surface melting     [W/m2]  
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice        !: heat conduction flux in the layer below surface   [W/m2]  
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice_tr     !: solar flux transmitted below the ice surface      [W/m2] 
     53 
    6654   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   utau_ice       !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
    6755   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vtau_ice       !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
    68    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr1_i0         !: Solar surface transmission parameter, thick ice  [-] 
    69    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0         !: Solar surface transmission parameter, thin ice   [-] 
    7056   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice          [kg/m2/s] 
    7157 
    … …  
    8369   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qprec_ice      !: enthalpy of precip over ice                 [J/m3] 
    8470   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_oce        !: evap - precip over ocean                 [kg/m2/s] 
    85 #endif 
    86 #if defined key_lim3 || defined key_lim2 
    8771   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndm_ice       !: wind speed module at T-point                 [m/s] 
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sstfrz         !: wind speed module at T-point                 [m/s] 
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tsfc_ice       !: sea ice surface skin temperature (on categories) 
    8874#endif 
    8975 
    … …  
    10692   INTEGER , PUBLIC, PARAMETER ::   jpl = ncat 
    10793   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice          ! jpi, jpj 
    108 #endif 
    10994    
    110 #if defined key_lim2 || defined key_cice 
    11195   ! already defined in ice.F90 for LIM3 
    11296   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
    113    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s 
    114 #endif 
    115  
    116 #if defined key_cice 
     97   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  h_i, h_s 
     98 
    11799   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K] 
    118100#endif 
    119101 
    120102   REAL(wp), PUBLIC, SAVE ::   cldf_ice = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-] 
     103 
     104   !! arrays relating to embedding ice in the ocean 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass        !: mass of snow and ice at current  ice time step   [Kg/m2] 
     106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass_b      !: mass of snow and ice at previous ice time step   [Kg/m2] 
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s] 
    121108 
    122109   !!---------------------------------------------------------------------- 
    … …  
    131118      !!                     ***  FUNCTION sbc_ice_alloc  *** 
    132119      !!---------------------------------------------------------------------- 
    133       INTEGER :: ierr(5) 
     120      INTEGER :: ierr(4) 
    134121      !!---------------------------------------------------------------------- 
    135122      ierr(:) = 0 
    136123 
    137 #if defined key_lim3 || defined key_lim2 
    138       ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) ,     & 
    139          &      qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) ,     & 
    140          &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) ,   & 
    141          &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     , wndm_ice(jpi,jpj)     ,   & 
    142          &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     & 
    143 #if defined key_lim2 
    144          &      a_i(jpi,jpj,jpl)      ,                             & 
    145 #endif 
     124      ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(1) ) 
     125 
    146126#if defined key_lim3 
    147          &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) ,   & 
    148          &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) ,   & 
    149          &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce (jpi,jpj)  ,   & 
    150 #endif 
    151          &      emp_ice(jpi,jpj)      ,  STAT= ierr(1) ) 
     127      ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice  (jpi,jpj,jpl) ,     & 
     128         &      qla_ice (jpi,jpj,jpl) , dqla_ice (jpi,jpj,jpl) ,     & 
     129         &      dqns_ice(jpi,jpj,jpl) , tn_ice   (jpi,jpj,jpl) , alb_ice   (jpi,jpj,jpl) ,   & 
     130         &      qml_ice (jpi,jpj,jpl) , qcn_ice  (jpi,jpj,jpl) , qsr_ice_tr(jpi,jpj,jpl) ,   & 
     131         &      utau_ice(jpi,jpj)     , vtau_ice (jpi,jpj)     , wndm_ice  (jpi,jpj)     ,   & 
     132         &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice (jpi,jpj)     ,   & 
     133         &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce  (jpi,jpj)     ,   & 
     134         &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce   (jpi,jpj)     ,   & 
     135         &      emp_ice (jpi,jpj)     , tsfc_ice (jpi,jpj,jpl) , sstfrz    (jpi,jpj)     , STAT= ierr(2) ) 
    152136#endif 
    153137 
    … …  
    158142                ss_iov(jpi,jpj)       , fr_iu(jpi,jpj)        , fr_iv(jpi,jpj)        , & 
    159143                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 
    160                 STAT= ierr(1) ) 
    161       IF( ln_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , & 
    162          &                     v_ice(jpi,jpj)        , fr2_i0(jpi,jpj)       , alb_ice(jpi,jpj,1)    , & 
     144                STAT= ierr(2) ) 
     145      IF( ln_cpl )   ALLOCATE( u_ice(jpi,jpj)        , tn_ice (jpi,jpj,1)    , & 
     146         &                     v_ice(jpi,jpj)        , alb_ice(jpi,jpj,1)    , & 
    163147         &                     emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , & 
    164          &                     STAT= ierr(2) ) 
    165        
    166 #endif 
    167          ! 
    168 #if defined key_cice || defined key_lim2 
    169       IF( ln_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 
     148         &                     STAT= ierr(3) )       
     149      IF( ln_cpl )   ALLOCATE( h_i(jpi,jpj,jpl) , h_s(jpi,jpj,jpl) , STAT=ierr(4) ) 
    170150#endif 
    171151 
    … …  
    177157#else 
    178158   !!---------------------------------------------------------------------- 
    179    !!   Default option                      NO LIM 2.0 or 3.0 or CICE sea-ice model 
    180    !!---------------------------------------------------------------------- 
     159   !!   Default option                      NO LIM3 or CICE sea-ice model 
     160   !!---------------------------------------------------------------------- 
     161   USE lib_mpp          ! MPP library 
    181162   USE in_out_manager   ! I/O manager 
    182    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 ice model 
     163 
     164   IMPLICIT NONE 
     165   PRIVATE 
     166 
     167   PUBLIC   sbc_ice_alloc   ! 
     168 
    183169   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 ice model 
    184170   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  ice model 
    185171   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = '-'      !: no grid ice-velocity 
    186    REAL            , PUBLIC, PARAMETER ::   cldf_ice = 0.81       !: cloud fraction over sea ice, summer CLIO value   [-] 
     172   REAL(wp)        , PUBLIC, PARAMETER ::   cldf_ice = 0.81       !: cloud fraction over sea ice, summer CLIO value   [-] 
    187173   INTEGER         , PUBLIC, PARAMETER ::   jpl = 1  
    188    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj 
     174   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice                        ! jpi, jpj 
    189175   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
    190176   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i 
    191177   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
    192178   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
    193    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i, ht_s 
     179   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_i, h_s 
    194180   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt, botmelt 
     181   ! 
     182   !! arrays related to embedding ice in the ocean.  
     183   !! These arrays need to be declared even if no ice model is required.  
     184   !! In the no ice model or traditional levitating ice cases they contain only zeros 
     185   !! --------------------- 
     186   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass        !: mass of snow and ice at current  ice time step   [Kg/m2] 
     187   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass_b      !: mass of snow and ice at previous ice time step   [Kg/m2] 
     188   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s] 
     189   !!---------------------------------------------------------------------- 
     190CONTAINS 
     191 
     192   INTEGER FUNCTION sbc_ice_alloc() 
     193      !!---------------------------------------------------------------------- 
     194      !!                     ***  FUNCTION sbc_ice_alloc  *** 
     195      !!---------------------------------------------------------------------- 
     196      INTEGER :: ierr(1) 
     197      !!---------------------------------------------------------------------- 
     198      ierr(:) = 0 
     199      ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(1) ) 
     200      sbc_ice_alloc = MAXVAL( ierr ) 
     201      IF( lk_mpp            )   CALL mpp_sum ( sbc_ice_alloc ) 
     202      IF( sbc_ice_alloc > 0 )   CALL ctl_warn('sbc_ice_alloc: allocation of arrays failed') 
     203   END FUNCTION sbc_ice_alloc 
    195204#endif 
    196205 
Note: See TracChangeset for help on using the changeset viewer.