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

First attempt to put dynamic allocation on the trunk

Location:
trunk/NEMOGCM/NEMO/LIM_SRC_2
Files:
19 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90

    r2528 r2715  
    1515   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1616   !!---------------------------------------------------------------------- 
    17    USE par_ice_2 
     17   USE par_ice_2   ! LIM parameters 
    1818 
    1919   IMPLICIT NONE 
    2020   PRIVATE 
     21 
     22   PUBLIC    dom_ice_alloc_2    ! Called from nemogcm.F90 
    2123 
    2224   LOGICAL, PUBLIC ::   l_jeq     = .TRUE.     !: Equator inside the domain flag 
     
    2527      !                                        !  (otherwise = jpj+10 (SH) or -10 (SH) ) 
    2628 
    27    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   fs2cor , fcor     !: coriolis factor and coeficient 
    28    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   covrai            !: sine of geographic latitude 
    29    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   area              !: surface of grid cell  
    30    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   tms    , tmu      !: temperature and velocity points masks 
    31    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2)     ::   wght              !: weight of the 4 neighbours to compute averages 
     29   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   fs2cor , fcor     !: coriolis factor and coeficient 
     30   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   covrai            !: sine of geographic latitude 
     31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   area              !: surface of grid cell  
     32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tms    , tmu      !: temperature and velocity points masks 
     33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)     ::   wght              !: weight of the 4 neighbours to compute averages 
    3234 
    3335 
    3436# if defined key_lim2_vp 
    35    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2)     ::   akappa , bkappa   !: first and third group of metric coefficients 
    36    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2,2,2) ::   alambd            !: second group of metric coefficients 
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)     ::   akappa , bkappa   !: first and third group of metric coefficients 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:,:) ::   alambd            !: second group of metric coefficients 
    3739# else 
    38    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   tmv    , tmf      !: y-velocity and F-points masks 
    39    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   tmi               !: ice mask: =1 if ice thick > 0 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tmv    , tmf      !: y-velocity and F-points masks 
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tmi               !: ice mask: =1 if ice thick > 0 
    4042# endif 
     43   !!---------------------------------------------------------------------- 
     44   CONTAINS 
     45 
     46   INTEGER FUNCTION dom_ice_alloc_2() 
     47      !!---------------------------------------------------------------------- 
     48      USE lib_mpp, ONLY:   ctl_warn   ! MPP library 
     49      INTEGER :: ierr(2) 
     50      !!---------------------------------------------------------------------- 
     51      ierr(:) = 0 
     52      ! 
     53      ALLOCATE( fs2cor(jpi,jpj)     , fcor(jpi,jpj) ,                                   & 
     54         &      covrai(jpi,jpj)     , area(jpi,jpj) , tms(jpi,jpj) , tmu(jpi,jpj) ,     & 
     55         &      wght  (jpi,jpj,2,2)                                               , STAT=ierr(1) ) 
     56         ! 
     57      ALLOCATE(                                                    & 
     58#if defined key_lim2_vp  
     59         &        akappa(jpi,jpj,2,2)     , bkappa(jpi,jpj,2,2),   & 
     60         &        alambd(jpi,jpj,2,2,2,2) ,                        & 
     61#else 
     62         &        tmv(jpi,jpj) , tmf(jpi,jpj) , tmi(jpi,jpj) ,     & 
     63#endif 
     64         &        STAT=ierr(2) ) 
     65         ! 
     66      dom_ice_alloc_2 = MAXVAL(ierr) 
     67      IF( dom_ice_alloc_2 /= 0 )   CALL ctl_warn('dom_ice_alloc_2: failed to allocate arrays') 
     68      ! 
     69   END FUNCTION dom_ice_alloc_2 
    4170 
    4271#else 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90

    r2528 r2715  
    44   !! Sea Ice physics:  diagnostics variables of ice defined in memory 
    55   !!===================================================================== 
    6    !! History :  2.0  !  2003-08  (C. Ethe)  F90: Free form and module 
    7    !!            3.3  !  2009-05  (G.Garric) addition of the lim2_evp cas 
     6   !! History :  2.0  ! 2003-08  (C. Ethe)  F90: Free form and module 
     7   !!            3.3  ! 2009-05  (G.Garric) addition of the lim2_evp cas 
     8   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_lim2 
     
    1112   !!   'key_lim2' :                                  LIM 2.0 sea-ice model 
    1213   !!---------------------------------------------------------------------- 
    13    USE par_ice_2          ! LIM sea-ice parameters 
     14   USE par_ice_2      ! LIM sea-ice parameters 
    1415 
    1516   IMPLICIT NONE 
    1617   PRIVATE 
    1718    
     19   PUBLIC    ice_alloc_2  !  Called in iceini_2.F90 
     20 
    1821   INTEGER , PUBLIC ::   numit     !: ice iteration index 
    1922   REAL(wp), PUBLIC ::   rdt_ice   !: ice time step 
     
    5457   REAL(wp), PUBLIC ::   pstarh                !: pstar / 2.0 
    5558 
    56    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ahiu , ahiv   !: hor. diffusivity coeff. at ocean U- and V-points (m2/s) 
    57    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   pahu , pahv   !: ice hor. eddy diffusivity coef. at ocean U- and V-points 
    58    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ust2s         !: friction velocity 
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahiu , ahiv   !: hor. diffusivity coeff. at ocean U- and V-points (m2/s) 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pahu , pahv   !: ice hor. eddy diffusivity coef. at ocean U- and V-points 
     61   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ust2s         !: friction velocity 
    5962 
    6063   !!* Ice Rheology 
     
    6366   LOGICAL , PUBLIC ::   lk_lim2_vp = .TRUE.               !: Visco-Plactic reology flag  
    6467   ! 
    65    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hsnm , hicm   !: mean snow and ice thicknesses 
     68   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hsnm , hicm   !: mean snow and ice thicknesses 
    6669   ! 
    6770# else 
     
    6972   LOGICAL , PUBLIC::   lk_lim2_vp = .FALSE.               !: Visco-Plactic reology flag  
    7073   ! 
    71    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   stress1_i     !: first stress tensor element        
    72    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   stress2_i     !: second stress tensor element 
    73    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   stress12_i    !: diagonal stress tensor element 
    74    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   delta_i       !: rheology delta factor (see Flato and Hibler 95) [s-1] 
    75    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   divu_i        !: Divergence of the velocity field [s-1] -> limrhg.F90 
    76    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   shear_i       !: Shear of the velocity field [s-1] -> limrhg.F90 
    77    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   at_i          !: ice fraction 
     74   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress1_i     !: first stress tensor element        
     75   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress2_i     !: second stress tensor element 
     76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress12_i    !: diagonal stress tensor element 
     77   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   delta_i       !: rheology delta factor (see Flato and Hibler 95) [s-1] 
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   divu_i        !: Divergence of the velocity field [s-1] -> limrhg.F90 
     79   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i       !: Shear of the velocity field [s-1] -> limrhg.F90 
     80   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   at_i          !: ice fraction 
    7881   ! 
    7982   REAL(wp), PUBLIC, DIMENSION(:,:)    , POINTER :: vt_s ,vt_i    !: mean snow and ice thicknesses 
    80    REAL(wp), PUBLIC, DIMENSION(jpi,jpj), TARGET  :: hsnm , hicm   !: target vt_s,vt_i pointers  
     83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET  :: hsnm , hicm   !: target vt_s,vt_i pointers  
    8184#endif 
    8285 
    83    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvosif       !: ice volume change at ice surface (only used for outputs) 
    84    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvobif       !: ice volume change at ice bottom  (only used for outputs) 
    85    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fdvolif       !: Total   ice volume change (only used for outputs) 
    86    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvonif       !: Lateral ice volume change (only used for outputs) 
    87    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sist          !: Sea-Ice Surface Temperature [Kelvin] 
    88    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tfu           !: Freezing/Melting point temperature of sea water at SSS 
    89    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hicif         !: Ice thickness 
    90    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hsnif         !: Snow thickness 
    91    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hicifp        !: Ice production/melting 
    92    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   frld          !: Leads fraction = 1-a/totalarea 
    93    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   phicif        !: ice thickness  at previous time  
    94    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   pfrld         !: Leads fraction at previous time   
    95    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qstoif        !: Energy stored in the brine pockets 
    96    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fbif          !: Heat flux at the ice base 
    97    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdmsnif       !: Variation of snow mass 
    98    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdmicif       !: Variation of ice mass 
    99    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qldif         !: heat balance of the lead (or of the open ocean) 
    100    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qcmif         !: Energy needed to freeze the ocean surface layer 
    101    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fdtcn         !: net downward heat flux from the ice to the ocean 
    102    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qdtcn         !: energy from the ice to the ocean point (at a factor 2) 
    103    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   thcm          !: part of the solar energy used in the lead heat budget 
    104    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fstric        !: Solar flux transmitted trough the ice 
    105    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ffltbif       !: linked with the max heat contained in brine pockets (?) 
    106    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fscmbq        !: Linked with the solar flux below the ice (?) 
    107    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fsbbq         !: Also linked with the solar flux below the ice (?) 
    108    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qfvbq         !: used to store energy in case of toral lateral ablation (?) 
    109    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   dmgwi         !: Variation of the mass of snow ice 
    110    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   u_ice, v_ice  !: two components of the ice   velocity at I-point (m/s) 
    111    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   u_oce, v_oce  !: two components of the ocean velocity at I-point (m/s) 
     86   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvosif       !: ice volume change at ice surface (only used for outputs) 
     87   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvobif       !: ice volume change at ice bottom  (only used for outputs) 
     88   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fdvolif       !: Total   ice volume change (only used for outputs) 
     89   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvonif       !: Lateral ice volume change (only used for outputs) 
     90   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sist          !: Sea-Ice Surface Temperature [Kelvin] 
     91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tfu           !: Freezing/Melting point temperature of sea water at SSS 
     92   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicif         !: Ice thickness 
     93   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hsnif         !: Snow thickness 
     94   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicifp        !: Ice production/melting 
     95   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frld          !: Leads fraction = 1-a/totalarea 
     96   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   phicif        !: ice thickness  at previous time  
     97   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pfrld         !: Leads fraction at previous time   
     98   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qstoif        !: Energy stored in the brine pockets 
     99   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fbif          !: Heat flux at the ice base 
     100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdmsnif       !: Variation of snow mass 
     101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdmicif       !: Variation of ice mass 
     102   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qldif         !: heat balance of the lead (or of the open ocean) 
     103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qcmif         !: Energy needed to freeze the ocean surface layer 
     104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fdtcn         !: net downward heat flux from the ice to the ocean 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qdtcn         !: energy from the ice to the ocean point (at a factor 2) 
     106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   thcm          !: part of the solar energy used in the lead heat budget 
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fstric        !: Solar flux transmitted trough the ice 
     108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ffltbif       !: linked with the max heat contained in brine pockets (?) 
     109   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fscmbq        !: Linked with the solar flux below the ice (?) 
     110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fsbbq         !: Also linked with the solar flux below the ice (?) 
     111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qfvbq         !: used to store energy in case of toral lateral ablation (?) 
     112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dmgwi         !: Variation of the mass of snow ice 
     113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_ice, v_ice  !: two components of the ice   velocity at I-point (m/s) 
     114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce, v_oce  !: two components of the ocean velocity at I-point (m/s) 
    112115 
    113    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jplayersp1) ::   tbif  !: Temperature inside the ice/snow layer 
     116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tbif  !: Temperature inside the ice/snow layer 
    114117 
    115118   !!* moment used in the advection scheme 
    116    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxice, syice, sxxice, syyice, sxyice   !: for ice  volume 
    117    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxsn,  sysn,  sxxsn,  syysn,  sxysn    !: for snow volume 
    118    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxa,   sya,   sxxa,   syya,   sxya     !: for ice cover area 
    119    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxc0,  syc0,  sxxc0,  syyc0,  sxyc0    !: for heat content of snow 
    120    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxc1,  syc1,  sxxc1,  syyc1,  sxyc1    !: for heat content of 1st ice layer 
    121    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxc2,  syc2,  sxxc2,  syyc2,  sxyc2    !: for heat content of 2nd ice layer 
    122    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxst,  syst,  sxxst,  syyst,  sxyst    !: for heat content of brine pockets 
     119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxice, syice, sxxice, syyice, sxyice   !: for ice  volume 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxsn,  sysn,  sxxsn,  syysn,  sxysn    !: for snow volume                   
     121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxa,   sya,   sxxa,   syya,   sxya     !: for ice cover area                
     122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxc0,  syc0,  sxxc0,  syyc0,  sxyc0    !: for heat content of snow          
     123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxc1,  syc1,  sxxc1,  syyc1,  sxyc1    !: for heat content of 1st ice layer 
     124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxc2,  syc2,  sxxc2,  syyc2,  sxyc2    !: for heat content of 2nd ice layer 
     125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxst,  syst,  sxxst,  syyst,  sxyst    !: for heat content of brine pockets 
     126   !!---------------------------------------------------------------------- 
     127   CONTAINS 
     128 
     129   INTEGER FUNCTION ice_alloc_2() 
     130      !!----------------------------------------------------------------- 
     131      !!               *** FUNCTION ice_alloc_2 *** 
     132      !!----------------------------------------------------------------- 
     133      USE lib_mpp, ONLY:   ctl_warn   ! MPP library 
     134      INTEGER :: ierr(9)              ! Local variables 
     135      !!----------------------------------------------------------------- 
     136      ierr(:) = 0 
     137      ! 
     138      ALLOCATE( ahiu(jpi,jpj) , pahu(jpi,jpj) ,                      & 
     139         &      ahiv(jpi,jpj) , pahv(jpi,jpj) , ust2s(jpi,jpj) , STAT=ierr(1) ) 
     140         ! 
     141      !* Ice Rheology 
     142#if defined key_lim2_vp 
     143      ALLOCATE( hsnm(jpi,jpj) , hicm(jpi,jpj) , STAT=ierr(2) ) 
     144#else 
     145      ALLOCATE( stress1_i (jpi,jpj) , delta_i(jpi,jpj) , at_i(jpi,jpj) ,     & 
     146                stress2_i (jpi,jpj) , divu_i (jpi,jpj) , hsnm(jpi,jpj) ,     & 
     147                stress12_i(jpi,jpj) , shear_i(jpi,jpj) , hicm(jpi,jpj) , STAT=ierr(2) ) 
     148#endif 
     149      ALLOCATE( rdvosif(jpi,jpj) , rdvobif(jpi,jpj) ,                      & 
     150         &      fdvolif(jpi,jpj) , rdvonif(jpi,jpj) ,                      & 
     151         &      sist   (jpi,jpj) , tfu    (jpi,jpj) , hicif(jpi,jpj) ,     & 
     152         &      hsnif  (jpi,jpj) , hicifp (jpi,jpj) , frld (jpi,jpj) , STAT=ierr(3) ) 
     153 
     154      ALLOCATE(phicif(jpi,jpj) , pfrld  (jpi,jpj) , qstoif (jpi,jpj) ,     & 
     155         &     fbif  (jpi,jpj) , rdmsnif(jpi,jpj) , rdmicif(jpi,jpj) ,     & 
     156         &     qldif (jpi,jpj) , qcmif  (jpi,jpj) , fdtcn  (jpi,jpj) ,     & 
     157         &     qdtcn (jpi,jpj) , thcm   (jpi,jpj)                    , STAT=ierr(4) ) 
     158 
     159      ALLOCATE(fstric(jpi,jpj) , ffltbif(jpi,jpj) , fscmbq(jpi,jpj) ,     & 
     160         &     fsbbq (jpi,jpj) , qfvbq  (jpi,jpj) , dmgwi (jpi,jpj) ,     & 
     161         &     u_ice (jpi,jpj) , v_ice  (jpi,jpj) ,                       & 
     162         &     u_oce (jpi,jpj) , v_oce  (jpi,jpj) ,                       & 
     163         &     tbif  (jpi,jpj,jplayersp1)                           , STAT=ierr(5)) 
     164 
     165      !* moment used in the advection scheme 
     166      ALLOCATE(sxice (jpi,jpj) , syice (jpi,jpj) , sxxice(jpi,jpj) ,     & 
     167         &     syyice(jpi,jpj) , sxyice(jpi,jpj) ,                       & 
     168         &     sxsn  (jpi,jpj) , sysn  (jpi,jpj) , sxxsn (jpi,jpj) ,     & 
     169         &     syysn (jpi,jpj) , sxysn (jpi,jpj)                   , STAT=ierr(6) ) 
     170      ALLOCATE(sxa   (jpi,jpj) , sya   (jpi,jpj) , sxxa  (jpi,jpj) ,     & 
     171         &     syya  (jpi,jpj) , sxya  (jpi,jpj) ,                       &  
     172         &     sxc0  (jpi,jpj) , syc0  (jpi,jpj) , sxxc0 (jpi,jpj) ,     & 
     173         &     syyc0 (jpi,jpj) , sxyc0 (jpi,jpj)                   , STAT=ierr(7)) 
     174      ALLOCATE(sxc1  (jpi,jpj) , syc1  (jpi,jpj) , sxxc1 (jpi,jpj) ,     & 
     175         &     syyc1 (jpi,jpj) , sxyc1 (jpi,jpj) ,                       & 
     176         &     sxc2  (jpi,jpj) , syc2  (jpi,jpj) , sxxc2 (jpi,jpj) ,     & 
     177         &     syyc2 (jpi,jpj) , sxyc2 (jpi,jpj)                   , STAT=ierr(8)) 
     178      ALLOCATE(sxst  (jpi,jpj) , syst  (jpi,jpj) , sxxst (jpi,jpj) ,     & 
     179         &     syyst (jpi,jpj) , sxyst (jpi,jpj)                   , STAT=ierr(9)) 
     180         ! 
     181      ice_alloc_2 = MAXVAL( ierr ) 
     182      ! 
     183      IF( ice_alloc_2 /= 0 )   CALL ctl_warn('ice_alloc_2: failed to allocate arrays') 
     184      ! 
     185   END FUNCTION ice_alloc_2 
    123186 
    124187#else 
     
    127190   !!---------------------------------------------------------------------- 
    128191#endif 
    129  
    130    !!---------------------------------------------------------------------- 
     192   !!----------------------------------------------------------------- 
    131193   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    132194   !! $Id$ 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90

    r2528 r2715  
    44   !!   Sea-ice model : LIM 2.0 Sea ice model Initialization 
    55   !!====================================================================== 
    6    !! History :   1.0  !  02-08  (G. Madec)  F90: Free form and modules 
    7    !!             2.0  !  03-08  (C. Ethe)  add ice_run 
    8    !!             3.3  !  09-05  (G.Garric, C. Bricaud) addition of the lim2_evp case 
     6   !! History :  1.0  ! 2002-08  (G. Madec)  F90: Free form and modules 
     7   !!            2.0  ! 2003-08  (C. Ethe)  add ice_run 
     8   !!            3.3  ! 2009-05  (G. Garric, C. Bricaud) addition of the lim2_evp case 
     9   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_lim2 
     
    1213   !!   'key_lim2' :                                  LIM 2.0 sea-ice model 
    1314   !!---------------------------------------------------------------------- 
    14    !!---------------------------------------------------------------------- 
    1515   !!   ice_init_2       : sea-ice model initialization 
    1616   !!   ice_run_2        : Definition some run parameter for ice model 
    1717   !!---------------------------------------------------------------------- 
     18   USE phycst           ! physical constants 
    1819   USE dom_oce          ! ocean domain 
    19    USE dom_ice_2        ! LIM2: ice domain 
    2020   USE sbc_oce          ! surface boundary condition: ocean 
    21    USE sbc_ice          ! surface boundary condition: ice 
    22    USE phycst           ! Define parameters for the routines 
    23    USE ice_2            ! LIM2: ice variable 
    24    USE limmsh_2         ! LIM2: mesh 
    25    USE limistate_2      ! LIM2: initial state 
    26    USE limrst_2         ! LIM2: restart 
     21   USE sbc_ice          ! LIM2 surface boundary condition 
     22   USE dom_ice_2        ! LIM2 ice domain 
     23   USE par_ice_2        ! LIM2 parameters 
     24   USE thd_ice_2        ! LIM2 thermodynamical variables 
     25   USE limrhg           ! LIM2 rheology 
     26   USE ice_2            ! LIM2 ice variable 
     27   USE limmsh_2         ! LIM2 mesh 
     28   USE limistate_2      ! LIM2 initial state 
     29   USE limrst_2         ! LIM2 restart 
     30   USE limsbc_2         ! LIM2 surface boundary condition 
    2731   USE in_out_manager   ! I/O manager 
    28        
     32   USE lib_mpp          ! MPP library 
     33 
    2934   IMPLICIT NONE 
    3035   PRIVATE 
     
    3338 
    3439   !!---------------------------------------------------------------------- 
    35    !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
     40   !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) 
    3641   !! $Id$  
    3742   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    4550      !! ** purpose :   initialisation of LIM-2 domain and variables   
    4651      !!---------------------------------------------------------------------- 
     52      INTEGER :: ierr 
     53      !!---------------------------------------------------------------------- 
    4754      ! 
     55      IF(lwp) THEN 
     56         WRITE(numout,*) 
     57         WRITE(numout,*) 'ice_init_2 : LIM-2 sea-ice - initialization' 
     58         WRITE(numout,*) '~~~~~~~~~~~   ' 
     59      ENDIF 
     60      !                                ! Allocate the ice arrays 
     61      ierr =        ice_alloc_2    ()       ! ice variables 
     62      ierr = ierr + dom_ice_alloc_2()       ! domain 
     63      ierr = ierr + sbc_ice_alloc  ()       ! surface forcing 
     64      ierr = ierr + thd_ice_alloc_2()       ! thermodynamics 
     65#if ! defined key_lim2_vp 
     66      ierr = ierr + lim_rhg_alloc  () 
     67#endif 
     68      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     69      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ice_init_2 : unable to allocate ice arrays' ) 
     70 
     71      !                                ! adequation jpk versus ice/snow layers 
     72      IF( jpl > jpk  .OR.  jplayersp1 > jpk  )   CALL ctl_stop( 'STOP',           & 
     73         &     'ice_init: the 3rd dimension of workspace arrays is too small.',   & 
     74         &     'use more ocean levels or less ice layers/categories.' ) 
     75 
    4876      !                                ! Open the namelist file  
    4977      CALL ctl_opn( numnam_ice, 'namelist_ice', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )  
     
    6189      ENDIF 
    6290      ! 
    63       tn_ice(:,:,1) = sist(:,:)        ! initialisation of ice temperature    
    64       fr_i  (:,:) = 1.0 - frld(:,:)    ! initialisation of sea-ice fraction     
     91      tn_ice(:,:,1) = sist(:,:)        ! ice temperature  known by the ocean 
     92      fr_i  (:,:)   = 1.0 - frld(:,:)  ! sea-ice fraction known by the ocean 
     93      ! 
     94      CALL lim_sbc_init_2              ! ice surface boundary condition    
     95      ! 
     96      IF( lk_lim2_vp )   THEN   ;   WRITE(numout,*) '                VP  rheology - B-grid case' 
     97      ELSE                      ;   WRITE(numout,*) '                EVP rheology - C-grid case' 
     98      ENDIF 
    6599      ! 
    66100   END SUBROUTINE ice_init_2 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90

    r2528 r2715  
    2222   USE lbclnk 
    2323   USE in_out_manager     ! I/O manager 
     24   USE lib_mpp            ! MPP library 
    2425   USE prtctl             ! Print control 
    2526 
     
    5859      !! Reference:  Prather, 1986, JGR, 91, D6. 6671-6681. 
    5960      !!-------------------------------------------------------------------- 
     61      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     62      USE wrk_nemo, ONLY:   zf0  => wrk_2d_11 , zfx   => wrk_2d_12 , zfy    => wrk_2d_13 , zbet => wrk_2d_14   ! 2D workspace 
     63      USE wrk_nemo, ONLY:   zfm  => wrk_2d_15 , zfxx  => wrk_2d_16 , zfyy   => wrk_2d_17 , zfxy => wrk_2d_18   !  -      - 
     64      USE wrk_nemo, ONLY:   zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21                       !  -      - 
     65      ! 
    6066      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step 
    6167      REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0) 
     
    6571      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psx , psy          ! 1st moments  
    6672      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments 
    67       !!  
     73      !  
    6874      INTEGER  ::   ji, jj                               ! dummy loop indices 
    6975      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! temporary scalars 
    7076      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         - 
    7177      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         - 
    72       REAL(wp), DIMENSION(jpi,jpj) ::   zf0, zfx , zfy , zbet   ! 2D workspace 
    73       REAL(wp), DIMENSION(jpi,jpj) ::   zfm, zfxx, zfyy, zfxy   !  -      - 
    74       REAL(wp), DIMENSION(jpi,jpj) ::   zalg, zalg1, zalg1q     !  -      - 
    7578      !--------------------------------------------------------------------- 
     79 
     80      IF( wrk_in_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 
     81         CALL ctl_stop( 'lim_adv_x_2 : requested workspace arrays unavailable.' )   ;   RETURN 
     82      ENDIF 
    7683 
    7784      ! Limitation of moments.                                            
     
    218225      ENDIF 
    219226      ! 
     227      IF( wrk_not_released(2, 11,12,13,14,15,16,17,18,19,20,21) )   & 
     228          CALL ctl_stop( 'lim_adv_x_2 : failed to release workspace arrays.' ) 
     229      ! 
    220230   END SUBROUTINE lim_adv_x_2 
    221231 
     
    235245      !! Reference:  Prather, 1986, JGR, 91, D6. 6671-6681. 
    236246      !!--------------------------------------------------------------------- 
     247      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     248      USE wrk_nemo, ONLY:   zf0  => wrk_2d_11 , zfx   => wrk_2d_12 , zfy    => wrk_2d_13 , zbet => wrk_2d_14   ! 2D workspace 
     249      USE wrk_nemo, ONLY:   zfm  => wrk_2d_15 , zfxx  => wrk_2d_16 , zfyy   => wrk_2d_17 , zfxy => wrk_2d_18   !  -      - 
     250      USE wrk_nemo, ONLY:   zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21                       !  -      - 
     251      !! 
    237252      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step 
    238253      REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0) 
     
    247262      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         - 
    248263      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         - 
    249       REAL(wp), DIMENSION(jpi,jpj) ::   zf0, zfx , zfy , zbet   ! 2D workspace 
    250       REAL(wp), DIMENSION(jpi,jpj) ::   zfm, zfxx, zfyy, zfxy   !  -      - 
    251       REAL(wp), DIMENSION(jpi,jpj) ::   zalg, zalg1, zalg1q     !  -      - 
    252264      !--------------------------------------------------------------------- 
     265 
     266      IF(wrk_in_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 
     267         CALL ctl_stop( 'lim_adv_y_2 : requested workspace arrays unavailable.' )   ;   RETURN 
     268      END IF 
    253269 
    254270      ! Limitation of moments. 
     
    398414      ENDIF 
    399415      ! 
     416      IF( wrk_not_released(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 
     417        CALL ctl_stop( 'lim_adv_y_2 : failed to release workspace arrays.' ) 
     418      END IF 
     419      ! 
    400420   END SUBROUTINE lim_adv_y_2 
    401421 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90

    r2528 r2715  
    1212   !!   'key_lim2' :                                  LIM 2.0 sea-ice model 
    1313   !!---------------------------------------------------------------------- 
    14    !!---------------------------------------------------------------------- 
    1514   !!   lim_dia_2      : computation of the time evolution of keys var. 
    1615   !!   lim_dia_init_2 : initialization and namelist read 
     
    2423   USE limistate_2     ! 
    2524   USE in_out_manager  ! I/O manager 
     25   USE lib_mpp         ! MPP library 
    2626 
    2727   IMPLICIT NONE 
     
    2929 
    3030   PUBLIC               lim_dia_2          ! called by sbc_ice_lim_2 
     31 
    3132   INTEGER, PUBLIC ::   ntmoy   = 1 ,   &  !: instantaneous values of ice evolution or averaging ntmoy 
    3233      &                 ninfo   = 1        !: frequency of ouputs on file ice_evolu in case of averaging 
     
    5253   REAL(wp)                     ::   epsi06 = 1.e-06      ! ??? 
    5354   REAL(wp), DIMENSION(jpinfmx) ::   vinfom               ! temporary working space 
    54    REAL(wp), DIMENSION(jpi,jpj) ::   aire                 ! masked grid cell area 
     55   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   aire                 ! masked grid cell area 
    5556 
    5657   !! * Substitutions 
     
    6162   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6263   !!---------------------------------------------------------------------- 
    63  
    6464CONTAINS 
    6565 
     
    173173       !!------------------------------------------------------------------- 
    174174       CHARACTER(len=jpchinf) ::   titinf 
    175        INTEGER  ::   jv            ! dummy loop indice 
    176        INTEGER  ::   ntot , ndeb  
    177        INTEGER  ::   nv            ! indice of variable  
    178        REAL(wp) ::   zxx0, zxx1    ! temporary scalars 
     175       INTEGER  ::   jv   ! dummy loop indice 
     176       INTEGER  ::   ntot , ndeb, nv, ierr   ! local integer 
     177       REAL(wp) ::   zxx0, zxx1              ! local scalars 
    179178 
    180179       NAMELIST/namicedia/fmtinf, nfrinf, ninfo, ntmoy 
    181180       !!------------------------------------------------------------------- 
    182181 
    183        ! Read Namelist namicedia 
    184        REWIND ( numnam_ice ) 
    185        READ   ( numnam_ice  , namicedia ) 
     182       REWIND( numnam_ice )                     ! Read Namelist namicedia 
     183       READ  ( numnam_ice  , namicedia ) 
    186184        
    187        IF(lwp) THEN 
     185       IF(lwp) THEN                             ! control print 
    188186          WRITE(numout,*) 
    189187          WRITE(numout,*) 'lim_dia_init_2 : ice parameters for ice diagnostics ' 
     
    195193       ENDIF 
    196194 
    197        ! masked grid cell area 
     195       ALLOCATE( aire(jpi,jpj) , STAT=ierr )    ! masked grid cell area 
     196       IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     197       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'lim_dia_init_2 : unable to allocate standard arrays' ) 
    198198       aire(:,:) = area(:,:) * tms(:,:) 
    199199 
    200        ! Titles of ice key variables : 
    201        nv = 1 
     200       nv = 1                                   ! Titles of ice key variables 
    202201       titvar(nv) = 'NoIt'  ! iteration number 
    203202       nv = nv + 1 
    204203       titvar(nv) = 'T yr'  ! time step in years 
    205         
    206204       nbvt = nv - 1 
    207  
    208205       nv = nv + 1   ;   titvar(nv) = 'AEFN' ! sea ice area in the northern Hemisp.(10^12 km2) 
    209206       nv = nv + 1   ;   titvar(nv) = 'AEFS' ! sea ice area in the southern Hemisp.(10^12 km2) 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90

    r2528 r2715  
    1313   !!   lim_dmp_2      : ice model damping 
    1414   !!---------------------------------------------------------------------- 
    15    USE in_out_manager  ! I/O manager 
    1615   USE ice_2           ! ice variables  
    1716   USE sbc_oce, ONLY : nn_fsbc ! for fldread 
    1817   USE dom_oce         ! for mi0; mi1 etc ... 
    1918   USE fldread         ! read input fields 
    20     
     19   USE in_out_manager  ! I/O manager 
     20   USE lib_mpp         ! MPP library 
     21 
    2122   IMPLICIT NONE 
    2223   PRIVATE 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90

    r2528 r2715  
    5858      !!              - treatment of the case if no ice dynamic 
    5959      !!--------------------------------------------------------------------- 
     60      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     61      USE wrk_nemo, ONLY:   wrk_1d_1, wrk_1d_2 
     62      USE wrk_nemo, ONLY:   zu_io => wrk_2d_1, zv_io => wrk_2d_2  ! ice-ocean velocity 
     63      ! 
    6064      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    6165      !! 
     
    6367      INTEGER  ::   i_j1, i_jpj        ! Starting/ending j-indices for rheology 
    6468      REAL(wp) ::   zcoef              ! temporary scalar 
    65       REAL(wp), DIMENSION(jpj)     ::   zind           ! i-averaged indicator of sea-ice 
    66       REAL(wp), DIMENSION(jpj)     ::   zmsk           ! i-averaged of tmask 
    67       REAL(wp), DIMENSION(jpi,jpj) ::   zu_io, zv_io   ! ice-ocean velocity 
     69      REAL(wp), POINTER, DIMENSION(:) ::   zind     ! i-averaged indicator of sea-ice 
     70      REAL(wp), POINTER, DIMENSION(:) ::   zmsk     ! i-averaged of tmask 
    6871      !!--------------------------------------------------------------------- 
     72 
     73      IF(  wrk_in_use(1, 1,2)  .OR.  wrk_in_use(2, 1,2)  ) THEN 
     74         CALL ctl_stop( 'lim_dyn_2 : requested workspace arrays unavailable' )   ;   RETURN 
     75      ENDIF 
     76      zind => wrk_1d_1(1:jpj)      ! Set-up pointers to sub-arrays of workspaces 
     77      zmsk => wrk_1d_2(1:jpj) 
    6978 
    7079      IF( kt == nit000 )   CALL lim_dyn_init_2   ! Initialization (first time-step only) 
     
    93102            ! 
    94103            DO jj = 1, jpj 
    95                zind(jj) = SUM( frld (:,jj  ) )   ! = FLOAT(jpj) if ocean everywhere on a j-line 
    96                zmsk(jj) = SUM( tmask(:,jj,1) )   ! = 0          if land  everywhere on a j-line 
     104               zind(jj) = SUM( frld (:,jj  ) )   ! = REAL(jpj) if ocean everywhere on a j-line 
     105               zmsk(jj) = SUM( tmask(:,jj,1) )   ! = 0         if land  everywhere on a j-line 
    97106            END DO 
    98107            ! 
     
    200209      ! 
    201210      IF(ln_ctl)   CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn  : ust2s :') 
     211      ! 
     212      IF( wrk_not_released(1, 1,2)     .OR.   & 
     213          wrk_not_released(2, 1,2) )   CALL ctl_stop('lim_dyn_2 : failed to release workspace arrays') 
    202214      ! 
    203215   END SUBROUTINE lim_dyn_2 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90

    r2528 r2715  
    44   !! LIM 2.0 ice model : horizontal diffusion of sea-ice quantities 
    55   !!====================================================================== 
     6   !! History :  LIM  !  2000-01 (LIM) Original code 
     7   !!             -   !  2001-05 (G. Madec, R. Hordoir) opa norm 
     8   !!            1.0  !  2002-08 (C. Ethe)  F90, free form 
     9   !!---------------------------------------------------------------------- 
    610#if defined key_lim2 
    711   !!---------------------------------------------------------------------- 
     
    1014   !!   lim_hdf_2  : diffusion trend on sea-ice variable 
    1115   !!---------------------------------------------------------------------- 
    12    !! * Modules used 
    13    USE dom_oce 
    14    USE in_out_manager 
    15    USE ice_2 
    16    USE lbclnk 
    17    USE lib_mpp 
    18    USE prtctl          ! Print control 
     16   USE dom_oce          ! ocean domain 
     17   USE ice_2            ! LIM-2: ice variables 
     18   USE lbclnk           ! lateral boundary condition - MPP exchanges 
     19   USE lib_mpp          ! MPP library 
     20   USE prtctl           ! Print control 
     21   USE in_out_manager   ! I/O manager 
    1922 
    2023   IMPLICIT NONE 
    2124   PRIVATE 
    2225 
    23    !! * Routine accessibility 
    24    PUBLIC lim_hdf_2    ! called by lim_tra_2 
     26   PUBLIC   lim_hdf_2         ! called by limtrp_2.F90 
    2527 
    26    !! * Module variables 
    27    LOGICAL  ::   linit = .TRUE.              ! ??? 
    28    REAL(wp) ::   epsi04 = 1e-04              ! constant 
    29    REAL(wp), DIMENSION(jpi,jpj) ::   zfact   ! ??? 
     28   LOGICAL  ::   linit = .TRUE.   ! ! initialization flag (set to flase after the 1st call) 
     29   REAL(wp) ::   epsi04 = 1e-04   ! constant 
     30    
     31   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   efact   ! metric coefficient 
    3032 
    3133   !! * Substitution  
    3234#  include "vectopt_loop_substitute.h90" 
    3335   !!---------------------------------------------------------------------- 
    34    !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
     36   !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2010) 
    3537   !! $Id$ 
    36    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3739   !!---------------------------------------------------------------------- 
    38  
    3940CONTAINS 
    4041 
     
    4344      !!                  ***  ROUTINE lim_hdf_2  *** 
    4445      !! 
    45       !! ** purpose :   Compute and add the diffusive trend on sea-ice 
    46       !!      variables 
     46      !! ** purpose :   Compute and add the diffusive trend on sea-ice variables 
    4747      !! 
    4848      !! ** method  :   Second order diffusive operator evaluated using a 
    49       !!      Cranck-Nicholson time Scheme. 
     49      !!              Cranck-Nicholson time Scheme. 
    5050      !! 
    5151      !! ** Action  :    update ptab with the diffusive contribution 
    52       !! 
    53       !! History : 
    54       !!        !  00-01 (LIM) Original code 
    55       !!        !  01-05 (G. Madec, R. Hordoir) opa norm 
    56       !!        !  02-08 (C. Ethe)  F90, free form 
    5752      !!------------------------------------------------------------------- 
    58       ! * Arguments 
    59       REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   & 
    60          ptab                 ! Field on which the diffusion is applied   
    61       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    62          ptab0                ! ??? 
    63  
    64       ! * Local variables 
    65       INTEGER ::  ji, jj      ! dummy loop indices 
    66       INTEGER ::  & 
    67          its, iter            ! temporary integers 
     53      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     54      USE wrk_nemo, ONLY:   zflu => wrk_2d_11, zdiv  => wrk_2d_13, zrlx  => wrk_2d_15  
     55      USE wrk_nemo, ONLY:   zflv => wrk_2d_12, zdiv0 => wrk_2d_14, ztab0 => wrk_2d_16 
     56      ! 
     57      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   ptab   ! Field on which the diffusion is applied   
     58      ! 
     59      INTEGER  ::   ji, jj            ! dummy loop indices 
     60      INTEGER  ::   its, iter, ierr   ! local integers 
     61      REAL(wp) ::   zalfa, zrlxint, zconv, zeps   ! local scalars 
    6862      CHARACTER (len=55) :: charout 
    69       REAL(wp) ::  & 
    70          zalfa, zrlxint, zconv, zeps   ! temporary scalars 
    71       REAL(wp), DIMENSION(jpi,jpj) ::  &  
    72          zrlx, zflu, zflv, &  ! temporary workspaces 
    73          zdiv0, zdiv          !    "           " 
    7463      !!------------------------------------------------------------------- 
    7564 
    76       ! Initialisation 
    77       ! ---------------    
    78       ! Time integration parameters 
    79       zalfa = 0.5       ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 
    80       its   = 100       ! Maximum number of iteration 
    81       zeps  =  2. * epsi04 
     65      IF( wrk_in_use(2, 11,12,13,14,15,16) ) THEN 
     66         CALL ctl_stop( 'lim_hdf_2 : requested workspace arrays unavailable.' )   ;   RETURN 
     67      END IF 
    8268 
    83       ! Arrays initialization 
    84       ptab0 (:, : ) = ptab(:,:) 
    85 !bug  zflu (:,jpj) = 0.e0 
    86 !bug  zflv (:,jpj) = 0.e0 
    87       zdiv0(:, 1 ) = 0.e0 
    88       zdiv0(:,jpj) = 0.e0 
    89       IF( .NOT.lk_vopt_loop ) THEN 
    90          zflu (jpi,:) = 0.e0    
    91          zflv (jpi,:) = 0.e0 
    92          zdiv0(1,  :) = 0.e0 
    93          zdiv0(jpi,:) = 0.e0 
    94       ENDIF 
    95  
    96       ! Metric coefficient (compute at the first call and saved in 
    97       IF( linit ) THEN 
     69      !                       !==  Initialisation  ==! 
     70      ! 
     71      IF( linit ) THEN              ! Metric coefficient (compute at the first call and saved in efact) 
     72         ALLOCATE( efact(jpi,jpj) , STAT=ierr ) 
     73         IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     74         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'lim_hdf_2 : unable to allocate standard arrays' ) 
    9875         DO jj = 2, jpjm1   
    9976            DO ji = fs_2 , fs_jpim1   ! vector opt. 
    100                zfact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj  ) + e1v(ji,jj) + e1v(ji,jj-1) ) & 
    101                   &          / ( e1t(ji,jj) * e2t(ji,jj) ) 
     77               efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) / ( e1t(ji,jj) * e2t(ji,jj) ) 
    10278            END DO 
    10379         END DO 
    10480         linit = .FALSE. 
    10581      ENDIF 
     82      ! 
     83      !                             ! Time integration parameters 
     84      zalfa = 0.5_wp                      ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 
     85      its   = 100                         ! Maximum number of iteration 
     86      zeps  =  2._wp * epsi04 
     87      ! 
     88      ztab0(:, : ) = ptab(:,:)      ! Arrays initialization 
     89      zdiv0(:, 1 ) = 0._wp 
     90      zdiv0(:,jpj) = 0._wp 
     91      IF( .NOT.lk_vopt_loop ) THEN 
     92         zflu (jpi,:) = 0._wp    
     93         zflv (jpi,:) = 0._wp 
     94         zdiv0(1,  :) = 0._wp 
     95         zdiv0(jpi,:) = 0._wp 
     96      ENDIF 
    10697 
    107  
    108       ! Sub-time step loop 
    109       zconv = 1.e0 
     98      zconv = 1._wp           !==  horizontal diffusion using a Crant-Nicholson scheme  ==! 
    11099      iter  = 0 
    111  
    112       !                                                   !=================== 
    113       DO WHILE ( ( zconv > zeps ) .AND. (iter <= its) )   ! Sub-time step loop 
    114          !                                                !=================== 
    115          ! incrementation of the sub-time step number 
    116          iter = iter + 1 
    117  
    118          ! diffusive fluxes in U- and V- direction 
    119          DO jj = 1, jpjm1 
     100      ! 
     101      DO WHILE (  zconv > zeps  .AND.  iter <= its  )    ! Sub-time step loop 
     102         ! 
     103         iter = iter + 1                                       ! incrementation of the sub-time step number 
     104         ! 
     105         DO jj = 1, jpjm1                                      ! diffusive fluxes in U- and V- direction 
    120106            DO ji = 1 , fs_jpim1   ! vector opt. 
    121107               zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 
     
    123109            END DO 
    124110         END DO 
    125  
    126          ! diffusive trend : divergence of the fluxes 
    127          DO jj= 2, jpjm1 
     111         ! 
     112         DO jj= 2, jpjm1                                       ! diffusive trend : divergence of the fluxes 
    128113            DO ji = fs_2 , fs_jpim1   ! vector opt.  
    129114               zdiv (ji,jj) = (  zflu(ji,jj) - zflu(ji-1,jj  )   & 
     
    131116            END DO 
    132117         END DO 
    133  
    134          ! save the first evaluation of the diffusive trend in zdiv0 
    135          IF( iter == 1 )   zdiv0(:,:) = zdiv(:,:)        
    136  
    137          ! XXXX iterative evaluation????? 
    138          DO jj = 2, jpjm1 
     118         ! 
     119         IF( iter == 1 )   zdiv0(:,:) = zdiv(:,:)              ! save the 1st evaluation of the diffusive trend in zdiv0 
     120         ! 
     121         DO jj = 2, jpjm1                                      ! iterative evaluation 
    139122            DO ji = fs_2 , fs_jpim1   ! vector opt. 
    140                zrlxint = (   ptab0(ji,jj)    & 
    141                   &       +  rdt_ice * (           zalfa   * ( zdiv(ji,jj) + zfact(ji,jj) * ptab(ji,jj) )   & 
     123               zrlxint = (   ztab0(ji,jj)    & 
     124                  &       +  rdt_ice * (           zalfa   * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj) )   & 
    142125                  &                      + ( 1.0 - zalfa ) *   zdiv0(ji,jj) )  )                             &  
    143                   &    / ( 1.0 + zalfa * rdt_ice * zfact(ji,jj) ) 
     126                  &    / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) ) 
    144127               zrlx(ji,jj) = ptab(ji,jj) + om * ( zrlxint - ptab(ji,jj) ) 
    145128            END DO 
    146129         END DO 
     130         CALL lbc_lnk( zrlx, 'T', 1. )                         ! lateral boundary condition 
    147131 
    148          ! lateral boundary condition on ptab 
    149          CALL lbc_lnk( zrlx, 'T', 1. ) 
     132         zconv = 0._wp                                         ! convergence test 
    150133 
    151          ! convergence test 
    152          zconv = 0.e0 
    153134         DO jj = 2, jpjm1 
    154135            DO ji = 2, jpim1 
     
    156137            END DO 
    157138         END DO 
    158          IF( lk_mpp )   CALL mpp_max( zconv )   ! max over the global domain 
     139         IF( lk_mpp )   CALL mpp_max( zconv )                  ! max over the global domain 
    159140 
    160141         ptab(:,:) = zrlx(:,:) 
    161  
    162          !                                         !========================== 
    163       END DO                                       ! end of sub-time step loop 
    164       !                                            !========================== 
     142         ! 
     143      END DO                                             ! end of sub-time step loop 
    165144 
    166145      IF(ln_ctl)   THEN 
    167          zrlx(:,:) = ptab(:,:) - ptab0(:,:) 
     146         zrlx(:,:) = ptab(:,:) - ztab0(:,:) 
    168147         WRITE(charout,FMT="(' lim_hdf  : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter 
    169          CALL prt_ctl(tab2d_1=zrlx, clinfo1=charout) 
     148         CALL prt_ctl( tab2d_1=zrlx, clinfo1=charout ) 
    170149      ENDIF 
    171  
     150      ! 
     151      IF( wrk_not_released(2, 11,12,13,14,15,16) )   CALL ctl_stop('lim_hdf_2: failed to release workspace arrays') 
     152      ! 
    172153   END SUBROUTINE lim_hdf_2 
    173154 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90

    r2528 r2715  
    1919   USE lbclnk 
    2020   USE in_out_manager 
     21   USE lib_mpp          ! MPP library 
    2122 
    2223   IMPLICIT NONE 
     
    4546      !! ** Refer.  : Deleersnijder et al. Ocean Modelling 100, 7-10  
    4647      !!---------------------------------------------------------------------  
     48      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     49      USE wrk_nemo, ONLY: zd2d1 => wrk_2d_1, zd1d2 => wrk_2d_2 
    4750      INTEGER :: ji, jj      ! dummy loop indices 
    4851      REAL(wp) ::   zusden   ! local scalars 
     
    5154      REAL(wp) ::   zh1p  , zh2p      !   -      - 
    5255      REAL(wp) ::   zd2d1p, zd1d2p    !   -      - 
    53       REAL(wp), DIMENSION(jpi,jpj) ::   zd2d1 , zd1d2   ! 2D workspace 
    5456#endif 
    5557      !!--------------------------------------------------------------------- 
     58 
     59      IF( wrk_in_use(2, 1,2) ) THEN 
     60         CALL ctl_stop('lim_msh_2 : requested workspace arrays unavailable')   ;   RETURN 
     61      ENDIF 
    5662 
    5763      IF(lwp) THEN 
     
    275281      area(:,:) = e1t(:,:) * e2t(:,:) 
    276282      ! 
     283      IF( wrk_not_released(2, 1,2) )   CALL ctl_stop('lim_msh_2 : failed to release workspace arrays') 
     284      ! 
    277285   END SUBROUTINE lim_msh_2 
    278286 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90

    r2528 r2715  
    3333   PRIVATE 
    3434 
    35    PUBLIC   lim_rhg_2 ! routine called by lim_dyn 
     35   PUBLIC   lim_rhg_2         ! routine called by lim_dyn 
     36   PUBLIC   lim_rhg_alloc_2   ! routine called by lim_dyn_alloc_2 
    3637 
    3738   REAL(wp) ::   rzero   = 0._wp   ! constant value: zero 
    3839   REAL(wp) ::   rone    = 1._wp   !            and  one 
     40 
     41   ! 2D workspaces for lim_rhg_2. Can't use wrk_nemo module for them because 
     42   ! extent in 2nd dimension is > jpj. 
     43   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   zu0, zv0 
     44   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   zu_n, zv_n 
     45   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   zu_a, zv_a 
     46   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   zviszeta, zviseta 
     47   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   zzfrld, zztms 
     48   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   zi1, zi2, zmasst, zpresh 
    3949 
    4050   !! * Substitutions 
     
    4656   !!---------------------------------------------------------------------- 
    4757CONTAINS 
     58 
     59   INTEGER FUNCTION lim_rhg_alloc_2() 
     60      !!------------------------------------------------------------------- 
     61      !!               ***  FUNCTION lim_rhg_alloc_2  *** 
     62      !!------------------------------------------------------------------- 
     63      ALLOCATE( zu0(jpi,0:jpj+1),      zv0(jpi,0:jpj+1),     & 
     64         &      zu_n(jpi,0:jpj+1),     zv_n(jpi,0:jpj+1),    & 
     65         &      zu_a(jpi,0:jpj+1),     zv_a(jpi,0:jpj+1),    & 
     66         &      zviszeta(jpi,0:jpj+1), zviseta(jpi,0:jpj+1), & 
     67         &      zzfrld(jpi,0:jpj+1),   zztms(jpi,0:jpj+1),   & 
     68         &      zi1(jpi,0:jpj+1),      zi2(jpi,0:jpj+1),     & 
     69         &      zmasst(jpi,0:jpj+1),   zpresh(jpi,0:jpj+1),  & 
     70         &      Stat=lim_rhg_alloc_2) 
     71         ! 
     72      IF( lim_rhg_alloc_2 /= 0 )   CALL ctl_warn('lim_rhg_alloc_2 : failed to allocate arrays') 
     73      ! 
     74   END FUNCTION lim_rhg_alloc_2 
     75 
    4876 
    4977   SUBROUTINE lim_rhg_2( k_j1, k_jpj ) 
     
    5987      !!              at I-point 
    6088      !!------------------------------------------------------------------- 
     89      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     90      USE wrk_nemo, ONLY: zfrld => wrk_2d_1, zmass => wrk_2d_2, zcorl => wrk_2d_3 
     91      USE wrk_nemo, ONLY: za1ct => wrk_2d_4, za2ct => wrk_2d_5, zresr => wrk_2d_6 
     92      USE wrk_nemo, ONLY: zc1u  => wrk_2d_7, zc1v  => wrk_2d_8, zc2u => wrk_2d_9 
     93      USE wrk_nemo, ONLY: zc2v  => wrk_2d_10, zsang => wrk_2d_11 
     94      !! 
    6195      INTEGER, INTENT(in) ::   k_j1    ! southern j-index for ice computation 
    6296      INTEGER, INTENT(in) ::   k_jpj   ! northern j-index for ice computation 
     
    79113      REAL(wp) ::   zs21_11, zs21_12, zs21_21, zs21_22 
    80114      REAL(wp) ::   zs22_11, zs22_12, zs22_21, zs22_22 
    81       REAL(wp), DIMENSION(jpi,  jpj  ) ::   zfrld, zmass, zcorl 
    82       REAL(wp), DIMENSION(jpi,  jpj  ) ::   za1ct, za2ct, zresr 
    83       REAL(wp), DIMENSION(jpi,  jpj  ) ::   zc1u, zc1v, zc2u, zc2v 
    84       REAL(wp), DIMENSION(jpi,  jpj  ) ::   zsang 
    85       REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zu0, zv0 
    86       REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zu_n, zv_n 
    87       REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zu_a, zv_a 
    88       REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zviszeta, zviseta 
    89       REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zzfrld, zztms 
    90       REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zi1, zi2, zmasst, zpresh 
    91115      !!------------------------------------------------------------------- 
    92116       
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r2566 r2715  
    99   !!            3.3  ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case 
    1010   !!             -   ! 2010-11 (G. Madec) ice-ocean stress computed at each ocean time-step 
     11   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    1112   !!---------------------------------------------------------------------- 
    1213#if defined key_lim2 
     
    1415   !!   'key_lim2'                                    LIM 2.0 sea-ice model 
    1516   !!---------------------------------------------------------------------- 
    16    !!   lim_sbc_flx_2  : update mass, heat and salt fluxes at the ocean surface 
    17    !!   lim_sbc_tau_2  : update i- and j-stresses, and its modulus at the ocean surface 
     17   !!   lim_sbc_alloc_2 : allocate the limsbc arrays 
     18   !!   lim_sbc_init    : initialisation 
     19   !!   lim_sbc_flx_2   : update mass, heat and salt fluxes at the ocean surface 
     20   !!   lim_sbc_tau_2   : update i- and j-stresses, and its modulus at the ocean surface 
    1821   !!---------------------------------------------------------------------- 
    1922   USE par_oce          ! ocean parameters 
     
    2730   USE albedo           ! albedo parameters 
    2831   USE lbclnk           ! ocean lateral boundary condition - MPP exchanges 
     32   USE lib_mpp          ! MPP library 
    2933   USE in_out_manager   ! I/O manager 
    3034   USE diaar5, ONLY :   lk_diaar5 
     
    3640   PRIVATE 
    3741 
    38    PUBLIC   lim_sbc_flx_2   ! called by sbc_ice_lim_2 
    39    PUBLIC   lim_sbc_tau_2   ! called by sbc_ice_lim_2 
     42   PUBLIC   lim_sbc_init_2     ! called by ice_init_2 
     43   PUBLIC   lim_sbc_flx_2      ! called by sbc_ice_lim_2 
     44   PUBLIC   lim_sbc_tau_2      ! called by sbc_ice_lim_2 
    4045 
    4146   REAL(wp)  ::   r1_rdtice            ! = 1. / rdt_ice  
     
    4449   REAL(wp)  ::   rone   = 1._wp       !     -      - 
    4550   ! 
    46    REAL(wp), DIMENSION(jpi,jpj) ::   soce_0, sice_0   ! constant SSS and ice salinity used in levitating sea-ice case 
    47  
    48    REAL(wp), DIMENSION(jpi,jpj) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress              [N/m2] 
    49    REAL(wp), DIMENSION(jpi,jpj) ::   tmod_io              ! modulus of the ice-ocean relative velocity   [m/s] 
     51   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   soce_0, sice_0   ! constant SSS and ice salinity used in levitating sea-ice case 
     52 
     53   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress              [N/m2] 
     54   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmod_io              ! modulus of the ice-ocean relative velocity   [m/s] 
    5055 
    5156   !! * Substitutions 
    5257#  include "vectopt_loop_substitute.h90" 
    5358   !!---------------------------------------------------------------------- 
    54    !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
     59   !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) 
    5560   !! $Id$ 
    5661   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5762   !!---------------------------------------------------------------------- 
    5863CONTAINS 
     64 
     65   INTEGER FUNCTION lim_sbc_alloc_2() 
     66      !!------------------------------------------------------------------- 
     67      !!             ***  ROUTINE lim_sbc_alloc_2 *** 
     68      !!------------------------------------------------------------------- 
     69      ALLOCATE( soce_0(jpi,jpj) , utau_oce(jpi,jpj) ,                       & 
     70         &      sice_0(jpi,jpj) , vtau_oce(jpi,jpj) , tmod_io(jpi,jpj), STAT=lim_sbc_alloc_2) 
     71         ! 
     72      IF( lk_mpp               )   CALL mpp_sum( lim_sbc_alloc_2 ) 
     73      IF( lim_sbc_alloc_2 /= 0 )   CALL ctl_warn('lim_sbc_alloc_2: failed to allocate arrays.') 
     74      ! 
     75   END FUNCTION lim_sbc_alloc_2 
     76 
    5977 
    6078   SUBROUTINE lim_sbc_flx_2( kt ) 
     
    82100      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 
    83101      !!--------------------------------------------------------------------- 
     102      USE wrk_nemo, ONLY: wrk_not_released, wrk_in_use 
     103      USE wrk_nemo, ONLY: zqnsoce => wrk_2d_1 ! 2D workspace 
     104      USE wrk_nemo, ONLY: wrk_3d_4, wrk_3d_5 
    84105      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    85106      !! 
     
    90111      REAL(wp) ::   zqsr, zqns, zfm            ! local scalars 
    91112      REAL(wp) ::   zinda, zfons, zemp         !   -      - 
    92       REAL(wp), DIMENSION(jpi,jpj)   ::   zqnsoce       ! 2D workspace 
    93       REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb, zalbp   ! 2D/3D workspace 
     113      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp   ! 2D/3D workspace 
    94114      !!--------------------------------------------------------------------- 
    95115      
    96       IF( kt == nit000 ) THEN 
    97          IF(lwp) WRITE(numout,*) 
    98          IF(lwp) WRITE(numout,*) 'lim_sbc_flx_2 : LIM-2 sea-ice - surface boundary condition - Mass, heat & salt fluxes' 
    99          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   ' 
    100          ! 
    101          r1_rdtice = 1._wp / rdt_ice 
    102          ! 
    103          soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
    104          sice_0(:,:) = sice 
    105          ! 
    106          IF( cp_cfg == "orca" ) THEN            ! decrease ocean & ice reference salinities in the Baltic sea  
    107             WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
    108                &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
    109                soce_0(:,:) = 4._wp 
    110                sice_0(:,:) = 2._wp 
    111             END WHERE 
    112          ENDIF 
    113          ! 
     116      IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 4,5) )THEN 
     117         CALL ctl_stop('lim_sbc_flx_2 : requested workspace arrays unavailable')   ;   RETURN 
    114118      ENDIF 
     119      zalb  => wrk_3d_4(:,:,1:1)      ! Set-up pointers to sub-arrays of 3d workspaces 
     120      zalbp => wrk_3d_5(:,:,1:1) 
    115121 
    116122      !------------------------------------------! 
     
    150156!!$!                -> ice aera increases  ???         -> ice aera decreases ??? 
    151157!!$ 
    152 !!$            iadv    = ( 1  - i1mfr ) * zinda   
     158!!$            iadv    = ( 1  - i1mfr ) * zinda 
    153159!!$!                     pure ocean      ice at 
    154160!!$!                     at current      previous 
     
    159165!!$!                            current          
    160166!!$!                         -> ??? 
    161 !!$  
    162 !!$            ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv  
    163 !!$!                                                    ice disapear                            
     167!!$ 
     168!!$            ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv 
     169!!$!                                                    ice disapear 
    164170!!$ 
    165171!!$ 
     
    229235 
    230236      IF( lk_cpl ) THEN          ! coupled case 
    231          ! Ice surface temperature  
    232237         tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature        
    233          ! Computation of snow/ice and ocean albedo 
     238         !                                  ! Computation of snow/ice and ocean albedo 
    234239         CALL albedo_ice( tn_ice, reshape( hicif, (/jpi,jpj,1/) ), reshape( hsnif, (/jpi,jpj,1/) ), zalbp, zalb ) 
    235240         alb_ice(:,:,1) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys) 
     
    244249         CALL prt_ctl(tab2d_1=fr_i  , clinfo1=' lim_sbc: fr_i   : ', tab2d_2=tn_ice(:,:,1), clinfo2=' tn_ice  : ') 
    245250      ENDIF  
     251      ! 
     252      IF( wrk_not_released(2, 1)     .OR.    & 
     253          wrk_not_released(3, 4,5) )   CALL ctl_stop('lim_sbc_flx_2 : failed to release workspace arrays') 
    246254      ! 
    247255   END SUBROUTINE lim_sbc_flx_2 
     
    274282      !!              - taum       : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes 
    275283      !!--------------------------------------------------------------------- 
     284      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     285      USE wrk_nemo, ONLY: ztio_u => wrk_2d_1, ztio_v => wrk_2d_2     ! ocean stress below sea-ice 
    276286      INTEGER ,                     INTENT(in) ::   kt               ! ocean time-step index 
    277287      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pu_oce, pv_oce   ! surface ocean currents 
     
    281291      REAL(wp) ::   zfrldv, zat_v, zv_i, zvtau_ice, zv_t, zmodi   !   -      - 
    282292      REAL(wp) ::   zsang, zumt                                   !    -         - 
    283       REAL(wp), DIMENSION(jpi,jpj) ::   ztio_u, ztio_v   ! ocean stress below sea-ice 
    284293      !!--------------------------------------------------------------------- 
    285294      ! 
    286       IF( kt == nit000 .AND. lwp ) THEN         ! control print 
    287          WRITE(numout,*) 
    288          WRITE(numout,*) 'lim_sbc_tau_2 : LIM 2.0 sea-ice - surface ocean momentum fluxes' 
    289          WRITE(numout,*) '~~~~~~~~~~~~~ ' 
    290          IF( lk_lim2_vp )   THEN   ;   WRITE(numout,*) '                VP  rheology - B-grid case' 
    291          ELSE                      ;   WRITE(numout,*) '                EVP rheology - C-grid case' 
    292          ENDIF 
     295      IF( wrk_in_use(2, 1,2) ) THEN 
     296         CALL ctl_stop('lim_sbc_tau_2 : requested workspace arrays unavailable.')   ;   RETURN 
    293297      ENDIF 
    294298      ! 
     
    405409         &                       tab2d_2=vtau, clinfo2=' vtau    : '        , mask2=vmask ) 
    406410      !   
     411      IF( wrk_not_released(2, 1,2) )   CALL ctl_stop('lim_sbc_tau_2 : failed to release workspace arrays') 
     412      ! 
    407413   END SUBROUTINE lim_sbc_tau_2 
     414 
     415 
     416   SUBROUTINE lim_sbc_init_2 
     417      !!------------------------------------------------------------------- 
     418      !!                  ***  ROUTINE lim_sbc_init  *** 
     419      !!              
     420      !! ** Purpose : Preparation of the file ice_evolu for the output of 
     421      !!      the temporal evolution of key variables 
     422      !! 
     423      !! ** input   : Namelist namicedia 
     424      !!------------------------------------------------------------------- 
     425      ! 
     426      IF(lwp) WRITE(numout,*) 
     427      IF(lwp) WRITE(numout,*) 'lim_sbc_init_2 : LIM-2 sea-ice - surface boundary condition' 
     428      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~   ' 
     429 
     430      !                                      ! allocate lim_sbc arrays 
     431      IF( lim_sbc_alloc_2() /= 0 )   CALL ctl_stop( 'STOP', 'lim_sbc_flx_2 : unable to allocate arrays' ) 
     432      ! 
     433      r1_rdtice = 1._wp / rdt_ice 
     434      ! 
     435      soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
     436      sice_0(:,:) = sice 
     437      ! 
     438      IF( cp_cfg == "orca" ) THEN            ! decrease ocean & ice reference salinities in the Baltic sea  
     439         WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
     440            &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
     441            soce_0(:,:) = 4._wp 
     442            sice_0(:,:) = 2._wp 
     443         END WHERE 
     444      ENDIF 
     445      ! 
     446   END SUBROUTINE lim_sbc_init_2 
    408447 
    409448#else 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limtab_2.F90

    r2528 r2715  
    22   !!====================================================================== 
    33   !!                       ***  MODULE limtab_2   *** 
    4    !!             transform 1D (2D) array to a 2D (1D) table 
     4   !!   LIM : transform 1D (2D) array to a 2D (1D) table 
    55   !!====================================================================== 
    66#if defined key_lim2 
    77   !!---------------------------------------------------------------------- 
    8    !!   tab_2d_1d  : 2-D to 1-D 
    9    !!   tab_1d_2d  : 1-D to 2-D 
     8   !!   tab_2d_1d  : 2-D <==> 1-D 
     9   !!   tab_1d_2d  : 1-D <==> 2-D 
    1010   !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    1211   USE par_kind 
    1312 
     
    1514   PRIVATE 
    1615 
    17    !! * Routine accessibility 
    18    PUBLIC tab_2d_1d_2  ! called by lim_ther 
    19    PUBLIC tab_1d_2d_2  ! called by lim_ther 
     16   PUBLIC   tab_2d_1d_2   ! called by limthd 
     17   PUBLIC   tab_1d_2d_2   ! called by limthd 
    2018 
    2119   !!---------------------------------------------------------------------- 
    22    !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
     20   !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2010) 
    2321   !! $Id$ 
    24    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     22   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    2523   !!---------------------------------------------------------------------- 
    2624CONTAINS 
    2725 
    2826   SUBROUTINE tab_2d_1d_2 ( ndim1d, tab1d, tab2d, ndim2d_x, ndim2d_y, tab_ind ) 
    29  
    30       INTEGER, INTENT(in) :: & 
    31          ndim1d, ndim2d_x, ndim2d_y 
    32  
    33       REAL(wp), DIMENSION (ndim2d_x, ndim2d_y), INTENT(in) ::  & 
    34          tab2d 
    35  
    36       INTEGER, DIMENSION ( ndim1d), INTENT ( in) :: & 
    37          tab_ind 
    38  
    39       REAL(wp), DIMENSION(ndim1d), INTENT ( out) ::  &  
    40          tab1d 
    41  
    42       INTEGER ::  & 
    43          jn , jid, jjd 
    44          
     27      !!---------------------------------------------------------------------- 
     28      !!                  ***  ROUTINE tab_2d_1d  *** 
     29      !!---------------------------------------------------------------------- 
     30      INTEGER                               , INTENT(in   ) ::   ndim1d, ndim2d_x, ndim2d_y   ! 1D & 2D sizes 
     31      REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT(in   ) ::   tab2d                        ! input 2D field 
     32      INTEGER , DIMENSION(ndim1d)           , INTENT(in   ) ::   tab_ind                      ! input index 
     33      REAL(wp), DIMENSION(ndim1d)           , INTENT(  out) ::   tab1d                        ! output 1D field 
     34      ! 
     35      INTEGER ::   jn , jid, jjd 
     36      !!---------------------------------------------------------------------- 
    4537      DO jn = 1, ndim1d 
    46          jid        = MOD( tab_ind(jn) - 1, ndim2d_x ) + 1 
    47          jjd        = ( tab_ind(jn) - 1 ) / ndim2d_x + 1 
     38         jid        = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 1 
     39         jjd        =    ( tab_ind(jn) - 1 ) / ndim2d_x + 1 
    4840         tab1d( jn) = tab2d( jid, jjd) 
    4941      END DO  
    50  
    5142   END SUBROUTINE tab_2d_1d_2 
    5243 
    5344 
    5445   SUBROUTINE tab_1d_2d_2 ( ndim1d, tab2d, tab_ind, tab1d, ndim2d_x, ndim2d_y ) 
    55  
    56       INTEGER, INTENT ( in) :: & 
    57          ndim1d, ndim2d_x, ndim2d_y 
    58  
    59       INTEGER, DIMENSION (ndim1d) , INTENT (in) :: & 
    60          tab_ind 
    61  
    62       REAL(wp), DIMENSION(ndim1d), INTENT (in) ::  & 
    63          tab1d   
    64  
    65       REAL(wp), DIMENSION (ndim2d_x, ndim2d_y), INTENT ( out) :: & 
    66          tab2d 
    67  
    68       INTEGER :: & 
    69          jn, jid, jjd 
    70  
     46      !!---------------------------------------------------------------------- 
     47      !!                  ***  ROUTINE tab_2d_1d  *** 
     48      !!---------------------------------------------------------------------- 
     49      INTEGER                               , INTENT(in   ) ::   ndim1d, ndim2d_x, ndim2d_y   ! 1d & 2D sizes 
     50      REAL(wp), DIMENSION(ndim1d)           , INTENT(in   ) ::   tab1d                        ! input 1D field 
     51      INTEGER , DIMENSION(ndim1d)           , INTENT(in   ) ::   tab_ind                      ! input index 
     52      REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT(  out) ::   tab2d                        ! output 2D field 
     53      ! 
     54      INTEGER ::   jn , jid, jjd 
     55      !!---------------------------------------------------------------------- 
    7156      DO jn = 1, ndim1d 
    72          jid             = MOD( tab_ind(jn) - 1, ndim2d_x) + 1 
     57         jid             = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 1 
    7358         jjd             =    ( tab_ind(jn) - 1 ) / ndim2d_x  + 1 
    7459         tab2d(jid, jjd) = tab1d( jn) 
    7560      END DO 
    76  
    7761   END SUBROUTINE tab_1d_2d_2 
    7862 
     63#else 
     64   !!---------------------------------------------------------------------- 
     65   !!   Default option        Dummy module             NO LIM sea-ice model 
     66   !!---------------------------------------------------------------------- 
    7967#endif 
     68   !!====================================================================== 
    8069END MODULE limtab_2 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r2528 r2715  
    7575      !! References :   Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 
    7676      !!--------------------------------------------------------------------- 
     77      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     78      USE wrk_nemo, ONLY: ztmp    => wrk_2d_1, & ! 2D workspace 
     79                          zqlbsbq => wrk_2d_2, & ! link with lead energy budget qldif 
     80                          zlicegr => wrk_2d_3    ! link with lateral ice growth  
     81      USE wrk_nemo, ONLY: zmsk => wrk_3d_4       ! 3D workspace 
     82      USE wrk_nemo, ONLY: zdvosif => wrk_2d_4, & !: Variation of volume at surface 
     83                          zdvobif => wrk_2d_5, & !: Variation of ice volume at the bottom ice     (outputs only) 
     84                          zdvolif => wrk_2d_6, & !: Total variation of ice volume                 (outputs only) 
     85                          zdvonif => wrk_2d_7, & !: Surface accretion Snow to Ice transformation  (outputs only) 
     86                          zdvomif => wrk_2d_8, & !: Bottom variation of ice volume due to melting (outputs only) 
     87                          zu_imasstr =>wrk_2d_9, & !: Sea-ice transport along i-axis at U-point     (outputs only)  
     88                          zv_imasstr =>wrk_2d_10   !: Sea-ice transport along j-axis at V-point     (outputs only)  
     89      !! 
    7790      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    7891      !! 
     
    91104      REAL(wp) ::   zfontn               ! heat flux from snow thickness 
    92105      REAL(wp) ::   zfntlat, zpareff     ! test. the val. of lead heat budget 
    93       REAL(wp), DIMENSION(jpi,jpj)     ::   ztmp      ! 2D workspace 
    94       REAL(wp), DIMENSION(jpi,jpj)     ::   zqlbsbq   ! link with lead energy budget qldif 
     106 
    95107      REAL(wp) ::   zuice_m, zvice_m     ! Sea-ice velocities at U & V-points 
    96108      REAL(wp) ::   zhice_u, zhice_v     ! Sea-ice volume at U & V-points 
     
    98110      REAL(wp) ::   zrhoij, zrhoijm1     ! temporary scalars 
    99111      REAL(wp) ::   zztmp                ! temporary scalars within a loop 
    100       REAL(wp), DIMENSION(jpi,jpj)     ::   zlicegr   ! link with lateral ice growth  
    101       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmsk      ! 3D workspace 
    102112!!$      REAL(wp), DIMENSION(jpi,jpj) ::   firic         !: IR flux over the ice            (outputs only) 
    103113!!$      REAL(wp), DIMENSION(jpi,jpj) ::   fcsic         !: Sensible heat flux over the ice (outputs only) 
    104114!!$      REAL(wp), DIMENSION(jpi,jpj) ::   fleic         !: Latent heat flux over the ice   (outputs only) 
    105115!!$      REAL(wp), DIMENSION(jpi,jpj) ::   qlatic        !: latent flux                     (outputs only) 
    106       REAL(wp), DIMENSION(jpi,jpj) ::   zdvosif       !: Variation of volume at surface                (outputs only) 
    107       REAL(wp), DIMENSION(jpi,jpj) ::   zdvobif       !: Variation of ice volume at the bottom ice     (outputs only) 
    108       REAL(wp), DIMENSION(jpi,jpj) ::   zdvolif       !: Total variation of ice volume                 (outputs only) 
    109       REAL(wp), DIMENSION(jpi,jpj) ::   zdvonif       !: Surface accretion Snow to Ice transformation  (outputs only) 
    110       REAL(wp), DIMENSION(jpi,jpj) ::   zdvomif       !: Bottom variation of ice volume due to melting (outputs only) 
    111       REAL(wp), DIMENSION(jpi,jpj) ::   zu_imasstr    !: Sea-ice transport along i-axis at U-point     (outputs only)  
    112       REAL(wp), DIMENSION(jpi,jpj) ::   zv_imasstr    !: Sea-ice transport along j-axis at V-point     (outputs only)  
    113116      !!------------------------------------------------------------------- 
     117 
     118      IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10)   .OR.  & 
     119          wrk_in_use(3, 4)                    ) THEN 
     120         CALL ctl_stop('lim_thd_2 : requested workspace arrays unavailable')   ;   RETURN 
     121      ENDIF 
    114122 
    115123      IF( kt == nit000 )   CALL lim_thd_init_2  ! Initialization (first time-step only) 
     
    512520      ENDIF 
    513521       ! 
     522      IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10)   .OR.  & 
     523          wrk_not_released(3, 4)                    ) THEN 
     524         CALL ctl_stop('lim_thd_2 : failed to release workspace arrays') 
     525      ENDIF 
     526      ! 
    514527    END SUBROUTINE lim_thd_2 
    515528 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90

    r2528 r2715  
    77 
    88   !!---------------------------------------------------------------------- 
    9    !!   lim_lat_acr_2    : lateral accretion of ice 
    10    !! * Modules used 
     9   !!   lim_lat_acr_2   : lateral accretion of ice 
     10   !!---------------------------------------------------------------------- 
    1111   USE par_oce          ! ocean parameters 
    1212   USE phycst 
     
    1414   USE ice_2 
    1515   USE limistate_2  
    16       
     16   USE lib_mpp          ! MPP library 
     17 
    1718   IMPLICIT NONE 
    1819   PRIVATE 
    1920 
    20    !! * Routine accessibility 
    21    PUBLIC lim_thd_lac_2   ! called by lim_thd_2 
    22  
    23    !! * Module variables 
     21   PUBLIC   lim_thd_lac_2   ! called by lim_thd_2 
     22 
    2423   REAL(wp)  ::           &  ! constant values 
    2524      epsi20 = 1.e-20  ,  & 
     
    2726      zzero  = 0.e0    ,  & 
    2827      zone   = 1.e0 
     28 
    2929   !!---------------------------------------------------------------------- 
    3030   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
     
    6868      !!   2.0  !  02-08 (C. Ethe, G. Madec)  F90, mpp 
    6969      !!------------------------------------------------------------------- 
    70       !! * Arguments 
     70      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     71      USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2, wrk_1d_3, wrk_1d_4, wrk_1d_5, wrk_1d_6 
     72      ! 
    7173      INTEGER , INTENT(IN)::  & 
    7274         kideb          ,   &  ! start point on which the the computation is applied 
    7375         kiut                  ! end point on which the the computation is applied 
    7476 
    75       !! * Local variables 
     77      ! * Local variables 
    7678      INTEGER ::            & 
    7779         ji             ,   &  !  dummy loop indices 
     
    7981         iiceform       ,   &  !  1 = ice formed   ; 0 = no ice formed 
    8082         ihemis                !  dummy indice 
    81       REAL(wp), DIMENSION(jpij) :: & 
     83      REAL(wp), POINTER, DIMENSION(:) :: & 
    8284         zqbgow           ,  &  !  heat budget of the open water (negative) 
    8385         zfrl_old         ,  &  !  previous sea/ice fraction 
     
    101103         zah, zalpha , zbeta 
    102104      !!---------------------------------------------------------------------       
    103                     
     105                
     106      IF( wrk_in_use(1, 1,2,3,4,5,6) ) THEN 
     107         CALL ctl_stop('lim_thd_lac_2 : requestead workspace arrays unavailable')   ;   RETURN 
     108      ENDIF 
     109      ! Set-up pointers to sub-arrays of workspace arrays 
     110      zqbgow    => wrk_1d_1(1:jpij) 
     111      zfrl_old  => wrk_1d_2(1:jpij)          
     112      zhice_old => wrk_1d_3(1:jpij)         
     113      zhice0    => wrk_1d_4(1:jpij)         
     114      zfrlmin   => wrk_1d_5(1:jpij)         
     115      zdhicbot  => wrk_1d_6(1:jpij)  
     116       
    104117      !-------------------------------------------------------------- 
    105118      !   Computation of the heat budget of the open water (negative) 
     
    219232      END DO 
    220233       
     234      IF( wrk_not_released(1, 1,2,3,4,5,6) )   CALL ctl_stop('lim_thd_lac_2 : failed to release workspace arrays.') 
     235      ! 
    221236   END SUBROUTINE lim_thd_lac_2 
    222237#else 
    223    !!====================================================================== 
     238   !!---------------------------------------------------------------------- 
    224239   !!                       ***  MODULE limthd_lac_2   *** 
    225240   !!                           no sea ice model 
    226    !!====================================================================== 
     241   !!---------------------------------------------------------------------- 
    227242CONTAINS 
    228243   SUBROUTINE lim_thd_lac_2           ! Empty routine 
    229244   END SUBROUTINE lim_thd_lac_2 
    230245#endif 
     246   !!====================================================================== 
    231247END MODULE limthd_lac_2 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90

    r2528 r2715  
    1111   !!   'key_lim2'                                    LIM 2.0 sea-ice model 
    1212   !!---------------------------------------------------------------------- 
    13    !!---------------------------------------------------------------------- 
    1413   !!   lim_thd_zdf_2 : vertical accr./abl. and lateral ablation of sea ice 
    1514   !!---------------------------------------------------------------------- 
    16    !! * Modules used 
    1715   USE par_oce          ! ocean parameters 
    1816   USE phycst           ! ??? 
     
    2119   USE limistate_2 
    2220   USE in_out_manager 
     21   USE lib_mpp          ! MPP library 
    2322   USE cpl_oasis3, ONLY : lk_cpl 
    2423       
     
    3534   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    3635   !! $Id$ 
    37    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     36   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3837   !!---------------------------------------------------------------------- 
    39  
    4038CONTAINS 
    4139 
     
    6967      !!              Fichefet T. and M. Maqueda 1999, Clim. Dyn, 15(4), 251-268   
    7068      !!------------------------------------------------------------------ 
     69      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     70      USE wrk_nemo, ONLY: wrk_1d_1,  wrk_1d_2,  wrk_1d_3,  wrk_1d_4,  wrk_1d_5  
     71      USE wrk_nemo, ONLY: wrk_1d_6,  wrk_1d_7,  wrk_1d_8,  wrk_1d_9,  wrk_1d_10 
     72      USE wrk_nemo, ONLY: wrk_1d_11, wrk_1d_12, wrk_1d_13, wrk_1d_14, wrk_1d_15 
     73      USE wrk_nemo, ONLY: wrk_1d_16, wrk_1d_17, wrk_1d_18, wrk_1d_19, wrk_1d_20 
     74      USE wrk_nemo, ONLY: wrk_1d_21, wrk_1d_22, wrk_1d_23, wrk_1d_24, wrk_1d_25 
     75      USE wrk_nemo, ONLY: wrk_1d_26, wrk_1d_27 
     76      !! 
    7177      INTEGER, INTENT(in) ::   kideb    ! Start point on which the  the computation is applied 
    7278      INTEGER, INTENT(in) ::   kiut     ! End point on which the  the computation is applied 
    7379      !! 
    7480      INTEGER ::   ji       ! dummy loop indices 
    75       REAL(wp), DIMENSION(jpij,2) ::   zqcmlt        ! energy due to surface( /1 ) and bottom melting( /2 ) 
    76       REAL(wp), DIMENSION(jpij) ::  & 
     81      REAL(wp), POINTER, DIMENSION(:) ::   zqcmlts        ! energy due to surface melting 
     82      REAL(wp), POINTER, DIMENSION(:) ::   zqcmltb        ! energy due to bottom melting 
     83      REAL(wp), POINTER, DIMENSION(:) ::  & 
    7784         ztsmlt      &    ! snow/ice surface melting temperature 
    7885         ,ztbif      &    ! int. temp. at the mid-point of the 1st layer of the snow/ice sys.  
     
    8895         , zts_old   &    ! previous surface temperature 
    8996         , zidsn , z1midsn , zidsnic ! tempory variables 
    90       REAL(wp), DIMENSION(jpij) ::   & 
     97      REAL(wp), POINTER, DIMENSION(:) ::   & 
    9198          zfnet       &  ! net heat flux at the top surface( incl. conductive heat flux) 
    9299          , zsprecip  &    ! snow accumulation 
     
    160167       !!---------------------------------------------------------------------- 
    161168 
     169       IF(wrk_in_use(1, 1,  2, 3, 4, 5, 6, 7, 8, 9,10, & 
     170          &             11,12,13,14,15,16,17,18,19,20, & 
     171          &             21,22,23,24,25,26,27) ) THEN 
     172          CALL ctl_stop('lim_thd_zdf_2 : requested workspace arrays unavailable')   ;   RETURN 
     173       ENDIF 
     174 
     175       ztsmlt  => wrk_1d_1(1:jpij) 
     176       ztbif   => wrk_1d_2(1:jpij)   
     177       zksn    => wrk_1d_3(1:jpij)   
     178       zkic    => wrk_1d_4(1:jpij)    
     179       zksndh  => wrk_1d_5(1:jpij)    
     180       zfcsu   => wrk_1d_6(1:jpij)    
     181       zfcsudt => wrk_1d_7(1:jpij)   
     182       zi0     => wrk_1d_8(1:jpij)    
     183       z1mi0   => wrk_1d_9(1:jpij)     
     184       zqmax   => wrk_1d_10(1:jpij)     
     185       zrcpdt  => wrk_1d_11(1:jpij)   
     186       zts_old => wrk_1d_12(1:jpij)   
     187       zidsn   => wrk_1d_13(1:jpij)  
     188       z1midsn => wrk_1d_14(1:jpij)  
     189       zidsnic => wrk_1d_15(1:jpij) 
     190 
     191       zfnet     => wrk_1d_16(1:jpij) 
     192       zsprecip  => wrk_1d_17(1:jpij)   
     193       zhsnw_old => wrk_1d_18(1:jpij)  
     194       zdhictop  => wrk_1d_19(1:jpij)  
     195       zdhicbot  => wrk_1d_20(1:jpij) 
     196       zqsup     => wrk_1d_21(1:jpij)   
     197       zqocea    => wrk_1d_22(1:jpij) 
     198       zfrl_old  => wrk_1d_23(1:jpij)  
     199       zfrld_1d  => wrk_1d_24(1:jpij)  
     200       zep       => wrk_1d_25(1:jpij)  
     201 
     202       zqcmlts   => wrk_1d_26(1:jpij) 
     203       zqcmltb   => wrk_1d_27(1:jpij) 
     204 
    162205       !----------------------------------------------------------------------- 
    163206       !  1. Boundaries conditions for snow/ice system internal temperature 
     
    171214          zihic = MAX( zzero , SIGN( zone , hicdif - h_ice_1d(ji) ) ) 
    172215          !--computation of energy due to surface melting 
    173           zqcmlt(ji,1) = ( MAX ( zzero ,  & 
     216          zqcmlts(ji) = ( MAX ( zzero ,  & 
    174217             &                   rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn ) 
    175218          !--computation of energy due to bottom melting 
    176           zqcmlt(ji,2) = ( MAX( zzero , & 
     219          zqcmltb(ji) = ( MAX( zzero , & 
    177220             &                  rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) & 
    178221             &           + MAX( zzero , & 
     
    467510          zhsnw_old(ji) =  h_snow_1d(ji) 
    468511          !--computation of the energy needed to melt snow 
    469           zqsnw_mlt  = zfnet(ji) * rdt_ice - zqcmlt(ji,1) 
     512          zqsnw_mlt  = zfnet(ji) * rdt_ice - zqcmlts(ji) 
    470513          !--change in snow thickness due to melt 
    471514          zdhsmlt = - zqsnw_mlt / xlsn 
     
    587630 
    588631          !---treatment of the case of melting/growing 
    589           zqice_bot   =         zibmlt   * ( zqice_bot_mlt - zqcmlt(ji,2) )   & 
    590              &        + ( 1.0 - zibmlt ) * ( zqice_bot - zqcmlt(ji,2)  ) 
     632          zqice_bot   =         zibmlt   * ( zqice_bot_mlt - zqcmltb(ji) )   & 
     633             &        + ( 1.0 - zibmlt ) * ( zqice_bot - zqcmltb(ji)  ) 
    591634          qstbif_1d(ji) =         zibmlt   * qstbif_1d(ji)   & 
    592635             &           + ( 1.0 - zibmlt ) * zqstbif_bot 
     
    762805       END DO 
    763806       !  
     807       IF( wrk_not_released(1, 1,  2, 3, 4, 5, 6, 7, 8, 9,10,   & 
     808           &                   11,12,13,14,15,16,17,18,19,20,   & 
     809           &                   21,22,23,24,25,26,27)        )   & 
     810           CALL ctl_stop('lim_thd_zdf_2 : failed to release workspace arrays.') 
     811       ! 
    764812    END SUBROUTINE lim_thd_zdf_2 
    765813 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90

    r2528 r2715  
    6363      !! ** action : 
    6464      !!--------------------------------------------------------------------- 
     65      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     66      USE wrk_nemo, ONLY: zui_u  => wrk_2d_1, zvi_v => wrk_2d_2, zsm  => wrk_2d_3 
     67      USE wrk_nemo, ONLY: zs0ice => wrk_2d_4, zs0sn => wrk_2d_5, zs0a => wrk_2d_6 
     68      USE wrk_nemo, ONLY: zs0c0 => wrk_2d_7,  zs0c1 => wrk_2d_8, zs0c2 => wrk_2d_9, & 
     69                          zs0st => wrk_2d_10 
     70      !! 
    6571      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    6672      !! 
     
    7177      REAL(wp) ::   zvbord , zcfl   , zusnit            !   -      - 
    7278      REAL(wp) ::   zrtt   , ztsn   , ztic1 , ztic2     !   -      - 
    73       REAL(wp), DIMENSION(jpi,jpj)  ::   zui_u , zvi_v , zsm             ! 2D workspace 
    74       REAL(wp), DIMENSION(jpi,jpj)  ::   zs0ice, zs0sn , zs0a            !  -      - 
    75       REAL(wp), DIMENSION(jpi,jpj)  ::   zs0c0 , zs0c1 , zs0c2 , zs0st   !  -      - 
    7679      !--------------------------------------------------------------------- 
     80 
     81      IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10) ) THEN 
     82         CALL ctl_stop('lim_trp_2 : requested workspace arrays unavailable')   ;   RETURN 
     83      ENDIF 
    7784 
    7885      IF( kt == nit000  )   CALL lim_trp_init_2      ! Initialization (first time-step only) 
     
    266273      ENDIF 
    267274      ! 
     275      IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10) )   CALL ctl_stop('lim_trp_2 : failed to release workspace arrays') 
     276      ! 
    268277   END SUBROUTINE lim_trp_2 
    269278 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90

    r2528 r2715  
    2626   USE ice_2 
    2727 
     28   USE dianam          ! build name of file (routine) 
    2829   USE lbclnk 
    29    USE dianam          ! build name of file (routine) 
    3030   USE in_out_manager 
     31   USE lib_mpp         ! MPP library 
    3132   USE iom 
    3233   USE ioipsl 
     
    3940#endif 
    4041   PUBLIC   lim_wri_state_2   ! called by dia_wri_state  
     42   PUBLIC   lim_wri_alloc_2   ! called by nemogcm.F90 
    4143 
    4244   INTEGER, PARAMETER                       ::   jpnoumax = 40   ! maximum number of variable for ice output 
     
    5052 
    5153   INTEGER ::   nice, nhorid, ndim, niter, ndepid       ! ???? 
    52    INTEGER , DIMENSION( jpij ) ::   ndex51              ! ???? 
    53  
    54    REAL(wp)  ::            &  ! constant values 
    55       epsi16 = 1.e-16   ,  & 
    56       zzero  = 0.e0     ,  & 
    57       zone   = 1.e0 
     54   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex51   ! ???? 
     55 
     56   REAL(wp) ::   epsi16 = 1.e-16_wp   ! constant values 
     57   REAL(wp) ::   zzero  = 0._wp       !     -      - 
     58   REAL(wp) ::   zone   = 1._wp       !     -      - 
     59 
     60   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zcmo      ! Workspace array for netcdf writer.  
     61 
    5862 
    5963   !! * Substitutions 
     
    6468   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6569   !!---------------------------------------------------------------------- 
    66  
    6770CONTAINS 
     71 
     72   INTEGER FUNCTION lim_wri_alloc_2() 
     73      !!------------------------------------------------------------------- 
     74      !!                  ***   ROUTINE lim_wri_alloc_2  *** 
     75      !!------------------------------------------------------------------- 
     76      ALLOCATE( ndex51(jpij), zcmo(jpi,jpj,jpnoumax), STAT=lim_wri_alloc_2) 
     77      ! 
     78      IF( lk_mpp               )   CALL mpp_sum ( lim_wri_alloc_2 ) 
     79      IF( lim_wri_alloc_2 /= 0 )   CALL ctl_warn('lim_wri_alloc_2: failed to allocate array ndex51') 
     80      ! 
     81   END FUNCTION lim_wri_alloc_2 
     82 
    6883 
    6984#if ! defined key_iomput 
     
    85100      !!      of a day 
    86101      !!------------------------------------------------------------------- 
     102      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     103      USE wrk_nemo, ONLY: zfield => wrk_2d_1 
     104      !! 
    87105      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    88106      !! 
     
    92110         &          zindh, zinda, zindb, ztmu 
    93111      REAL(wp), DIMENSION(1)                ::   zdept 
    94       REAL(wp), DIMENSION(jpi,jpj)          ::   zfield 
    95       REAL(wp), DIMENSION(jpi,jpj,jpnoumax) ::   zcmo 
    96       !!------------------------------------------------------------------- 
     112      !!------------------------------------------------------------------- 
     113 
     114      IF( wrk_in_use(2, 1) ) THEN 
     115         CALL ctl_stop('lim_wri_2 : requested workspace array unavailable')   ;   RETURN 
     116      ENDIF 
    97117                                                 !--------------------! 
    98118      IF( kt == nit000 ) THEN                    !   Initialisation   ! 
    99119         !                                       !--------------------! 
     120 
    100121         CALL lim_wri_init_2  
    101122                            
     
    186207      IF( ( nn_fsbc * niter ) >= nitend )   CALL histclo( nice )  
    187208 
     209      IF( wrk_not_released(2, 1) )   CALL ctl_stop('lim_wri_2 : failed to release workspace array.') 
     210      ! 
    188211   END SUBROUTINE lim_wri_2 
    189212      
     
    222245         field_19 
    223246      !!------------------------------------------------------------------- 
     247      ! 
     248      IF( lim_wri_alloc_2() /= 0 ) THEN      ! allocate lim_wri arrrays 
     249         CALL ctl_stop( 'STOP', 'lim_wri_init_2 : unable to allocate standard arrays' )   ;   RETURN 
     250      ENDIF 
    224251 
    225252      REWIND ( numnam_ice )                ! Read Namelist namicewri 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90

    r2528 r2715  
    1818    INTEGER, INTENT(in) ::   kt     ! number of iteration 
    1919 
    20     REAL(wp),DIMENSION(1) ::   zdept 
     20    INTEGER , SAVE ::   nmoyice   !: counter for averaging 
     21    INTEGER , SAVE ::   nwf       !: number of fields to write on disk 
     22    INTEGER , SAVE, DIMENSION(:), ALLOCATABLE  :: nsubindex   !: subindex to be saved 
     23    INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid 
     24    REAL(wp), SAVE, DIMENSION(jpi,jpj,jpnoumax) :: rcmoy 
    2125 
    22     REAL(wp) :: & 
    23          zsto, zsec, zjulian,zout, & 
    24          zindh,zinda,zindb,  & 
    25          ztmu 
    26     REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: & 
    27          zcmo 
    28     REAL(wp), DIMENSION(jpi,jpj) ::  & 
    29          zfield 
    30     INTEGER, SAVE :: nmoyice, &  !: counter for averaging 
    31          &             nwf         !: number of fields to write on disk 
    32     INTEGER, SAVE,DIMENSION (:), ALLOCATABLE  :: nsubindex   !: subindex to be saved 
    33     ! according to namelist 
     26    INTEGER ::  ji, jj, jf, ii   ! dummy loop indices and array index 
     27    INTEGER :: iyear, iday, imon !  
     28    CHARACTER(LEN=80) :: clname, cltext, clmode 
     29    REAL(wp), DIMENSION(1) ::   zdept 
     30    REAL(wp) ::   zsto, zsec, zjulian,zout 
     31    REAL(wp) ::   zindh,zinda,zindb, ztmu 
     32    REAL(wp), DIMENSION(jpi,jpj,jpnoumax) ::   zcmo   !ARPDBGWORK 
     33    REAL(wp), DIMENSION(jpi,jpj)          ::   zfield 
    3434 
    35     REAL(wp), SAVE, DIMENSION(jpi,jpj,jpnoumax) :: rcmoy 
    3635#if ! defined key_diainstant 
    3736    LOGICAL, PARAMETER :: ll_dia_inst=.false.      ! local logical variable  
     
    3938    LOGICAL, PARAMETER :: ll_dia_inst=.true. 
    4039#endif 
    41     INTEGER ::  ji, jj, jf, ii   ! dummy loop indices and array index 
    42     INTEGER :: iyear, iday, imon !  
     40    !!------------------------------------------------------------------- 
    4341 
    44     CHARACTER(LEN=80) :: clname, cltext, clmode 
    45  
    46  
    47     INTEGER , SAVE ::      & 
    48          nice, nhorid, ndim, niter, ndepid 
    49     INTEGER , DIMENSION( jpij ) , SAVE ::  & 
    50          ndex51   
    51     !!------------------------------------------------------------------- 
    52     IF ( kt == nit000 ) THEN  
    53  
     42    IF( kt == nit000 ) THEN  
     43       ! 
    5444       CALL lim_wri_init_2  
    5545 
     
    5747       ii  = 0 
    5848 
    59        IF (lwp ) THEN 
     49       IF(lwp ) THEN 
    6050          WRITE(numout,*) 'lim_wri_2 : Write ice outputs in dimg' 
    6151          WRITE(numout,*) '~~~~~~~~' 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90

    r2528 r2715  
    1212   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1313   !!---------------------------------------------------------------------- 
    14    !! * Modules used 
    1514   USE par_ice_2 
    1615 
    1716   IMPLICIT NONE 
    1817   PRIVATE 
     18 
     19   PUBLIC thd_ice_alloc_2 ! Routine called by nemogcm.F90 
    1920 
    2021   !! * Share Module variables 
     
    4344      cnscg                  !: ratio  rcpsn/rcpic 
    4445 
    45    INTEGER , PUBLIC, DIMENSION(jpij) ::   &  !: 
     46   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !: 
    4647      npb     ,   &   !: number of points where computations has to be done 
    4748      npac            !: correspondance between the points 
    4849 
    49    REAL(wp), PUBLIC, DIMENSION(jpij) ::   &  !:  
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !:  
    5051      qldif_1d    ,     &  !: corresponding to the 2D var  qldif 
    5152      qcmif_1d    ,     &  !: corresponding to the 2D var  qcmif 
     
    8081      dqla_ice_1d          !:    "                  "      dqla_ice 
    8182 
    82    REAL(wp), PUBLIC, DIMENSION(jpij,jplayersp1) ::   &  !: 
     83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    8384      tbif_1d              !: corresponding to the 2D var  tbif 
    8485 
     86   !!---------------------------------------------------------------------- 
     87   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
     88   !! $Id$ 
     89   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     90   !!---------------------------------------------------------------------- 
     91 CONTAINS 
     92 
     93   INTEGER FUNCTION thd_ice_alloc_2() 
     94      !!---------------------------------------------------------------------- 
     95      USE lib_mpp        ! MPP library 
     96      INTEGER :: ierr(4) 
     97      !!---------------------------------------------------------------------- 
     98      ! 
     99      ierr(:) = 0 
     100      ! 
     101      ALLOCATE( npb(jpij), npac(jpij),                             & 
     102         &      qldif_1d(jpij), qcmif_1d(jpij), thcm_1d(jpij),     & 
     103         &      fstbif_1d(jpij), fltbif_1d(jpij), fscbq_1d(jpij),  & 
     104         &      qsr_ice_1d(jpij),fr1_i0_1d(jpij), fr2_i0_1d(jpij), Stat=ierr(1)) 
     105         ! 
     106      ALLOCATE( qns_ice_1d(jpij), qfvbq_1d(jpij), sist_1d(jpij), tfu_1d(jpij), & 
     107         &      sprecip_1d(jpij), h_snow_1d(jpij),h_ice_1d(jpij),frld_1d(jpij),& 
     108         &      qstbif_1d(jpij),  fbif_1d(jpij),  Stat=ierr(2)) 
     109         ! 
     110      ALLOCATE( rdmicif_1d(jpij), rdmsnif_1d(jpij), qlbbq_1d(jpij),   & 
     111         &      dmgwi_1d(jpij)  , dvsbq_1d(jpij)  , rdvomif_1d(jpij), & 
     112         &      dvbbq_1d(jpij)  , dvlbq_1d(jpij)  , dvnbq_1d(jpij)  , & 
     113         &      Stat=ierr(3)) 
     114         ! 
     115      ALLOCATE( dqns_ice_1d(jpij) ,qla_ice_1d(jpij), dqla_ice_1d(jpij), & 
     116         &      tbif_1d(jpij, jplayersp1), Stat=ierr(4)) 
     117         ! 
     118      thd_ice_alloc_2 = MAXVAL(ierr) 
     119      IF( thd_ice_alloc_2 /= 0 )   CALL ctl_warn('thd_ice_alloc_2: failed to allocate arrays') 
     120      ! 
     121   END FUNCTION thd_ice_alloc_2 
     122 
     123#endif 
    85124   !!====================================================================== 
    86 #endif 
    87125END MODULE thd_ice_2 
Note: See TracChangeset for help on using the changeset viewer.