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 3144 – NEMO

Changeset 3144


Ignore:
Timestamp:
2011-11-17T16:41:58+01:00 (12 years ago)
Author:
smasson
Message:

dev_NEMO_MERGE_2011: upgade wrk_nemo_2 to specify lower bounds of wrk arrays /= 1

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/wrk_nemo_2.F90

    r3134 r3144  
    1717   !!   INTEGER, POINTER, DIMENSION(:) :: arr1, arr2, ... arr10 
    1818   !!   ... 
    19    !!   CALL wrk_alloc( nx, arr1, arr2, ... arr10 ) 
    20    !!   ... 
    21    !!   CALL wrk_dealloc( nx, arr1, arr2, ... arr10 ) 
     19   !!   CALL wrk_alloc( nx, arr1, arr2, ... arr10, kistart = kistart ) 
     20   !!   ... 
     21   !!   CALL wrk_dealloc( nx, arr1, arr2, ... arr10, kistart = kistart) 
    2222   !!   with: 
    2323   !!     - arr*: 1d arrays. real or (not and) integer 
    2424   !!     - nx: size of the 1d arr* arrays 
    2525   !!     - arr2, ..., arr10: optional parameters 
     26   !!     - kistart: optional parameter to lower bound of the 1st dimension (default = 1) 
    2627   !! 
    2728   !! 2d arrays: 
    … …  
    3031   !!   INTEGER, POINTER, DIMENSION(:,:) :: arr1, arr2, ... arr10 
    3132   !!   ... 
    32    !!   CALL wrk_alloc( nx, ny, arr1, arr2, ... arr10 ) 
    33    !!   ... 
    34    !!   CALL wrk_dealloc( nx, ny, arr1, arr2, ... arr10 ) 
     33   !!   CALL wrk_alloc( nx, ny, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart ) 
     34   !!   ... 
     35   !!   CALL wrk_dealloc( nx, ny, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart ) 
    3536   !!   with: 
    3637   !!     - arr* 2d arrays. real or (not and) integer 
    3738   !!     - nx, ny: size of the 2d arr* arrays 
    3839   !!     - arr2, ..., arr10: optional parameters 
     40   !!     - kistart, kjstart: optional parameters to lower bound of the 1st/2nd dimension (default = 1) 
    3941   !! 
    4042   !! 3d arrays: 
    … …  
    4345   !!   INTEGER, POINTER, DIMENSION(:,:,:) :: arr1, arr2, ... arr10 
    4446   !!   ... 
    45    !!   CALL wrk_alloc( nx, ny, nz, arr1, arr2, ... arr10 ) 
    46    !!   ... 
    47    !!   CALL wrk_dealloc( nx, ny, nz, arr1, arr2, ... arr10 ) 
     47   !!   CALL wrk_alloc( nx, ny, nz, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart, kkstart = kkstart ) 
     48   !!   ... 
     49   !!   CALL wrk_dealloc( nx, ny, nz, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart, kkstart = kkstart ) 
    4850   !!   with: 
    4951   !!     - arr* 3d arrays. real or (not and) integer 
    5052   !!     - nx, ny, nz: size of the 3d arr* arrays 
    5153   !!     - arr2, ..., arr10: optional parameters 
     54   !!     - kistart, kjstart, kkstart: optional parameters to lower bound of the 1st/2nd/3rd dimension (default = 1) 
    5255   !! 
    5356   !! 4d arrays: 
    … …  
    5659   !!   INTEGER, POINTER, DIMENSION(:,:,:,:) :: arr1, arr2, ... arr10 
    5760   !!   ... 
    58    !!   CALL wrk_alloc( nx, ny, nz, nl, arr1, arr2, ... arr10 ) 
    59    !!   ... 
    60    !!   CALL wrk_dealloc( nx, ny, nz, nl, arr1, arr2, ... arr10 ) 
     61   !!   CALL wrk_alloc( nx, ny, nz, nl, arr1, arr2, ... arr10, & 
     62   !!      &            kistart = kistart, kjstart = kjstart, kkstart = kkstart, klstart = klstart ) 
     63   !!   ... 
     64   !!   CALL wrk_dealloc( nx, ny, nz, nl, arr1, arr2, ... arr10, & 
     65   !!      &            kistart = kistart, kjstart = kjstart, kkstart = kkstart, klstart = klstart ) 
    6166   !!   with: 
    6267   !!     - arr* 3d arrays. real or (not and) integer 
    6368   !!     - nx, ny, nz, nl: size of the 4d arr* arrays 
    6469   !!     - arr2, ..., arr10: optional parameters 
     70   !!     - kistart, kjstart, kkstart, klstart: optional parameters to lower bound of the 1st/2nd/3rd/4th dimension (default = 1) 
    6571   !!    
    6672   !!---------------------------------------------------------------------- 
    … …  
    107113   TYPE branch 
    108114      INTEGER :: itype 
    109       INTEGER, DIMENSION(jpmaxdim) :: ishape 
     115      INTEGER, DIMENSION(jpmaxdim) :: ishape, istart 
    110116      TYPE(leaf), POINTER :: start => NULL()      
    111117      TYPE(leaf), POINTER :: current => NULL()       
    … …  
    141147 
    142148 
    143    SUBROUTINE wrk_alloc_1dr( kidim, p1d01, p1d02, p1d03, p1d04, p1d05, p1d06, p1d07, p1d08, p1d09, p1d10 ) 
     149   SUBROUTINE wrk_alloc_1dr( kidim, p1d01, p1d02, p1d03, p1d04, p1d05, p1d06, p1d07, p1d08, p1d09, p1d10, kistart ) 
    144150      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size 
    145151      REAL(wp), POINTER, DIMENSION(:), INTENT(inout)           ::   p1d01 
    146152      REAL(wp), POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   p1d02,p1d03,p1d04,p1d05,p1d06,p1d07,p1d08,p1d09,p1d10 
    147       ! 
    148       CALL wrk_alloc_xd( kidim, 0, 0, 0, p1d01 = p1d01, p1d02 = p1d02, p1d03 = p1d03, p1d04 = p1d04, p1d05 = p1d05,   & 
    149       &                                  p1d06 = p1d06, p1d07 = p1d07, p1d08 = p1d08, p1d09 = p1d09, p1d10 = p1d10    ) 
     153      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart 
     154      ! 
     155      CALL wrk_alloc_xd( kidim, 0, 0, 0, kistart, 1, 1, 1,                                            & 
     156         &               p1d01 = p1d01, p1d02 = p1d02, p1d03 = p1d03, p1d04 = p1d04, p1d05 = p1d05,   & 
     157         &               p1d06 = p1d06, p1d07 = p1d07, p1d08 = p1d08, p1d09 = p1d09, p1d10 = p1d10    ) 
    150158      ! 
    151159   END SUBROUTINE wrk_alloc_1dr 
    152160 
    153161 
    154    SUBROUTINE wrk_alloc_1di( kidim, k1d01, k1d02, k1d03, k1d04, k1d05, k1d06, k1d07, k1d08, k1d09, k1d10 ) 
     162   SUBROUTINE wrk_alloc_1di( kidim, k1d01, k1d02, k1d03, k1d04, k1d05, k1d06, k1d07, k1d08, k1d09, k1d10, kistart ) 
    155163      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size 
    156164      INTEGER , POINTER, DIMENSION(:), INTENT(inout)           ::   k1d01 
    157165      INTEGER , POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   k1d02,k1d03,k1d04,k1d05,k1d06,k1d07,k1d08,k1d09,k1d10 
    158       ! 
    159       CALL wrk_alloc_xd( kidim, 0, 0, 0, k1d01 = k1d01, k1d02 = k1d02, k1d03 = k1d03, k1d04 = k1d04, k1d05 = k1d05,   & 
    160       &                                  k1d06 = k1d06, k1d07 = k1d07, k1d08 = k1d08, k1d09 = k1d09, k1d10 = k1d10    ) 
     166      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart 
     167      ! 
     168      CALL wrk_alloc_xd( kidim, 0, 0, 0, kistart, 1, 1, 1,                                            & 
     169         &               k1d01 = k1d01, k1d02 = k1d02, k1d03 = k1d03, k1d04 = k1d04, k1d05 = k1d05,   & 
     170         &               k1d06 = k1d06, k1d07 = k1d07, k1d08 = k1d08, k1d09 = k1d09, k1d10 = k1d10    ) 
    161171      ! 
    162172   END SUBROUTINE wrk_alloc_1di 
    163173 
    164174 
    165    SUBROUTINE wrk_alloc_2dr( kidim, kjdim, p2d01, p2d02, p2d03, p2d04, p2d05, p2d06, p2d07, p2d08, p2d09, p2d10 ) 
     175   SUBROUTINE wrk_alloc_2dr( kidim, kjdim, p2d01, p2d02, p2d03, p2d04, p2d05, p2d06, p2d07, p2d08, p2d09, p2d10, kistart, kjstart ) 
    166176      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size 
    167177      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout)           ::   p2d01 
    168178      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   p2d02,p2d03,p2d04,p2d05,p2d06,p2d07,p2d08,p2d09,p2d10 
    169       ! 
    170       CALL wrk_alloc_xd( kidim, kjdim, 0, 0, p2d01 = p2d01, p2d02 = p2d02, p2d03 = p2d03, p2d04 = p2d04, p2d05 = p2d05,   & 
    171       &                                      p2d06 = p2d06, p2d07 = p2d07, p2d08 = p2d08, p2d09 = p2d09, p2d10 = p2d10    ) 
     179      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart 
     180      ! 
     181      CALL wrk_alloc_xd( kidim, kjdim, 0, 0, kistart, kjstart, 1, 1,                                  & 
     182         &               p2d01 = p2d01, p2d02 = p2d02, p2d03 = p2d03, p2d04 = p2d04, p2d05 = p2d05,   & 
     183         &               p2d06 = p2d06, p2d07 = p2d07, p2d08 = p2d08, p2d09 = p2d09, p2d10 = p2d10    ) 
    172184      ! 
    173185   END SUBROUTINE wrk_alloc_2dr 
    174186 
    175187 
    176    SUBROUTINE wrk_alloc_2di( kidim, kjdim, k2d01, k2d02, k2d03, k2d04, k2d05, k2d06, k2d07, k2d08, k2d09, k2d10 ) 
     188   SUBROUTINE wrk_alloc_2di( kidim, kjdim, k2d01, k2d02, k2d03, k2d04, k2d05, k2d06, k2d07, k2d08, k2d09, k2d10, kistart, kjstart ) 
    177189      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size 
    178190      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout)           ::   k2d01 
    179191      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   k2d02,k2d03,k2d04,k2d05,k2d06,k2d07,k2d08,k2d09,k2d10 
    180       ! 
    181       CALL wrk_alloc_xd( kidim, kjdim, 0, 0, k2d01 = k2d01, k2d02 = k2d02, k2d03 = k2d03, k2d04 = k2d04, k2d05 = k2d05,   & 
    182       &                                      k2d06 = k2d06, k2d07 = k2d07, k2d08 = k2d08, k2d09 = k2d09, k2d10 = k2d10    ) 
     192      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart 
     193      ! 
     194      CALL wrk_alloc_xd( kidim, kjdim, 0, 0, kistart, kjstart, 1, 1,                                  & 
     195         &               k2d01 = k2d01, k2d02 = k2d02, k2d03 = k2d03, k2d04 = k2d04, k2d05 = k2d05,   & 
     196         &               k2d06 = k2d06, k2d07 = k2d07, k2d08 = k2d08, k2d09 = k2d09, k2d10 = k2d10    ) 
    183197      ! 
    184198   END SUBROUTINE wrk_alloc_2di 
    185199 
    186200 
    187    SUBROUTINE wrk_alloc_3dr( kidim, kjdim, kkdim, p3d01, p3d02, p3d03, p3d04, p3d05, p3d06, p3d07, p3d08, p3d09, p3d10 ) 
     201   SUBROUTINE wrk_alloc_3dr( kidim, kjdim, kkdim, p3d01, p3d02, p3d03, p3d04, p3d05, p3d06, p3d07, p3d08, p3d09, p3d10,   & 
     202      &                      kistart, kjstart, kkstart ) 
    188203      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size 
    189204      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   p3d01 
    190205      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   p3d02,p3d03,p3d04,p3d05,p3d06,p3d07,p3d08,p3d09,p3d10 
    191       ! 
    192       CALL wrk_alloc_xd( kidim, kjdim, kkdim, 0, p3d01 = p3d01, p3d02 = p3d02, p3d03 = p3d03, p3d04 = p3d04, p3d05 = p3d05,   & 
    193       &                                          p3d06 = p3d06, p3d07 = p3d07, p3d08 = p3d08, p3d09 = p3d09, p3d10 = p3d10    ) 
     206      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart 
     207      ! 
     208      CALL wrk_alloc_xd( kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1,                        & 
     209         &               p3d01 = p3d01, p3d02 = p3d02, p3d03 = p3d03, p3d04 = p3d04, p3d05 = p3d05,   & 
     210         &               p3d06 = p3d06, p3d07 = p3d07, p3d08 = p3d08, p3d09 = p3d09, p3d10 = p3d10    ) 
    194211      ! 
    195212   END SUBROUTINE wrk_alloc_3dr 
    196213 
    197214 
    198    SUBROUTINE wrk_alloc_3di( kidim, kjdim, kkdim, k3d01, k3d02, k3d03, k3d04, k3d05, k3d06, k3d07, k3d08, k3d09, k3d10 ) 
     215   SUBROUTINE wrk_alloc_3di( kidim, kjdim, kkdim, k3d01, k3d02, k3d03, k3d04, k3d05, k3d06, k3d07, k3d08, k3d09, k3d10,   & 
     216      &                      kistart, kjstart, kkstart ) 
    199217      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size 
    200218      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   k3d01 
    201219      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   k3d02,k3d03,k3d04,k3d05,k3d06,k3d07,k3d08,k3d09,k3d10 
    202       ! 
    203       CALL wrk_alloc_xd( kidim, kjdim, kkdim, 0, k3d01 = k3d01, k3d02 = k3d02, k3d03 = k3d03, k3d04 = k3d04, k3d05 = k3d05,   & 
    204       &                                          k3d06 = k3d06, k3d07 = k3d07, k3d08 = k3d08, k3d09 = k3d09, k3d10 = k3d10    ) 
     220      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart 
     221      ! 
     222      CALL wrk_alloc_xd( kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1,                        & 
     223         &               k3d01 = k3d01, k3d02 = k3d02, k3d03 = k3d03, k3d04 = k3d04, k3d05 = k3d05,   & 
     224         &               k3d06 = k3d06, k3d07 = k3d07, k3d08 = k3d08, k3d09 = k3d09, k3d10 = k3d10    ) 
    205225      ! 
    206226   END SUBROUTINE wrk_alloc_3di 
    207227 
    208228 
    209    SUBROUTINE wrk_alloc_4dr( kidim, kjdim, kkdim, kldim, p4d01, p4d02, p4d03, p4d04, p4d05, p4d06, p4d07, p4d08, p4d09, p4d10 ) 
     229   SUBROUTINE wrk_alloc_4dr( kidim, kjdim, kkdim, kldim, p4d01, p4d02, p4d03, p4d04, p4d05, p4d06, p4d07, p4d08, p4d09, p4d10,   & 
     230      &                      kistart, kjstart, kkstart, klstart ) 
    210231      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size 
    211232      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   p4d01 
    212233      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   p4d02,p4d03,p4d04,p4d05,p4d06,p4d07,p4d08,p4d09,p4d10 
    213       ! 
    214       CALL wrk_alloc_xd( kidim, kjdim, kkdim, kldim, p4d01 = p4d01, p4d02 = p4d02, p4d03 = p4d03, p4d04 = p4d04, p4d05 = p4d05,   & 
    215       &                                              p4d06 = p4d06, p4d07 = p4d07, p4d08 = p4d08, p4d09 = p4d09, p4d10 = p4d10    ) 
     234      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart 
     235      ! 
     236      CALL wrk_alloc_xd( kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart,              & 
     237         &               p4d01 = p4d01, p4d02 = p4d02, p4d03 = p4d03, p4d04 = p4d04, p4d05 = p4d05,   & 
     238         &               p4d06 = p4d06, p4d07 = p4d07, p4d08 = p4d08, p4d09 = p4d09, p4d10 = p4d10    ) 
    216239      ! 
    217240   END SUBROUTINE wrk_alloc_4dr 
    218241 
    219242 
    220    SUBROUTINE wrk_alloc_4di( kidim, kjdim, kkdim, kldim, k4d01, k4d02, k4d03, k4d04, k4d05, k4d06, k4d07, k4d08, k4d09, k4d10 ) 
     243   SUBROUTINE wrk_alloc_4di( kidim, kjdim, kkdim, kldim, k4d01, k4d02, k4d03, k4d04, k4d05, k4d06, k4d07, k4d08, k4d09, k4d10,   & 
     244      &                      kistart, kjstart, kkstart, klstart ) 
    221245      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size 
    222246      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   k4d01 
    223247      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   k4d02,k4d03,k4d04,k4d05,k4d06,k4d07,k4d08,k4d09,k4d10 
    224       ! 
    225       CALL wrk_alloc_xd( kidim, kjdim, kkdim, kldim, k4d01 = k4d01, k4d02 = k4d02, k4d03 = k4d03, k4d04 = k4d04, k4d05 = k4d05,   & 
    226       &                                              k4d06 = k4d06, k4d07 = k4d07, k4d08 = k4d08, k4d09 = k4d09, k4d10 = k4d10    ) 
     248      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart 
     249      ! 
     250      CALL wrk_alloc_xd( kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart,              & 
     251         &               k4d01 = k4d01, k4d02 = k4d02, k4d03 = k4d03, k4d04 = k4d04, k4d05 = k4d05,   & 
     252         &               k4d06 = k4d06, k4d07 = k4d07, k4d08 = k4d08, k4d09 = k4d09, k4d10 = k4d10    ) 
    227253      ! 
    228254   END SUBROUTINE wrk_alloc_4di 
    229255 
    230256 
    231    SUBROUTINE wrk_dealloc_1dr( kidim, p1d01, p1d02, p1d03, p1d04, p1d05, p1d06, p1d07, p1d08, p1d09, p1d10 ) 
     257   SUBROUTINE wrk_dealloc_1dr( kidim, p1d01, p1d02, p1d03, p1d04, p1d05, p1d06, p1d07, p1d08, p1d09, p1d10, kistart ) 
    232258      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size 
    233259      REAL(wp), POINTER, DIMENSION(:), INTENT(inout)           ::   p1d01 
    234260      REAL(wp), POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   p1d02,p1d03,p1d04,p1d05,p1d06,p1d07,p1d08,p1d09,p1d10 
     261      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart 
    235262      ! 
    236263      INTEGER :: icnt, jn 
    237264      icnt = 1 + COUNT( (/                PRESENT(p1d02),PRESENT(p1d03),PRESENT(p1d04),PRESENT(p1d05),   & 
    238265         &                 PRESENT(p1d06),PRESENT(p1d07),PRESENT(p1d08),PRESENT(p1d09),PRESENT(p1d10) /) ) 
    239       DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, 0, 0, 0 )   ;   END DO 
     266      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, 0, 0, 0, kistart, 1, 1, 1)   ;   END DO 
    240267      ! 
    241268   END SUBROUTINE wrk_dealloc_1dr 
    242269 
    243270 
    244    SUBROUTINE wrk_dealloc_1di( kidim, k1d01, k1d02, k1d03, k1d04, k1d05, k1d06, k1d07, k1d08, k1d09, k1d10 ) 
     271   SUBROUTINE wrk_dealloc_1di( kidim, k1d01, k1d02, k1d03, k1d04, k1d05, k1d06, k1d07, k1d08, k1d09, k1d10, kistart ) 
    245272      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size 
    246273      INTEGER , POINTER, DIMENSION(:), INTENT(inout)           ::   k1d01 
    247274      INTEGER , POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   k1d02,k1d03,k1d04,k1d05,k1d06,k1d07,k1d08,k1d09,k1d10 
     275      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart 
    248276      ! 
    249277      INTEGER :: icnt, jn 
    250278      icnt = 1 + COUNT( (/                PRESENT(k1d02),PRESENT(k1d03),PRESENT(k1d04),PRESENT(k1d05),   & 
    251279         &                 PRESENT(k1d06),PRESENT(k1d07),PRESENT(k1d08),PRESENT(k1d09),PRESENT(k1d10) /) ) 
    252       DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, 0, 0, 0 )   ;   END DO 
     280      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, 0, 0, 0, kistart, 1, 1, 1 )   ;   END DO 
    253281      ! 
    254282   END SUBROUTINE wrk_dealloc_1di 
    255283 
    256284 
    257    SUBROUTINE wrk_dealloc_2dr( kidim, kjdim, p2d01, p2d02, p2d03, p2d04, p2d05, p2d06, p2d07, p2d08, p2d09, p2d10 ) 
     285   SUBROUTINE wrk_dealloc_2dr( kidim, kjdim, p2d01, p2d02, p2d03, p2d04, p2d05, p2d06, p2d07, p2d08, p2d09, p2d10, kistart,kjstart ) 
    258286      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size 
    259287      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout)           ::   p2d01 
    260288      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   p2d02,p2d03,p2d04,p2d05,p2d06,p2d07,p2d08,p2d09,p2d10 
     289      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart 
    261290      ! 
    262291      INTEGER :: icnt, jn 
    263292      icnt = 1 + COUNT( (/                PRESENT(p2d02),PRESENT(p2d03),PRESENT(p2d04),PRESENT(p2d05),   & 
    264293         &                 PRESENT(p2d06),PRESENT(p2d07),PRESENT(p2d08),PRESENT(p2d09),PRESENT(p2d10) /) ) 
    265       DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, kjdim, 0, 0 )   ;   END DO 
     294      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, kjdim, 0, 0, kistart, kjstart, 1, 1 )   ;   END DO 
    266295      ! 
    267296   END SUBROUTINE wrk_dealloc_2dr 
    268297 
    269298 
    270    SUBROUTINE wrk_dealloc_2di( kidim, kjdim, k2d01, k2d02, k2d03, k2d04, k2d05, k2d06, k2d07, k2d08, k2d09, k2d10 ) 
     299   SUBROUTINE wrk_dealloc_2di( kidim, kjdim, k2d01, k2d02, k2d03, k2d04, k2d05, k2d06, k2d07, k2d08, k2d09, k2d10, kistart,kjstart ) 
    271300      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size 
    272301      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout)           ::   k2d01 
    273302      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   k2d02,k2d03,k2d04,k2d05,k2d06,k2d07,k2d08,k2d09,k2d10 
     303      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart 
    274304      ! 
    275305      INTEGER :: icnt, jn 
    276306      icnt = 1 + COUNT( (/                PRESENT(k2d02),PRESENT(k2d03),PRESENT(k2d04),PRESENT(k2d05),   & 
    277307         &                 PRESENT(k2d06),PRESENT(k2d07),PRESENT(k2d08),PRESENT(k2d09),PRESENT(k2d10) /) ) 
    278       DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, kjdim, 0, 0 )   ;   END DO 
     308      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, kjdim, 0, 0, kistart, kjstart, 1, 1 )   ;   END DO 
    279309      ! 
    280310   END SUBROUTINE wrk_dealloc_2di 
    281311 
    282312 
    283    SUBROUTINE wrk_dealloc_3dr( kidim, kjdim, kkdim, p3d01, p3d02, p3d03, p3d04, p3d05, p3d06, p3d07, p3d08, p3d09, p3d10 ) 
     313   SUBROUTINE wrk_dealloc_3dr( kidim, kjdim, kkdim, p3d01, p3d02, p3d03, p3d04, p3d05, p3d06, p3d07, p3d08, p3d09, p3d10,   & 
     314      &                        kistart, kjstart, kkstart ) 
    284315      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size 
    285316      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   p3d01 
    286317      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   p3d02,p3d03,p3d04,p3d05,p3d06,p3d07,p3d08,p3d09,p3d10 
     318      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart 
    287319      ! 
    288320      INTEGER :: icnt, jn 
    289321      icnt = 1 + COUNT( (/                PRESENT(p3d02),PRESENT(p3d03),PRESENT(p3d04),PRESENT(p3d05),   & 
    290322         &                 PRESENT(p3d06),PRESENT(p3d07),PRESENT(p3d08),PRESENT(p3d09),PRESENT(p3d10) /) ) 
    291       DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, kjdim, kkdim, 0 )   ;   END DO 
     323      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1 )   ;   END DO 
    292324      ! 
    293325   END SUBROUTINE wrk_dealloc_3dr 
    294326 
    295327 
    296    SUBROUTINE wrk_dealloc_3di( kidim, kjdim, kkdim, k3d01, k3d02, k3d03, k3d04, k3d05, k3d06, k3d07, k3d08, k3d09, k3d10 ) 
     328   SUBROUTINE wrk_dealloc_3di( kidim, kjdim, kkdim, k3d01, k3d02, k3d03, k3d04, k3d05, k3d06, k3d07, k3d08, k3d09, k3d10,   & 
     329      &                        kistart, kjstart, kkstart ) 
    297330      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size 
    298331      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   k3d01 
    299332      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   k3d02,k3d03,k3d04,k3d05,k3d06,k3d07,k3d08,k3d09,k3d10 
     333      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart 
    300334      ! 
    301335      INTEGER :: icnt, jn 
    302336      icnt = 1 + COUNT( (/                PRESENT(k3d02),PRESENT(k3d03),PRESENT(k3d04),PRESENT(k3d05),   & 
    303337         &                 PRESENT(k3d06),PRESENT(k3d07),PRESENT(k3d08),PRESENT(k3d09),PRESENT(k3d10) /) ) 
    304       DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, kjdim, kkdim, 0 )   ;   END DO 
     338      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1 )   ;   END DO 
    305339      ! 
    306340   END SUBROUTINE wrk_dealloc_3di 
    307341 
    308342 
    309    SUBROUTINE wrk_dealloc_4dr( kidim, kjdim, kkdim, kldim, p4d01, p4d02, p4d03, p4d04, p4d05, p4d06, p4d07, p4d08, p4d09, p4d10 ) 
     343   SUBROUTINE wrk_dealloc_4dr( kidim, kjdim, kkdim, kldim, p4d01, p4d02, p4d03, p4d04, p4d05, p4d06, p4d07, p4d08, p4d09, p4d10,   & 
     344      &                        kistart, kjstart, kkstart, klstart ) 
    310345      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size 
    311346      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   p4d01 
    312347      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   p4d02,p4d03,p4d04,p4d05,p4d06,p4d07,p4d08,p4d09,p4d10 
     348      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart 
    313349      ! 
    314350      INTEGER :: icnt, jn 
    315351      icnt = 1 + COUNT( (/                PRESENT(p4d02),PRESENT(p4d03),PRESENT(p4d04),PRESENT(p4d05),   & 
    316352         &                 PRESENT(p4d06),PRESENT(p4d07),PRESENT(p4d08),PRESENT(p4d09),PRESENT(p4d10) /) ) 
    317       DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, kjdim, kkdim, kldim )   ;  END DO 
     353      DO jn = 1, icnt ; CALL wrk_deallocbase( jpreal, kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart ) ; END DO 
    318354      ! 
    319355   END SUBROUTINE wrk_dealloc_4dr 
    320356 
    321357 
    322    SUBROUTINE wrk_dealloc_4di( kidim, kjdim, kkdim, kldim, k4d01, k4d02, k4d03, k4d04, k4d05, k4d06, k4d07, k4d08, k4d09, k4d10 ) 
     358   SUBROUTINE wrk_dealloc_4di( kidim, kjdim, kkdim, kldim, k4d01, k4d02, k4d03, k4d04, k4d05, k4d06, k4d07, k4d08, k4d09, k4d10,   & 
     359      &                        kistart, kjstart, kkstart, klstart ) 
    323360      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size 
    324361      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   k4d01 
    325362      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   k4d02,k4d03,k4d04,k4d05,k4d06,k4d07,k4d08,k4d09,k4d10 
     363      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart 
    326364      ! 
    327365      INTEGER :: icnt, jn 
    328366      icnt = 1 + COUNT( (/                PRESENT(k4d02),PRESENT(k4d03),PRESENT(k4d04),PRESENT(k4d05),   & 
    329367         &                 PRESENT(k4d06),PRESENT(k4d07),PRESENT(k4d08),PRESENT(k4d09),PRESENT(k4d10) /) ) 
    330       DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, kjdim, kkdim, kldim )   ;  END DO 
     368      DO jn = 1, icnt ; CALL wrk_deallocbase( jpinteger, kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart ) ; END DO 
    331369      ! 
    332370   END SUBROUTINE wrk_dealloc_4di 
    … …  
    334372 
    335373   SUBROUTINE wrk_alloc_xd( kidim, kjdim, kkdim, kldim,                                             & 
     374      &                     kisrt, kjsrt, kksrt, klsrt,                                             & 
    336375      &                     k1d01, k1d02, k1d03, k1d04, k1d05, k1d06, k1d07, k1d08, k1d09, k1d10,   & 
    337376      &                     k2d01, k2d02, k2d03, k2d04, k2d05, k2d06, k2d07, k2d08, k2d09, k2d10,   & 
    … …  
    343382      &                     p4d01, p4d02, p4d03, p4d04, p4d05, p4d06, p4d07, p4d08, p4d09, p4d10    ) 
    344383      INTEGER                              ,INTENT(in   )         ::   kidim, kjdim, kkdim, kldim   ! dimensions size 
     384      INTEGER                              ,INTENT(in   ),OPTIONAL::   kisrt, kjsrt, kksrt, klsrt 
    345385      INTEGER , POINTER, DIMENSION(:      ),INTENT(inout),OPTIONAL::   k1d01,k1d02,k1d03,k1d04,k1d05,k1d06,k1d07,k1d08,k1d09,k1d10 
    346386      INTEGER , POINTER, DIMENSION(:,:    ),INTENT(inout),OPTIONAL::   k2d01,k2d02,k2d03,k2d04,k2d05,k2d06,k2d07,k2d08,k2d09,k2d10 
    … …  
    353393      ! 
    354394      LOGICAL ::   llpres 
    355       INTEGER ::   jn 
     395      INTEGER ::   jn, iisrt, ijsrt, iksrt, ilsrt 
    356396      ! 
    357397      IF( .NOT. linit ) THEN 
    358398         tree(:)%itype = jpnotdefined 
    359          DO jn = 1, jparray   ;   tree(jn)%ishape(:) = 0   ;   END DO 
     399         DO jn = 1, jparray   ;   tree(jn)%ishape(:) = 0   ;   tree(jn)%istart(:) = 0   ;   END DO 
    360400         linit = .TRUE. 
    361401      ENDIF 
    362402 
     403      IF( PRESENT(kisrt) ) THEN   ;   iisrt =  kisrt   ;   ELSE   ;   iisrt = 1   ;   ENDIF  
     404      IF( PRESENT(kjsrt) ) THEN   ;   ijsrt =  kjsrt   ;   ELSE   ;   ijsrt = 1   ;   ENDIF  
     405      IF( PRESENT(kksrt) ) THEN   ;   iksrt =  kksrt   ;   ELSE   ;   iksrt = 1   ;   ENDIF  
     406      IF( PRESENT(klsrt) ) THEN   ;   ilsrt =  klsrt   ;   ELSE   ;   ilsrt = 1   ;   ENDIF  
     407 
    363408      llpres =  PRESENT(k1d01) .OR. PRESENT(k2d01) .OR. PRESENT(k3d01) .OR. PRESENT(k4d01)   & 
    364409         & .OR. PRESENT(p1d01) .OR. PRESENT(p2d01) .OR. PRESENT(p3d01) .OR. PRESENT(p4d01) 
    365       IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, k1d01, k2d01, k3d01, k4d01, p1d01, p2d01, p3d01, p4d01 ) 
     410      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   & 
     411         &                             k1d01, k2d01, k3d01, k4d01, p1d01, p2d01, p3d01, p4d01    ) 
    366412      llpres =  PRESENT(k1d02) .OR. PRESENT(k2d02) .OR. PRESENT(k3d02) .OR. PRESENT(k4d02)   & 
    367413         & .OR. PRESENT(p1d02) .OR. PRESENT(p2d02) .OR. PRESENT(p3d02) .OR. PRESENT(p4d02) 
    368       IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, k1d02, k2d02, k3d02, k4d02, p1d02, p2d02, p3d02, p4d02 ) 
     414      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   & 
     415         &                             k1d02, k2d02, k3d02, k4d02, p1d02, p2d02, p3d02, p4d02    ) 
    369416      llpres =  PRESENT(k1d03) .OR. PRESENT(k2d03) .OR. PRESENT(k3d03) .OR. PRESENT(k4d03)   & 
    370417         & .OR. PRESENT(p1d03) .OR. PRESENT(p2d03) .OR. PRESENT(p3d03) .OR. PRESENT(p4d03) 
    371       IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, k1d03, k2d03, k3d03, k4d03, p1d03, p2d03, p3d03, p4d03 ) 
     418      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   & 
     419         &                             k1d03, k2d03, k3d03, k4d03, p1d03, p2d03, p3d03, p4d03    ) 
    372420      llpres =  PRESENT(k1d04) .OR. PRESENT(k2d04) .OR. PRESENT(k3d04) .OR. PRESENT(k4d04)   & 
    373421         & .OR. PRESENT(p1d04) .OR. PRESENT(p2d04) .OR. PRESENT(p3d04) .OR. PRESENT(p4d04) 
    374       IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, k1d04, k2d04, k3d04, k4d04, p1d04, p2d04, p3d04, p4d04 ) 
     422      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   & 
     423         &                             k1d04, k2d04, k3d04, k4d04, p1d04, p2d04, p3d04, p4d04    ) 
    375424      llpres =  PRESENT(k1d05) .OR. PRESENT(k2d05) .OR. PRESENT(k3d05) .OR. PRESENT(k4d05)   & 
    376425         & .OR. PRESENT(p1d05) .OR. PRESENT(p2d05) .OR. PRESENT(p3d05) .OR. PRESENT(p4d05) 
    377       IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, k1d05, k2d05, k3d05, k4d05, p1d05, p2d05, p3d05, p4d05 ) 
     426      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   & 
     427         &                             k1d05, k2d05, k3d05, k4d05, p1d05, p2d05, p3d05, p4d05    ) 
    378428      llpres =  PRESENT(k1d06) .OR. PRESENT(k2d06) .OR. PRESENT(k3d06) .OR. PRESENT(k4d06)   & 
    379429         & .OR. PRESENT(p1d06) .OR. PRESENT(p2d06) .OR. PRESENT(p3d06) .OR. PRESENT(p4d06) 
    380       IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, k1d06, k2d06, k3d06, k4d06, p1d06, p2d06, p3d06, p4d06 ) 
     430      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   & 
     431         &                             k1d06, k2d06, k3d06, k4d06, p1d06, p2d06, p3d06, p4d06    ) 
    381432      llpres =  PRESENT(k1d07) .OR. PRESENT(k2d07) .OR. PRESENT(k3d07) .OR. PRESENT(k4d07)   & 
    382433         & .OR. PRESENT(p1d07) .OR. PRESENT(p2d07) .OR. PRESENT(p3d07) .OR. PRESENT(p4d07) 
    383       IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, k1d07, k2d07, k3d07, k4d07, p1d07, p2d07, p3d07, p4d07 ) 
     434      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   & 
     435         &                             k1d07, k2d07, k3d07, k4d07, p1d07, p2d07, p3d07, p4d07    ) 
    384436      llpres =  PRESENT(k1d08) .OR. PRESENT(k2d08) .OR. PRESENT(k3d08) .OR. PRESENT(k4d08)   & 
    385437         & .OR. PRESENT(p1d08) .OR. PRESENT(p2d08) .OR. PRESENT(p3d08) .OR. PRESENT(p4d08) 
    386       IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, k1d08, k2d08, k3d08, k4d08, p1d08, p2d08, p3d08, p4d08 ) 
     438      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   & 
     439         &                             k1d08, k2d08, k3d08, k4d08, p1d08, p2d08, p3d08, p4d08    ) 
    387440      llpres =  PRESENT(k1d09) .OR. PRESENT(k2d09) .OR. PRESENT(k3d09) .OR. PRESENT(k4d09)   & 
    388441         & .OR. PRESENT(p1d09) .OR. PRESENT(p2d09) .OR. PRESENT(p3d09) .OR. PRESENT(p4d09) 
    389       IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, k1d09, k2d09, k3d09, k4d09, p1d09, p2d09, p3d09, p4d09 ) 
     442      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   & 
     443         &                             k1d09, k2d09, k3d09, k4d09, p1d09, p2d09, p3d09, p4d09    ) 
    390444      llpres =  PRESENT(k1d10) .OR. PRESENT(k2d10) .OR. PRESENT(k3d10) .OR. PRESENT(k4d10)   & 
    391445         & .OR. PRESENT(p1d10) .OR. PRESENT(p2d10) .OR. PRESENT(p3d10) .OR. PRESENT(p4d10) 
    392       IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, k1d10, k2d10, k3d10, k4d10, p1d10, p2d10, p3d10, p4d10 ) 
     446      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   & 
     447         &                             k1d10, k2d10, k3d10, k4d10, p1d10, p2d10, p3d10, p4d10    ) 
    393448 
    394449   END SUBROUTINE wrk_alloc_xd 
    395450 
    396451 
    397    SUBROUTINE wrk_allocbase( kidim, kjdim, kkdim, kldim, kwrk1d, kwrk2d, kwrk3d, kwrk4d, pwrk1d, pwrk2d, pwrk3d, pwrk4d ) 
     452   SUBROUTINE wrk_allocbase( kidim , kjdim , kkdim , kldim , kisrt , kjsrt , kksrt , klsrt ,   & 
     453      &                      kwrk1d, kwrk2d, kwrk3d, kwrk4d, pwrk1d, pwrk2d, pwrk3d, pwrk4d    ) 
    398454      INTEGER                              , INTENT(in   )           :: kidim, kjdim, kkdim, kldim 
     455      INTEGER                              , INTENT(in   )           :: kisrt, kjsrt, kksrt, klsrt 
    399456      INTEGER , POINTER, DIMENSION(:)      , INTENT(inout), OPTIONAL :: kwrk1d   
    400457      INTEGER , POINTER, DIMENSION(:,:)    , INTENT(inout), OPTIONAL :: kwrk2d   
    … …  
    406463      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL :: pwrk4d   
    407464      ! 
    408       INTEGER, DIMENSION(jpmaxdim) :: ishape 
     465      INTEGER, DIMENSION(jpmaxdim) :: ishape, isrt, iend 
    409466      INTEGER :: itype 
    410467      INTEGER :: ii 
    … …  
    412469      ! define the shape to be given to the work array 
    413470      ishape(:) = (/ kidim, kjdim, kkdim, kldim /) 
     471      ! define the starting index of the dimension shape to be given to the work array 
     472      isrt  (:) = (/ kisrt, kjsrt, kksrt, klsrt /) 
     473      iend  (:) = ishape(:) + isrt(:) - 1 
    414474 
    415475      ! is it integer or real array? 
    … …  
    417477      IF( PRESENT(pwrk1d) .OR. PRESENT(pwrk2d) .OR. PRESENT(pwrk3d) .OR. PRESENT(pwrk4d) )   itype = jpreal          
    418478 
    419       ! find the branch with the matcing shape and type or get the first "free" branch  
     479      ! find the branch with the matching shape, staring index and type or get the first "free" branch  
    420480      ii = 1                           
    421       DO WHILE( ( ANY( tree(ii)%ishape /= ishape ) .OR. tree(ii)%itype /= itype ) .AND. SUM( tree(ii)%ishape ) /= 0 ) 
     481      DO WHILE(       ( ANY( tree(ii)%ishape /= ishape ) .OR. ANY( tree(ii)%istart /= isrt ) .OR. tree(ii)%itype /= itype )   & 
     482         &      .AND. SUM( tree(ii)%ishape ) /= 0 ) 
    422483         ii = ii + 1 
    423484         IF (ii > jparray) STOP   ! increase the value of jparray (should not be needed as already very big!) 
    … …  
    426487      IF( SUM( tree(ii)%ishape ) == 0 ) THEN                    ! create a new branch  
    427488         tree(ii)%itype = itype                                        ! define the type of this branch  
    428          tree(ii)%ishape(:) = ishape                                   ! define the shape of this branch  
     489         tree(ii)%ishape(:) = ishape(:)                                ! define the shape of this branch  
     490         tree(ii)%istart(:) = isrt(:)                                  ! define the lower bounds of this branch  
    429491         ALLOCATE( tree(ii)%start )                                    ! allocate its start 
    430492         ALLOCATE( tree(ii)%current)                                   ! allocate the current leaf (the first leaf) 
    … …  
    440502         tree(ii)%current%next => NULL()                               ! next leaf is not yet defined 
    441503         ! allocate the array of the first leaf 
    442          IF( present(kwrk1d) ) ALLOCATE( tree(ii)%current%iwrk1d(kidim                  ) )    
    443          IF( present(kwrk2d) ) ALLOCATE( tree(ii)%current%iwrk2d(kidim,kjdim            ) )    
    444          IF( present(kwrk3d) ) ALLOCATE( tree(ii)%current%iwrk3d(kidim,kjdim,kkdim      ) )    
    445          IF( present(kwrk4d) ) ALLOCATE( tree(ii)%current%iwrk4d(kidim,kjdim,kkdim,kldim) )    
    446          IF( present(pwrk1d) ) ALLOCATE( tree(ii)%current%zwrk1d(kidim                  ) )    
    447          IF( present(pwrk2d) ) ALLOCATE( tree(ii)%current%zwrk2d(kidim,kjdim            ) )    
    448          IF( present(pwrk3d) ) ALLOCATE( tree(ii)%current%zwrk3d(kidim,kjdim,kkdim      ) )    
    449          IF( present(pwrk4d) ) ALLOCATE( tree(ii)%current%zwrk4d(kidim,kjdim,kkdim,kldim) )    
     504         IF( PRESENT(kwrk1d) ) ALLOCATE( tree(ii)%current%iwrk1d(isrt(1):iend(1)                                                ) ) 
     505         IF( PRESENT(kwrk2d) ) ALLOCATE( tree(ii)%current%iwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) ) 
     506         IF( PRESENT(kwrk3d) ) ALLOCATE( tree(ii)%current%iwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) ) 
     507         IF( PRESENT(kwrk4d) ) ALLOCATE( tree(ii)%current%iwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) ) 
     508         IF( PRESENT(pwrk1d) ) ALLOCATE( tree(ii)%current%zwrk1d(isrt(1):iend(1)                                                ) ) 
     509         IF( PRESENT(pwrk2d) ) ALLOCATE( tree(ii)%current%zwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) ) 
     510         IF( PRESENT(pwrk3d) ) ALLOCATE( tree(ii)%current%zwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) ) 
     511         IF( PRESENT(pwrk4d) ) ALLOCATE( tree(ii)%current%zwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) ) 
    450512                   
    451513      ELSE IF( .NOT. ASSOCIATED(tree(ii)%current%next) ) THEN   ! all leafs used -> define a new one 
    … …  
    459521  
    460522         ! allocate the array of the new leaf 
    461          IF( present(kwrk1d) ) ALLOCATE( tree(ii)%current%iwrk1d(kidim                  ) )    
    462          IF( present(kwrk2d) ) ALLOCATE( tree(ii)%current%iwrk2d(kidim,kjdim            ) )    
    463          IF( present(kwrk3d) ) ALLOCATE( tree(ii)%current%iwrk3d(kidim,kjdim,kkdim      ) )    
    464          IF( present(kwrk4d) ) ALLOCATE( tree(ii)%current%iwrk4d(kidim,kjdim,kkdim,kldim) )    
    465          IF( present(pwrk1d) ) ALLOCATE( tree(ii)%current%zwrk1d(kidim                  ) )    
    466          IF( present(pwrk2d) ) ALLOCATE( tree(ii)%current%zwrk2d(kidim,kjdim            ) )    
    467          IF( present(pwrk3d) ) ALLOCATE( tree(ii)%current%zwrk3d(kidim,kjdim,kkdim      ) )    
    468          IF( present(pwrk4d) ) ALLOCATE( tree(ii)%current%zwrk4d(kidim,kjdim,kkdim,kldim) )    
     523         IF( PRESENT(kwrk1d) ) ALLOCATE( tree(ii)%current%iwrk1d(isrt(1):iend(1)                                                ) ) 
     524         IF( PRESENT(kwrk2d) ) ALLOCATE( tree(ii)%current%iwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) ) 
     525         IF( PRESENT(kwrk3d) ) ALLOCATE( tree(ii)%current%iwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) ) 
     526         IF( PRESENT(kwrk4d) ) ALLOCATE( tree(ii)%current%iwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) ) 
     527         IF( PRESENT(pwrk1d) ) ALLOCATE( tree(ii)%current%zwrk1d(isrt(1):iend(1)                                                ) ) 
     528         IF( PRESENT(pwrk2d) ) ALLOCATE( tree(ii)%current%zwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) ) 
     529         IF( PRESENT(pwrk3d) ) ALLOCATE( tree(ii)%current%zwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) ) 
     530         IF( PRESENT(pwrk4d) ) ALLOCATE( tree(ii)%current%zwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) ) 
    469531          
    470532      ELSE  
    … …  
    486548 
    487549 
    488    SUBROUTINE wrk_deallocbase( ktype, kidim, kjdim, kkdim, kldim ) 
    489       INTEGER, INTENT(in   ) :: ktype 
    490       INTEGER, INTENT(in   ) :: kidim, kjdim, kkdim, kldim 
    491       ! 
     550   SUBROUTINE wrk_deallocbase( ktype, kidim, kjdim, kkdim, kldim, kisrt, kjsrt, kksrt, klsrt ) 
     551      INTEGER, INTENT(in   )           :: ktype 
     552      INTEGER, INTENT(in   )           :: kidim, kjdim, kkdim, kldim 
     553      INTEGER, INTENT(in   ), OPTIONAL :: kisrt, kjsrt, kksrt, klsrt 
     554      ! 
     555      INTEGER, DIMENSION(jpmaxdim) :: ishape, istart 
    492556      INTEGER :: ii 
     557 
     558      ishape(:) = (/ kidim, kjdim, kkdim, kldim /) 
     559      IF( PRESENT(kisrt) ) THEN   ;   istart(1) =  kisrt   ;   ELSE   ;   istart(1) = 1   ;   ENDIF  
     560      IF( PRESENT(kjsrt) ) THEN   ;   istart(2) =  kjsrt   ;   ELSE   ;   istart(2) = 1   ;   ENDIF  
     561      IF( PRESENT(kksrt) ) THEN   ;   istart(3) =  kksrt   ;   ELSE   ;   istart(3) = 1   ;   ENDIF  
     562      IF( PRESENT(klsrt) ) THEN   ;   istart(4) =  klsrt   ;   ELSE   ;   istart(4) = 1   ;   ENDIF  
    493563 
    494564      ! find the branch with the matcing shape and type or get the first "free" branch  
    495565      ii = 1                           
    496       DO WHILE( ANY( tree(ii)%ishape /= (/ kidim, kjdim, kkdim, kldim /) ) .OR. tree(ii)%itype /= ktype ) 
     566      DO WHILE( ANY( tree(ii)%ishape /= ishape ) .OR. ANY( tree(ii)%istart /= istart ) .OR. tree(ii)%itype /= ktype ) 
    497567         ii = ii + 1 
    498568      END DO 
Note: See TracChangeset for help on using the changeset viewer.