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 2590 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

Ignore:
Timestamp:
2011-02-18T13:49:27+01:00 (13 years ago)
Author:
trackstand2
Message:

Merge branch 'dynamic_memory' into master-svn-dyn

Location:
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_3
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90

    r2528 r2590  
    1111   PRIVATE 
    1212 
     13   PUBLIC dom_ice_alloc   ! Routine called by nemogcm.F90 
     14 
    1315   LOGICAL, PUBLIC ::   l_jeq = .TRUE.       !: Equator inside the domain flag 
    1416 
    1517   INTEGER, PUBLIC ::   njeq , njeqm1        !: j-index of the equator if it is inside the domain 
    1618 
    17    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fs2cor     !: coriolis factor 
    18    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fcor       !: coriolis coefficient 
    19    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   covrai     !: sine of geographic latitude 
    20    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   area       !: surface of grid cell  
    21    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tms, tmi   !: temperature mask, mask for stress 
    22    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tmu, tmv   !: mask at u and v velocity points 
    23    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tmf        !: mask at f-point 
     19   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fs2cor     !: coriolis factor 
     20   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fcor       !: coriolis coefficient 
     21   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   covrai     !: sine of geographic latitude 
     22   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   area       !: surface of grid cell  
     23   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tms, tmi   !: temperature mask, mask for stress 
     24   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmu, tmv   !: mask at u and v velocity points 
     25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmf        !: mask at f-point 
    2426 
    25    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2) ::   wght     !: weight of the 4 neighbours to compute averages 
     27   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   wght   !: weight of the 4 neighbours to compute averages 
    2628 
    2729   !!---------------------------------------------------------------------- 
     
    3032   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3133   !!====================================================================== 
     34CONTAINS 
     35 
     36   FUNCTION dom_ice_alloc 
     37      !!------------------------------------------------------------------- 
     38      !!            *** Routine dom_ice_alloc *** 
     39      !!------------------------------------------------------------------- 
     40      INTEGER :: dom_ice_alloc 
     41      !!------------------------------------------------------------------- 
     42 
     43      ALLOCATE(fs2cor(jpi,jpj), fcor(jpi,jpj), & 
     44               covrai(jpi,jpj), area(jpi,jpj), & 
     45               tms(jpi,jpj)   , tmi(jpi,jpj) , & 
     46               tmu(jpi,jpj)   , tmv(jpi,jpj) , & 
     47               tmf(jpi,jpj)   ,                & 
     48               wght(jpi,jpj,2,2), Stat = dom_ice_alloc) 
     49 
     50      IF(dom_ice_alloc /= 0)THEN 
     51         CALL ctl_warn('dom_ice_alloc: failed to allocate arrays.') 
     52      END IF 
     53 
     54   END FUNCTION dom_ice_alloc 
     55 
    3256END MODULE dom_ice 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r2528 r2590  
    2727   USE prtctl           ! Print control 
    2828   USE lib_mpp 
     29   USE wrk_nemo, ONLY: wrk_use, wrk_release 
    2930 
    3031   IMPLICIT NONE 
     
    3940   PUBLIC lim_itd_me_init 
    4041   PUBLIC lim_itd_me_zapsmall 
     42   PUBLIC lim_idt_me_alloc  ! called by nemogcm.F90 
    4143 
    4244   !! * Module variables 
     
    5153   ! Variables shared among ridging subroutines 
    5254   !----------------------------------------------------------------------- 
    53    REAL(wp), DIMENSION (jpi,jpj) ::    & 
     55   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:) ::    & 
    5456      asum         , & ! sum of total ice and open water area 
    5557      aksum            ! ratio of area removed to area ridged 
    5658 
    57    REAL(wp), DIMENSION(jpi,jpj,0:jpl) :: &      
     59   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: &      
    5860      athorn           ! participation function; fraction of ridging/ 
    5961   !  closing associated w/ category n 
    6062 
    61    REAL(wp), DIMENSION(jpi,jpj,jpl) ::  & 
     63   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  & 
    6264      hrmin      , &   ! minimum ridge thickness 
    6365      hrmax      , &   ! maximum ridge thickness 
     
    7880   !----------------------------------------------------------------------- 
    7981   ! 
    80    REAL (wp), DIMENSION(jpi,jpj) :: & 
     82   REAL (wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: & 
    8183      dardg1dt     , & ! rate of fractional area loss by ridging ice (1/s) 
    8284      dardg2dt     , & ! rate of fractional area gain by new ridges (1/s) 
     
    9698   !!-----------------------------------------------------------------------------! 
    9799   !!-----------------------------------------------------------------------------! 
     100 
     101   FUNCTION lim_idt_me_alloc() 
     102      !!---------------------------------------------------------------------! 
     103      !!                ***  ROUTINE lim_itd_me_alloc *** 
     104      !!---------------------------------------------------------------------! 
     105      INTEGER :: lim_idt_me_alloc 
     106      !!---------------------------------------------------------------------! 
     107 
     108      ALLOCATE(asum(jpi,jpj), aksum(jpi,jpj), athorn(jpi,jpj,0:jpl), & 
     109               ! 
     110               hrmin(jpi,jpj,jpl),  hrmax(jpi,jpj,jpl)      , & 
     111               hraft(jpi,jpj,jpl),  krdg(jpi,jpj,jpl)       , & 
     112               aridge(jpi,jpj,jpl), araft(jpi,jpj,jpl)      , & 
     113               ! 
     114               dardg1dt(jpi,jpj)  , dardg2dt(jpi,jpj)       , &  
     115               dvirdgdt(jpi,jpj)  , opening(jpi,jpj)        , & 
     116               !  
     117               Stat=lim_idt_me_alloc) 
     118 
     119      IF(lim_idt_me_alloc /= 0)THEN 
     120         CALL ctl_warn('lim_idt_me_alloc: failed to allocate arrays.') 
     121      END IF 
     122 
     123   END FUNCTION lim_idt_me_alloc 
     124 
    98125 
    99126   SUBROUTINE lim_itd_me ! (subroutine 1/6) 
     
    149176      !!  and Elizabeth C. Hunke, LANL are gratefully acknowledged 
    150177      !!--------------------------------------------------------------------! 
     178      USE wrk_nemo, ONLY: & 
     179          closing_net   => wrk_2d_1, &  ! net rate at which area is removed    (1/s) 
     180                                        ! (ridging ice area - area of new ridges) / dt 
     181          divu_adv      => wrk_2d_2, &  ! divu as implied by transport scheme  (1/s) 
     182          opning        => wrk_2d_3, &  ! rate of opening due to divergence/shear 
     183          closing_gross => wrk_2d_4, &  ! rate at which area removed, not counting 
     184                                        ! area of new ridges 
     185          msnow_mlt     => wrk_2d_5, &  ! mass of snow added to ocean (kg m-2) 
     186          esnow_mlt     => wrk_2d_6       ! energy needed to melt snow in ocean (J m-2) 
     187      USE wrk_nemo, ONLY: vt_i_init  => wrk_2d_7, &  !  ice volume summed over  
     188                          vt_i_final => wrk_2d_8     !  categories 
     189 
    151190      !! * Arguments 
    152191 
     
    164203         epsi06    =  1.0e-6 
    165204 
    166       REAL(wp), DIMENSION(jpi,jpj) :: & 
    167          closing_net,        &  ! net rate at which area is removed    (1/s) 
    168                                 ! (ridging ice area - area of new ridges) / dt 
    169          divu_adv   ,        &  ! divu as implied by transport scheme  (1/s) 
    170          opning     ,        &  ! rate of opening due to divergence/shear 
    171          closing_gross,      &  ! rate at which area removed, not counting 
    172                                 ! area of new ridges 
    173          msnow_mlt  ,        &  ! mass of snow added to ocean (kg m-2) 
    174          esnow_mlt              ! energy needed to melt snow in ocean (J m-2) 
    175  
    176205      REAL(wp) ::            & 
    177206         w1,                 &  ! temporary variable 
     
    187216         big = 1.0e8 
    188217 
    189       REAL (wp), DIMENSION(jpi,jpj) :: &  !  
    190          vt_i_init, vt_i_final       !  ice volume summed over categories 
    191  
    192218      CHARACTER (len = 15) :: fieldid 
    193219 
    194220      !!-- End of declarations 
    195221      !-----------------------------------------------------------------------------! 
     222 
     223      IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7,8))THEN 
     224         CALL ctl_stop(' : requested workspace arrays unavailable.') 
     225         RETURN 
     226      END IF 
    196227 
    197228      IF( numit == nstart  ) CALL lim_itd_me_init ! Initialization (first time-step only) 
     
    551582      END DO 
    552583 
     584      IF(.NOT. wrk_release(2, 1,2,3,4,5,6,7,8))THEN 
     585         CALL ctl_stop('lim_itd_me : failed to release workspace arrays.') 
     586      END IF 
     587 
    553588   END SUBROUTINE lim_itd_me 
    554589 
     
    577612      !!                 
    578613      !!---------------------------------------------------------------------- 
     614      USE wrk_nemo, ONLY: zworka => wrk_2d_1 !: temporary array used here 
     615      ! 
    579616      !! * Arguments 
    580617 
     
    594631         zdummy 
    595632 
    596       REAL(wp), DIMENSION(jpi,jpj) :: & 
    597          zworka              !: temporary array used here 
     633      IF(.NOT. wrk_use(2, 1))THEN 
     634         CALL ctl_stop('lim_itd_me_icestrength : requested workspace array unavailable.') 
     635         RETURN 
     636      END IF 
    598637 
    599638      !------------------------------------------------------------------------------! 
     
    765804      ! Boundary conditions 
    766805      CALL lbc_lnk( strength, 'T', 1. ) 
     806 
     807      IF(.NOT. wrk_release(2, 1))THEN 
     808         CALL ctl_stop('lim_itd_me_icestrength : failed to release workspace array.') 
     809      END IF 
    767810 
    768811   END SUBROUTINE lim_itd_me_icestrength 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r2580 r2590  
    3737   PRIVATE 
    3838 
    39    PUBLIC   lim_rhg   ! routine called by lim_dyn (or lim_dyn_2) 
     39   PUBLIC   lim_rhg        ! routine called by lim_dyn (or lim_dyn_2) 
     40   PUBLIC   lim_rhg_alloc  ! routine called by nemo_alloc in nemogcm.F90 
    4041 
    4142   REAL(wp) ::   rzero   = 0._wp   ! constant values 
    4243   REAL(wp) ::   rone    = 1._wp   ! constant values 
    4344       
     45   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: & 
     46         zpresh        ,             & !: temporary array for ice strength 
     47         zpreshc       ,             & !: Ice strength on grid cell corners (zpreshc) 
     48         zfrld1, zfrld2,             & !: lead fraction on U/V points                                     
     49         zmass1, zmass2,             & !: ice/snow mass on U/V points                                     
     50         zcorl1, zcorl2,             & !: coriolis parameter on U/V points 
     51         za1ct, za2ct  ,             & !: temporary arrays 
     52         zc1           ,             & !: ice mass 
     53         zusw          ,             & !: temporary weight for the computation 
     54                                !: of ice strength 
     55         u_oce1, v_oce1,             & !: ocean u/v component on U points                            
     56         u_oce2, v_oce2,             & !: ocean u/v component on V points 
     57         u_ice2,                     & !: ice u component on V point 
     58         v_ice1                        !: ice v component on U point 
     59 
     60   REAL(wp),ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zf1, zf2   ! arrays for internal stresses 
     61 
     62   REAL(wp),ALLOCATABLE, SAVE, DIMENSION(:,:) :: & 
     63         zdd, zdt,                   & ! Divergence and tension at centre of grid cells 
     64         zds,                        & ! Shear on northeast corner of grid cells 
     65         deltat,                     & ! Delta at centre of grid cells 
     66         deltac,                     & ! Delta on corners 
     67         zs1, zs2,                   & ! Diagonal stress tensor components zs1 and zs2  
     68         zs12                          ! Non-diagonal stress tensor component zs12 
     69 
     70   REAL(wp),ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zu_ice, zv_ice, zresr   ! Local error on velocity 
     71 
    4472   !! * Substitutions 
    4573#  include "vectopt_loop_substitute.h90" 
     
    5078   !!---------------------------------------------------------------------- 
    5179CONTAINS 
     80 
     81   FUNCTION lim_rhg_alloc() 
     82      !!------------------------------------------------------------------- 
     83      !!                 ***  FUNCTION lim_rhg_alloc  *** 
     84      !!------------------------------------------------------------------- 
     85      IMPLICIT none 
     86      INTEGER :: lim_rhg_alloc 
     87      INTEGER :: ierr(2) 
     88      !!------------------------------------------------------------------- 
     89 
     90      ierr(:) = 0 
     91 
     92      ALLOCATE(zpresh(jpi,jpj), zpreshc(jpi,jpj), & 
     93               zfrld1(jpi,jpj), zfrld2(jpi,jpj),  & 
     94               zmass1(jpi,jpj), zmass2(jpi,jpj),  & 
     95               zcorl1(jpi,jpj), zcorl2(jpi,jpj),  & 
     96               za1ct(jpi,jpj),  za2ct(jpi,jpj) ,  & 
     97               zc1(jpi,jpj)   , zusw(jpi,jpj)  ,  & 
     98               u_oce1(jpi,jpj), v_oce1(jpi,jpj),  & 
     99               u_oce2(jpi,jpj), v_oce2(jpi,jpj),  & 
     100               u_ice2(jpi,jpj), v_ice1(jpi,jpj), Stat=ierr(1)) 
     101 
     102      ALLOCATE(zf1(jpi,jpj),    zf2(jpi,jpj),               & 
     103               zdd(jpi,jpj),    zdt(jpi,jpj), zds(jpi,jpj), & 
     104               deltat(jpi,jpj), deltac(jpi,jpj),            & 
     105               zs1(jpi,jpj),    zs2(jpi,jpj), zs12(jpi,jpj),& 
     106               zu_ice(jpi,jpj), zv_ice(jpi,jpj),            & 
     107               zresr(jpi,jpj), Stat=ierr(2)) 
     108 
     109      lim_rhg_alloc = MAXVAL(ierr) 
     110 
     111   END FUNCTION lim_rhg_alloc 
     112 
    52113 
    53114   SUBROUTINE lim_rhg( k_j1, k_jpj ) 
     
    111172      REAL(wp) ::   za, zstms, zsang, zmask   ! local scalars 
    112173 
    113       REAL(wp),DIMENSION(jpi,jpj) :: & 
    114          zpresh        ,             & !: temporary array for ice strength 
    115          zpreshc       ,             & !: Ice strength on grid cell corners (zpreshc) 
    116          zfrld1, zfrld2,             & !: lead fraction on U/V points                                     
    117          zmass1, zmass2,             & !: ice/snow mass on U/V points                                     
    118          zcorl1, zcorl2,             & !: coriolis parameter on U/V points 
    119          za1ct, za2ct  ,             & !: temporary arrays 
    120          zc1           ,             & !: ice mass 
    121          zusw          ,             & !: temporary weight for the computation 
    122                                 !: of ice strength 
    123          u_oce1, v_oce1,             & !: ocean u/v component on U points                            
    124          u_oce2, v_oce2,             & !: ocean u/v component on V points 
    125          u_ice2,                     & !: ice u component on V point 
    126          v_ice1                        !: ice v component on U point 
    127  
    128174      REAL(wp) :: & 
    129175         dtevp,                      & ! time step for subcycling 
     
    140186         sigma1, sigma2                ! internal ice stress 
    141187 
    142       REAL(wp),DIMENSION(jpi,jpj) ::   zf1, zf2   ! arrays for internal stresses 
    143  
    144       REAL(wp),DIMENSION(jpi,jpj) :: & 
    145          zdd, zdt,                   & ! Divergence and tension at centre of grid cells 
    146          zds,                        & ! Shear on northeast corner of grid cells 
    147          deltat,                     & ! Delta at centre of grid cells 
    148          deltac,                     & ! Delta on corners 
    149          zs1, zs2,                   & ! Diagonal stress tensor components zs1 and zs2  
    150          zs12                          ! Non-diagonal stress tensor component zs12 
    151  
    152188      REAL(wp) :: & 
    153189         zresm            ,          & ! Maximal error on ice velocity 
     
    155191         zdummy                        ! dummy argument 
    156192 
    157       REAL(wp),DIMENSION(jpi,jpj) ::   zu_ice, zv_ice, zresr   ! Local error on velocity 
    158193      !!------------------------------------------------------------------- 
    159194#if  defined key_lim2 && ! defined key_lim2_vp 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r2528 r2590  
    1616   IMPLICIT NONE 
    1717   PRIVATE 
     18 
     19   PUBLIC thd_ice_alloc ! Routine called by nemogcm.F90 
    1820 
    1921   !!--------------------------- 
     
    5153   !: are the variables corresponding to 2d vectors 
    5254 
    53    INTEGER , PUBLIC, DIMENSION(jpij) ::   &  !: 
     55   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !: 
    5456      npb     ,   &   !: number of points where computations has to be done 
    5557      npac            !: correspondance between the points (lateral accretion) 
    5658 
    57    REAL(wp), PUBLIC, DIMENSION(jpij) ::   &  !:  
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !:  
    5860      qldif_1d    ,     &  !: corresponding to the 2D var  qldif 
    5961      qcmif_1d    ,     &  !: corresponding to the 2D var  qcmif 
     
    6870      t_bo_b               !:    "                  "      t_bo 
    6971 
    70    REAL(wp), PUBLIC, DIMENSION(jpij) ::   &  !:  
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !:  
    7173      sprecip_1d  ,     &  !:    "                  "      sprecip 
    7274      frld_1d     ,     &  !:    "                  "      frld 
     
    106108      hicol_b              !:    Ice collection thickness accumulated in fleads 
    107109 
    108    REAL(wp), PUBLIC, DIMENSION(jpij) ::   &  !: 
     110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !: 
    109111      t_su_b      ,     &  !:    "                  "      t_su 
    110112      a_i_b       ,     &  !:                              a_i 
     
    122124      o_i_b                !:    Ice age                        [days] 
    123125 
    124    REAL(wp), PUBLIC, DIMENSION(jpij,nlay_s) ::   &  !: 
     126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    125127      t_s_b              !: corresponding to the 2D var  t_s 
    126    REAL(wp), PUBLIC, DIMENSION(jpij,jkmax) ::   &  !: 
     128   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    127129      t_i_b,            &  !: corresponding to the 2D var  t_i 
    128130      s_i_b,            &  !: profiled ice salinity 
     
    132134   ! Clean the following ... 
    133135   ! These variables are coded for conservation checks 
    134    REAL(wp), PUBLIC, DIMENSION(jpij,jpl)    ::   &  ! 
     136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)    ::   &  ! 
    135137      qt_i_in   ,           &  !: ice energy summed over categories (initial) 
    136138      qt_i_fin  ,           &  !: ice energy summed over categories (final) 
     
    140142      cons_error, surf_error   !: conservation, surface error 
    141143 
    142    REAL(wp), PUBLIC, DIMENSION(jpij,jkmax)::   &  !:  goes to trash 
     144   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)::   &  !:  goes to trash 
    143145      q_i_layer_in,         & 
    144146      q_i_layer_fin,        & 
    145147      dq_i_layer, radab 
    146148 
    147    REAL(wp), PUBLIC, DIMENSION(jpij) ::   &  !: 
     149   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !: 
    148150      ftotal_in  ,          &  !: initial total heat flux 
    149151      ftotal_fin               !: final total heat flux 
    150152 
    151    REAL(wp), PUBLIC, DIMENSION(jpij,0:nlay_s) ::   &  !: 
     153   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    152154      fc_s 
    153    REAL(wp), PUBLIC, DIMENSION(jpij,0:jkmax)  ::   &  !: 
     155   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)  ::   &  !: 
    154156      fc_i 
    155    REAL(wp), PUBLIC, DIMENSION(jpij,nlay_s) ::   &  !: 
     157   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    156158      de_s_lay 
    157    REAL(wp), PUBLIC, DIMENSION(jpij,jkmax)  ::   &  !: 
     159   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)  ::   &  !: 
    158160      de_i_lay 
    159161   INTEGER , PUBLIC ::                           & 
     
    161163 
    162164   !!====================================================================== 
     165CONTAINS 
     166 
     167   FUNCTION thd_ice_alloc() 
     168      !!---------------------------------------------------------------------! 
     169      !!                ***  ROUTINE thd_ice_alloc *** 
     170      !!---------------------------------------------------------------------! 
     171      INTEGER :: thd_ice_alloc 
     172      INTEGER :: ierr(4) 
     173      !!---------------------------------------------------------------------! 
     174 
     175      ALLOCATE(npb(jpij)     , npac(jpij),                           & 
     176               ! 
     177               qldif_1d(jpij) , qcmif_1d(jpij) , fstbif_1d(jpij)   , &    
     178               fltbif_1d(jpij), fscbq_1d(jpij) , qsr_ice_1d(jpij)  , &    
     179               fr1_i0_1d(jpij), fr2_i0_1d(jpij), qnsr_ice_1d(jpij) , &     
     180               qfvbq_1d(jpij) , t_bo_b(jpij)   ,                     & 
     181               Stat=ierr(1)) 
     182               ! 
     183      ALLOCATE(sprecip_1d(jpij), frld_1d(jpij)   , at_i_b(jpij)    , &     
     184               fbif_1d(jpij)   , rdmicif_1d(jpij), rdmsnif_1d(jpij), & 
     185               qlbbq_1d(jpij)  , dmgwi_1d(jpij)  , dvsbq_1d(jpij)  , &    
     186               dvbbq_1d(jpij)  , dvlbq_1d(jpij)  , dvnbq_1d(jpij)  , &    
     187               dqns_ice_1d(jpij),qla_ice_1d(jpij), dqla_ice_1d(jpij),& 
     188               tatm_ice_1d(jpij),fsup(jpij)      , focea(jpij)     , &    
     189               i0(jpij)        , old_ht_i_b(jpij), old_ht_s_b(jpij), &   
     190               fsbri_1d(jpij)  , fhbri_1d(jpij)  , fseqv_1d(jpij)  , & 
     191               dsm_i_fl_1d(jpij),dsm_i_gd_1d(jpij),dsm_i_se_1d(jpij),&      
     192               dsm_i_si_1d(jpij),hicol_b(jpij)                     , & 
     193               Stat=ierr(2)) 
     194               ! 
     195      ALLOCATE(t_su_b(jpij)     , a_i_b(jpij)    , ht_i_b(jpij)    , &    
     196               ht_s_b(jpij)     , fc_su(jpij)    , fc_bo_i(jpij)   , &     
     197               dh_s_tot(jpij)   , dh_i_surf(jpij), dh_i_bott(jpij) , &     
     198               dh_snowice(jpij) , sm_i_b(jpij)   , s_i_new(jpij)   , &     
     199               s_snowice(jpij)  , o_i_b(jpij)                      , & 
     200               ! 
     201               t_s_b(jpij,nlay_s),                                   & 
     202               ! 
     203               t_i_b(jpij,jkmax), s_i_b(jpij,jkmax)                , &             
     204               q_i_b(jpij,jkmax), q_s_b(jpij,jkmax)                , & 
     205               Stat=ierr(3)) 
     206               ! 
     207      ALLOCATE(qt_i_in(jpij,jpl) , qt_i_fin(jpij,jpl), qt_s_in(jpij,jpl),   & 
     208               qt_s_fin(jpij,jpl), dq_i(jpij,jpl)    , sum_fluxq(jpij,jpl), & 
     209               fatm(jpij,jpl),     foce(jpij,jpl)    , cons_error(jpij,jpl),& 
     210               surf_error(jpij,jpl),                                        & 
     211               ! 
     212               q_i_layer_in(jpij,jkmax), q_i_layer_fin(jpij,jkmax),        & 
     213               dq_i_layer(jpij,jkmax)  , radab(jpij,jkmax),                & 
     214               ! 
     215               ftotal_in(jpij), ftotal_fin(jpij),                          & 
     216               ! 
     217               fc_s(jpij,0:nlay_s),   fc_i(jpij,0:jkmax)                 , & 
     218               de_s_lay(jpij,nlay_s), de_i_lay(jpij,jkmax)               , & 
     219               ! 
     220               Stat=ierr(4)) 
     221 
     222      thd_ice_alloc = MAXVAL(ierr) 
     223 
     224      IF(thd_ice_alloc /= 0)THEN 
     225         CALL ctl_warn('thd_ice_alloc: failed to allocate arrays.') 
     226      END IF 
     227 
     228   END FUNCTION thd_ice_alloc 
     229 
    163230END MODULE thd_ice 
Note: See TracChangeset for help on using the changeset viewer.