New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 2613 – NEMO

Changeset 2613


Ignore:
Timestamp:
2011-02-25T11:45:57+01:00 (13 years ago)
Author:
gm
Message:

dynamic mem: #785 ; move the allocation of ice in iceini_2/iceini module + bug fixes (define key_esopa)

Location:
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO
Files:
31 edited

Legend:

Unmodified
Added
Removed
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90

    r2590 r2613  
    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 
     
    1617   PRIVATE 
    1718    
    18    ! Routine accessibility 
    19    PUBLIC    ice_alloc_2  !  Called in nemogcm.F90 
     19   PUBLIC    ice_alloc_2  !  Called in iceini_2.F90 
    2020 
    2121   INTEGER , PUBLIC ::   numit     !: ice iteration index 
     
    124124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxc2,  syc2,  sxxc2,  syyc2,  sxyc2    !: for heat content of 2nd ice layer 
    125125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxst,  syst,  sxxst,  syyst,  sxyst    !: for heat content of brine pockets 
    126  
     126   !!---------------------------------------------------------------------- 
     127   CONTAINS 
     128 
     129   FUNCTION ice_alloc_2() 
     130      !!----------------------------------------------------------------- 
     131      !!               *** FUNCTION ice_alloc_2 *** 
     132      !!----------------------------------------------------------------- 
     133      USE in_out_manager, ONLY: ctl_warn 
     134      INTEGER :: ice_alloc_2     ! return value 
     135      INTEGER :: ierr(9)        ! Local variables 
     136      !!----------------------------------------------------------------- 
     137 
     138      ierr(:) = 0 
     139 
     140      ALLOCATE( ahiu(jpi,jpj) , pahu(jpi,jpj) ,                      & 
     141         &      ahiv(jpi,jpj) , pahv(jpi,jpj) , ust2s(jpi,jpj) , STAT=ierr(1) ) 
     142 
     143      !* Ice Rheology 
     144#if defined key_lim2_vp 
     145      ALLOCATE( hsnm(jpi,jpj) , hicm(jpi,jpj) , STAT=ierr(2) ) 
    127146#else 
     147      ALLOCATE( stress1_i (jpi,jpj) , delta_i(jpi,jpj) , at_i(jpi,jpj) ,     & 
     148                stress2_i (jpi,jpj) , divu_i (jpi,jpj) , hsnm(jpi,jpj) ,     & 
     149                stress12_i(jpi,jpj) , shear_i(jpi,jpj) , hicm(jpi,jpj) , STAT=ierr(2) ) 
     150#endif 
     151 
     152      ALLOCATE( rdvosif(jpi,jpj) , rdvobif(jpi,jpj) ,                      & 
     153         &      fdvolif(jpi,jpj) , rdvonif(jpi,jpj) ,                      & 
     154         &      sist   (jpi,jpj) , tfu    (jpi,jpj) , hicif(jpi,jpj) ,     & 
     155         &      hsnif  (jpi,jpj) , hicifp (jpi,jpj) , frld (jpi,jpj) , STAT=ierr(3) ) 
     156 
     157      ALLOCATE(phicif(jpi,jpj) , pfrld  (jpi,jpj) , qstoif (jpi,jpj) ,     & 
     158         &     fbif  (jpi,jpj) , rdmsnif(jpi,jpj) , rdmicif(jpi,jpj) ,     & 
     159         &     qldif (jpi,jpj) , qcmif  (jpi,jpj) , fdtcn  (jpi,jpj) ,     & 
     160         &     qdtcn (jpi,jpj) , thcm   (jpi,jpj)                    , STAT=ierr(4) ) 
     161 
     162      ALLOCATE(fstric(jpi,jpj) , ffltbif(jpi,jpj) , fscmbq(jpi,jpj) ,     & 
     163         &     fsbbq (jpi,jpj) , qfvbq  (jpi,jpj) , dmgwi (jpi,jpj) ,     & 
     164         &     u_ice (jpi,jpj) , v_ice  (jpi,jpj) ,                       & 
     165         &     u_oce (jpi,jpj) , v_oce  (jpi,jpj) ,                       & 
     166         &     tbif  (jpi,jpj,jplayersp1)                           , STAT=ierr(5)) 
     167 
     168      !* moment used in the advection scheme 
     169      ALLOCATE(sxice (jpi,jpj) , syice (jpi,jpj) , sxxice(jpi,jpj) ,     & 
     170         &     syyice(jpi,jpj) , sxyice(jpi,jpj) ,                       & 
     171         &     sxsn  (jpi,jpj) , sysn  (jpi,jpj) , sxxsn (jpi,jpj) ,     & 
     172         &     syysn (jpi,jpj) , sxysn (jpi,jpj)                   , STAT=ierr(6) ) 
     173      ALLOCATE(sxa   (jpi,jpj) , sya   (jpi,jpj) , sxxa  (jpi,jpj) ,     & 
     174         &     syya  (jpi,jpj) , sxya  (jpi,jpj) ,                       &  
     175         &     sxc0  (jpi,jpj) , syc0  (jpi,jpj) , sxxc0 (jpi,jpj) ,     & 
     176         &     syyc0 (jpi,jpj) , sxyc0 (jpi,jpj)                   , STAT=ierr(7)) 
     177      ALLOCATE(sxc1  (jpi,jpj) , syc1  (jpi,jpj) , sxxc1 (jpi,jpj) ,     & 
     178         &     syyc1 (jpi,jpj) , sxyc1 (jpi,jpj) ,                       & 
     179         &     sxc2  (jpi,jpj) , syc2  (jpi,jpj) , sxxc2 (jpi,jpj) ,     & 
     180         &     syyc2 (jpi,jpj) , sxyc2 (jpi,jpj)                   , STAT=ierr(8)) 
     181      ALLOCATE(sxst  (jpi,jpj) , syst  (jpi,jpj) , sxxst (jpi,jpj) ,     & 
     182         &     syyst (jpi,jpj) , sxyst (jpi,jpj)                   , STAT=ierr(9)) 
     183 
     184      ice_alloc_2 = MAXVAL( ierr ) 
     185 
     186      IF( ice_alloc_2 /= 0 )   CALL ctl_warn('ice_alloc_2: failed to allocate arrays.') 
     187      ! 
     188   END FUNCTION ice_alloc_2 
     189 
     190#else 
    128191   !!---------------------------------------------------------------------- 
    129192   !!   Default option         Empty module        NO LIM 2.0 sea-ice model 
    130193   !!---------------------------------------------------------------------- 
    131194#endif 
    132  
    133    !!---------------------------------------------------------------------- 
     195   !!----------------------------------------------------------------- 
    134196   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    135197   !! $Id$ 
    136198   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    137199   !!====================================================================== 
    138  
    139 #if defined key_lim2 
    140    CONTAINS 
    141  
    142      FUNCTION ice_alloc_2() 
    143         !!----------------------------------------------------------------- 
    144         !!               *** Routine ice_alloc_2 *** 
    145         !!----------------------------------------------------------------- 
    146         USE in_out_manager, ONLY: ctl_warn 
    147         IMPLICIT none 
    148         INTEGER :: ice_alloc_2 
    149         ! Local variables 
    150         INTEGER :: ierr(9) 
    151         !!----------------------------------------------------------------- 
    152  
    153         ierr(:) = 0 
    154  
    155         ! What could be one huge allocate statement is broken-up to try to 
    156         ! stay within Fortran's max-line length limit. 
    157         ALLOCATE(ahiu(jpi,jpj), ahiv(jpi,jpj), & 
    158                  pahu(jpi,jpj), pahv(jpi,jpj), & 
    159                  ust2s(jpi,jpj), Stat=ierr(1)) 
    160  
    161         ALLOCATE(                              & 
    162 #if defined key_lim2_vp 
    163                  hsnm(jpi,jpj), hicm(jpi,jpj), & 
    164 #else 
    165                  stress1_i(jpi,jpj), stress2_i(jpi,jpj), stress12_i(jpi,jpj), & 
    166                  delta_i(jpi,jpj),   divu_i(jpi,jpj),    shear_i(jpi,jpj),    & 
    167                  at_i(jpi,jpj), hsnm(jpi,jpj), hicm(jpi,jpj),                 & 
    168 #endif 
    169                  Stat=ierr(2)) 
    170  
    171         ALLOCATE(rdvosif(jpi,jpj), rdvobif(jpi,jpj),                          & 
    172                  fdvolif(jpi,jpj), rdvonif(jpi,jpj),                          & 
    173                  sist(jpi,jpj),    tfu(jpi,jpj),         hicif(jpi,jpj),      & 
    174                  hsnif(jpi,jpj),   hicifp(jpi,jpj),      frld(jpi,jpj),       & 
    175                  Stat=ierr(3)) 
    176  
    177         ALLOCATE(phicif(jpi,jpj),  pfrld(jpi,jpj),       qstoif(jpi,jpj),     & 
    178                  fbif(jpi,jpj),    rdmsnif(jpi,jpj),     rdmicif(jpi,jpj),    & 
    179                  qldif(jpi,jpj),   qcmif(jpi,jpj),       fdtcn(jpi,jpj),      & 
    180                  qdtcn(jpi,jpj),   thcm(jpi,jpj),        Stat=ierr(4)) 
    181  
    182         ALLOCATE(fstric(jpi,jpj),  ffltbif(jpi,jpj),     fscmbq(jpi,jpj),     & 
    183                  fsbbq(jpi,jpj),   qfvbq(jpi,jpj),       dmgwi(jpi,jpj),      & 
    184                  u_ice(jpi,jpj),   v_ice(jpi,jpj),                            & 
    185                  u_oce(jpi,jpj),   v_oce(jpi,jpj),                            & 
    186                  tbif(jpi,jpj,jplayersp1), Stat=ierr(5)) 
    187  
    188         ALLOCATE(sxice(jpi,jpj),   syice(jpi,jpj),  sxxice(jpi,jpj),          & 
    189                  syyice(jpi,jpj),  sxyice(jpi,jpj),                           & 
    190                  sxsn(jpi,jpj),    sysn(jpi,jpj),  sxxsn(jpi,jpj),            & 
    191                  syysn(jpi,jpj),   sxysn(jpi,jpj), Stat=ierr(6)) 
    192  
    193         ALLOCATE(sxa(jpi,jpj),     sya(jpi,jpj),   sxxa(jpi,jpj),             & 
    194                  syya(jpi,jpj),    sxya(jpi,jpj),                             &  
    195                  sxc0(jpi,jpj),    syc0(jpi,jpj),  sxxc0(jpi,jpj),            & 
    196                  syyc0(jpi,jpj),   sxyc0(jpi,jpj), Stat=ierr(7)) 
    197  
    198         ALLOCATE(sxc1(jpi,jpj),    syc1(jpi,jpj),  sxxc1(jpi,jpj),            & 
    199                  syyc1(jpi,jpj),   sxyc1(jpi,jpj),                            & 
    200                  sxc2(jpi,jpj),    syc2(jpi,jpj),  sxxc2(jpi,jpj),            & 
    201                  syyc2(jpi,jpj),   sxyc2(jpi,jpj), Stat=ierr(8)) 
    202  
    203         ALLOCATE(sxst(jpi,jpj),    syst(jpi,jpj),  sxxst(jpi,jpj),            & 
    204                  syyst(jpi,jpj),   sxyst(jpi,jpj), Stat=ierr(9)) 
    205  
    206         ice_alloc_2 = MAXVAL(ierr) 
    207  
    208         IF(ice_alloc_2 /= 0)THEN 
    209            CALL ctl_warn('ice_alloc_2: failed to allocate arrays.') 
    210         END IF 
    211  
    212      END FUNCTION ice_alloc_2 
    213  
    214 #endif 
    215  
    216200END MODULE ice_2 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90

    r2528 r2613  
    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 
     20   USE dom_ice_2        ! LIM2 ice domain 
    2021   USE sbc_oce          ! surface boundary condition: ocean 
    2122   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 
     23   USE thd_ice_2        ! LIM2 thermodynamical variables 
     24   USE limrhg           ! LIM2 rheology 
     25   USE ice_2            ! LIM2 ice variable 
     26   USE limmsh_2         ! LIM2 mesh 
     27   USE limistate_2      ! LIM2 initial state 
     28   USE limrst_2         ! LIM2 restart 
     29   USE limsbc_2         ! LIM2 surface boundary condition 
    2730   USE in_out_manager   ! I/O manager 
    2831       
     
    3336 
    3437   !!---------------------------------------------------------------------- 
    35    !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
     38   !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) 
    3639   !! $Id$  
    3740   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    4548      !! ** purpose :   initialisation of LIM-2 domain and variables   
    4649      !!---------------------------------------------------------------------- 
     50      INTEGER :: ierr 
     51      !!---------------------------------------------------------------------- 
    4752      ! 
     53      IF(lwp) THEN 
     54         WRITE(numout,*) 
     55         WRITE(numout,*) 'ice_init_2 : LIM-2 sea-ice - initialization' 
     56         WRITE(numout,*) '~~~~~~~~~~~   ' 
     57      ENDIF 
     58      !                                ! Allocate the ice arrays 
     59      ierr =        ice_alloc_2    ()       ! ice variables 
     60      ierr = ierr + dom_ice_alloc_2()       ! domain 
     61      ierr = ierr + sbc_ice_alloc  ()       ! surface forcing 
     62      ierr = ierr + thd_ice_alloc_2()       ! thermodynamics 
     63#if ! defined key_lim2_vp 
     64      ierr = ierr + lim_rhg_alloc  () 
     65#endif 
     66      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     67      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ice_init_2 : unable to allocate ice arrays' ) 
     68 
    4869      !                                ! Open the namelist file  
    4970      CALL ctl_opn( numnam_ice, 'namelist_ice', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )  
     
    6182      ENDIF 
    6283      ! 
    63       tn_ice(:,:,1) = sist(:,:)        ! initialisation of ice temperature    
    64       fr_i  (:,:) = 1.0 - frld(:,:)    ! initialisation of sea-ice fraction     
     84      tn_ice(:,:,1) = sist(:,:)        ! ice temperature  known by the ocean 
     85      fr_i  (:,:)   = 1.0 - frld(:,:)  ! sea-ice fraction known by the ocean 
     86      ! 
     87      CALL lim_sbc_init_2              ! ice surface boundary condition    
     88      ! 
     89      IF( lk_lim2_vp )   THEN   ;   WRITE(numout,*) '                VP  rheology - B-grid case' 
     90      ELSE                      ;   WRITE(numout,*) '                EVP rheology - C-grid case' 
     91      ENDIF 
    6592      ! 
    6693   END SUBROUTINE ice_init_2 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90

    r2590 r2613  
    5858      !! Reference:  Prather, 1986, JGR, 91, D6. 6671-6681. 
    5959      !!-------------------------------------------------------------------- 
    60       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    61       USE wrk_nemo, ONLY: zf0 => wrk_2d_11, zfx => wrk_2d_12, zfy => wrk_2d_13 
    62       USE wrk_nemo, ONLY: zbet => wrk_2d_14, zfm => wrk_2d_15, zfxx => wrk_2d_16 
    63       USE wrk_nemo, ONLY: zfyy => wrk_2d_17, zfxy => wrk_2d_18, zalg => wrk_2d_19 
    64       USE wrk_nemo, ONLY: zalg1 => wrk_2d_20, zalg1q => wrk_2d_21 
    65       !! 
     60      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     61      USE wrk_nemo, ONLY:   zf0  => wrk_2d_11 , zfx   => wrk_2d_12 , zfy    => wrk_2d_13 , zbet => wrk_2d_14   ! 2D workspace 
     62      USE wrk_nemo, ONLY:   zfm  => wrk_2d_15 , zfxx  => wrk_2d_16 , zfyy   => wrk_2d_17 , zfxy => wrk_2d_18   !  -      - 
     63      USE wrk_nemo, ONLY:   zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21                       !  -      - 
     64      ! 
    6665      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step 
    6766      REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0) 
     
    7170      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psx , psy          ! 1st moments  
    7271      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments 
    73       !!  
     72      !  
    7473      INTEGER  ::   ji, jj                               ! dummy loop indices 
    7574      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! temporary scalars 
     
    7877      !--------------------------------------------------------------------- 
    7978 
    80       IF(.NOT. wrk_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.') 
    82          RETURN 
     79      IF( .NOT. wrk_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 
     80         CALL ctl_stop( 'lim_adv_x_2 : requested workspace arrays unavailable.' )   ;   RETURN 
    8381      END IF 
    8482 
     
    226224      ENDIF 
    227225      ! 
    228       IF(.NOT. wrk_release(2, 11,12,13,14,15,16,17,18,19,20,21))THEN 
    229          CALL ctl_stop('lim_adv_x_2 : failed to release workspace arrays.') 
     226      IF( .NOT. wrk_release(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 
     227         CALL ctl_stop( 'lim_adv_x_2 : failed to release workspace arrays.' ) 
    230228      END IF 
    231229      ! 
     
    247245      !! Reference:  Prather, 1986, JGR, 91, D6. 6671-6681. 
    248246      !!--------------------------------------------------------------------- 
    249       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    250       USE wrk_nemo, ONLY: zf0 => wrk_2d_11, zfx => wrk_2d_12, zfy => wrk_2d_13 
    251       USE wrk_nemo, ONLY: zbet => wrk_2d_14, zfm => wrk_2d_15, zfxx => wrk_2d_16 
    252       USE wrk_nemo, ONLY: zfyy => wrk_2d_17, zfxy => wrk_2d_18, zalg => wrk_2d_19 
    253       USE wrk_nemo, ONLY: zalg1 => wrk_2d_20, zalg1q => wrk_2d_21 
     247      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     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                       !  -      - 
    254251      !! 
    255252      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step 
     
    267264      !--------------------------------------------------------------------- 
    268265 
    269       IF(.NOT. wrk_use(2, 11,12,13,14,15,16,17,18,19,20,21))THEN 
    270          CALL ctl_stop('lim_adv_y_2 : requested workspace arrays unavailable.') 
    271          RETURN 
     266      IF(.NOT. wrk_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 
    272268      END IF 
    273269 
     
    418414      ENDIF 
    419415      ! 
    420       IF(.NOT. wrk_release(2, 11,12,13,14,15,16,17,18,19,20,21))THEN 
    421         CALL ctl_stop('lim_adv_y_2 : failed to release workspace arrays.') 
     416      IF( .NOT. wrk_release(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.' ) 
    422418      END IF 
    423419      ! 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90

    r2590 r2613  
    2929 
    3030   PUBLIC               lim_dia_2          ! called by sbc_ice_lim_2 
    31    PUBLIC               lim_dia_alloc_2    ! called by nemogcm 
    3231 
    3332   INTEGER, PUBLIC ::   ntmoy   = 1 ,   &  !: instantaneous values of ice evolution or averaging ntmoy 
     
    6362   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6463   !!---------------------------------------------------------------------- 
    65  
    6664CONTAINS 
    67  
    68    FUNCTION lim_dia_alloc_2() 
    69       !!-------------------------------------------------------------------- 
    70       !!                  ***  ROUTINE lim_dia_2  *** 
    71       !!-------------------------------------------------------------------- 
    72       IMPLICIT none 
    73       INTEGER :: lim_dia_alloc_2 
    74       !!-------------------------------------------------------------------- 
    75  
    76       ALLOCATE(aire(jpi,jpj), Stat=lim_dia_alloc_2) 
    77  
    78       IF(lim_dia_alloc_2 /= 0)THEN 
    79          CALL ctl_warn('lim_dia_alloc_2: failed to allocate array aire.') 
    80       END IF 
    81  
    82    END FUNCTION lim_dia_alloc_2 
    83  
    8465 
    8566   SUBROUTINE lim_dia_2( kt ) 
     
    192173       !!------------------------------------------------------------------- 
    193174       CHARACTER(len=jpchinf) ::   titinf 
    194        INTEGER  ::   jv            ! dummy loop indice 
    195        INTEGER  ::   ntot , ndeb  
    196        INTEGER  ::   nv            ! indice of variable  
    197        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 
    198178 
    199179       NAMELIST/namicedia/fmtinf, nfrinf, ninfo, ntmoy 
    200180       !!------------------------------------------------------------------- 
    201181 
    202        ! Read Namelist namicedia 
    203        REWIND ( numnam_ice ) 
    204        READ   ( numnam_ice  , namicedia ) 
     182       REWIND( numnam_ice )                     ! Read Namelist namicedia 
     183       READ  ( numnam_ice  , namicedia ) 
    205184        
    206        IF(lwp) THEN 
     185       IF(lwp) THEN                             ! control print 
    207186          WRITE(numout,*) 
    208187          WRITE(numout,*) 'lim_dia_init_2 : ice parameters for ice diagnostics ' 
     
    214193       ENDIF 
    215194 
    216        ! 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' ) 
    217198       aire(:,:) = area(:,:) * tms(:,:) 
    218199 
    219        ! Titles of ice key variables : 
    220        nv = 1 
     200       nv = 1                                   ! Titles of ice key variables 
    221201       titvar(nv) = 'NoIt'  ! iteration number 
    222202       nv = nv + 1 
    223203       titvar(nv) = 'T yr'  ! time step in years 
    224         
    225204       nbvt = nv - 1 
    226  
    227205       nv = nv + 1   ;   titvar(nv) = 'AEFN' ! sea ice area in the northern Hemisp.(10^12 km2) 
    228206       nv = nv + 1   ;   titvar(nv) = 'AEFS' ! sea ice area in the southern Hemisp.(10^12 km2) 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90

    r2590 r2613  
    5858      !!              - treatment of the case if no ice dynamic 
    5959      !!--------------------------------------------------------------------- 
    60       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    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 
     60      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     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      ! 
    6364      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    6465      !! 
     
    6667      INTEGER  ::   i_j1, i_jpj        ! Starting/ending j-indices for rheology 
    6768      REAL(wp) ::   zcoef              ! temporary scalar 
    68       REAL(wp), POINTER, DIMENSION(:)     ::   zind     ! i-averaged indicator of sea-ice 
    69       REAL(wp), POINTER, DIMENSION(:)     ::   zmsk     ! i-averaged of tmask 
     69      REAL(wp), POINTER, DIMENSION(:) ::   zind     ! i-averaged indicator of sea-ice 
     70      REAL(wp), POINTER, DIMENSION(:) ::   zmsk     ! i-averaged of tmask 
    7071      !!--------------------------------------------------------------------- 
    7172 
    72       IF( (.NOT. wrk_use(1, 1,2)) .OR. (.NOT. wrk_use(2, 1,2)) )THEN 
    73          CALL ctl_stop('lim_dyn_2 : requested workspace arrays unavailable.') 
    74          RETURN 
     73      IF(  .NOT. wrk_use(1, 1,2)  .OR.  .NOT. wrk_use(2, 1,2)  ) THEN 
     74         CALL ctl_stop( 'lim_dyn_2 : requested workspace arrays unavailable.' )   ;   RETURN 
    7575      END IF 
    76       ! Set-up pointers to sub-arrays of workspaces 
    77       zind => wrk_1d_1(1:jpj) 
     76      zind => wrk_1d_1(1:jpj)      ! Set-up pointers to sub-arrays of workspaces 
    7877      zmsk => wrk_1d_2(1:jpj) 
    7978 
     
    103102            ! 
    104103            DO jj = 1, jpj 
    105                zind(jj) = SUM( frld (:,jj  ) )   ! = FLOAT(jpj) if ocean everywhere on a j-line 
    106                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 
    107106            END DO 
    108107            ! 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90

    r2600 r2613  
    2525 
    2626   PUBLIC   lim_hdf_2         ! called by limtrp_2.F90 
    27    PUBLIC   lim_hdf_alloc_2   ! called by nemogcm.F90 
    2827 
    2928   LOGICAL  ::   linit = .TRUE.   ! ! initialization flag (set to flase after the 1st call) 
    3029   REAL(wp) ::   epsi04 = 1e-04   ! constant 
    3130    
    32    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   efact   ! ??? 
     31   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   efact   ! metric coefficient 
    3332 
    3433   !! * Substitution  
     
    4039   !!---------------------------------------------------------------------- 
    4140CONTAINS 
    42  
    43    FUNCTION lim_hdf_alloc_2() 
    44       !!------------------------------------------------------------------- 
    45       !!                  ***  ROUTINE lim_hdf_alloc_2  *** 
    46       !!------------------------------------------------------------------- 
    47       INTEGER :: lim_hdf_alloc_2 
    48       !!------------------------------------------------------------------- 
    49       ! 
    50       ALLOCATE( efact(jpi,jpj) , STAT=lim_hdf_alloc_2 ) 
    51       ! 
    52       IF( lim_hdf_alloc_2 /= 0 ) THEN 
    53          CALL ctl_warn( 'lim_hdf_alloc_2: failed to allocate efact array.' ) 
    54       ENDIF 
    55       ! 
    56    END FUNCTION lim_hdf_alloc_2 
    57  
    5841 
    5942   SUBROUTINE lim_hdf_2( ptab ) 
     
    7457      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   ptab   ! Field on which the diffusion is applied   
    7558      ! 
    76       INTEGER  ::  ji, jj      ! dummy loop indices 
    77       INTEGER  ::  its, iter   ! local integers 
     59      INTEGER  ::   ji, jj            ! dummy loop indices 
     60      INTEGER  ::   its, iter, ierr   ! local integers 
    7861      REAL(wp) ::   zalfa, zrlxint, zconv, zeps   ! local scalars 
    7962      CHARACTER (len=55) :: charout 
     
    8770      ! 
    8871      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' ) 
    8975         DO jj = 2, jpjm1   
    9076            DO ji = fs_2 , fs_jpim1   ! vector opt. 
    91                efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj  ) + e1v(ji,jj) + e1v(ji,jj-1) ) & 
    92                   &          / ( 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) ) 
    9378            END DO 
    9479         END DO 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r2590 r2613  
    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 
     
    3639   PRIVATE 
    3740 
    38    PUBLIC   lim_sbc_flx_2     ! called by sbc_ice_lim_2 
    39    PUBLIC   lim_sbc_tau_2     ! called by sbc_ice_lim_2 
    40    PUBLIC   lim_sbc_alloc_2   ! called by nemogcm.F90 
     41   PUBLIC   lim_sbc_init_2     ! called by ice_init_2 
     42   PUBLIC   lim_sbc_flx_2      ! called by sbc_ice_lim_2 
     43   PUBLIC   lim_sbc_tau_2      ! called by sbc_ice_lim_2 
    4144 
    4245   REAL(wp)  ::   r1_rdtice            ! = 1. / rdt_ice  
     
    5356#  include "vectopt_loop_substitute.h90" 
    5457   !!---------------------------------------------------------------------- 
    55    !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
     58   !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) 
    5659   !! $Id$ 
    5760   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    6366      !!             ***  ROUTINE lim_sbc_alloc_2 *** 
    6467      !!------------------------------------------------------------------- 
    65       IMPLICIT none 
    6668      INTEGER :: lim_sbc_alloc_2 
    6769      !!------------------------------------------------------------------- 
    68  
    69       ALLOCATE(soce_0(jpi,jpj),   sice_0(jpi,jpj),   & 
    70                utau_oce(jpi,jpj), vtau_oce(jpi,jpj), & 
    71                tmod_io(jpi,jpj),                     & 
    72                Stat=lim_sbc_alloc_2) 
    73  
    74       IF(lim_sbc_alloc_2 /= 0)THEN 
    75          CALL ctl_warn('lim_sbc_alloc_2: failed to allocate arrays.') 
    76       END IF 
    77  
     70      ! 
     71      ALLOCATE( soce_0(jpi,jpj) , utau_oce(jpi,jpj) ,                       & 
     72         &      sice_0(jpi,jpj) , vtau_oce(jpi,jpj) , tmod_io(jpi,jpj), STAT=lim_sbc_alloc_2) 
     73         ! 
     74      IF( lk_mpp               )   CALL mpp_sum( lim_sbc_alloc_2 ) 
     75      IF( lim_sbc_alloc_2 /= 0 )   CALL ctl_warn('lim_sbc_alloc_2: failed to allocate arrays.') 
     76      ! 
    7877   END FUNCTION lim_sbc_alloc_2 
    7978 
     
    121120         RETURN 
    122121      END IF 
    123       ! Set-up pointers to sub-arrays of 3d workspaces 
    124       zalb  => wrk_3d_4(:,:,1:1) 
     122      zalb  => wrk_3d_4(:,:,1:1)      ! Set-up pointers to sub-arrays of 3d workspaces 
    125123      zalbp => wrk_3d_5(:,:,1:1) 
    126  
    127       IF( kt == nit000 ) THEN 
    128          IF(lwp) WRITE(numout,*) 
    129          IF(lwp) WRITE(numout,*) 'lim_sbc_flx_2 : LIM-2 sea-ice - surface boundary condition - Mass, heat & salt fluxes' 
    130          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   ' 
    131          ! 
    132          r1_rdtice = 1._wp / rdt_ice 
    133          ! 
    134          soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
    135          sice_0(:,:) = sice 
    136          ! 
    137          IF( cp_cfg == "orca" ) THEN            ! decrease ocean & ice reference salinities in the Baltic sea  
    138             WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
    139                &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
    140                soce_0(:,:) = 4._wp 
    141                sice_0(:,:) = 2._wp 
    142             END WHERE 
    143          ENDIF 
    144          ! 
    145       ENDIF 
    146124 
    147125      !------------------------------------------! 
     
    260238 
    261239      IF( lk_cpl ) THEN          ! coupled case 
    262          ! Ice surface temperature  
    263240         tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature        
    264          ! Computation of snow/ice and ocean albedo 
     241         !                                  ! Computation of snow/ice and ocean albedo 
    265242         CALL albedo_ice( tn_ice, reshape( hicif, (/jpi,jpj,1/) ), reshape( hsnif, (/jpi,jpj,1/) ), zalbp, zalb ) 
    266243         alb_ice(:,:,1) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys) 
     
    321298      ! 
    322299      IF(.NOT. wrk_use(2, 1,2))THEN 
    323          CALL ctl_stop('lim_sbc_tau_2 : requested workspace arrays unavailable.') 
    324          RETURN 
     300         CALL ctl_stop('lim_sbc_tau_2 : requested workspace arrays unavailable.')   ;   RETURN 
    325301      END IF 
    326       ! 
    327       IF( kt == nit000 .AND. lwp ) THEN         ! control print 
    328          WRITE(numout,*) 
    329          WRITE(numout,*) 'lim_sbc_tau_2 : LIM 2.0 sea-ice - surface ocean momentum fluxes' 
    330          WRITE(numout,*) '~~~~~~~~~~~~~ ' 
    331          IF( lk_lim2_vp )   THEN   ;   WRITE(numout,*) '                VP  rheology - B-grid case' 
    332          ELSE                      ;   WRITE(numout,*) '                EVP rheology - C-grid case' 
    333          ENDIF 
    334       ENDIF 
    335302      ! 
    336303      SELECT CASE( cp_ice_msh )      
     
    446413         &                       tab2d_2=vtau, clinfo2=' vtau    : '        , mask2=vmask ) 
    447414      !   
    448       IF(.NOT. wrk_release(2, 1,2))THEN 
    449          CALL ctl_stop('lim_sbc_tau_2 : failed to release workspace arrays.') 
    450       END IF 
    451  
     415      IF(.NOT. wrk_release(2, 1,2) )   CALL ctl_stop('lim_sbc_tau_2 : failed to release workspace arrays.') 
     416      ! 
    452417   END SUBROUTINE lim_sbc_tau_2 
     418 
     419 
     420   SUBROUTINE lim_sbc_init_2 
     421      !!------------------------------------------------------------------- 
     422      !!                  ***  ROUTINE lim_sbc_init  *** 
     423      !!              
     424      !! ** Purpose : Preparation of the file ice_evolu for the output of 
     425      !!      the temporal evolution of key variables 
     426      !! 
     427      !! ** input   : Namelist namicedia 
     428      !!------------------------------------------------------------------- 
     429      ! 
     430      IF(lwp) WRITE(numout,*) 
     431      IF(lwp) WRITE(numout,*) 'lim_sbc_init_2 : LIM-2 sea-ice - surface boundary condition' 
     432      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~   ' 
     433 
     434      !                                      ! allocate lim_sbc arrays 
     435      IF( lim_sbc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'lim_sbc_flx_2 : unable to allocate arrays' ) 
     436      ! 
     437      r1_rdtice = 1._wp / rdt_ice 
     438      ! 
     439      soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
     440      sice_0(:,:) = sice 
     441      ! 
     442      IF( cp_cfg == "orca" ) THEN            ! decrease ocean & ice reference salinities in the Baltic sea  
     443         WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
     444            &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
     445            soce_0(:,:) = 4._wp 
     446            sice_0(:,:) = 2._wp 
     447         END WHERE 
     448      ENDIF 
     449      ! 
     450   END SUBROUTINE lim_sbc_init_2 
    453451 
    454452#else 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limtab_2.F90

    r2528 r2613  
    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 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90

    r2590 r2613  
    5353   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex51   ! ???? 
    5454 
    55    REAL(wp)  ::            &  ! constant values 
    56       epsi16 = 1.e-16   ,  & 
    57       zzero  = 0.e0     ,  & 
    58       zone   = 1.e0 
     55   REAL(wp) ::   epsi16 = 1.e-16_wp   ! constant values 
     56   REAL(wp) ::   zzero  = 0._wp       !     -      - 
     57   REAL(wp) ::   zone   = 1._wp       !     -      - 
    5958 
    6059   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zcmo      ! Workspace array for netcdf writer.  
     
    6867   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6968   !!---------------------------------------------------------------------- 
    70  
    7169CONTAINS 
    7270 
     
    7876      INTEGER :: lim_wri_alloc_2 
    7977      !!------------------------------------------------------------------- 
    80  
    81       ALLOCATE(ndex51(jpij), zcmo(jpi,jpj,jpnoumax), Stat=lim_wri_alloc_2) 
    82  
    83       IF(lim_wri_alloc_2 /= 0)THEN 
    84          CALL ctl_warn('lim_wri_alloc_2: failed to allocate array ndex51') 
    85       END IF 
    86  
     78      ! 
     79      ALLOCATE( ndex51(jpij), zcmo(jpi,jpj,jpnoumax), STAT=lim_wri_alloc_2) 
     80      ! 
     81      IF( lk_mpp               )   CALL mpp_sum( ierr ) 
     82      IF( lim_wri_alloc_2 /= 0 )   CALL ctl_warn('lim_wri_alloc_2: failed to allocate array ndex51') 
     83      ! 
    8784   END FUNCTION lim_wri_alloc_2 
    8885 
     
    125122      IF( kt == nit000 ) THEN                    !   Initialisation   ! 
    126123         !                                       !--------------------! 
     124 
    127125         CALL lim_wri_init_2  
    128126                            
     
    253251         field_19 
    254252      !!------------------------------------------------------------------- 
     253      ! 
     254      IF( lim_wri_alloc_2() /= 0 ) THEN      ! allocate lim_wri arrrays 
     255         CALL ctl_stop( 'STOP', 'lim_wri_init_2 : unable to allocate standard arrays' )   ;   RETURN 
     256      ENDIF 
    255257 
    256258      REWIND ( numnam_ice )                ! Read Namelist namicewri 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90

    r2590 r2613  
    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 !ARPDBGWORK 
    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,*) '~~~~~~~~' 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r2590 r2613  
    3232   LOGICAL ::   ln_vol  = .false.     !: =T volume correction              
    3333   LOGICAL ::   ln_mask = .false.     !: =T read bdymask from file 
    34    LOGICAL ::   ln_clim = .false.     !: if true, we assume that bdy data files contain  
    35    !                                    !  1 time dump  (-->bdy forcing will be constant)  
    36    !                                    !  or 12 months (-->bdy forcing will be cyclic)  
     34   LOGICAL ::   ln_clim = .false.     !: =T bdy data files contain  1 time dump  (-->bdy forcing will be constant)  
     35   !                                  !                         or 12 months     (-->bdy forcing will be cyclic)  
    3736   LOGICAL ::   ln_dyn_fla  = .false. !: =T Flather boundary conditions on barotropic velocities 
    3837   LOGICAL ::   ln_dyn_frs  = .false. !: =T FRS boundary conditions on velocities 
     
    4039   LOGICAL ::   ln_ice_frs  = .false. !: =T FRS boundary conditions on seaice (leads fraction, ice depth, snow depth) 
    4140   ! 
    42    INTEGER ::   nn_rimwidth = 7         !: boundary rim width 
    43    INTEGER ::   nn_dtactl   = 1          !: = 0 use the initial state as bdy dta or = 1 read it in a NetCDF file 
    44    INTEGER ::   nn_volctl   = 1         !: = 0 the total volume will have the variability of the surface Flux E-P  
    45    !                                    !  = 1 the volume will be constant during all the integration. 
     41   INTEGER ::   nn_rimwidth = 7       !: boundary rim width 
     42   INTEGER ::   nn_dtactl   = 1       !: = 0 use the initial state as bdy dta ; = 1 read it in a NetCDF file 
     43   INTEGER ::   nn_volctl   = 1       !: = 0 the total volume will have the variability of the surface Flux E-P  
     44   !                                  !  = 1 the volume will be constant during all the integration. 
    4645 
    4746   !!---------------------------------------------------------------------- 
     
    6362   INTEGER, DIMENSION(jpbdim,jpbgrd) ::   nbmap           !: Indices of data in file for data in memory  
    6463     
    65    REAL(wp) ::   bdysurftot                             !: Lateral surface of unstructured open boundary 
     64   REAL(wp) ::   bdysurftot                               !: Lateral surface of unstructured open boundary 
    6665 
    6766   REAL(wp), DIMENSION(jpbdim)        ::   flagu, flagv   !: Flag for normal velocity compnt for velocity components 
     
    7574   REAL(wp), DIMENSION(jpbdim) ::   utide, vtide          !: Tidal boundary array : U and V 
    7675#if defined key_lim2 
    77    REAL(wp), DIMENSION(jpbdim) ::  & 
    78       frld_bdy, hicif_bdy,  & !: Now clim of ice leads fraction, ice   
    79       hsnif_bdy               !: thickness and snow thickness 
     76   REAL(wp), DIMENSION(jpbdim) ::   frld_bdy    !: now ice leads fraction climatology    
     77   REAL(wp), DIMENSION(jpbdim) ::   hicif_bdy   !: Now ice  thickness climatology 
     78   REAL(wp), DIMENSION(jpbdim) ::   hsnif_bdy   !: now snow thickness 
    8079#endif 
     80 
     81   !!---------------------------------------------------------------------- 
     82   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     83   !! $Id$  
     84   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     85   !!---------------------------------------------------------------------- 
     86CONTAINS 
     87 
     88   FUNCTION bdy_oce_alloc() 
     89      !!---------------------------------------------------------------------- 
     90      INTEGER :: bdy_oce_alloc 
     91      !!---------------------------------------------------------------------- 
     92      ! 
     93      ALLOCATE( bdytmask(jpi,jpj) , tbdy(jpbdim,jpk) , sbdy(jpbdim,jpk) ,     & 
     94         &      bdyumask(jpi,jpj) , ubdy(jpbdim,jpk) ,                        & 
     95         &      bdyvmask(jpi,jpj) , vbdy(jpbdim,jpk) ,                    STAT=bdy_oce_alloc ) 
     96         ! 
     97      IF( lk_mpp             )   CALL mpp_sum ( bdy_oce_alloc ) 
     98      IF( bdy_oce_alloc /= 0 )   CALL ctl_warn('bdy_oce_alloc: failed to allocate arrays.') 
     99      ! 
     100   END FUNCTION bdy_oce_alloc 
    81101 
    82102#else 
     
    87107#endif 
    88108 
    89    !!---------------------------------------------------------------------- 
    90    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    91    !! $Id$  
    92    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    93109   !!====================================================================== 
    94 #if defined key_bdy  
    95 CONTAINS 
    96  
    97    FUNCTION bdy_oce_alloc() 
    98       INTEGER :: bdy_oce_alloc 
    99  
    100       ALLOCATE(bdytmask(jpi,jpj), bdyumask(jpi,jpj), bdyvmask(jpi,jpj), & 
    101                tbdy(jpbdim,jpk),  sbdy(jpbdim,jpk),                     & 
    102                ubdy(jpbdim,jpk),  vbdy(jpbdim,jpk),                     & 
    103                Stat=bdy_oce_alloc) 
    104   
    105       IF(bdy_oce_alloc /= 0)THEN 
    106          CALL ctl_warn('bdy_oce_alloc: failed to allocate arrays.') 
    107       END IF 
    108  
    109    END FUNCTION bdy_oce_alloc 
    110 #endif 
    111  
    112110END MODULE bdy_oce 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r2528 r2613  
    3333 
    3434   !!---------------------------------------------------------------------- 
    35    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     35   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    3636   !! $Id$  
    37    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     37   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3838   !!---------------------------------------------------------------------- 
    3939CONTAINS 
     
    4444      !!          
    4545      !! ** Purpose :   Initialization of the dynamics and tracer fields with  
    46       !!      unstructured open boundaries. 
     46      !!              unstructured open boundaries. 
    4747      !! 
    48       !! ** Method  :  Read initialization arrays (mask, indices) to identify  
    49       !!               an unstructured open boundary 
     48      !! ** Method  :   Read initialization arrays (mask, indices) to identify  
     49      !!              an unstructured open boundary 
    5050      !! 
    5151      !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries 
    5252      !!----------------------------------------------------------------------       
    53       INTEGER ::   ii, ij, ik, igrd, ib, ir   ! dummy loop indices 
    54       INTEGER ::   icount, icountr 
    55       INTEGER ::   ib_len, ibr_max 
    56       INTEGER ::   iw, ie, is, in  
    57       INTEGER ::   inum                 ! local logical unit 
    58       INTEGER ::   id_dummy             ! local integers 
    59       INTEGER ::   igrd_start, igrd_end ! start and end of loops on igrd 
     53      INTEGER  ::   ii, ij, ik, igrd, ib, ir   ! dummy loop indices 
     54      INTEGER  ::   icount, icountr, ib_len, ibr_max   ! local integers 
     55      INTEGER  ::   iw, ie, is, in, inum, id_dummy     !   -       - 
     56      INTEGER  ::   igrd_start, igrd_end               !   -       - 
     57      REAL(wp) ::   zefl, zwfl, znfl, zsfl              ! local scalars 
    6058      INTEGER, DIMENSION (2)             ::   kdimsz 
    6159      INTEGER, DIMENSION(jpbdta, jpbgrd) ::   nbidta, nbjdta   ! Index arrays: i and j indices of bdy dta 
    6260      INTEGER, DIMENSION(jpbdta, jpbgrd) ::   nbrdta           ! Discrete distance from rim points 
    63       REAL(wp) :: zefl, zwfl, znfl, zsfl                       ! temporary scalars 
    64       REAL(wp) , DIMENSION(jpidta,jpjdta) ::   zmask           ! global domain mask 
    65       REAL(wp) , DIMENSION(jpbdta,1)      ::   zdta            ! temporary array  
    66       CHARACTER(LEN=80),DIMENSION(6)      ::   clfile 
     61      REAL(wp), DIMENSION(jpidta,jpjdta) ::   zmask            ! global domain mask 
     62      REAL(wp), DIMENSION(jpbdta,1)      ::   zdta             ! temporary array  
     63      CHARACTER(LEN=80),DIMENSION(6)     ::   clfile 
    6764      !! 
    68       NAMELIST/nambdy/cn_mask, cn_dta_frs_T, cn_dta_frs_U, cn_dta_frs_V,          & 
    69          &            cn_dta_fla_T, cn_dta_fla_U, cn_dta_fla_V,              & 
    70          &            ln_tides, ln_clim, ln_vol, ln_mask,                & 
    71          &            ln_dyn_fla, ln_dyn_frs, ln_tra_frs,ln_ice_frs,     & 
     65      NAMELIST/nambdy/cn_mask, cn_dta_frs_T, cn_dta_frs_U, cn_dta_frs_V,   & 
     66         &            cn_dta_fla_T, cn_dta_fla_U, cn_dta_fla_V,            & 
     67         &            ln_tides, ln_clim, ln_vol, ln_mask,                  & 
     68         &            ln_dyn_fla, ln_dyn_frs, ln_tra_frs,ln_ice_frs,       & 
    7269         &            nn_dtactl, nn_rimwidth, nn_volctl 
    7370      !!---------------------------------------------------------------------- 
     
    7774      IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    7875      ! 
     76      !                                      ! allocate bdy_oce arrays 
     77      IF( bdy_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'bdy_init : unable to allocate arrays' ) 
     78 
    7979      IF( jperio /= 0 )   CALL ctl_stop( 'Cyclic or symmetric,',   & 
    8080         &                               ' and unstructured open boundary condition are not compatible' ) 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r2590 r2613  
    77   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 
    88   !!---------------------------------------------------------------------- 
    9 #if defined key_diaar5 
     9#if defined key_diaar5   || defined key_esopa 
    1010   !!---------------------------------------------------------------------- 
    1111   !!   'key_diaar5'  :                           activate ar5 diagnotics 
     
    5050      INTEGER :: dia_ar5_alloc 
    5151      !!---------------------------------------------------------------------- 
    52  
    53       ALLOCATE(area(jpi,jpj), thick0(jpi,jpj), sn0(jpi,jpj,jpk), & 
    54                Stat=dia_ar5_alloc) 
    55  
    56       IF(dia_ar5_alloc /= 0)THEN 
    57          CALL ctl_warn('dia_ar5_alloc: failed to allocate arrays') 
    58       END IF 
    59  
     52      ! 
     53      ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 
     54      ! 
     55      IF( lk_mpp             )   CALL mpp_sum ( dia_ar5_alloc ) 
     56      IF( dia_ar5_alloc /= 0 )   CALL ctl_warn('dia_ar5_alloc: failed to allocate arrays') 
     57      ! 
    6058   END FUNCTION dia_ar5_alloc 
    6159 
     
    6664      !! 
    6765      !! ** Purpose :   compute and output some AR5 diagnostics 
    68       !! 
    6966      !!---------------------------------------------------------------------- 
    7067      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     
    8279          (.NOT. wrk_use(3, 1,2)) .OR. & 
    8380          (.NOT. wrk_use(4, 1)) )THEN 
    84          CALL ctl_stop('dia_ar5: requested workspace arrays unavailable') 
    85          RETURN 
     81         CALL ctl_stop('dia_ar5: requested workspace arrays unavailable')   ;   RETURN 
    8682      END IF 
    8783 
     
    190186      ! 
    191187      IF(.NOT. wrk_use(4, 1))THEN 
    192          CALL ctl_stop('dia_ar5_init: requested workspace array unavailable.') 
    193          RETURN 
     188         CALL ctl_stop('dia_ar5_init: requested workspace array unavailable.')   ;   RETURN 
    194189      END IF 
    195190      zsaldta => wrk_4d_1(:,:,:,1:2) 
     191 
     192      !                                      ! allocate dia_ar5 arrays 
     193      IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 
    196194 
    197195      area(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90

    r2590 r2613  
    66# if defined key_dimgout 
    77   !!---------------------------------------------------------------------- 
    8    !! * Modules used 
    98   USE oce             ! ocean dynamics and tracers  
    109   USE dom_oce         ! ocean space and time domain 
     
    1514   PRIVATE 
    1615 
    17    !! * Accessibility 
    1816   PUBLIC dia_wri_dimg            ! called by trd_mld (eg) 
    1917   PUBLIC dia_wri_dimg_alloc      ! called by nemo_alloc in nemogcm.F90 
    2018 
     19 
     20   !! These workspace arrays are inside the module so that we can make them 
     21   !! allocatable in a clean way. Not done in wrk_nemo because these are of KIND(sp). 
     22   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: z42d    ! 2d temporary workspace (sp) 
     23   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:)   :: z4dep   ! vertical level (sp) 
     24 
    2125   !! * Substitutions 
    2226#  include "domzgr_substitute.h90" 
    23  
    24    !! These workspace arrays are inside the module so that we can make them 
    25    !! allocatable in a clean way. Not done in wrk_nemo because these are 
    26    !! of KIND(sp). 
    27    REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: z42d  ! 2d temporary workspace (sp) 
    28    REAL(sp), ALLOCATABLE, SAVE,   DIMENSION(:) :: z4dep ! vertical level (sp) 
    29  
    3027   !!---------------------------------------------------------------------- 
    3128   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    3330   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3431   !!---------------------------------------------------------------------- 
    35  
    3632CONTAINS 
    3733 
    38   FUNCTION dia_wri_dimg_alloc() 
    39      !!--------------------------------------------------------------------- 
    40      !!        *** ROUTINE dia_wri_dimg_alloc *** 
    41      !! 
    42      !!--------------------------------------------------------------------- 
    43      INTEGER :: dia_wri_dimg_alloc 
    44      !!--------------------------------------------------------------------- 
    45  
    46      ALLOCATE(z42d(jpi,jpj), z4dep(jpk), Stat=dia_wri_dimg_alloc) 
    47  
    48      IF(dia_wri_dimg_alloc /= 0)THEN 
    49         CALL ctl_warn('dia_wri_dimg_alloc: allocation of array failed.') 
    50      END IF 
    51  
     34   FUNCTION dia_wri_dimg_alloc() 
     35      !!--------------------------------------------------------------------- 
     36      !!        *** ROUTINE dia_wri_dimg_alloc *** 
     37      !! 
     38      !!--------------------------------------------------------------------- 
     39      INTEGER :: dia_wri_dimg_alloc   ! return value 
     40      !!--------------------------------------------------------------------- 
     41      ! 
     42      ALLOCATE( z42d(jpi,jpj), z4dep(jpk), STAT=dia_wri_dimg_alloc ) 
     43      ! 
     44      IF( lk_mpp                  )   CALL mpp_sum ( dia_wri_dimg_alloc ) 
     45      IF( dia_wri_dimg_alloc /= 0 )   CALL ctl_warn('dia_wri_dimg_alloc: allocation of array failed.') 
     46      ! 
    5247  END FUNCTION dia_wri_dimg_alloc 
    5348 
    5449 
    55   SUBROUTINE dia_wri_dimg(cd_name, cd_text, ptab, klev, cd_type , ksubi ) 
     50  SUBROUTINE dia_wri_dimg( cd_name, cd_text, ptab, klev, cd_type , ksubi ) 
    5651    !!------------------------------------------------------------------------- 
    5752    !!        *** ROUTINE dia_wri_dimg *** 
    5853    !! 
    59     !! ** Purpose : write ptab in the dimg file cd_name, with comment cd_text. 
    60     !!       ptab has klev x 2D fields 
     54    !! ** Purpose :   write ptab in the dimg file cd_name, with comment cd_text. 
     55    !!              ptab has klev x 2D fields 
    6156    !! 
    62     !! ** Action : 
    63     !!       Define header variables from the config parameters 
    64     !!       Open the dimg file on unit inum = 14 ( IEEE I4R4 file ) 
    65     !!       Write header on record 1 
    66     !!       Write ptab on the following klev records 
     57    !! ** Action :   Define header variables from the config parameters 
     58    !!               Open the dimg file on unit inum = 14 ( IEEE I4R4 file ) 
     59    !!               Write header on record 1 
     60    !!               Write ptab on the following klev records 
    6761    !! 
    68     !! History : 
    69     !!   03-12 (J.M. Molines ) : Original. Replace ctl_opn, writn2d 
     62    !! History :  2003-12 (J.M. Molines ) : Original. Replace ctl_opn, writn2d 
    7063    !!--------------------------------------------------------------------------- 
    71     !! * Arguments 
    7264    CHARACTER(len=*),INTENT(in) ::   & 
    7365         &                            cd_name,  &  ! dimg file name 
     
    9183    CHARACTER(LEN=4) :: clver='@!01'           ! dimg string identifier 
    9284    !!--------------------------------------------------------------------------- 
     85 
     86    !                                      ! allocate dia_wri_dimg array 
     87    IF( dia_wri_dimg_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_wri_dimg : unable to allocate arrays' ) 
    9388 
    9489    !! * Initialisations 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90

    r2590 r2613  
    2121   USE phycst          ! physical constants 
    2222   USE in_out_manager  ! I/O manager 
     23   USE lib_mpp         ! MPP library 
    2324   USE iom             ! I/O library 
    2425 
     
    2930   PUBLIC   dia_hth_alloc ! routine called by nemogcm.F90 
    3031 
    31    LOGICAL , PUBLIC, PARAMETER          ::   lk_diahth = .TRUE.   !: thermocline-20d depths flag 
     32   LOGICAL , PUBLIC, PARAMETER          ::   lk_diahth = .TRUE.    !: thermocline-20d depths flag 
    3233   ! note: following variables should move to local variables once iom_put is always used  
    33    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hth                  !: depth of the max vertical temperature gradient [m] 
    34    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd20                 !: depth of 20 C isotherm                         [m] 
    35    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd28                 !: depth of 28 C isotherm                         [m] 
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc3                 !: heat content of first 300 m                    [W] 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hth    !: depth of the max vertical temperature gradient [m] 
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd20   !: depth of 20 C isotherm                         [m] 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd28   !: depth of 28 C isotherm                         [m] 
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc3   !: heat content of first 300 m                    [W] 
    3738 
    3839   !! * Substitutions 
    3940#  include "domzgr_substitute.h90" 
    4041   !!---------------------------------------------------------------------- 
    41    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     42   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    4243   !! $Id$  
    4344   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    4647 
    4748   FUNCTION dia_hth_alloc() 
    48      !!--------------------------------------------------------------------- 
    49       IMPLICIT none 
     49      !!--------------------------------------------------------------------- 
    5050      INTEGER :: dia_hth_alloc 
    51  
    52       ALLOCATE(hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), & 
    53                Stat=dia_hth_alloc) 
    54  
    55       IF(dia_hth_alloc /= 0)THEN 
    56          CALL ctl_warn('dia_hth_alloc: failed to allocate arrays.') 
    57       END IF 
     51      !!--------------------------------------------------------------------- 
     52      ! 
     53      ALLOCATE(hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), STAT=dia_hth_alloc) 
     54      ! 
     55      IF( lk_mpp           )   CALL mpp_sum ( dia_hth_alloc ) 
     56      IF(dia_hth_alloc /= 0)   CALL ctl_warn('dia_hth_alloc: failed to allocate arrays.') 
     57      ! 
    5858   END FUNCTION dia_hth_alloc 
    5959 
     
    117117                     zmaxdzT(jpi,jpj), & 
    118118                     zthick(jpi,jpj),  & 
    119                      zdelr(jpi,jpj), Stat=ji) 
    120             IF(ji /= 0)THEN 
    121                WRITE(*,*) 'ERROR: allocation of arrays failed in dia_hth' 
    122                CALL mppabort() 
    123             END IF 
     119                     zdelr(jpi,jpj), STAT=ji) 
     120            IF( lk_mpp  )   CALL mpp_sum(ji) 
     121            IF( ji /= 0 )   CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard ocean arrays' ) 
    124122         END IF 
    125123 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r2590 r2613  
    7575CONTAINS 
    7676 
    77   FUNCTION dia_wri_alloc() 
    78     !!---------------------------------------------------------------------- 
    79     IMPLICIT none 
    80     INTEGER :: dia_wri_alloc 
    81     INTEGER, DIMENSION(2) :: ierr 
    82     !!---------------------------------------------------------------------- 
    83      
    84     ierr = 0 
    85  
    86     ALLOCATE(ndex_hT(jpi*jpj), ndex_hU(jpi*jpj), ndex_hV(jpi*jpj), & 
    87              ndex_T(jpi*jpj*jpk), ndex_U(jpi*jpj*jpk), ndex_V(jpi*jpj*jpk), & 
    88              Stat=ierr(1)) 
    89  
    90     dia_wri_alloc = MAXVAL(ierr) 
    91  
     77   FUNCTION dia_wri_alloc() 
     78      !!---------------------------------------------------------------------- 
     79      IMPLICIT none 
     80      INTEGER :: dia_wri_alloc 
     81      INTEGER, DIMENSION(2) :: ierr 
     82      !!---------------------------------------------------------------------- 
     83      ! 
     84      ierr = 0 
     85      ! 
     86      ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     & 
     87         &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     & 
     88         &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 
     89         ! 
     90      dia_wri_alloc = MAXVAL(ierr) 
     91      IF( lk_mpp )   CALL mpp_sum( ierr ) 
     92      ! 
    9293  END FUNCTION dia_wri_alloc 
    9394 
     
    106107   !!   'key_iomput'                                        use IOM library 
    107108   !!---------------------------------------------------------------------- 
     109 
    108110   SUBROUTINE dia_wri( kt ) 
    109111      !!--------------------------------------------------------------------- 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    r2590 r2613  
    6969    INTEGER ,INTENT(in) :: kt 
    7070    !! 
    71     INTEGER :: inbsel, jk 
    72     INTEGER :: iyear,imon,iday 
    73     INTEGER, SAVE :: nmoyct  
    74  
    7571#if defined key_diainstant 
    7672    LOGICAL, PARAMETER :: ll_dia_inst=.TRUE.  !: for instantaneous output 
     
    7874    LOGICAL, PARAMETER :: ll_dia_inst=.FALSE. !: for average output 
    7975#endif 
    80  
    81     REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  um , vm   ! used to compute mean u, v fields 
    82     REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  wm        ! used to compute mean w fields 
    83     REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  avtm      ! used to compute mean kz fields 
    84     REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  tm , sm   ! used to compute mean t, s fields 
    85     REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  fsel      ! used to compute mean 2d fields 
     76    INTEGER              , SAVE                    ::  nmoyct  
     77    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  um , vm, wm   ! mean u, v, w fields 
     78    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  avtm          ! mean kz fields 
     79    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  tm , sm       ! mean t, s fields 
     80    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  fsel          ! mean 2d fields 
     81     
     82    INTEGER :: inbsel, jk 
     83    INTEGER :: iyear,imon,iday 
    8684    REAL(wp) :: zdtj 
    87     ! 
    8885    CHARACTER(LEN=80) :: clname 
    8986    CHARACTER(LEN=80) :: cltext 
     
    260257       cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode) 
    261258       ! 
    262        IF( ll_dia_inst) THEN  
    263           CALL dia_wri_dimg(clname, cltext, un, jpk, 'T') 
    264  
    265        ELSE  
    266           CALL dia_wri_dimg(clname, cltext, um, jpk, 'T') 
     259       IF( ll_dia_inst) THEN   ;   CALL dia_wri_dimg(clname, cltext, un, jpk, 'T') 
     260       ELSE                    ;   CALL dia_wri_dimg(clname, cltext, um, jpk, 'T') 
    267261       ENDIF 
    268262 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r2590 r2613  
    7272      !!                  ***  routine dyn_spg_ts_alloc  *** 
    7373      !!---------------------------------------------------------------------- 
    74       IMPLICIT none 
    75       INTEGER :: dyn_spg_ts_malloc 
     74      INTEGER ::   dyn_spg_ts_alloc   ! return value 
    7675      !!---------------------------------------------------------------------- 
    77  
     76      ! 
    7877      ALLOCATE(ftnw(jpi,jpj), ftne(jpi,jpj), ftsw(jpi,jpj), ftse(jpi,jpj), & 
    79                un_b(jpi,jpj), vn_b(jpi,jpj), ub_b(jpi,jpj), vb_b(jpi,jpj), & 
    80                Stat=dyn_spg_ts_malloc) 
    81  
    82    END FUNCTION dyn_spg_ts_malloc 
     78         &      un_b(jpi,jpj), vn_b(jpi,jpj), ub_b(jpi,jpj), vb_b(jpi,jpj), & 
     79         &      STAT=dyn_spg_ts_alloc) 
     80         ! 
     81   END FUNCTION dyn_spg_ts_alloc 
    8382 
    8483 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90

    r2590 r2613  
    1616   PUBLIC 
    1717 
    18    PUBLIC flo_oce_alloc ! Routine called in nemogcm.F90 
     18   PUBLIC   flo_oce_alloc  ! Routine called in nemogcm.F90 
    1919 
    2020   LOGICAL, PUBLIC, PARAMETER ::   lk_floats = .TRUE.    !: float flag 
     
    3434   REAL(wp), PUBLIC, DIMENSION(jpnfl) ::   tpifl, tpjfl, tpkfl   !: (i,j,k) indices of float position 
    3535 
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wb              !: vertical velocity at previous time step (m s-1). 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wb   !: vertical velocity at previous time step (m s-1). 
    3737    
    3838   !                                            !!! * namelist namflo : langrangian floats * 
     
    4343   INTEGER, PUBLIC  ::   nn_stockfl = 450        !: frequency of float restart file 
    4444 
     45   !!---------------------------------------------------------------------- 
    4546CONTAINS 
    4647 
    4748   FUNCTION flo_oce_alloc() 
    48      IMPLICIT none 
    49      INTEGER :: flo_oce_alloc 
    50  
    51      ALLOCATE(wb(jpi,jpj,jpk), Stat=flo_oce_alloc) 
    52  
     49      !!---------------------------------------------------------------------- 
     50      INTEGER :: flo_oce_alloc 
     51      !!---------------------------------------------------------------------- 
     52      ! 
     53      ALLOCATE(wb(jpi,jpj,jpk), Stat=flo_oce_alloc) 
     54      ! 
    5355   END FUNCTION flo_oce_alloc 
    5456 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90

    r2590 r2613  
    2424 
    2525   PUBLIC   flo_wri          ! routine called by floats.F90 
    26    PUBLIC   flow_wri_alloc   ! routine called by nemogcm.F90 
     26   PUBLIC   flo_wri_alloc   ! routine called by nemogcm.F90 
    2727 
    2828   INTEGER ::   jfl      ! number of floats 
     
    3737#  include "domzgr_substitute.h90" 
    3838   !!---------------------------------------------------------------------- 
    39    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     39   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    4040   !! $Id$  
    4141   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    4343CONTAINS 
    4444 
    45    FUNCTION flow_wri_alloc 
     45   FUNCTION flo_wri_alloc 
    4646      !!------------------------------------------------------------------- 
    4747      !!                ***  ROUTINE flo_wri_alloc  *** 
    4848      !!------------------------------------------------------------------- 
    49       INTEGER :: flow_wri_alloc 
    50  
    51       ALLOCATE(ztemp(jpk,jpnfl), zsal(jpk,jpnfl), Stat=flow_wri_alloc) 
    52  
    53       IF(flow_wri_alloc /= 0)THEN 
    54          CALL ctl_warn('flow_wri_alloc: failed to allocate arrays.') 
    55       END IF 
    56  
    57    END FUNCTION flow_wri_alloc 
     49      INTEGER :: flo_wri_alloc 
     50      !!------------------------------------------------------------------- 
     51      ! 
     52      ALLOCATE(ztemp(jpk,jpnfl), zsal(jpk,jpnfl), Stat=flo_wri_alloc) 
     53      ! 
     54      IF( lk_mpp             )   CALL mpp_sum ( flo_wri_alloc ) 
     55      IF( flo_wri_alloc /= 0 )   CALL ctl_warn('flo_wri_alloc: failed to allocate arrays.') 
     56      ! 
     57   END FUNCTION flo_wri_alloc 
    5858 
    5959 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r2528 r2613  
    2020   USE lib_print     ! formated print library 
    2121   USE nc4interface  ! NetCDF4 interface 
     22   USE lib_mpp, ONLY :   lk_mpp 
    2223 
    2324   IMPLICIT NONE 
     
    137138CONTAINS 
    138139 
    139    SUBROUTINE ctl_stop( cd1, cd2, cd3, cd4, cd5,   & 
    140       &                 cd6, cd7, cd8, cd9, cd10 ) 
     140   SUBROUTINE ctl_stop( cd_stop, cd1, cd2, cd3, cd4, cd5 ,   & 
     141      &                          cd6, cd7, cd8, cd9, cd10 ) 
    141142      !!---------------------------------------------------------------------- 
    142143      !!                  ***  ROUTINE  stop_opa  *** 
     
    145146      !!                increment the error number (nstop) by one. 
    146147      !!---------------------------------------------------------------------- 
    147       CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5 
    148       CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10 
     148      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd_stop, cd1, cd2, cd3, cd4, cd5 
     149      CHARACTER(len=*), INTENT(in), OPTIONAL ::           cd6, cd7, cd8, cd9, cd10 
    149150      !!---------------------------------------------------------------------- 
    150151      ! 
     
    167168      IF( numsol     /= -1 )   CALL FLUSH(numsol    ) 
    168169      IF( numevo_ice /= -1 )   CALL FLUSH(numevo_ice) 
     170      ! 
     171      IF( PRESENT(cd_stop) ) THEN 
     172         IF( cd_stop == 'STOP' ) THEN 
     173            WRITE(numout,*)  
     174            WRITE(numout,*) 'huge E-R-R-O-R : immediate stop' 
     175            IF(lk_mpp)   CALL mppstop() 
     176            STOP 
     177         ENDIF 
     178      ENDIF 
    169179      ! 
    170180   END SUBROUTINE ctl_stop 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r2590 r2613  
    22   !!====================================================================== 
    33   !!                 ***  MODULE  sbc_ice  *** 
    4    !!        parameter and  variables defined in memory in forced mode 
     4   !! Surface module - LIM-3: parameters & variables defined in memory 
    55   !!====================================================================== 
    6    !! History :  3.0  !  2006-08  (G. Madec)  Surface module 
    7    !!            3.2  !  2009-06  (S. Masson) merge with ice_oce 
     6   !! History :  3.0  ! 2006-08  (G. Madec)  Surface module 
     7   !!            3.2  ! 2009-06  (S. Masson) merge with ice_oce 
     8   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_lim3 || defined key_lim2 
     
    1314   USE par_oce          ! ocean parameters 
    1415# if defined key_lim3 
    15    USE par_ice          ! ice parameters 
     16   USE par_ice          ! LIM-3 parameters 
    1617# endif 
    1718# if defined key_lim2 
    18    USE par_ice_2        ! ice parameters 
     19   USE par_ice_2        ! LIM-2 parameters 
    1920# endif 
    2021 
     
    3940# endif 
    4041 
    41    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice   !: non solar heat flux over ice                         [W/m2] 
    42    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice   !: solar heat flux over ice                             [W/m2] 
    43    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice   !: latent flux over ice                                 [W/m2] 
    44    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice  !: latent sensibility over ice                          [W/m2/K] 
    45    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqns_ice  !: non solar heat flux sensibility over ice (LW+SEN+LA) [W/m2/K] 
    46    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice    !: ice surface temperature                              [K] 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice   !: non solar heat flux over ice                  [W/m2] 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice   !: solar heat flux over ice                      [W/m2] 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice   !: latent flux over ice                          [W/m2] 
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice  !: latent sensibility over ice                 [W/m2/K] 
     46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqns_ice  !: non solar heat flux over ice (LW+SEN+LA)    [W/m2/K] 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice    !: ice surface temperature                          [K] 
    4748   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   alb_ice   !: albedo of ice 
    4849 
    49    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_ice    !: u-stress over ice (I-pt for VP or U,V-pts for EVP)   [N/m2] 
    50    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau_ice    !: v-stress over ice (I-pt for VP or U,V-pts for EVP)   [N/m2] 
    51    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr1_i0      !: 1st fraction of Qsr which penetrates inside the ice cover 
    52    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr2_i0      !: 2nd fraction of Qsr which penetrates inside the ice cover 
    53    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_ice     !: solid freshwater budget over ice: sublivation - snow 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_ice    !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau_ice    !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr1_i0      !: 1st Qsr fraction penetrating inside ice cover    [-] 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr2_i0      !: 2nd Qsr fraction penetrating inside ice cover    [-] 
     54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_ice     !: sublimation-snow budget over ice             [kg/m2] 
    5455 
    5556# if defined key_lim3 
     
    5758# endif 
    5859 
     60   !!---------------------------------------------------------------------- 
     61   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     62   !! $Id$  
     63   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     64   !!---------------------------------------------------------------------- 
    5965CONTAINS 
    6066 
    61   FUNCTION sbc_ice_alloc() 
    62     !!---------------------------------------------------------------------- 
    63     !!---------------------------------------------------------------------- 
    64     IMPLICIT none 
    65     INTEGER :: sbc_ice_alloc 
    66     !!---------------------------------------------------------------------- 
    67   
    68     ALLOCATE(qns_ice(jpi,jpj,jpl),  qsr_ice(jpi,jpj,jpl),               & 
    69              qla_ice(jpi,jpj,jpl),  dqla_ice(jpi,jpj,jpl),              & 
    70              dqns_ice(jpi,jpj,jpl), tn_ice(jpi,jpj,jpl),                & 
    71              alb_ice(jpi,jpj,jpl),                                      & 
    72              utau_ice(jpi,jpj),     vtau_ice(jpi,jpj), fr1_i0(jpi,jpj), & 
    73              fr2_i0(jpi,jpj),       emp_ice(jpi,jpj),                   & 
    74              Stat=sbc_ice_alloc) 
    75  
     67   FUNCTION sbc_ice_alloc() 
     68      !!---------------------------------------------------------------------- 
     69     !!                     ***  FUNCTION sbc_ice_alloc  *** 
     70     !! 
     71     !! ** Purpose :   Allocate all the dynamic arrays in the modules 
     72      !!---------------------------------------------------------------------- 
     73      INTEGER :: sbc_ice_alloc   ! return value 
     74      !!---------------------------------------------------------------------- 
     75      ! 
     76      ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) ,     & 
     77         &      qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) ,     & 
     78         &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl) ,     & 
     79         &      alb_ice (jpi,jpj,jpl) ,                             & 
     80         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     ,     & 
     81         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     & 
     82         &      emp_ice(jpi,jpj)                              , STAT=sbc_ice_alloc) 
     83      ! 
    7684  END FUNCTION sbc_ice_alloc 
    7785 
     
    8593#endif 
    8694 
    87    !!---------------------------------------------------------------------- 
    88    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    89    !! $Id$  
    90    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    9195   !!====================================================================== 
    9296END MODULE sbc_ice 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r2599 r2613  
    6363#  include "vectopt_loop_substitute.h90" 
    6464   !!---------------------------------------------------------------------- 
    65    !! NEMO/OPA 4.0 , UCL NEMO Consortium (2010) 
     65   !! NEMO/OPA 4.0 , UCL NEMO Consortium (2011) 
    6666   !! $Id$ 
    6767   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    146146         CASE( 3 )                                       ! CLIO bulk formulation 
    147147            CALL blk_ice_clio( t_su , zalb_ice_cs, zalb_ice_os,                           & 
    148                &                      utau_ice  , vtau_ice  , qns_ice   , qsr_ice   ,   & 
    149                &                      qla_ice   , dqns_ice  , dqla_ice  ,               & 
    150                &                      tprecip   , sprecip   ,                           & 
    151                &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl  ) 
     148               &                      utau_ice   , vtau_ice   , qns_ice   , qsr_ice   ,   & 
     149               &                      qla_ice    , dqns_ice   , dqla_ice  ,               & 
     150               &                      tprecip    , sprecip    ,                           & 
     151               &                      fr1_i0     , fr2_i0     , cp_ice_msh, jpl  ) 
    152152            !          
    153153         CASE( 4 )                                       ! CORE bulk formulation 
    154154            CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice_cs,               & 
    155                &                      utau_ice  , vtau_ice  , qns_ice   , qsr_ice   ,   & 
    156                &                      qla_ice   , dqns_ice  , dqla_ice  ,               & 
    157                &                      tprecip   , sprecip   ,                           & 
     155               &                      utau_ice  , vtau_ice  , qns_ice    , qsr_ice   ,   & 
     156               &                      qla_ice   , dqns_ice  , dqla_ice   ,               & 
     157               &                      tprecip   , sprecip   ,                            & 
    158158               &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl  ) 
    159159         END SELECT 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r2594 r2613  
    5757      INTEGER :: tra_ldf_iso_grif_alloc 
    5858      !!---------------------------------------------------------------------- 
    59  
     59      ! 
    6060      ALLOCATE(zdkt(jpi,jpj,0:1), Stat=tra_ldf_iso_grif_alloc) 
    61  
    62       IF(tra_ldf_iso_grif_alloc /= 0)THEN 
    63          CALL ctl_warn('tra_ldf_iso_grif_alloc : allocation of arrays failed.') 
    64       END IF 
    65  
     61      ! 
     62      IF( tra_ldf_iso_grif_alloc /= 0 )   CALL ctl_warn('tra_ldf_iso_grif_alloc : allocation of arrays failed.') 
     63      ! 
    6664  END FUNCTION tra_ldf_iso_grif_alloc 
    6765 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90

    r2590 r2613  
    7272      INTEGER :: trd_mld_alloc 
    7373      !!---------------------------------------------------------------------- 
    74  
     74      ! 
    7575      ALLOCATE(ndextrd1(jpi*jpj), Stat=trd_mld_alloc) 
    76  
    77       IF(trd_mld_alloc /= 0)THEN 
    78          CALL ctl_warn('trd_mld_alloc: failed to allocate array ndextrd1.') 
    79       END IF 
    80  
     76      ! 
     77      IF( trd_mld_alloc /= 0 )   CALL ctl_warn('trd_mld_alloc: failed to allocate array ndextrd1.') 
     78      ! 
    8179   END FUNCTION trd_mld_alloc 
     80 
    8281 
    8382   SUBROUTINE trd_mld_zint( pttrdmld, pstrdmld, ktrd, ctype ) 
     
    262261      USE wrk_nemo, ONLY: ztmltot2 => wrk_2d_7, ztmlres2 => wrk_2d_8, ztmltrdm2 => wrk_2d_9    ! \  working arrays to diagnose the trends 
    263262      USE wrk_nemo, ONLY: zsmltot2 => wrk_2d_10, zsmlres2 => wrk_2d_11, zsmltrdm2 => wrk_2d_12 !  > associated with the time meaned ML T & S 
    264       USE wrk_nemo, ONLY: ztmlatf2 => wrk_2d_13, zsmlatf2 => wrk_2d_14                         ! / 
     263      USE wrk_nemo, ONLY: ztmlatf2 => wrk_2d_13, zsmlatf2 => wrk_2d_14     
     264      USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2                     ! / 
    265265      !! 
    266266      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     
    269269      LOGICAL :: lldebug = .TRUE. 
    270270      REAL(wp) :: zavt, zfn, zfn2 
    271       REAL(wp), POINTER, DIMENSION(:,:,:) ::  & 
    272            ztmltrd2, zsmltrd2               ! only needed for mean diagnostics 
     271      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztmltrd2, zsmltrd2   ! only needed for mean diagnostics 
    273272#if defined key_dimgout 
    274273      INTEGER ::  iyear,imon,iday 
     
    282281         CALL ctl_stop('trd_mld : requested workspace arrays unavailable.') 
    283282         RETURN 
    284       ELSE IF(jpltrd > jpk) 
     283      ELSE IF(jpltrd > jpk) THEN 
    285284         ! ARPDBG, is this reasonable or will this cause trouble in the future? 
    286285         CALL ctl_stop('trd_mld : no. of mixed-layer trends (jpltrd) exceeds no. of model levels so cannot use 3D workspaces.') 
     
    288287      END IF 
    289288      ! Set-up pointers into sub-arrays of 3d-workspaces 
    290       ztmltrd2 => wrk_3d_1(:,:,1:jpltrd) 
    291       zsmltrd2 => wrk_3d_2(:,:,1:jpltrd) 
     289      ztmltrd2 => wrk_3d_1(1:,:,1:jpltrd) 
     290      zsmltrd2 => wrk_3d_2(1:,:,1:jpltrd) 
    292291 
    293292      ! ====================================================================== 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90

    r2590 r2613  
    7171      tmlatfm, smlatfm                !: accumulator for Asselin trends (needed for storage only) 
    7272 
    73    REAL(wp), PUBLIC, DIMENSION(:,:,:) ::  & 
     73   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::  & 
    7474      tmltrd,                       & !: \ physical contributions to the total trend (for T/S), 
    7575      smltrd,                       & !: / cumulated over the current analysis window 
     
    8282#endif 
    8383   !!---------------------------------------------------------------------- 
    84    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     84   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    8585   !! $Id$  
    8686   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    87    !!====================================================================== 
     87   !!---------------------------------------------------------------------- 
    8888CONTAINS 
    8989 
     
    9292     !!---------------------------------------------------------------------- 
    9393     USE in_out_manager, ONLY: ctl_warn 
    94      IMPLICIT none 
    9594     INTEGER :: trdmld_oce_alloc 
    9695     INTEGER :: ierr(5) 
     
    104103 
    105104#if   defined  key_trdmld   ||   defined key_esopa 
    106      ALLOCATE(nmld(jpi,jpj), nbol(jpi,jpj),       & 
    107               wkx(jpi,jpj,jpk), rmld(jpi,jpj),    &  
    108               tml(jpi,jpj)    , sml(jpi,jpj),     &  
    109               tmlb(jpi,jpj)   , smlb(jpi,jpj) ,   & 
    110               tmlbb(jpi,jpj)  , smlbb(jpi,jpj),   & 
    111               Stat = ierr(1)) 
     105     ALLOCATE( nmld(jpi,jpj), nbol(jpi,jpj),       & 
     106        &      wkx(jpi,jpj,jpk), rmld(jpi,jpj),    &  
     107        &      tml(jpi,jpj)    , sml(jpi,jpj),     &  
     108        &      tmlb(jpi,jpj)   , smlb(jpi,jpj) ,   & 
     109        &      tmlbb(jpi,jpj)  , smlbb(jpi,jpj),   & 
     110        &      Stat = ierr(1)) 
    112111 
    113      ALLOCATE(tmlbn(jpi,jpj)  , smlbn(jpi,jpj),   & 
    114               tmltrdm(jpi,jpj), smltrdm(jpi,jpj), & 
    115               tml_sum(jpi,jpj), tml_sumb(jpi,jpj),& 
    116               tmltrd_atf_sumb(jpi,jpj), Stat=ierr(2)) 
     112     ALLOCATE( tmlbn(jpi,jpj)  , smlbn(jpi,jpj),   & 
     113        &      tmltrdm(jpi,jpj), smltrdm(jpi,jpj), & 
     114        &      tml_sum(jpi,jpj), tml_sumb(jpi,jpj),& 
     115        &      tmltrd_atf_sumb(jpi,jpj), Stat=ierr(2)) 
    117116 
    118      ALLOCATE(sml_sum(jpi,jpj), sml_sumb(jpi,jpj), & 
    119               smltrd_atf_sumb(jpi,jpj),            & 
    120               rmld_sum(jpi,jpj), rmldbn(jpi,jpj),  & 
    121               tmlatfb(jpi,jpj), tmlatfn(jpi,jpj),  &  
    122               Stat = ierr(3)) 
     117     ALLOCATE( sml_sum(jpi,jpj), sml_sumb(jpi,jpj), & 
     118        &      smltrd_atf_sumb(jpi,jpj),            & 
     119        &      rmld_sum(jpi,jpj), rmldbn(jpi,jpj),  & 
     120        &      tmlatfb(jpi,jpj), tmlatfn(jpi,jpj),  &  
     121        &      Stat = ierr(3)) 
    123122 
    124      ALLOCATE(smlatfb(jpi,jpj), smlatfn(jpi,jpj), &  
    125               tmlatfm(jpi,jpj), smlatfm(jpi,jpj), & 
    126               tmltrd(jpi,jpj,jpltrd),   smltrd(jpi,jpj,jpltrd), & 
    127               Stat=ierr(4)) 
     123     ALLOCATE( smlatfb(jpi,jpj), smlatfn(jpi,jpj), &  
     124        &      tmlatfm(jpi,jpj), smlatfm(jpi,jpj), & 
     125        &      tmltrd(jpi,jpj,jpltrd),   smltrd(jpi,jpj,jpltrd), & 
     126        &      Stat=ierr(4)) 
    128127 
    129      ALLOCATE(tmltrd_sum(jpi,jpj,jpltrd),tmltrd_csum_ln(jpi,jpj,jpltrd),      & 
    130               tmltrd_csum_ub(jpi,jpj,jpltrd), smltrd_sum(jpi,jpj,jpltrd),     & 
    131               smltrd_csum_ln(jpi,jpj,jpltrd), smltrd_csum_ub(jpi,jpj,jpltrd), & 
    132               Stat=ierr(5)) 
     128     ALLOCATE( tmltrd_sum(jpi,jpj,jpltrd),tmltrd_csum_ln(jpi,jpj,jpltrd),      & 
     129        &      tmltrd_csum_ub(jpi,jpj,jpltrd), smltrd_sum(jpi,jpj,jpltrd),     & 
     130        &      smltrd_csum_ln(jpi,jpj,jpltrd), smltrd_csum_ub(jpi,jpj,jpltrd), & 
     131        &      Stat=ierr(5)) 
    133132#endif 
     133      ! 
     134      trdmld_oce_alloc = MAXVAL(ierr) 
     135      ! 
     136      IF( trdmld_oce_alloc /= 0 )   CALL ctl_warn('trdmld_oce_alloc: failed to allocate arrays.') 
     137      ! 
     138   END FUNCTION trdmld_oce_alloc 
    134139 
    135      trdmld_oce_alloc = MAXVAL(ierr) 
    136  
    137     IF(trdmld_oce_alloc /= 0)THEN 
    138        CALL ctl_warn('trdmld_oce_alloc: failed to allocate arrays.') 
    139     END IF 
    140  
    141   END FUNCTION trdmld_oce_alloc 
    142  
     140   !!====================================================================== 
    143141END MODULE trdmld_oce 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90

    r2590 r2613  
    5858                          z2dx  => wrk_2d_5,  & 
    5959                          z2dy  => wrk_2d_6 
    60       IMPLICIT none 
    61       INTEGER, INTENT( in ) ::   kt                                ! time step 
    62       INTEGER, INTENT( in ) ::   ktrd                              ! tracer trend index 
    63       CHARACTER(len=3), INTENT( in ) ::   ctype                    ! momentum or tracers trends type 'DYN'/'TRA' 
    64       REAL(wp), DIMENSION(:,:,:), INTENT( inout ) ::   ptrdx ! Temperature or U trend  
    65       REAL(wp), DIMENSION(:,:,:), INTENT( inout ) ::   ptrdy ! Salinity    or V trend 
     60      ! 
     61      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend  
     62      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend 
     63      CHARACTER(len=3)          , INTENT(in   ) ::   ctype   ! momentum or tracers trends type 'DYN'/'TRA' 
     64      INTEGER                   , INTENT(in   ) ::   kt      ! time step 
     65      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    6666      !! 
    67       INTEGER ::   ji, jj 
     67      INTEGER ::   ji, jj   ! dummy loop indices 
    6868      !!---------------------------------------------------------------------- 
    6969 
    7070      IF(.not. wrk_use(2, 1,2,3,4,5,6))THEN 
    71          CALL ctl_error('trd_mod: Requested workspace arrays already in use.') 
    72          RETURN 
     71         CALL ctl_warn('trd_mod: Requested workspace arrays already in use.')   ;   RETURN 
    7372      END IF 
    7473 
    75       z2dx(:,:)   = 0.e0   ;   z2dy(:,:)   = 0.e0                  ! initialization of workspace arrays 
    76  
    77       IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdtra (restarting with Euler time stepping) 
    78       ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt      ! = 2 rdttra (leapfrog) 
     74      z2dx(:,:) = 0._wp   ;   z2dy(:,:) = 0._wp                            ! initialization of workspace arrays 
     75 
     76      IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt   ! = rdtra (restart with Euler time stepping) 
     77      ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt   ! = 2 rdttra (leapfrog) 
    7978      ENDIF 
    8079 
     
    9493            CASE ( jptra_trd_dmp )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_dmp, ctype )   ! damping 
    9594            CASE ( jptra_trd_qsr )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_qsr, ctype )   ! penetrative solar radiat. 
    96             CASE ( jptra_trd_nsr )    
    97                z2dx(:,:) = ptrdx(:,:,1)   ;   z2dy(:,:) = ptrdy(:,:,1) 
    98                CALL trd_icp( z2dx, z2dy, jpicpt_nsr, ctype )                               ! non solar radiation 
     95            CASE ( jptra_trd_nsr )   ;   z2dx(:,:) = ptrdx(:,:,1)    
     96                                         z2dy(:,:) = ptrdy(:,:,1) 
     97                                         CALL trd_icp( z2dx , z2dy , jpicpt_nsr, ctype )   ! non solar radiation 
    9998            CASE ( jptra_trd_xad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_xad, ctype )   ! x- horiz adv 
    10099            CASE ( jptra_trd_yad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype )   ! y- horiz adv 
    101             CASE ( jptra_trd_zad )                                                         ! z- vertical adv  
    102                CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )    
    103                ! compute the surface flux condition wn(:,:,1)*tn(:,:,1) 
    104                z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 
    105                z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1) 
    106                CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )                             ! 1st z- vertical adv  
     100            CASE ( jptra_trd_zad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )   ! z- vertical adv  
     101                                         CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )    
     102                                         ! compute the surface flux condition wn(:,:,1)*tn(:,:,1) 
     103                                         z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 
     104                                         z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1) 
     105                                         CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )   ! 1st z- vertical adv  
    107106            END SELECT 
    108107         END IF 
     
    123122               ! subtract surface forcing/bottom friction trends  
    124123               ! from vertical diffusive momentum trends 
    125                ztswu(:,:) = 0.e0   ;   ztswv(:,:) = 0.e0 
    126                ztbfu(:,:) = 0.e0   ;   ztbfv(:,:) = 0.e0  
     124               ztswu(:,:) = 0._wp   ;   ztswv(:,:) = 0._wp 
     125               ztbfu(:,:) = 0._wp   ;   ztbfv(:,:) = 0._wp  
    127126               DO jj = 2, jpjm1    
    128127                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    131130                     ztswv(ji,jj) = vtau(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) 
    132131                     ! bottom friction contribution now handled explicitly 
    133                      ! 
    134                      ptrdx(ji,jj,1     ) = ptrdx(ji,jj,1     ) - ztswu(ji,jj) 
    135                      ptrdy(ji,jj,1     ) = ptrdy(ji,jj,1     ) - ztswv(ji,jj) 
     132                     ptrdx(ji,jj,1) = ptrdx(ji,jj,1) - ztswu(ji,jj) 
     133                     ptrdy(ji,jj,1) = ptrdy(ji,jj,1) - ztswv(ji,jj) 
    136134                  END DO 
    137135               END DO 
     
    228226      ENDIF 
    229227      ! 
    230       IF(.not. wrk_release(2, 1,2,3,4,5,6))THEN 
    231          CALL ctl_error('trd_mod: Failed to release workspace arrays.') 
    232       END IF 
     228      IF( .not. wrk_release(2, 1,2,3,4,5,6) )   CALL ctl_warn('trd_mod: Failed to release workspace arrays.') 
    233229      ! 
    234230   END SUBROUTINE trd_mod 
     
    242238   USE trdicp          ! ocean bassin integral constraints properties 
    243239   USE trdmld          ! ocean active mixed layer tracers trends  
    244  
     240   !!---------------------------------------------------------------------- 
    245241CONTAINS 
    246242   SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt )   ! Empty routine 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r2590 r2613  
    225225                          zustar => wrk_2d_3 
    226226      USE wrk_nemo, ONLY: zmask  => wrk_2d_4 
    227       USE wrk_nemo, ONLY: wrk_2d_5, wrk_2d_6, wrk_2d_7, wrk_2d_8, wrk_2d_9, & 
     227!gm      USE wrk_nemo, ONLY: wrk_2d_5, wrk_2d_6, wrk_2d_7, wrk_2d_8, wrk_2d_9, & 
     228      USE wrk_nemo, ONLY:           wrk_2d_6, wrk_2d_7, wrk_2d_8, wrk_2d_9, & 
    228229                          wrk_2d_10,wrk_2d_11 
    229230      USE wrk_nemo, ONLY: wrk_1d_1,  wrk_1d_2,  wrk_1d_3,  wrk_1d_4,  & 
     
    260261      REAL(wp) ::   zflag, ztemp, zrn2, zdep21, zdep32, zdep43 
    261262      REAL(wp) ::   zdku2, zdkv2, ze3sqr, zsh2, zri, zfri          ! Interior richardson mixing 
    262       REAL(wp), POINTER, DIMENSION(:,:) ::   zmoek                 ! Moning-Obukov limitation 
     263!gm      REAL(wp), POINTER, DIMENSION(:,:) ::   zmoek                 ! Moning-Obukov limitation 
     264      REAL(wp), DIMENSION(jpi,0:2) ::   zmoek                 ! Moning-Obukov limitation 
    263265      REAL(wp), POINTER, DIMENSION(:)   ::   zmoa, zekman                 
    264266      REAL(wp)                          ::   zmob, zek 
     
    285287      END IF 
    286288      ! Set-up pointers to 2D spaces 
    287       zmoek(1:jpi,0:2) => wrk_2d_5(1:jpi,1:3) 
     289!gm      zmoek(1:jpi,0:2) => wrk_2d_5(1:jpi,1:3) 
    288290      zdepw => wrk_2d_6(:,1:4) 
    289291      zdift => wrk_2d_7(:,1:4) 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90

    r2590 r2613  
    3131   PUBLIC   zdf_ric         ! called by step.F90 
    3232   PUBLIC   zdf_ric_init    ! called by opa.F90 
     33   PUBLIC   zdf_ric_alloc   ! called by nemogcm.F90 
    3334 
    3435   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfric = .TRUE.   !: Richardson vertical mixing flag 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r2608 r2613  
    101101      !!              - finalize the run by closing files and communications 
    102102      !! 
    103       !! References : Madec, Delecluse,Imbard, and Levy, 1997:  internal report, IPSL. 
     103      !! References : Madec, Delecluse, Imbard, and Levy, 1997:  internal report, IPSL. 
    104104      !!              Madec, 2008, internal report, IPSL. 
    105105      !!---------------------------------------------------------------------- 
     
    183183      !! ** Purpose :   initialization of the NEMO GCM 
    184184      !!---------------------------------------------------------------------- 
    185       INTEGER ::   ji          ! dummy loop indices 
    186       INTEGER :: ilocal_comm   ! local integer 
     185      INTEGER ::   ji            ! dummy loop indices 
     186      INTEGER ::   ilocal_comm   ! local integer 
    187187      CHARACTER(len=80), DIMENSION(10) ::   cltxt 
    188188      !! 
     
    456456   END SUBROUTINE nemo_closefile 
    457457 
    458    !!====================================================================== 
    459458 
    460459   SUBROUTINE nemo_alloc 
     
    462461     !!                     ***  ROUTINE nemo_alloc  *** 
    463462     !! 
    464      !! ** Purpose :   Allocate all the dynamic arrays in the modules 
     463     !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules 
    465464     !! 
    466465     !! ** Method  : 
    467      !! 
    468      !! History : 
    469      !!   9.0  !  01-11  (A. R. Porter, STFC Daresbury) 
    470466     !!---------------------------------------------------------------------- 
    471 #if defined key_lim2 
    472      USE dom_ice_2,    ONLY: dom_ice_alloc_2 
    473      USE ice_2,        ONLY: ice_alloc_2 
    474      USE limdia_2,     ONLY: lim_dia_alloc_2 
    475      USE limhdf_2,     ONLY: lim_hdf_alloc_2 
    476      USE limsbc_2,     ONLY: lim_sbc_alloc_2 
    477      USE limwri_2,     ONLY: lim_wri_alloc_2 
    478      USE thd_ice_2,    ONLY: thd_ice_alloc_2 
    479 #endif 
    480 #if defined key_lim3 || (  defined key_lim2 && ! defined key_lim2_vp ) 
    481      USE limrhg,       ONLY: lim_rhg_alloc 
    482 #endif 
    483 #if defined key_lim3 
    484      USE dom_ice,      ONLY: dom_ice_alloc 
    485      USE limitd_me,    ONLY: lim_itd_me_alloc 
    486      USE thd_ice,      ONLY: thd_ice_alloc 
    487 #endif 
    488 #if defined key_bdy  
    489      USE bdy_oce,      ONLY: bdy_oce_alloc 
    490 #endif 
    491 #if defined key_diaar5 
    492      USE diaar5,       ONLY: dia_ar5_alloc 
    493 #endif 
    494 # if defined key_dimgout 
    495      USE diadimg,      ONLY: dia_wri_dimg_alloc 
    496 #endif 
    497467#if   defined key_diahth   ||   defined key_esopa 
    498468     USE diahth,       ONLY: dia_hth_alloc 
     
    549519     USE sbcdcy,       ONLY: sbc_dcy_alloc 
    550520     USE sbcfwb,       ONLY: sbc_fwb_alloc 
    551 #if defined key_lim3 || defined key_lim2 
    552      USE sbc_ice,      ONLY: sbc_ice_alloc 
    553 #endif 
    554521     USE sbc_oce,      ONLY: sbc_oce_alloc 
    555522     USE sbcrnf,       ONLY: sbc_rnf_alloc 
     
    575542     ! TOP-related alloc routines... 
    576543#if defined key_top 
    577      USE trcadv,       ONLY: trc_adv_alloc 
    578      USE trc,          ONLY: trc_alloc 
    579      USE trcnxt,       ONLY: trc_nxt_alloc 
    580      USE trczdf,       ONLY: trc_zdf_alloc 
    581      USE trdmod_trc_oce,ONLY: trd_mod_trc_oce_alloc 
     544      USE trcadv,       ONLY: trc_adv_alloc 
     545      USE trc,          ONLY: trc_alloc 
     546      USE trcnxt,       ONLY: trc_nxt_alloc 
     547      USE trczdf,       ONLY: trc_zdf_alloc 
     548      USE trdmod_trc_oce,ONLY: trd_mod_trc_oce_alloc 
    582549#endif 
    583550#if defined key_top && ! defined key_iomput 
    584      USE trcdia,       ONLY: trc_dia_alloc 
     551      USE trcdia,       ONLY: trc_dia_alloc 
    585552#endif 
    586553#if  defined key_top && defined key_trcdmp  
    587      USE trcdmp,       ONLY: trc_dmp_alloc 
     554      USE trcdmp,       ONLY: trc_dmp_alloc 
    588555#endif 
    589556#if  defined key_top  &&  defined key_dtatrc 
    590      USE trcdta,       ONLY: trc_dta_alloc 
     557      USE trcdta,       ONLY: trc_dta_alloc 
    591558#endif 
    592559#if   defined key_top && ( defined key_trdmld_trc   ||   defined key_esopa ) 
    593      USE trdmld_trc,   ONLY: trd_mld_trc_alloc 
    594 #endif 
    595      ! ...end of TOP-related alloc routines 
    596  
    597      ! LOBSTER-related alloc routines... 
    598      USE sms_lobster,  ONLY: sms_lobster_alloc 
    599      ! ...end of LOBSTER-related alloc routines 
    600  
    601      USE trc_oce,      ONLY: trc_oce_alloc 
     560      USE trdmld_trc,   ONLY: trd_mld_trc_alloc 
     561#endif 
     562      ! ...end of TOP-related alloc routines 
     563 
     564      ! LOBSTER-related alloc routines... 
     565      USE sms_lobster,  ONLY: sms_lobster_alloc 
     566      ! ...end of LOBSTER-related alloc routines 
     567 
     568      USE trc_oce,      ONLY: trc_oce_alloc 
    602569#if   defined key_trdmld   ||   defined key_esopa 
    603      USE trdmld,       ONLY: trd_mld_alloc 
    604 #endif 
    605      USE trdmld_oce,   ONLY: trdmld_oce_alloc 
     570      USE trdmld,       ONLY: trd_mld_alloc 
     571#endif 
     572      USE trdmld_oce,   ONLY: trdmld_oce_alloc 
    606573#if  defined key_trdtra || defined key_trdmld || defined key_trdmld_trc  
    607      USE trdtra,       ONLY: trd_tra_alloc 
     574      USE trdtra,       ONLY: trd_tra_alloc 
    608575#endif 
    609576#if defined key_trdvor   ||   defined key_esopa 
    610      USE trdvor,       ONLY: trd_vor_alloc 
    611 #endif 
    612      USE wrk_nemo,     ONLY: wrk_alloc 
    613      USE zdfbfr,       ONLY: zdf_bfr_alloc 
     577      USE trdvor,       ONLY: trd_vor_alloc 
     578#endif 
     579      USE wrk_nemo,     ONLY: wrk_alloc 
     580      USE zdfbfr,       ONLY: zdf_bfr_alloc 
    614581#if defined key_zdfddm   ||   defined key_esopa 
    615      USE zdfddm,       ONLY: zdf_ddm_alloc 
     582      USE zdfddm,       ONLY: zdf_ddm_alloc 
    616583#endif 
    617584#if defined key_zdfkpp   ||   defined key_esopa 
    618      USE zdfkpp,       ONLY: zdf_kpp_alloc 
     585      USE zdfkpp,       ONLY: zdf_kpp_alloc 
    619586#endif 
    620587#if defined key_zdfgls   ||   defined key_esopa 
    621      USE zdfgls,       ONLY: zdf_gls_alloc 
    622 #endif 
    623      USE zdfmxl,       ONLY: zdf_mxl_alloc 
    624      USE zdf_oce,      ONLY: zdf_oce_alloc 
     588      USE zdfgls,       ONLY: zdf_gls_alloc 
     589#endif 
     590      USE zdfmxl,       ONLY: zdf_mxl_alloc 
     591      USE zdf_oce,      ONLY: zdf_oce_alloc 
    625592#if defined key_zdfric   ||   defined key_esopa 
    626      USE zdfric,       ONLY: zdf_ric_alloc 
     593      USE zdfric,       ONLY: zdf_ric_alloc 
    627594#endif 
    628595#if defined key_zdftke   ||   defined key_esopa 
    629      USE zdftke,       ONLY: zdf_tke_alloc 
     596      USE zdftke,       ONLY: zdf_tke_alloc 
    630597#endif 
    631598#if defined key_zdftmx 
    632      USE zdftmx,       ONLY: zdf_tmx_alloc 
    633 #endif 
    634      IMPLICIT none 
    635      INTEGER :: ierr 
    636      INTEGER :: i 
    637      !!---------------------------------------------------------------------- 
    638  
    639      ierr = 0 
    640  
    641      !! Calls to the _alloc() routines should be in the same order as the  
    642      !! modules are USE'd above 
    643 #if defined key_lim2 
    644      ierr = ierr + dom_ice_alloc_2() 
    645      ierr = ierr + ice_alloc_2() 
    646      ierr = ierr + lim_dia_alloc_2() 
    647      ierr = ierr + lim_hdf_alloc_2() 
    648      ierr = ierr + lim_sbc_alloc_2() 
    649      ierr = ierr + lim_wri_alloc_2() 
    650      ierr = ierr + thd_ice_alloc_2() 
    651 #endif 
    652 #if defined key_lim3 || (  defined key_lim2 && ! defined key_lim2_vp ) 
    653      ierr = ierr + lim_rhg_alloc() 
    654 #endif 
    655 #if defined key_lim3 
    656      ierr = ierr + dom_ice_alloc() 
    657      ierr = ierr + lim_itd_me_alloc() 
    658      ierr = ierr + thd_ice_alloc() 
    659 #endif 
    660      ! End of ice-related allocations 
    661 #if  defined key_bdy 
    662      ierr = ierr + bdy_oce_alloc() 
    663 #endif 
    664 #if defined key_diaar5 
    665      ierr = ierr + dia_ar5_alloc() 
    666 #endif 
    667 # if defined key_dimgout 
    668      ierr = ierr + dia_wri_dimg_alloc() 
    669 #endif 
    670      ierr = ierr + div_cur_alloc() 
     599      USE zdftmx,       ONLY: zdf_tmx_alloc 
     600#endif 
     601      IMPLICIT none 
     602      INTEGER :: ierr 
     603      INTEGER :: i 
     604      !!---------------------------------------------------------------------- 
     605 
     606      ierr = 0 
     607 
     608      !! Calls to the _alloc() routines should be in the same order as the  
     609      !! modules are USE'd above 
     610      ! End of ice-related allocations 
     611      ierr = ierr + div_cur_alloc() 
    671612#if   defined key_diahth   ||   defined key_esopa 
    672      ierr = ierr + dia_hth_alloc() 
    673 #endif 
    674      ierr = ierr + dia_ptr_alloc() 
    675      ierr = ierr + dia_wri_alloc() 
    676      ierr = ierr + dom_oce_alloc() 
     613      ierr = ierr + dia_hth_alloc() 
     614#endif 
     615      ierr = ierr + dia_ptr_alloc() 
     616      ierr = ierr + dia_wri_alloc() 
     617      ierr = ierr + dom_oce_alloc() 
    677618#if defined key_vvl 
    678      ierr = ierr + dom_vvl_alloc() 
    679 #endif 
    680      ierr = ierr + dom_wri_alloc() 
     619      ierr = ierr + dom_vvl_alloc() 
     620#endif 
     621      ierr = ierr + dom_wri_alloc() 
    681622#if defined key_dtasal   ||   defined key_esopa 
    682      ierr = ierr + dta_sal_alloc() 
     623      ierr = ierr + dta_sal_alloc() 
    683624#endif 
    684625#if defined key_ldfslp   ||   defined key_esopa 
    685      ierr = ierr + dyn_ldf_bilapg_alloc() 
     626      ierr = ierr + dyn_ldf_bilapg_alloc() 
    686627#endif 
    687628#if defined key_dtasal   ||   defined key_esopa 
    688      ierr = ierr + dta_sal_alloc() 
     629      ierr = ierr + dta_sal_alloc() 
    689630#endif 
    690631#if defined key_dtatem   ||   defined key_esopa 
    691      ierr = ierr + dta_tem_alloc() 
     632      ierr = ierr + dta_tem_alloc() 
    692633#endif 
    693634#if defined key_ldfslp   ||   defined key_esopa 
    694      ierr = ierr + dyn_ldf_iso_alloc() 
     635      ierr = ierr + dyn_ldf_iso_alloc() 
    695636#endif 
    696637#if   defined key_dynspg_ts   ||   defined key_vvl   ||   defined key_esopa 
    697      ierr = ierr + dynspg_oce_alloc() 
    698 #endif 
    699      ierr = ierr + dyn_vor_alloc() 
    700      ierr = ierr + dyn_zdf_exp_alloc() 
     638      ierr = ierr + dynspg_oce_alloc() 
     639#endif 
     640      ierr = ierr + dyn_vor_alloc() 
     641      ierr = ierr + dyn_zdf_exp_alloc() 
    701642#if   defined key_floats   ||   defined key_esopa 
    702      ierr = ierr + flo_oce_alloc() 
     643      ierr = ierr + flo_oce_alloc() 
    703644#endif 
    704645#if   defined key_floats   ||   defined key_esopa 
    705      ierr = ierr + flo_wri_alloc() 
    706 #endif 
    707      ierr = ierr + geo2oce_alloc() 
    708      ierr = ierr + ldfdyn_oce_alloc() 
     646      ierr = ierr + flo_wri_alloc() 
     647#endif 
     648      ierr = ierr + geo2oce_alloc() 
     649      ierr = ierr + ldfdyn_oce_alloc() 
    709650#if   defined key_ldfslp   ||   defined key_esopa 
    710651     ierr = ierr + ldf_slp_alloc() 
    711652#endif 
    712      ierr = ierr + ldftra_oce_alloc() 
     653      ierr = ierr + ldftra_oce_alloc() 
    713654#if defined key_mpp_mpi  
    714      ierr = ierr + lib_mpp_alloc() 
     655      ierr = ierr + lib_mpp_alloc() 
    715656#endif 
    716657#if defined key_obc 
    717      ierr = ierr + obc_dta_alloc() 
    718      ierr = ierr + obc_oce_alloc() 
    719 #endif 
    720      ierr = ierr + oce_alloc() 
    721      ierr = ierr + sbc_blk_clio_alloc() 
     658      ierr = ierr + obc_dta_alloc() 
     659      ierr = ierr + obc_oce_alloc() 
     660#endif 
     661      ierr = ierr + oce_alloc() 
     662      ierr = ierr + sbc_blk_clio_alloc() 
    722663#if defined key_oasis3 || defined key_oasis4 
    723      ierr = ierr + sbc_cpl_init_alloc() 
    724 #endif 
    725      ierr = ierr + sbc_dcy_alloc() 
    726      ierr = ierr + sbc_fwb_alloc() 
    727 #if defined key_lim3 || defined key_lim2 
    728      ierr = ierr + sbc_ice_alloc() 
    729 #endif 
    730      ierr = ierr + sbc_oce_alloc() 
    731      ierr = ierr + sbc_rnf_alloc() 
    732      ierr = ierr + sbc_ssr_alloc() 
    733      ierr = ierr + sol_oce_alloc() 
    734      ierr = ierr + sol_mat_alloc() 
    735      ierr = ierr + tra_adv_alloc() 
    736      ierr = ierr + tra_adv_cen2_alloc() 
    737 #if   defined key_trabbl   ||   defined key_esopa 
    738      ierr = ierr + tra_bbl_alloc() 
    739 #endif 
    740 #if   defined key_tradmp   ||   defined key_esopa 
    741      ierr = ierr + tra_dmp_alloc() 
    742 #endif 
    743      ierr = ierr + tra_ldf_alloc() 
    744 #if   defined key_ldfslp   ||   defined key_esopa 
    745      ierr = ierr + tra_ldf_iso_grif_alloc() 
    746 #endif 
    747      ierr = ierr + tra_ldf_lap_alloc() 
    748      ierr = ierr + tra_nxt_alloc() 
    749      ierr = ierr + tra_zdf_alloc() 
    750  
    751      ! Start of TOP-related alloc routines... 
     664      ierr = ierr + sbc_cpl_init_alloc() 
     665#endif 
     666      ierr = ierr + sbc_dcy_alloc() 
     667      ierr = ierr + sbc_fwb_alloc() 
     668      ierr = ierr + sbc_oce_alloc() 
     669      ierr = ierr + sbc_rnf_alloc() 
     670      ierr = ierr + sbc_ssr_alloc() 
     671      ierr = ierr + sol_oce_alloc() 
     672      ierr = ierr + sol_mat_alloc() 
     673      ierr = ierr + tra_adv_alloc() 
     674      ierr = ierr + tra_adv_cen2_alloc() 
     675#if defined key_trabbl   ||   defined key_esopa 
     676      ierr = ierr + tra_bbl_alloc() 
     677#endif 
     678#if defined key_tradmp   ||   defined key_esopa 
     679      ierr = ierr + tra_dmp_alloc() 
     680#endif 
     681      ierr = ierr + tra_ldf_alloc() 
     682#if defined key_ldfslp   ||   defined key_esopa 
     683      ierr = ierr + tra_ldf_iso_grif_alloc() 
     684#endif 
     685      ierr = ierr + tra_ldf_lap_alloc() 
     686      ierr = ierr + tra_nxt_alloc() 
     687      ierr = ierr + tra_zdf_alloc() 
     688 
     689      ! Start of TOP-related alloc routines... 
    752690#if defined key_top 
    753      ierr = ierr + trc_adv_alloc() 
    754      ierr = ierr + trc_alloc() 
    755      ierr = ierr + trc_nxt_alloc() 
    756      ierr = ierr + trc_zdf_alloc() 
    757      ierr = ierr + trd_mod_trc_oce_alloc() 
     691      ierr = ierr + trc_adv_alloc() 
     692      ierr = ierr + trc_alloc() 
     693      ierr = ierr + trc_nxt_alloc() 
     694      ierr = ierr + trc_zdf_alloc() 
     695      ierr = ierr + trd_mod_trc_oce_alloc() 
    758696#endif 
    759697#if defined key_top && ! defined key_iomput 
    760      ierr = ierr + trc_dia_alloc() 
     698      ierr = ierr + trc_dia_alloc() 
    761699#endif 
    762700#if  defined key_top && defined key_trcdmp  
    763      ierr = ierr + trc_dmp_alloc() 
     701      ierr = ierr + trc_dmp_alloc() 
    764702#endif 
    765703#if  defined key_top  &&  defined key_dtatrc 
    766      ierr = ierr + trc_dta_alloc() 
     704      ierr = ierr + trc_dta_alloc() 
    767705#endif 
    768706#if   defined key_top && ( defined key_trdmld_trc   ||   defined key_esopa ) 
    769      ierr = ierr + trd_mld_trc_alloc() 
    770 #endif 
    771      ! ...end of TOP-related alloc routines 
    772  
    773      ! Start of LOBSTER-related alloc routines 
    774      ierr = ierr + sms_lobster_alloc() 
    775      ! ...end of LOBSTER-related alloc routines 
    776  
    777      ierr = ierr + trc_oce_alloc() 
     707      ierr = ierr + trd_mld_trc_alloc() 
     708#endif 
     709      ! ...end of TOP-related alloc routines 
     710 
     711      ! Start of LOBSTER-related alloc routines 
     712      ierr = ierr + sms_lobster_alloc() 
     713      ! ...end of LOBSTER-related alloc routines 
     714 
     715      ierr = ierr + trc_oce_alloc() 
    778716#if   defined key_trdmld   ||   defined key_esopa 
    779      ierr = ierr + trd_mld_alloc() 
    780 #endif 
    781      ierr = ierr + trdmld_oce_alloc() 
     717      ierr = ierr + trd_mld_alloc() 
     718#endif 
     719      ierr = ierr + trdmld_oce_alloc() 
    782720#if  defined key_trdtra || defined key_trdmld || defined key_trdmld_trc  
    783      ierr = ierr + trd_tra_alloc() 
     721      ierr = ierr + trd_tra_alloc() 
    784722#endif 
    785723#if defined key_trdvor   ||   defined key_esopa 
    786      ierr = ierr + trd_vor_alloc() 
    787 #endif 
    788      ierr = ierr + wrk_alloc() 
    789      ierr = ierr + zdf_bfr_alloc() 
     724      ierr = ierr + trd_vor_alloc() 
     725#endif 
     726      ierr = ierr + wrk_alloc() 
     727      ierr = ierr + zdf_bfr_alloc() 
    790728#if defined key_zdfddm   ||   defined key_esopa 
    791      ierr = ierr + zdf_ddm_alloc() 
     729      ierr = ierr + zdf_ddm_alloc() 
    792730#endif 
    793731#if defined key_zdfkpp   ||   defined key_esopa 
    794      ierr = ierr + zdf_kpp_alloc() 
     732      ierr = ierr + zdf_kpp_alloc() 
    795733#endif 
    796734#if defined key_zdfgls   ||   defined key_esopa 
    797      ierr = ierr + zdf_gls_alloc() 
    798 #endif 
    799      ierr = ierr + zdf_mxl_alloc() 
    800      ierr = ierr + zdf_oce_alloc() 
     735      ierr = ierr + zdf_gls_alloc() 
     736#endif 
     737      ierr = ierr + zdf_mxl_alloc() 
     738      ierr = ierr + zdf_oce_alloc() 
    801739#if defined key_zdfric   ||   defined key_esopa 
    802      ierr = ierr + zdf_ric_alloc() 
     740      ierr = ierr + zdf_ric_alloc() 
    803741#endif 
    804742#if defined key_zdftke   ||   defined key_esopa 
    805      ierr = ierr + zdf_tke_alloc() 
     743      ierr = ierr + zdf_tke_alloc() 
    806744#endif 
    807745#if defined key_zdftmx 
    808      ierr = ierr + zdf_tmx_alloc() 
    809 #endif 
    810  
    811      IF( lk_mpp ) CALL mpp_sum(ierr) 
    812  
    813      IF(ierr > 0)THEN 
    814         WRITE(numout,*)  
    815         WRITE(numout,*) 'ERROR: Allocation of memory failed in nemo_alloc' 
    816         IF( lk_mpp ) CALL mppstop() 
    817         STOP 
    818      END IF 
    819  
     746      ierr = ierr + zdf_tmx_alloc() 
     747#endif 
     748 
     749      IF( lk_mpp    )   CALL mpp_sum(ierr) 
     750      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' ) 
     751      ! 
    820752   END SUBROUTINE nemo_alloc 
    821753 
    822    !!====================================================================== 
    823  
    824    SUBROUTINE nemo_partition(num_pes) 
     754 
     755   SUBROUTINE nemo_partition( num_pes ) 
    825756     USE par_oce 
    826      IMPLICIT none 
    827757     INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 
    828758     ! Local variables 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90

    r2598 r2613  
    2020   INTEGER, PARAMETER :: num_2d_wrkspaces  = 35   ! No. of 2D workspace arrays (jpi,jpj) 
    2121   INTEGER, PARAMETER :: num_3d_wrkspaces  = 15   ! No. of 3D workspace arrays (jpi,jpj,jpk) 
    22    INTEGER, PARAMETER :: num_4d_wrkspaces  = 4   ! No. of 4D workspace arrays (jpi,jpj,jpk,jpts) 
     22   INTEGER, PARAMETER :: num_4d_wrkspaces  = 4    ! No. of 4D workspace arrays (jpi,jpj,jpk,jpts) 
    2323 
    2424   INTEGER, PARAMETER :: num_xz_wrkspaces  = 4   ! No. of 2D, xz workspace arrays (jpi,jpk) 
Note: See TracChangeset for help on using the changeset viewer.