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

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/LIM_SRC_2
Files:
10 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,*) '~~~~~~~~' 
Note: See TracChangeset for help on using the changeset viewer.