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 2715 for trunk/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90 – NEMO

Ignore:
Timestamp:
2011-03-30T17:58:35+02:00 (13 years ago)
Author:
rblod
Message:

First attempt to put dynamic allocation on the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r2528 r2715  
    44   !! LIM sea-ice :   Ice thermodynamics in 1D 
    55   !!===================================================================== 
    6    !! History : 
    7    !!   2.0  !  02-11  (C. Ethe)  F90: Free form and module 
     6   !! History :  3.0  !  2002-11  (C. Ethe)  F90: Free form and module 
    87   !!---------------------------------------------------------------------- 
    9    !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010) 
    10    !! $Id$ 
    11    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    12    !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    14    USE par_ice 
     8   USE par_ice        ! LIM-3 parameters 
     9   USE in_out_manager ! I/O manager 
     10   USE lib_mpp         ! MPP library 
    1511 
    1612   IMPLICIT NONE 
    1713   PRIVATE 
     14 
     15   PUBLIC thd_ice_alloc ! Routine called by nemogcm.F90 
    1816 
    1917   !!--------------------------- 
    2018   !! * Share Module variables 
    2119   !!--------------------------- 
    22    REAL(wp) , PUBLIC ::   & !!! ** ice-thermo namelist (namicethd) ** 
    23       hmelt   = -0.15  ,  &  !: maximum melting at the bottom; active only for 
    24                                 !: one category 
    25       hicmin  = 0.2    ,  &  !: (REMOVE) 
    26       hiclim  = 0.05   ,  &  !: minimum ice thickness 
    27       amax    = 0.999  ,  &  !: maximum lead fraction 
    28       sbeta   = 1.0    ,  &  !: numerical scheme for diffusion in ice  (REMOVE) 
    29       parlat  = 0.0    ,  &  !: (REMOVE) 
    30       hakspl  = 0.5    ,  &  !: (REMOVE) 
    31       hibspl  = 0.5    ,  &  !: (REMOVE) 
    32       exld    = 2.0    ,  &  !: (REMOVE) 
    33       hakdif  = 1.0    ,  &  !: (REMOVE) 
    34       thth    = 0.2    ,  &  !: (REMOVE) 
    35       hnzst   = 0.1    ,  &  !: thick. of the surf. layer in temp. comp. 
    36       parsub  = 1.0    ,  &  !: switch for snow sublimation or not 
    37       alphs   = 1.0    ,  &  !: coef. for snow density when snow-ice formation 
    38       fraz_swi= 1.0    ,  &  !: use of frazil ice collection in function of wind (1.0) or not (0.0) 
    39       maxfrazb= 0.7    ,  &  !: maximum portion of frazil ice collecting at the ice bottom 
    40       vfrazb  = 0.41667,  &  !: threshold drift speed for collection of bottom frazil ice 
    41       Cfrazb  = 5.0          !: squeezing coefficient for collection of bottom frazil ice 
    42  
    43    REAL(wp), PUBLIC, DIMENSION(2)  ::  &  !:    
    44       hiccrit = (/0.3,0.3/)  !: ice th. for lateral accretion in the NH (SH) (m) 
     20   !                                         !!! ** ice-thermo namelist (namicethd) ** 
     21   REAL(wp), PUBLIC ::   hmelt   = -0.15     !: maximum melting at the bottom; active only for one category 
     22   REAL(wp), PUBLIC ::   hicmin  = 0.2       !: (REMOVE) 
     23   REAL(wp), PUBLIC ::   hiclim  = 0.05      !: minimum ice thickness 
     24   REAL(wp), PUBLIC ::   amax    = 0.999     !: maximum lead fraction 
     25   REAL(wp), PUBLIC ::   sbeta   = 1.0       !: numerical scheme for diffusion in ice  (REMOVE) 
     26   REAL(wp), PUBLIC ::   parlat  = 0.0       !: (REMOVE) 
     27   REAL(wp), PUBLIC ::   hakspl  = 0.5       !: (REMOVE) 
     28   REAL(wp), PUBLIC ::   hibspl  = 0.5       !: (REMOVE) 
     29   REAL(wp), PUBLIC ::   exld    = 2.0       !: (REMOVE) 
     30   REAL(wp), PUBLIC ::   hakdif  = 1.0       !: (REMOVE) 
     31   REAL(wp), PUBLIC ::   thth    = 0.2       !: (REMOVE) 
     32   REAL(wp), PUBLIC ::   hnzst   = 0.1       !: thick. of the surf. layer in temp. comp. 
     33   REAL(wp), PUBLIC ::   parsub  = 1.0       !: switch for snow sublimation or not 
     34   REAL(wp), PUBLIC ::   alphs   = 1.0       !: coef. for snow density when snow-ice formation 
     35   REAL(wp), PUBLIC ::   fraz_swi= 1.0       !: use of frazil ice collection in function of wind (1.0) or not (0.0) 
     36   REAL(wp), PUBLIC ::   maxfrazb= 0.7       !: maximum portion of frazil ice collecting at the ice bottom 
     37   REAL(wp), PUBLIC ::   vfrazb  = 0.41667   !: threshold drift speed for collection of bottom frazil ice 
     38   REAL(wp), PUBLIC ::   Cfrazb  = 5.0       !: squeezing coefficient for collection of bottom frazil ice 
     39 
     40   REAL(wp), PUBLIC, DIMENSION(2) ::   hiccrit = (/0.3,0.3/)  !: ice th. for lateral accretion in the NH (SH) (m) 
    4541 
    4642   !!----------------------------- 
     
    5147   !: are the variables corresponding to 2d vectors 
    5248 
    53    INTEGER , PUBLIC, DIMENSION(jpij) ::   &  !: 
    54       npb     ,   &   !: number of points where computations has to be done 
    55       npac            !: correspondance between the points (lateral accretion) 
    56  
    57    REAL(wp), PUBLIC, DIMENSION(jpij) ::   &  !:  
    58       qldif_1d    ,     &  !: corresponding to the 2D var  qldif 
    59       qcmif_1d    ,     &  !: corresponding to the 2D var  qcmif 
    60       fstbif_1d   ,     &  !:    "                  "      fstric 
    61       fltbif_1d   ,     &  !:    "                  "      ffltbif 
    62       fscbq_1d    ,     &  !:    "                  "      fscmcbq 
    63       qsr_ice_1d  ,     &  !:    "                  "      qsr_ice 
    64       fr1_i0_1d   ,     &  !:    "                  "      fr1_i0 
    65       fr2_i0_1d   ,     &  !:    "                  "      fr2_i0 
    66       qnsr_ice_1d ,     &  !:    "                  "      qns_ice 
    67       qfvbq_1d    ,     &  !:    "                  "      qfvbq 
    68       t_bo_b               !:    "                  "      t_bo 
    69  
    70    REAL(wp), PUBLIC, DIMENSION(jpij) ::   &  !:  
    71       sprecip_1d  ,     &  !:    "                  "      sprecip 
    72       frld_1d     ,     &  !:    "                  "      frld 
    73       at_i_b      ,     &  !:    "                  "      frld 
    74       fbif_1d     ,     &  !:    "                  "      fbif 
    75       rdmicif_1d  ,     &  !:    "                  "      rdmicif 
    76       rdmsnif_1d  ,     &  !:    "                  "      rdmsnif 
    77       qlbbq_1d    ,     &  !:    "                  "      qlbsbq 
    78       dmgwi_1d    ,     &  !:    "                  "      dmgwi 
    79       dvsbq_1d    ,     &  !:    "                  "      rdvosif 
    80       dvbbq_1d    ,     &  !:    "                  "      rdvobif 
    81       dvlbq_1d    ,     &  !:    "                  "      rdvolif 
    82       dvnbq_1d    ,     &  !:    "                  "      rdvolif 
    83       dqns_ice_1d ,     &  !:    "                  "      dqns_ice 
    84       qla_ice_1d  ,     &  !:    "                  "      qla_ice 
    85       dqla_ice_1d ,     &  !:    "                  "      dqla_ice 
    86                                 ! to reintegrate longwave flux inside the ice thermodynamics 
    87 !!sm: not used      qtur_ice_1d ,     &  !:    "                  "      qtur_ice 
    88 !!sm: not used      dqtu_ice_1d ,     &  !:    "                  "      dqtu_ice 
    89 !!sm: not used      catm_ice_1d ,     &  !:    "                  "      catm_ice 
    90       tatm_ice_1d ,     &  !:    "                  "      tatm_ice 
    91 !!sm: not used      evsq_ice_1d ,     &  !:    "                  "      evsq_ice 
    92 !!sm: not used      sbud_ice_1d ,     &  !:    "                  "      sbud_ice 
    93       fsup        ,     &  !:    Energy flux sent from bottom to lateral ablation if |dhb|> 0.15 m 
    94       focea       ,     &  !:    Remaining energy in case of total ablation 
    95       i0          ,     &  !:    fraction of radiation transmitted to the ice interior 
    96       old_ht_i_b  ,     &  !:    Ice thickness at the beginnning of the time step [m] 
    97       old_ht_s_b  ,     &  !:    Snow thickness at the beginning of the time step [m] 
    98       fsbri_1d    ,     &  !:    Salt flux due to brine drainage 
    99       fhbri_1d    ,     &  !:    Heat flux due to brine drainage 
    100       fseqv_1d    ,     &  !:    Equivalent Salt flux due to ice growth/decay 
    101       dsm_i_fl_1d ,     &  !:    Ice salinity variations due to flushing 
    102       dsm_i_gd_1d ,     &  !:    Ice salinity variations due to gravity drainage 
    103       dsm_i_se_1d ,     &  !:    Ice salinity variations due to basal salt entrapment 
    104 !!sm: not used      dsm_i_la_1d ,     &  !:    Ice salinity variations due to lateral accretion     
    105       dsm_i_si_1d ,     &  !:    Ice salinity variations due to lateral accretion     
    106       hicol_b              !:    Ice collection thickness accumulated in fleads 
    107  
    108    REAL(wp), PUBLIC, DIMENSION(jpij) ::   &  !: 
    109       t_su_b      ,     &  !:    "                  "      t_su 
    110       a_i_b       ,     &  !:                              a_i 
    111       ht_i_b      ,     &  !:    "                  "      ht_s 
    112       ht_s_b      ,     &  !:    "                  "      ht_i 
    113       fc_su       ,     &  !:    Surface Conduction flux  
    114       fc_bo_i     ,     &  !:    Bottom  Conduction flux  
    115       dh_s_tot    ,     &  !:    Snow accretion/ablation        [m] 
    116       dh_i_surf   ,     &  !:    Ice surface accretion/ablation [m] 
    117       dh_i_bott   ,     &  !:    Ice bottom accretion/ablation  [m] 
    118       dh_snowice  ,     &  !:    Snow ice formation             [m of ice] 
    119       sm_i_b      ,     &  !:    Ice bulk salinity [ppt] 
    120       s_i_new     ,     &  !:    Salinity of new ice at the bottom 
    121       s_snowice   ,     &  !:    Salinity of new snow ice on top of the ice 
    122       o_i_b                !:    Ice age                        [days] 
    123  
    124    REAL(wp), PUBLIC, DIMENSION(jpij,nlay_s) ::   &  !: 
    125       t_s_b              !: corresponding to the 2D var  t_s 
    126    REAL(wp), PUBLIC, DIMENSION(jpij,jkmax) ::   &  !: 
    127       t_i_b,            &  !: corresponding to the 2D var  t_i 
    128       s_i_b,            &  !: profiled ice salinity 
    129       q_i_b,            &  !:    Ice  enthalpy per unit volume 
    130       q_s_b                !:    Snow enthalpy per unit volume 
     49   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npb    !: number of points where computations has to be done 
     50   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: correspondance between points (lateral accretion) 
     51 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qldif_1d      !: <==> the 2D  qldif 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qcmif_1d      !: <==> the 2D  qcmif 
     54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fstbif_1d     !: <==> the 2D  fstric 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fltbif_1d     !: <==> the 2D  ffltbif 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fscbq_1d      !: <==> the 2D  fscmcbq 
     57   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d    !: <==> the 2D  qsr_ice 
     58   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d     !: <==> the 2D  fr1_i0 
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d     !: <==> the 2D  fr2_i0 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qnsr_ice_1d   !: <==> the 2D  qns_ice 
     61   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qfvbq_1d      !: <==> the 2D  qfvbq 
     62   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_b        !: <==> the 2D  t_bo 
     63 
     64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d    !: <==> the 2D  sprecip 
     65   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   frld_1d       !: <==> the 2D  frld 
     66   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_b        !: <==> the 2D  frld 
     67   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fbif_1d       !: <==> the 2D  fbif 
     68   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdmicif_1d    !: <==> the 2D  rdmicif 
     69   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdmsnif_1d    !: <==> the 2D  rdmsnif 
     70   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlbbq_1d      !: <==> the 2D  qlbsbq 
     71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dmgwi_1d      !: <==> the 2D  dmgwi 
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvsbq_1d      !: <==> the 2D  rdvosif 
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvbbq_1d      !: <==> the 2D  rdvobif 
     74   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvlbq_1d      !: <==> the 2D  rdvolif 
     75   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvnbq_1d      !: <==> the 2D  rdvolif 
     76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice 
     77   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qla_ice_1d    !: <==> the 2D  qla_ice 
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqla_ice_1d   !: <==> the 2D  dqla_ice 
     79   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tatm_ice_1d   !: <==> the 2D  tatm_ice 
     80   !                                                     ! to reintegrate longwave flux inside the ice thermodynamics 
     81   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fsup          !: Energy flux sent from bottom to lateral ablation if |dhb|> 0.15 m 
     82   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   focea         !: Remaining energy in case of total ablation 
     83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice 
     84   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_i_b    !: Ice thickness at the beginnning of the time step [m] 
     85    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::  old_ht_s_b    !: Snow thickness at the beginning of the time step [m] 
     86   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fsbri_1d      !: Salt flux due to brine drainage 
     87   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhbri_1d      !: Heat flux due to brine drainage 
     88   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fseqv_1d      !: Equivalent Salt flux due to ice growth/decay 
     89   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_fl_1d   !: Ice salinity variations due to flushing 
     90   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_gd_1d   !: Ice salinity variations due to gravity drainage 
     91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_se_1d   !: Ice salinity variations due to basal salt entrapment 
     92   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_si_1d   !: Ice salinity variations due to lateral accretion     
     93   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hicol_b       !: Ice collection thickness accumulated in fleads 
     94 
     95   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_b      !: <==> the 2D  t_su 
     96   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_b       !: <==> the 2D  a_i 
     97   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_i_b      !: <==> the 2D  ht_s 
     98   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_s_b      !: <==> the 2D  ht_i 
     99   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_su       !: Surface Conduction flux  
     100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_bo_i     !: Bottom  Conduction flux  
     101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot    !: Snow accretion/ablation        [m] 
     102   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf   !: Ice surface accretion/ablation [m] 
     103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott   !: Ice bottom accretion/ablation  [m] 
     104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice  !: Snow ice formation             [m of ice] 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sm_i_b      !: Ice bulk salinity [ppt] 
     106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new     !: Salinity of new ice at the bottom 
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_snowice   !: Salinity of new snow ice on top of the ice 
     108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   o_i_b       !: Ice age                        [days] 
     109 
     110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_b   !: corresponding to the 2D var  t_s 
     111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_b   !: corresponding to the 2D var  t_i 
     112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s_i_b   !: profiled ice salinity 
     113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_b   !:    Ice  enthalpy per unit volume 
     114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_s_b   !:    Snow enthalpy per unit volume 
    131115 
    132116   ! Clean the following ... 
    133117   ! These variables are coded for conservation checks 
    134    REAL(wp), PUBLIC, DIMENSION(jpij,jpl)    ::   &  ! 
    135       qt_i_in   ,           &  !: ice energy summed over categories (initial) 
    136       qt_i_fin  ,           &  !: ice energy summed over categories (final) 
    137       qt_s_in, qt_s_fin  ,  &  !: snow energy summed over categories 
    138       dq_i, sum_fluxq    ,  &  !: increment of energy, sum of fluxes 
    139       fatm, foce,           &  !: atmospheric, oceanic, heat flux 
    140       cons_error, surf_error   !: conservation, surface error 
    141  
    142    REAL(wp), PUBLIC, DIMENSION(jpij,jkmax)::   &  !:  goes to trash 
    143       q_i_layer_in,         & 
    144       q_i_layer_fin,        & 
    145       dq_i_layer, radab 
    146  
    147    REAL(wp), PUBLIC, DIMENSION(jpij) ::   &  !: 
    148       ftotal_in  ,          &  !: initial total heat flux 
    149       ftotal_fin               !: final total heat flux 
    150  
    151    REAL(wp), PUBLIC, DIMENSION(jpij,0:nlay_s) ::   &  !: 
    152       fc_s 
    153    REAL(wp), PUBLIC, DIMENSION(jpij,0:jkmax)  ::   &  !: 
    154       fc_i 
    155    REAL(wp), PUBLIC, DIMENSION(jpij,nlay_s) ::   &  !: 
    156       de_s_lay 
    157    REAL(wp), PUBLIC, DIMENSION(jpij,jkmax)  ::   &  !: 
    158       de_i_lay 
    159    INTEGER , PUBLIC ::                           & 
    160       jiindex_1d   ! 1D index of debugging point 
    161  
     118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_i_in                  !: ice energy summed over categories (initial) 
     119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_i_fin                 !: ice energy summed over categories (final) 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_s_in, qt_s_fin        !: snow energy summed over categories 
     121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dq_i, sum_fluxq          !: increment of energy, sum of fluxes 
     122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fatm, foce               !: atmospheric, oceanic, heat flux 
     123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cons_error, surf_error   !: conservation, surface error 
     124 
     125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_layer_in        !: goes to trash 
     126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_layer_fin       !: goes to trash 
     127   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dq_i_layer, radab   !: goes to trash 
     128 
     129   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftotal_in    !: initial total heat flux 
     130   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftotal_fin   !: final total heat flux 
     131 
     132   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fc_s 
     133   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fc_i 
     134   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   de_s_lay 
     135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   de_i_lay 
     136    
     137   INTEGER , PUBLIC ::   jiindex_1d   ! 1D index of debugging point 
     138 
     139   !!---------------------------------------------------------------------- 
     140   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     141   !! $Id$ 
     142   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     143   !!---------------------------------------------------------------------- 
     144CONTAINS 
     145 
     146   FUNCTION thd_ice_alloc() 
     147      !!---------------------------------------------------------------------! 
     148      !!                ***  ROUTINE thd_ice_alloc *** 
     149      !!---------------------------------------------------------------------! 
     150      INTEGER ::   thd_ice_alloc   ! return value 
     151      INTEGER ::   ierr(4) 
     152      !!---------------------------------------------------------------------! 
     153 
     154      ALLOCATE( npb      (jpij) , npac     (jpij),                          & 
     155         !                                                                  ! 
     156         &      qldif_1d (jpij) , qcmif_1d (jpij) , fstbif_1d  (jpij) ,     & 
     157         &      fltbif_1d(jpij) , fscbq_1d (jpij) , qsr_ice_1d (jpij) ,     & 
     158         &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qnsr_ice_1d(jpij) ,     & 
     159         &      qfvbq_1d (jpij) , t_bo_b   (jpij)                     , STAT=ierr(1) ) 
     160      ! 
     161      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_b     (jpij) ,     & 
     162         &      fbif_1d    (jpij) , rdmicif_1d (jpij) , rdmsnif_1d (jpij) ,     & 
     163         &      qlbbq_1d   (jpij) , dmgwi_1d   (jpij) , dvsbq_1d   (jpij) ,     & 
     164         &      dvbbq_1d   (jpij) , dvlbq_1d   (jpij) , dvnbq_1d   (jpij) ,     & 
     165         &      dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) ,     & 
     166         &      tatm_ice_1d(jpij) , fsup       (jpij) , focea      (jpij) ,     &    
     167         &      i0         (jpij) , old_ht_i_b (jpij) , old_ht_s_b (jpij) ,     &   
     168         &      fsbri_1d   (jpij) , fhbri_1d   (jpij) , fseqv_1d   (jpij) ,     & 
     169         &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,     &      
     170         &      dsm_i_si_1d(jpij) , hicol_b    (jpij)                     , STAT=ierr(2) ) 
     171      ! 
     172      ALLOCATE( t_su_b    (jpij) , a_i_b    (jpij) , ht_i_b   (jpij) ,    &    
     173         &      ht_s_b    (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &     
     174         &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) ,    &     
     175         &      dh_snowice(jpij) , sm_i_b   (jpij) , s_i_new  (jpij) ,    &     
     176         &      s_snowice (jpij) , o_i_b    (jpij)                   ,    & 
     177         !                                                                ! 
     178         &      t_s_b(jpij,nlay_s),                                       & 
     179         !                                                                ! 
     180         &      t_i_b(jpij,jkmax), s_i_b(jpij,jkmax)                ,     &             
     181         &      q_i_b(jpij,jkmax), q_s_b(jpij,jkmax)                , STAT=ierr(3)) 
     182      ! 
     183      ALLOCATE( qt_i_in   (jpij,jpl) , qt_i_fin(jpij,jpl) , qt_s_in   (jpij,jpl) ,     & 
     184         &      qt_s_fin  (jpij,jpl) , dq_i    (jpij,jpl) , sum_fluxq (jpij,jpl) ,     & 
     185         &      fatm      (jpij,jpl) , foce    (jpij,jpl) , cons_error(jpij,jpl) ,     & 
     186         &      surf_error(jpij,jpl)                                             ,     & 
     187         !                                                                             ! 
     188         &      q_i_layer_in(jpij,jkmax) , q_i_layer_fin(jpij,jkmax)             ,     & 
     189         &      dq_i_layer  (jpij,jkmax) , radab        (jpij,jkmax)             ,     & 
     190         !                                                                             ! 
     191         &      ftotal_in(jpij), ftotal_fin(jpij)                                ,     & 
     192         !                                                                             ! 
     193         &      fc_s(jpij,0:nlay_s) , de_s_lay(jpij,nlay_s)                      ,     & 
     194         &      fc_i(jpij,0:jkmax)  , de_i_lay(jpij,jkmax)                       , STAT=ierr(4) ) 
     195 
     196      thd_ice_alloc = MAXVAL( ierr ) 
     197 
     198      IF( thd_ice_alloc /= 0 )   CALL ctl_warn( 'thd_ice_alloc: failed to allocate arrays.' ) 
     199      ! 
     200   END FUNCTION thd_ice_alloc 
     201    
    162202   !!====================================================================== 
    163203END MODULE thd_ice 
Note: See TracChangeset for help on using the changeset viewer.