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

Changeset 2598


Ignore:
Timestamp:
2011-02-20T15:56:41+01:00 (13 years ago)
Author:
gm
Message:

dynamic mem: #785 ; LIM-3 case: add TARGET for 4D arrays + style

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90

    r2590 r2598  
    1717   PUBLIC wrk_release, llwrk_release, iwrk_release, wrk_release_xz 
    1818 
    19    INTEGER, PARAMETER :: num_1d_wrkspaces  = 27 ! No. of 1D workspace arrays ( MAX(jpi*jpj,jpi*jpk,jpj*jpk) ) 
    20    INTEGER, PARAMETER :: num_2d_wrkspaces  = 35 ! No. of 2D workspace arrays (jpi,jpj) 
    21    INTEGER, PARAMETER :: num_3d_wrkspaces  = 15 ! No. of 3D workspace arrays (jpi,jpj,jpk) 
    22    INTEGER, PARAMETER :: num_4d_wrkspaces  = 4 ! No. of 4D workspace arrays (jpi,jpj,jpk,jpts) 
    23  
    24    INTEGER, PARAMETER :: num_xz_wrkspaces  = 4 ! No. of 2D, xz workspace arrays (jpi,jpk) 
    25  
    26    INTEGER, PARAMETER :: num_1d_lwrkspaces = 0 ! No. of 1D logical workspace arrays 
    27    INTEGER, PARAMETER :: num_2d_lwrkspaces = 3 ! No. of 2D logical workspace arrays 
    28    INTEGER, PARAMETER :: num_3d_lwrkspaces = 1 ! No. of 3D logical workspace arrays 
    29    INTEGER, PARAMETER :: num_4d_lwrkspaces = 0 ! No. of 4D logical workspace arrays 
    30  
    31    INTEGER, PARAMETER :: num_1d_iwrkspaces = 0 ! No. of 1D integer workspace arrays 
    32    INTEGER, PARAMETER :: num_2d_iwrkspaces = 1 ! No. of 2D integer workspace arrays 
    33    INTEGER, PARAMETER :: num_3d_iwrkspaces = 0 ! No. of 3D integer workspace arrays 
    34    INTEGER, PARAMETER :: num_4d_iwrkspaces = 0 ! No. of 4D integer workspace arrays 
     19   INTEGER, PARAMETER :: num_1d_wrkspaces  = 27   ! No. of 1D workspace arrays ( MAX(jpi*jpj,jpi*jpk,jpj*jpk) ) 
     20   INTEGER, PARAMETER :: num_2d_wrkspaces  = 35   ! No. of 2D workspace arrays (jpi,jpj) 
     21   INTEGER, PARAMETER :: num_3d_wrkspaces  = 15   ! No. of 3D workspace arrays (jpi,jpj,jpk) 
     22   INTEGER, PARAMETER :: num_4d_wrkspaces  = 4   ! No. of 4D workspace arrays (jpi,jpj,jpk,jpts) 
     23 
     24   INTEGER, PARAMETER :: num_xz_wrkspaces  = 4   ! No. of 2D, xz workspace arrays (jpi,jpk) 
     25 
     26   INTEGER, PARAMETER :: num_1d_lwrkspaces = 0   ! No. of 1D logical workspace arrays 
     27   INTEGER, PARAMETER :: num_2d_lwrkspaces = 3   ! No. of 2D logical workspace arrays 
     28   INTEGER, PARAMETER :: num_3d_lwrkspaces = 1   ! No. of 3D logical workspace arrays 
     29   INTEGER, PARAMETER :: num_4d_lwrkspaces = 0   ! No. of 4D logical workspace arrays 
     30 
     31   INTEGER, PARAMETER :: num_1d_iwrkspaces = 0   ! No. of 1D integer workspace arrays 
     32   INTEGER, PARAMETER :: num_2d_iwrkspaces = 1   ! No. of 2D integer workspace arrays 
     33   INTEGER, PARAMETER :: num_3d_iwrkspaces = 0   ! No. of 3D integer workspace arrays 
     34   INTEGER, PARAMETER :: num_4d_iwrkspaces = 0   ! No. of 4D integer workspace arrays 
    3535   ! Maximum no. of workspaces of any one dimensionality that can be 
    36    ! requested - MAX(num_1d_wrkspaces, num_2d_wrkspaces, num_3d_wrkspaces, 
    37    ! num_4d_wrkspaces)  
     36   ! requested - MAX(num_1d_wrkspaces, num_2d_wrkspaces, num_3d_wrkspaces, num_4d_wrkspaces)  
    3837   INTEGER, PARAMETER :: max_num_wrkspaces = 35 
    3938 
     
    4140   ! num_Xd_wrkspaces parameter above and to allocate them in wrk_alloc() 
    4241 
    43    ! 1D, REAL(wp) workspaces 
    44    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:), TARGET, PUBLIC :: wrk_1d_1,  wrk_1d_2 
    45    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:), TARGET, PUBLIC :: wrk_1d_3,  wrk_1d_4 
    46    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:), TARGET, PUBLIC :: wrk_1d_5,  wrk_1d_6  
    47    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:), TARGET, PUBLIC :: wrk_1d_7,  wrk_1d_8 
    48    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:), TARGET, PUBLIC :: wrk_1d_9,  wrk_1d_10 
    49    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:), TARGET, PUBLIC :: wrk_1d_11, wrk_1d_12 
    50    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:), TARGET, PUBLIC :: wrk_1d_13, wrk_1d_14 
    51    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:), TARGET, PUBLIC :: wrk_1d_15, wrk_1d_16 
    52    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:), TARGET, PUBLIC :: wrk_1d_17, wrk_1d_18 
    53    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:), TARGET, PUBLIC :: wrk_1d_19, wrk_1d_20 
    54    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:), TARGET, PUBLIC :: wrk_1d_21, wrk_1d_22 
    55    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:), TARGET, PUBLIC :: wrk_1d_23, wrk_1d_24 
    56    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:), TARGET, PUBLIC :: wrk_1d_25, wrk_1d_26 
    57    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:), TARGET, PUBLIC :: wrk_1d_27 
    58  
    59    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_1 !: 2D real workspace 
    60    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_2 !: 2D real workspace 
    61    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_3 !: 2D real workspace 
    62    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_4 !: 2D real workspace 
    63    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_5 !: 2D real workspace 
    64    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_6 !: 2D real workspace 
    65    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_7 !: 2D real workspace 
    66    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_8 !: 2D real workspace 
    67    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_9 !: 2D real workspace 
    68    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_10 !: 2D real workspace 
    69    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_11 !: 2D real workspace 
    70    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_12 !: 2D real workspace 
    71    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_13 !: 2D real workspace 
    72    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_14 !: 2D real workspace 
    73    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_15 !: 2D real workspace 
    74    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_16 !: 2D real workspace 
    75    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_17 !: 2D real workspace 
    76    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_18 !: 2D real workspace 
    77    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_19 !: 2D real workspace 
    78    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_20 !: 2D real workspace 
    79    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_21 !: 2D real workspace 
    80    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_22 !: 2D real workspace 
    81    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_23 !: 2D real workspace 
    82    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_24 !: 2D real workspace 
    83    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_25 !: 2D real workspace 
    84    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_26 !: 2D real workspace 
    85    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_27 !: 2D real workspace 
    86    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_28 !: 2D real workspace 
    87    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_29 !: 2D real workspace 
    88    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_30 !: 2D real workspace 
    89    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_31 !: 2D real workspace 
    90    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_32 !: 2D real workspace 
    91    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_33 !: 2D real workspace 
    92    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_34 !: 2D real workspace 
    93    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET, PUBLIC :: wrk_2d_35 !: 2D real workspace 
    94  
    95    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC ::  wrk_3d_1   !: 3D real workspace 
    96    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC ::  wrk_3d_2   !: 3D real workspace 
    97    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC ::  wrk_3d_3   !: 3D real workspace 
    98    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC ::  wrk_3d_4   !: 3D real workspace 
    99    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC ::  wrk_3d_5   !: 3D real workspace 
    100    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC ::  wrk_3d_6   !: 3D real workspace 
    101    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC ::  wrk_3d_7   !: 3D real workspace 
    102    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC ::  wrk_3d_8   !: 3D real workspace 
    103    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC ::  wrk_3d_9   !: 3D real workspace 
    104    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC ::  wrk_3d_10  !: 3D real workspace 
    105    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC ::  wrk_3d_11  !: 3D real workspace 
    106    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC ::  wrk_3d_12  !: 3D real workspace 
    107    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC ::  wrk_3d_13  !: 3D real workspace 
    108    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC ::  wrk_3d_14  !: 3D real workspace 
    109    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC ::  wrk_3d_15  !: 3D real workspace 
    110  
    111    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:), PUBLIC :: wrk_4d_1, wrk_4d_2, wrk_4d_3, wrk_4d_4   !: 4D real workspace 
    112  
    113    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: wrk_xz_1, wrk_xz_2, wrk_xz_3, wrk_xz_4 !: 2D, x-z workspaces 
    114  
    115    LOGICAL,  ALLOCATABLE, SAVE, DIMENSION(:,:)    , PUBLIC :: llwrk_2d_1, llwrk_2d_2, llwrk_2d_3 !: 2D logical workspace 
    116    LOGICAL,  ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET, PUBLIC :: llwrk_3d_1 !: 3D logical workspace 
    117  
    118    INTEGER,  ALLOCATABLE, SAVE, DIMENSION(:,:)    , PUBLIC :: iwrk_2d_1 !: 2D integer workspace 
    119  
    120  
    121    LOGICAL, DIMENSION(num_1d_wrkspaces)  :: in_use_1d   !: Flags to track which 1D workspace arrays are in use   
    122    LOGICAL, DIMENSION(num_2d_wrkspaces)  :: in_use_2d   !: Flags to track which 2D workspace arrays are in use 
    123    LOGICAL, DIMENSION(num_3d_wrkspaces)  :: in_use_3d   !: Flags to track which 3D workspace arrays are in use 
    124    LOGICAL, DIMENSION(num_4d_wrkspaces)  :: in_use_4d   !: Flags to track which 4D workspace arrays are in use 
    125    LOGICAL, DIMENSION(num_xz_wrkspaces)  :: in_use_xz   !: Flags to track which 2D, xz workspace arrays are in use 
    126    LOGICAL, DIMENSION(num_2d_lwrkspaces) :: in_use_2dll !: Flags to track which 2D, logical workspace arrays are in use 
    127    LOGICAL, DIMENSION(num_3d_lwrkspaces) :: in_use_3dll !: Flags to track which 3D, logical workspace arrays are in use 
    128    LOGICAL, DIMENSION(num_2d_iwrkspaces) :: in_use_2di  !: Flags to track which 2D, integer workspace arrays are in use 
     42   !                                                                    !!**  1D, REAL(wp) workspaces  ** 
     43   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)      , TARGET, PUBLIC ::   wrk_1d_1 , wrk_1d_2 , wrk_1d_3 , wrk_1d_4 , wrk_1d_5 
     44   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)      , TARGET, PUBLIC ::   wrk_1d_6 , wrk_1d_7 , wrk_1d_8 , wrk_1d_9 , wrk_1d_10 
     45   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)      , TARGET, PUBLIC ::   wrk_1d_11, wrk_1d_12, wrk_1d_13, wrk_1d_14, wrk_1d_15 
     46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)      , TARGET, PUBLIC ::   wrk_1d_16, wrk_1d_17, wrk_1d_18, wrk_1d_19, wrk_1d_20 
     47   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)      , TARGET, PUBLIC ::   wrk_1d_21, wrk_1d_22, wrk_1d_23, wrk_1d_24, wrk_1d_25 
     48   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)      , TARGET, PUBLIC ::   wrk_1d_26, wrk_1d_27 
     49 
     50   !                                                                    !!**  2D, x-y, REAL(wp) workspaces  ** 
     51   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_1 , wrk_2d_2 , wrk_2d_3 , wrk_2d_4 , wrk_2d_5 
     52   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_6 , wrk_2d_7 , wrk_2d_8 , wrk_2d_9 , wrk_2d_10 
     53   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_11, wrk_2d_12, wrk_2d_13, wrk_2d_14, wrk_2d_15 
     54   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_16, wrk_2d_17, wrk_2d_18, wrk_2d_19, wrk_2d_20 
     55   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_21, wrk_2d_22, wrk_2d_23, wrk_2d_24, wrk_2d_25 
     56   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_26, wrk_2d_27, wrk_2d_28, wrk_2d_29, wrk_2d_30 
     57   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_31, wrk_2d_32, wrk_2d_33, wrk_2d_34, wrk_2d_35 
     58 
     59   !                                                                    !!**  2D, x-z, REAL(wp) workspaces  ** 
     60   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)            , PUBLIC ::   wrk_xz_1, wrk_xz_2, wrk_xz_3, wrk_xz_4  
     61    
     62   !                                                                    !!**  3D, x-y-z, REAL(wp) workspaces  ** 
     63   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   wrk_3d_1 , wrk_3d_2 , wrk_3d_3 , wrk_3d_4 , wrk_3d_5 
     64   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   wrk_3d_6 , wrk_3d_7 , wrk_3d_8 , wrk_3d_9 , wrk_3d_10 
     65   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   wrk_3d_11, wrk_3d_12, wrk_3d_13, wrk_3d_14, wrk_3d_15 
     66 
     67   !                                                                    !!**  4D, x-y-z-tra, REAL(wp) workspaces  ** 
     68   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:), TARGET, PUBLIC ::   wrk_4d_1, wrk_4d_2, wrk_4d_3, wrk_4d_4  
     69 
     70 
     71   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)            , PUBLIC ::   llwrk_2d_1, llwrk_2d_2, llwrk_2d_3 !: 2D logical workspace 
     72   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   llwrk_3d_1 !: 3D logical workspace 
     73   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)            , PUBLIC ::   iwrk_2d_1 !: 2D integer workspace 
     74 
     75   LOGICAL, DIMENSION(num_1d_wrkspaces)  :: in_use_1d     !: Flags to track which 1D workspace arrays are in use   
     76   LOGICAL, DIMENSION(num_2d_wrkspaces)  :: in_use_2d     !: Flags to track which 2D workspace arrays are in use 
     77   LOGICAL, DIMENSION(num_3d_wrkspaces)  :: in_use_3d     !: Flags to track which 3D workspace arrays are in use 
     78   LOGICAL, DIMENSION(num_4d_wrkspaces)  :: in_use_4d     !: Flags to track which 4D workspace arrays are in use 
     79   LOGICAL, DIMENSION(num_xz_wrkspaces)  :: in_use_xz     !: Flags to track which 2D, xz workspace arrays are in use 
     80   LOGICAL, DIMENSION(num_2d_lwrkspaces) :: in_use_2dll   !: Flags to track which 2D, logical workspace arrays are in use 
     81   LOGICAL, DIMENSION(num_3d_lwrkspaces) :: in_use_3dll   !: Flags to track which 3D, logical workspace arrays are in use 
     82   LOGICAL, DIMENSION(num_2d_iwrkspaces) :: in_use_2di    !: Flags to track which 2D, integer workspace arrays are in use 
    12983 
    13084   ! Labels for specifying workspace type in call to print_in_use_list() 
     
    13488 
    13589   !!---------------------------------------------------------------------- 
    136    !! NEMO/OPA 4.0 , NEMO Consortium (2010) 
     90   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    13791   !! $Id$ 
    13892   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    14094CONTAINS 
    14195 
    142  
    14396  FUNCTION wrk_alloc() 
    14497      !!---------------------------------------------------------------------- 
    145       !!                   ***  ROUTINE wrk_alloc  *** 
     98      !!                   ***  FUNCTION wrk_alloc  *** 
    14699      !! 
    147100      !! ** Purpose :   Define in memory once for all the NEMO 2D, 3D and 4d  
     
    153106      !!---------------------------------------------------------------------- 
    154107      ! 
    155       ! Extent to use for 1D work arrays - find the maximum product of 
    156       ! jpi*jpj, jpi*jpk and jpj*jpk and use that 
    157       IF(jpi < jpj .AND. jpi < jpk)THEN 
    158          extent_1d = jpj*jpk 
    159       ELSE IF(jpj < jpi .AND. jpj < jpk)THEN 
    160          extent_1d = jpi*jpk 
    161       ELSE 
    162          extent_1d = jpi*jpj 
     108      ! Extent to use for 1D work arrays - find the maximum product of jpi*jpj, jpi*jpk and jpj*jpk and use that 
     109      IF    ( jpi < jpj .AND. jpi < jpk ) THEN   ;   extent_1d = jpj*jpk 
     110      ELSEIF( jpj < jpi .AND. jpj < jpk ) THEN   ;   extent_1d = jpi*jpk 
     111      ELSE                                       ;   extent_1d = jpi*jpj 
    163112      END IF 
    164113      ! 
    165114      ! Initialise the 'in use' flags for each work-space array 
    166       in_use_1d(:) = .FALSE. 
    167  
    168       in_use_2d(:) = .FALSE. 
    169  
    170       in_use_3d(:) = .FALSE. 
    171  
    172       in_use_4d(:) = .FALSE. 
    173  
    174       in_use_xz(:) = .FALSE. 
    175  
     115      in_use_1d  (:) = .FALSE. 
     116      in_use_2d  (:) = .FALSE. 
     117      in_use_3d  (:) = .FALSE. 
     118      in_use_4d  (:) = .FALSE. 
     119      in_use_xz  (:) = .FALSE. 
    176120      in_use_2dll(:) = .FALSE. 
    177  
    178121      in_use_3dll(:) = .FALSE. 
    179  
    180       in_use_2di(:) = .FALSE. 
    181  
     122      in_use_2di (:) = .FALSE. 
     123       
    182124      ierror(:) = 0 
    183125 
    184       ALLOCATE(wrk_1d_1(extent_1d)        , wrk_1d_2(extent_1d)       ,  & 
    185                wrk_1d_3(extent_1d)        , wrk_1d_4(extent_1d)       ,  & 
    186                wrk_1d_5(extent_1d)        , wrk_1d_6(extent_1d)       ,  & 
    187                wrk_1d_7(extent_1d)        , wrk_1d_8(extent_1d)       ,  & 
    188                wrk_1d_9(extent_1d)        , wrk_1d_10(extent_1d)      ,  & 
    189                wrk_1d_11(extent_1d)       , wrk_1d_12(extent_1d)      ,  & 
    190                wrk_1d_13(extent_1d)       , wrk_1d_14(extent_1d)      ,  & 
    191                wrk_1d_15(extent_1d)       , wrk_1d_16(extent_1d)      ,  & 
    192                wrk_1d_17(extent_1d)       , wrk_1d_18(extent_1d)      ,  & 
    193                wrk_1d_19(extent_1d)       , wrk_1d_20(extent_1d)      ,  & 
    194                wrk_1d_21(extent_1d)       , wrk_1d_22(extent_1d)      ,  & 
    195                wrk_1d_23(extent_1d)       , wrk_1d_24(extent_1d)      ,  & 
    196                wrk_1d_25(extent_1d)       , wrk_1d_26(extent_1d)      ,  & 
    197                wrk_1d_27(extent_1d)       , Stat=ierror(1)) 
    198       ! 
    199       ALLOCATE(wrk_2d_1(jpi,jpj)          , wrk_2d_2(jpi,jpj)         ,  & 
    200                wrk_2d_3(jpi,jpj)          , wrk_2d_4(jpi,jpj)         ,  &  
    201                wrk_2d_5(jpi,jpj)          , wrk_2d_6(jpi,jpj)         ,  & 
    202                wrk_2d_7(jpi,jpj)          , wrk_2d_8(jpi,jpj)         ,  & 
    203                wrk_2d_9(jpi,jpj)          , wrk_2d_10(jpi,jpj)        ,  & 
    204                wrk_2d_11(jpi,jpj)         , wrk_2d_12(jpi,jpj)        ,  & 
    205                wrk_2d_13(jpi,jpj)         , wrk_2d_14(jpi,jpj)        ,  & 
    206                wrk_2d_15(jpi,jpj)         , wrk_2d_16(jpi,jpj)        ,  & 
    207                wrk_2d_17(jpi,jpj)         , wrk_2d_18(jpi,jpj)        ,  & 
    208                wrk_2d_19(jpi,jpj)         , wrk_2d_20(jpi,jpj)        ,  & 
    209                wrk_2d_21(jpi,jpj)         , wrk_2d_22(jpi,jpj)        ,  & 
    210                wrk_2d_23(jpi,jpj)         , wrk_2d_24(jpi,jpj)        ,  & 
    211                wrk_2d_25(jpi,jpj)         , wrk_2d_26(jpi,jpj)        ,  & 
    212                wrk_2d_27(jpi,jpj)         , wrk_2d_28(jpi,jpj)        ,  & 
    213                wrk_2d_29(jpi,jpj)         , wrk_2d_30(jpi,jpj)        ,  & 
    214                wrk_2d_31(jpi,jpj)         , wrk_2d_32(jpi,jpj)        ,  & 
    215                wrk_2d_33(jpi,jpj)         , wrk_2d_34(jpi,jpj)        ,  & 
    216                wrk_2d_35(jpi,jpj)         , Stat=ierror(2)) 
    217       ! 
    218       ALLOCATE(wrk_3d_1(jpi,jpj,jpk)      , wrk_3d_2(jpi,jpj,jpk)     ,  & 
    219                wrk_3d_3(jpi,jpj,jpk)      , wrk_3d_4(jpi,jpj,jpk)     ,  & 
    220                wrk_3d_5(jpi,jpj,jpk)      , wrk_3d_6(jpi,jpj,jpk)     ,  & 
    221                wrk_3d_7(jpi,jpj,jpk)      , wrk_3d_8(jpi,jpj,jpk)     ,  & 
    222                wrk_3d_9(jpi,jpj,jpk)      , wrk_3d_10(jpi,jpj,jpk)    ,  &  
    223                wrk_3d_11(jpi,jpj,jpk)     , wrk_3d_12(jpi,jpj,jpk)    ,  &  
    224                wrk_3d_13(jpi,jpj,jpk)     , wrk_3d_14(jpi,jpj,jpk)    ,  &  
    225                wrk_3d_15(jpi,jpj,jpk)     , Stat=ierror(3)) 
    226       ! 
    227       ALLOCATE(wrk_4d_1(jpi,jpj,jpk,jpts) , wrk_4d_2(jpi,jpj,jpk,jpts),  & 
    228                wrk_4d_3(jpi,jpj,jpk,jpts) , wrk_4d_4(jpi,jpj,jpk,jpts),  & 
    229                Stat=ierror(4) ) 
    230       ! 
    231       ALLOCATE(wrk_xz_1(jpi,jpk)          , wrk_xz_2(jpi,jpk),           & 
    232                wrk_xz_3(jpi,jpk)          , wrk_xz_4(jpi,jpk),           & 
    233                Stat=ierror(5)) 
    234       ! 
    235       ALLOCATE(llwrk_2d_1(jpi,jpj)        , llwrk_2d_2(jpi,jpj),         & 
    236                llwrk_2d_3(jpi,jpj)        , Stat=ierror(6)) 
    237       ! 
    238       ALLOCATE(llwrk_3d_1(jpi,jpj,jpk)    , Stat=ierror(7)) 
    239       ! 
    240       ALLOCATE(iwrk_2d_1(jpi,jpj)         , Stat=ierror(8)) 
    241       ! 
    242       wrk_alloc = MAXVAL(ierror) 
     126      ALLOCATE( wrk_1d_1 (extent_1d) , wrk_1d_2 (extent_1d) , wrk_1d_3 (extent_1d) , wrk_1d_4 (extent_1d) ,     & 
     127         &      wrk_1d_5 (extent_1d) , wrk_1d_6 (extent_1d) , wrk_1d_7 (extent_1d) , wrk_1d_8 (extent_1d) ,     & 
     128         &      wrk_1d_9 (extent_1d) , wrk_1d_10(extent_1d)                                               ,     & 
     129         &      wrk_1d_11(extent_1d) , wrk_1d_12(extent_1d) , wrk_1d_13(extent_1d) , wrk_1d_14(extent_1d) ,     & 
     130         &      wrk_1d_15(extent_1d) , wrk_1d_16(extent_1d) , wrk_1d_17(extent_1d) , wrk_1d_18(extent_1d) ,     & 
     131         &      wrk_1d_19(extent_1d) , wrk_1d_20(extent_1d)                                               ,     & 
     132         &      wrk_1d_21(extent_1d) , wrk_1d_22(extent_1d) , wrk_1d_23(extent_1d) , wrk_1d_24(extent_1d) ,     & 
     133         &      wrk_1d_25(extent_1d) , wrk_1d_26(extent_1d) , wrk_1d_27(extent_1d)                        , STAT=ierror(1) ) 
     134      ! 
     135      ALLOCATE( wrk_2d_1 (jpi,jpj) , wrk_2d_2 (jpi,jpj) , wrk_2d_3 (jpi,jpj) , wrk_2d_4 (jpi,jpj) ,     &  
     136         &      wrk_2d_5 (jpi,jpj) , wrk_2d_6 (jpi,jpj) , wrk_2d_7 (jpi,jpj) , wrk_2d_8 (jpi,jpj) ,     & 
     137         &      wrk_2d_9 (jpi,jpj) , wrk_2d_10(jpi,jpj)                                           ,     & 
     138         &      wrk_2d_11(jpi,jpj) , wrk_2d_12(jpi,jpj) , wrk_2d_13(jpi,jpj) , wrk_2d_14(jpi,jpj) ,     & 
     139         &      wrk_2d_15(jpi,jpj) , wrk_2d_16(jpi,jpj) , wrk_2d_17(jpi,jpj) , wrk_2d_18(jpi,jpj) ,     & 
     140         &      wrk_2d_19(jpi,jpj) , wrk_2d_20(jpi,jpj)                                           ,     & 
     141         &      wrk_2d_21(jpi,jpj) , wrk_2d_22(jpi,jpj) , wrk_2d_23(jpi,jpj) , wrk_2d_24(jpi,jpj) ,     & 
     142         &      wrk_2d_25(jpi,jpj) , wrk_2d_26(jpi,jpj) , wrk_2d_27(jpi,jpj) , wrk_2d_28(jpi,jpj) ,     & 
     143         &      wrk_2d_29(jpi,jpj) , wrk_2d_30(jpi,jpj)                                           ,     & 
     144         &      wrk_2d_31(jpi,jpj) , wrk_2d_32(jpi,jpj) , wrk_2d_33(jpi,jpj) , wrk_2d_34(jpi,jpj) ,     & 
     145         &      wrk_2d_35(jpi,jpj)                                                                , STAT=ierror(2) ) 
     146      ! 
     147      ALLOCATE( wrk_3d_1 (jpi,jpj,jpk) , wrk_3d_2 (jpi,jpj,jpk) , wrk_3d_3 (jpi,jpj,jpk) , wrk_3d_4 (jpi,jpj,jpk) ,     & 
     148         &      wrk_3d_5 (jpi,jpj,jpk) , wrk_3d_6 (jpi,jpj,jpk) , wrk_3d_7 (jpi,jpj,jpk) , wrk_3d_8 (jpi,jpj,jpk) ,     & 
     149         &      wrk_3d_9 (jpi,jpj,jpk) , wrk_3d_10(jpi,jpj,jpk)                                                   ,     &  
     150         &      wrk_3d_11(jpi,jpj,jpk) , wrk_3d_12(jpi,jpj,jpk) , wrk_3d_13(jpi,jpj,jpk) , wrk_3d_14(jpi,jpj,jpk) ,     &  
     151         &      wrk_3d_15(jpi,jpj,jpk)                                                                            , STAT=ierror(3) ) 
     152      ! 
     153      ALLOCATE( wrk_4d_1(jpi,jpj,jpk,jpts) , wrk_4d_2(jpi,jpj,jpk,jpts),     & 
     154         &      wrk_4d_3(jpi,jpj,jpk,jpts) , wrk_4d_4(jpi,jpj,jpk,jpts), STAT=ierror(4) ) 
     155      ! 
     156      ALLOCATE( wrk_xz_1(jpi,jpk) , wrk_xz_2(jpi,jpk) , wrk_xz_3(jpi,jpk) , wrk_xz_4(jpi,jpk) , STAT=ierror(5) ) 
     157      ! 
     158      ALLOCATE( llwrk_2d_1(jpi,jpj) , llwrk_2d_2(jpi,jpj) , llwrk_2d_3(jpi,jpj)               , STAT=ierror(6) ) 
     159      ! 
     160      ALLOCATE( llwrk_3d_1(jpi,jpj,jpk) , STAT=ierror(7) ) 
     161      ! 
     162      ALLOCATE( iwrk_2d_1(jpi,jpj)      , STAT=ierror(8) ) 
     163      ! 
     164      wrk_alloc = MAXVAL( ierror ) 
    243165 
    244166      ! Calling routine, nemo_alloc(), checks for errors and takes  
    245167      ! appropriate action - we just print a warning message 
    246       IF(wrk_alloc /= 0)THEN 
    247          CALL ctl_warn('wrk_alloc: allocation of workspace arrays failed') 
    248       END IF 
    249  
     168      IF( wrk_alloc /= 0 )   CALL ctl_warn('wrk_alloc: allocation of workspace arrays failed') 
     169      ! 
    250170   END FUNCTION wrk_alloc 
    251171 
    252172 
    253    FUNCTION wrk_use(ndim,    index1,  index2,  index3,  index4,  & 
    254                     index5,  index6,  index7,  index8,  index9,  & 
    255                     index10, index11, index12, index13, index14, & 
    256                     index15, index16, index17, index18, index19, & 
    257                     index20, index21, index22, index23, index24, & 
    258                     index25, index26, index27) 
    259       !!---------------------------------------------------------------------- 
    260       !!                   ***  ROUTINE wrk_use  *** 
     173   FUNCTION wrk_use( kdim,    index1,  index2,  index3,  index4,    & 
     174      &              index5,  index6,  index7,  index8,  index9,    & 
     175      &              index10, index11, index12, index13, index14,  & 
     176      &              index15, index16, index17, index18, index19,  & 
     177      &              index20, index21, index22, index23, index24,  & 
     178      &              index25, index26, index27) 
     179      !!---------------------------------------------------------------------- 
     180      !!                   ***  FUNCTION wrk_use  *** 
    261181      !! 
    262182      !! ** Purpose :   Request a set of KIND(wp) workspaces to use. Returns  
    263       !!                .TRUE. if all those requested are available, .FALSE.  
    264       !!                otherwise.  
    265       !! 
    266       !! ** Method  :   Sets 
    267       !!                internal flags to signal that requested workspaces 
    268       !!                are in use. 
    269       !!---------------------------------------------------------------------- 
    270       IMPLICIT none 
    271       LOGICAL             :: wrk_use     ! Return value 
    272       INTEGER, INTENT(in) :: ndim        ! Dimensionality of requested workspace(s) 
    273       INTEGER, INTENT(in) :: index1      ! Index of first requested workspace 
    274       INTEGER, OPTIONAL, INTENT(in) :: index2, index3,   index4,  index5,  & 
    275                                        index6, index7,   index8,  index9,  & 
    276                                        index10, index11, index12, index13, & 
    277                                        index14, index15, index16, index17, & 
    278                                        index18, index19, index20, index21, & 
    279                                        index22, index23, index24, index25, & 
    280                                        index26, index27 
    281       ! Local variables 
    282       INTEGER :: iarg, iptr 
     183      !!                .TRUE. if all those requested are available, .FALSE. otherwise.  
     184      !! 
     185      !! ** Method  :   Sets internal flags to signal that requested workspaces are in use. 
     186      !!---------------------------------------------------------------------- 
     187      INTEGER, INTENT(in) ::   kdim        ! Dimensionality of requested workspace(s) 
     188      INTEGER, INTENT(in) ::   index1      ! Index of first requested workspace 
     189      INTEGER, OPTIONAL, INTENT(in) ::            index2 , index3 , index4 , index5 , index6 , index7 , index8 , index9, index10 
     190      INTEGER, OPTIONAL, INTENT(in) ::   index11, index12, index13, index14, index15, index16, index17, index18, index19, index20 
     191      INTEGER, OPTIONAL, INTENT(in) ::   index21, index22, index23, index24, index25, index26, index27 
     192      ! 
     193      LOGICAL ::   wrk_use      ! Return value 
     194      INTEGER ::   iarg, iptr   ! local integer 
    283195      !!---------------------------------------------------------------------- 
    284196 
    285197      wrk_use = .TRUE. 
    286  
    287       iptr = index1 
    288       iarg = 1 
    289       DO WHILE(wrk_use .AND. iarg <= max_num_wrkspaces) 
    290  
    291          IF(ndim == 1)THEN 
    292  
    293             IF(iptr > num_1d_wrkspaces)THEN 
     198      iptr    = index1 
     199      iarg    = 1 
     200       
     201      DO WHILE( wrk_use .AND. iarg <= max_num_wrkspaces ) 
     202         ! 
     203         IF( kdim == 1 ) THEN 
     204            IF( iptr > num_1d_wrkspaces ) THEN 
    294205               CALL ctl_stop('wrk_use - more 1D workspace arrays requested than defined in wrk_nemo module') 
    295206               wrk_use = .FALSE. 
    296207               EXIT 
    297             ELSE IF( in_use_1d(iptr) )THEN 
     208            ELSEIF( in_use_1d(iptr) ) THEN 
    298209               wrk_use = .FALSE. 
    299210               CALL print_in_use_list(1, REAL_TYPE, in_use_1d) 
    300             END IF 
    301  
     211            ENDIF 
    302212            in_use_1d(iptr) = .TRUE. 
    303  
    304          ELSE IF(ndim == 2)THEN 
    305  
    306             IF(iptr > num_2d_wrkspaces)THEN 
     213            ! 
     214         ELSEIF( kdim == 2 ) THEN 
     215            IF( iptr > num_2d_wrkspaces ) THEN 
    307216               CALL ctl_stop('wrk_use - more 2D workspace arrays requested than defined in wrk_nemo module') 
    308217               wrk_use = .FALSE. 
    309218               EXIT 
    310             ELSE IF( in_use_2d(iptr) )THEN 
     219            ELSEIF( in_use_2d(iptr) ) THEN 
    311220               wrk_use = .FALSE. 
    312221               CALL print_in_use_list(2, REAL_TYPE, in_use_2d) 
    313             END IF 
    314  
     222            ENDIF 
    315223            in_use_2d(iptr) = .TRUE. 
    316  
    317          ELSE IF (ndim == 3)THEN 
    318  
    319             IF(iptr > num_3d_wrkspaces)THEN 
    320                CALL ctl_stop('wrk_use - more 3D workspace arrays requested than defined in wrk_nemo module') 
     224            ! 
     225         ELSEIF( kdim == 3 ) THEN 
     226            IF( iptr > num_3d_wrkspaces ) THEN 
     227               CALL ctl_stop( 'wrk_use - more 3D workspace arrays requested than defined in wrk_nemo module' ) 
    321228               wrk_use = .FALSE. 
    322229               EXIT 
    323             ELSE IF( in_use_3d(iptr) )THEN 
     230            ELSEIF( in_use_3d(iptr) ) THEN 
    324231               wrk_use = .FALSE. 
    325232               CALL print_in_use_list(3, REAL_TYPE, in_use_3d) 
    326             END IF 
    327  
     233            ENDIF 
    328234            in_use_3d(iptr) = .TRUE. 
    329  
    330          ELSE IF (ndim == 4) THEN 
    331  
     235            ! 
     236         ELSEIF( kdim == 4 ) THEN 
    332237            IF(iptr > num_4d_wrkspaces)THEN 
    333                CALL ctl_stop('wrk_use - more 4D workspace arrays requested than defined in wrk_nemo module') 
     238               CALL ctl_stop( 'wrk_use - more 4D workspace arrays requested than defined in wrk_nemo module' ) 
    334239               wrk_use = .FALSE. 
    335240               EXIT 
    336             ELSE IF( in_use_4d(iptr) )THEN 
     241            ELSEIF( in_use_4d(iptr) ) THEN 
    337242               wrk_use = .FALSE. 
    338                CALL print_in_use_list(4, REAL_TYPE, in_use_4d) 
    339             END IF 
    340  
     243               CALL print_in_use_list( 4, REAL_TYPE, in_use_4d ) 
     244            ENDIF 
     245            ! 
    341246            in_use_4d(iptr) = .TRUE. 
    342  
     247            ! 
    343248         ELSE  
    344             IF(lwp) WRITE(numout,*) 'wrk_use: unsupported value of ndim = ',ndim 
    345             CALL ctl_stop('wrk_use: unrecognised value for number of dimensions') 
     249            IF(lwp) WRITE(numout,*) 'wrk_use: unsupported value of kdim = ',kdim 
     250            CALL ctl_stop( 'wrk_use: unrecognised value for number of dimensions' ) 
    346251         END IF 
    347252 
    348          CALL get_next_arg(iarg  ,  iptr  ,  index2,  index3,  index4,  & 
    349                            index5,  index6,  index7,  index8,  index9,  & 
    350                            index10, index11, index12, index13, index14, & 
    351                            index15, index16, index17, index18, index19, & 
    352                            index20, index21, index22, index23, index24, & 
    353                            index25, index26, index27) 
    354  
    355          IF(iarg == -1)THEN 
    356             ! We've checked all of the arguments and are done 
    357             EXIT 
    358          ELSE IF(iarg == -99)THEN 
    359             CALL ctl_stop('wrk_use - ERROR, caught unexpected argument count - BUG') 
     253         CALL get_next_arg( iarg  ,  iptr  ,  index2,  index3,  index4,    & 
     254            &               index5,  index6,  index7,  index8,  index9,    & 
     255            &               index10, index11, index12, index13, index14,   & 
     256            &               index15, index16, index17, index18, index19,   & 
     257            &               index20, index21, index22, index23, index24,   & 
     258            &               index25, index26, index27) 
     259 
     260         IF( iarg == -1 ) THEN      ! We've checked all of the arguments and are done 
     261            EXIT 
     262         ELSEIF( iarg == -99 ) THEN 
     263            CALL ctl_stop( 'wrk_use - ERROR, caught unexpected argument count - BUG' ) 
    360264            EXIT 
    361265         END IF 
    362  
     266         ! 
    363267      END DO ! end of DO WHILE() 
    364  
     268      ! 
    365269    END FUNCTION wrk_use 
    366270 
    367271 
    368     FUNCTION llwrk_use(ndim,   index1, index2, index3, index4, & 
    369                        index5, index6, index7, index8, index9) 
    370       !!---------------------------------------------------------------------- 
    371       !!                   ***  ROUTINE llwrk_use  *** 
     272   FUNCTION llwrk_use( kdim,   index1, index2, index3, index4,  & 
     273      &                index5, index6, index7, index8, index9) 
     274      !!---------------------------------------------------------------------- 
     275      !!                   ***  FUNCTION llwrk_use  *** 
    372276      !! 
    373277      !! ** Purpose :   Request a set of LOGICAL workspaces to use. Returns  
    374       !!                .TRUE. if all those requested are available, .FALSE.  
    375       !!                otherwise.  
    376       !! 
    377       !! ** Method  :   Sets 
    378       !!                internal flags to signal that requested workspaces 
    379       !!                are in use. 
    380       !!---------------------------------------------------------------------- 
    381       LOGICAL             :: llwrk_use     ! Return value 
    382       INTEGER, INTENT(in) :: ndim        ! Dimensionality of requested workspace(s) 
    383       INTEGER, INTENT(in) :: index1      ! Index of first requested workspace 
    384       INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, & 
    385                                        index6, index7, index8, index9 
    386       ! Local variables 
    387       INTEGER :: iarg, iptr 
    388       !!---------------------------------------------------------------------- 
    389  
     278      !!                .TRUE. if all those requested are available, .FALSE. otherwise.  
     279      !! 
     280      !! ** Method  :   Sets internal flags to signal that requested workspaces are in use. 
     281      !!---------------------------------------------------------------------- 
     282      INTEGER, INTENT(in) ::   kdim     ! Dimensionality of requested workspace(s) 
     283      INTEGER, INTENT(in) ::   index1   ! Index of first requested workspace 
     284      INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, index6, index7, index8, index9 
     285      ! 
     286      LOGICAL ::   llwrk_use     ! Return value 
     287      INTEGER ::   iarg, iptr    ! local integers 
     288      !!---------------------------------------------------------------------- 
     289      ! 
    390290      llwrk_use = .TRUE. 
    391  
    392       iptr = index1 
    393       iarg = 1 
    394       DO WHILE(llwrk_use .AND. iarg <= max_num_wrkspaces) 
    395  
    396          IF(ndim == 2)THEN 
    397  
     291      iptr      = index1 
     292      iarg      = 1 
     293      ! 
     294      DO WHILE( llwrk_use .AND. iarg <= max_num_wrkspaces ) 
     295         ! 
     296         IF( kdim == 2 ) THEN 
    398297            IF(iptr > num_2d_lwrkspaces)THEN 
    399298               CALL ctl_stop('llwrk_use - more 2D workspace arrays requested than defined in wrk_nemo module') 
     
    404303               CALL print_in_use_list(2, REAL_TYPE, in_use_2d) 
    405304            END IF 
    406  
    407305            in_use_2dll(iptr) = .TRUE. 
    408  
    409          ELSE IF (ndim == 3)THEN 
    410  
     306            ! 
     307         ELSE IF (kdim == 3)THEN 
     308            ! 
    411309            IF(iptr > num_3d_lwrkspaces)THEN 
    412310               CALL ctl_stop('llwrk_use - more 3D workspace arrays requested than defined in wrk_nemo module') 
     
    417315               CALL print_in_use_list(3, REAL_TYPE, in_use_3d) 
    418316            END IF 
    419  
     317            ! 
    420318            in_use_3dll(iptr) = .TRUE. 
    421319         ELSE  
    422             IF(lwp) WRITE(numout,*) 'llwrk_use: unsupported value of ndim = ',ndim 
     320            IF(lwp) WRITE(numout,*) 'llwrk_use: unsupported value of kdim = ',kdim 
    423321            CALL ctl_stop('llwrk_use: unrecognised value for number of dimensions') 
    424322         END IF 
    425323 
    426          CALL get_next_arg(iarg  , iptr  , index2, index3, index4, & 
    427                            index5, index6, index7, index8, index9) 
    428  
    429          IF(iarg == -1)THEN 
    430             ! We've checked all of the arguments and are done 
    431             EXIT 
    432          ELSE IF(iarg == -99)THEN 
    433             CALL ctl_stop('llwrk_use - ERROR, caught unexpected argument count - BUG') 
    434             EXIT 
    435          END IF 
    436  
     324         CALL get_next_arg( iarg  , iptr  , index2, index3, index4, & 
     325            &               index5, index6, index7, index8, index9) 
     326 
     327         IF( iarg == -1 ) THEN      ! We've checked all of the arguments and are done 
     328            EXIT 
     329         ELSEIF( iarg == -99 ) THEN 
     330            CALL ctl_stop( 'llwrk_use - ERROR, caught unexpected argument count - BUG' ) 
     331            EXIT 
     332         ENDIF 
     333         ! 
    437334      END DO ! while(llwrk_use .AND. iarg <= max_num_wrkspaces) 
    438  
    439     END FUNCTION llwrk_use 
    440  
    441  
    442     FUNCTION iwrk_use(ndim,   index1, index2, index3, index4, & 
    443                       index5, index6, index7) 
    444       !!---------------------------------------------------------------------- 
    445       !!                   ***  ROUTINE iwrk_use  *** 
     335      ! 
     336   END FUNCTION llwrk_use 
     337 
     338 
     339   FUNCTION iwrk_use( kdim, index1, index2, index3, index4,  & 
     340      &                     index5, index6, index7 ) 
     341      !!---------------------------------------------------------------------- 
     342      !!                   ***  FUNCTION iwrk_use  *** 
    446343      !! 
    447344      !! ** Purpose :   Request a set of INTEGER workspaces to use. Returns  
    448       !!                .TRUE. if all those requested are available, .FALSE.  
    449       !!                otherwise.  
    450       !! 
    451       !! ** Method  :   Sets 
    452       !!                internal flags to signal that requested workspaces 
    453       !!                are in use. 
    454       !!---------------------------------------------------------------------- 
     345      !!                .TRUE. if all those requested are available, .FALSE. otherwise.  
     346      !! 
     347      !! ** Method  :   Sets internal flags to signal that requested workspaces are in use. 
     348      !!---------------------------------------------------------------------- 
     349      INTEGER          , INTENT(in) :: kdim        ! Dimensionality of requested workspace(s) 
     350      INTEGER          , INTENT(in) :: index1      ! Index of first requested workspace 
     351      INTEGER, OPTIONAL, INTENT(in) ::   index2, index3, index4, index5, index6, index7 
     352      ! 
    455353      LOGICAL             :: iwrk_use    ! Return value 
    456       INTEGER, INTENT(in) :: ndim        ! Dimensionality of requested workspace(s) 
    457       INTEGER, INTENT(in) :: index1      ! Index of first requested workspace 
    458       INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, & 
    459                                        index6, index7 
    460       ! Local variables 
    461354      INTEGER :: iarg, iptr 
    462355      !!---------------------------------------------------------------------- 
    463356 
    464357      iwrk_use = .TRUE. 
    465  
    466       iptr = index1 
    467       iarg = 1 
    468       DO WHILE(iwrk_use .AND. iarg <= max_num_wrkspaces) 
    469  
    470          IF(ndim == 2)THEN 
    471  
    472             IF(iptr > num_2d_wrkspaces)THEN 
    473                CALL ctl_stop('wrk_use - more 2D workspace arrays requested than defined in wrk_nemo module') 
     358      iptr     = index1 
     359      iarg     = 1 
     360       
     361      DO WHILE( iwrk_use .AND. iarg <= max_num_wrkspaces ) 
     362         ! 
     363         IF( kdim == 2 ) THEN 
     364            IF( iptr > num_2d_wrkspaces ) THEN 
     365               CALL ctl_stop( 'wrk_use - more 2D workspace arrays requested than defined in wrk_nemo module' ) 
    474366               iwrk_use = .FALSE. 
    475             ELSE IF( in_use_2di(iptr) )THEN 
     367            ELSEIF( in_use_2di(iptr) ) THEN 
    476368               iwrk_use = .FALSE. 
    477                CALL print_in_use_list(2, INTEGER_TYPE, in_use_2di) 
    478             END IF 
    479  
     369               CALL print_in_use_list( 2, INTEGER_TYPE, in_use_2di ) 
     370            END IF 
    480371            in_use_2di(iptr) = .TRUE. 
    481  
     372            ! 
    482373         ELSE 
    483             IF(lwp) WRITE(numout,*) 'iwrk_use: unsupported value of ndim = ',ndim 
     374            IF(lwp) WRITE(numout,*) 'iwrk_use: unsupported value of kdim = ',kdim 
    484375            CALL ctl_stop('iwrk_use: unsupported value for number of dimensions') 
    485376         END IF 
     
    488379         SELECT CASE (iarg) 
    489380         CASE ( 1 ) 
    490             IF(.not. PRESENT(index2))THEN 
    491                EXIT 
    492             ELSE 
    493                iarg = 2 
    494                iptr = index2 
     381            IF( .NOT. PRESENT(index2) ) THEN   ;   EXIT 
     382            ELSE                               ;   iarg = 2   ;   iptr = index2 
    495383            END IF 
    496384         CASE ( 2 ) 
    497             IF(.not. PRESENT(index3))THEN 
    498                EXIT 
    499             ELSE 
    500                iarg = 3 
    501                iptr = index3 
     385            IF( .NOT. PRESENT(index3) ) THEN   ;   EXIT 
     386            ELSE                               ;   iarg = 3   ;   iptr = index3 
    502387            END IF 
    503388         CASE ( 3 ) 
    504             IF(.not. PRESENT(index4))THEN 
    505                EXIT 
    506             ELSE 
    507                iarg = 4 
    508                iptr = index4 
     389            IF( .NOT. PRESENT(index4) ) THEN   ;   EXIT 
     390            ELSE                               ;   iarg = 4   ;   iptr = index4 
    509391            END IF 
    510392         CASE ( 4 ) 
    511             IF(.not. PRESENT(index5))THEN 
    512                EXIT 
    513             ELSE 
    514                iarg = 5 
    515                iptr = index5 
     393            IF( .NOT. PRESENT(index5) ) THEN   ;   EXIT 
     394            ELSE                               ;   iarg = 5   ;   iptr = index5 
    516395            END IF 
    517396         CASE ( 5 ) 
    518             IF(.not. PRESENT(index6))THEN 
    519                EXIT 
    520             ELSE 
    521                iarg = 6 
    522                iptr = index6 
     397            IF( .NOT. PRESENT(index6) ) THEN   ;   EXIT 
     398            ELSE                               ;   iarg = 6   ;   iptr = index6 
    523399            END IF 
    524400         CASE ( 6 ) 
    525             IF(.not. PRESENT(index7))THEN 
    526                EXIT 
    527             ELSE 
    528                iarg = 7 
    529                iptr = index7 
     401            IF( .NOT. PRESENT(index7) ) THEN   ;   EXIT 
     402            ELSE                               ;   iarg = 7   ;   iptr = index7 
    530403            END IF 
    531404         CASE ( 7 ) 
    532405            EXIT 
    533406         CASE DEFAULT 
    534             CALL ctl_stop('iwrk_use - ERROR, caught unexpected argument count - BUG') 
     407            CALL ctl_stop( 'iwrk_use - ERROR, caught unexpected argument count - BUG' ) 
    535408            EXIT 
    536409         END SELECT 
    537  
     410         ! 
    538411      END DO ! end of DO WHILE() 
    539  
     412      ! 
    540413    END FUNCTION iwrk_use 
    541414 
    542415 
    543     FUNCTION wrk_use_xz(index1, index2, index3, index4, & 
    544                         index5, index6, index7, index8, index9) 
    545       !!---------------------------------------------------------------------- 
    546       !!                   ***  ROUTINE wrk_use_xz  *** 
     416   FUNCTION wrk_use_xz( index1, index2, index3, index4,  & 
     417      &                 index5, index6, index7, index8, index9 ) 
     418      !!---------------------------------------------------------------------- 
     419      !!                   ***  FUNCTION wrk_use_xz  *** 
    547420      !! 
    548421      !! ** Purpose :   Request a set of 2D, xz (jpi,jpk) workspaces to use.  
     
    550423      !!                .FALSE. otherwise.  
    551424      !! 
    552       !! ** Method  :   Sets 
    553       !!                internal flags to signal that requested workspaces 
    554       !!                are in use. 
    555       !!---------------------------------------------------------------------- 
    556       LOGICAL             :: wrk_use_xz     ! Return value 
    557       INTEGER, INTENT(in) :: index1      ! Index of first requested workspace 
    558       INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, & 
    559                                        index6, index7, index8, index9 
     425      !! ** Method  :   Sets internal flags to signal that requested workspaces are in use. 
     426      !!---------------------------------------------------------------------- 
     427      INTEGER          , INTENT(in) :: index1      ! Index of first requested workspace 
     428      INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, index6, index7, index8, index9 
    560429      ! Local variables 
     430      LOGICAL ::   wrk_use_xz   ! Return value 
     431      INTEGER ::   iarg, iptr   ! local integer 
     432      !!---------------------------------------------------------------------- 
     433 
     434      wrk_use_xz = .TRUE. 
     435      iptr       = index1 
     436      iarg       = 1 
     437        
     438      DO WHILE( wrk_use_xz .AND. iarg <= max_num_wrkspaces ) 
     439         ! 
     440         IF(iptr > num_xz_wrkspaces)THEN 
     441            CALL ctl_stop('wrk_use_xz - more 2D xz workspace arrays requested than defined in wrk_nemo module') 
     442            wrk_use_xz = .FALSE. 
     443            EXIT 
     444         ELSE IF( in_use_xz(iptr) )THEN 
     445            wrk_use_xz = .FALSE. 
     446            CALL print_in_use_list(2, REAL_TYPE, in_use_xz) !ARPDBG - bug 
     447         END IF 
     448         ! 
     449         in_use_xz(iptr) = .TRUE. 
     450         ! 
     451         CALL get_next_arg(iarg  , iptr  , index2, index3, index4, & 
     452            &              index5, index6, index7, index8, index9) 
     453         ! 
     454         IF( iarg == -1 ) THEN      ! We've checked all of the arguments and are done 
     455            EXIT 
     456         ELSEIF( iarg == -99 ) THEN 
     457            CALL ctl_stop( 'wrk_use_xz - ERROR, caught unexpected argument count - BUG' )   ;   EXIT 
     458         END IF 
     459         ! 
     460      END DO ! while(wrk_use_xz .AND. iarg <= max_num_wrkspaces) 
     461      ! 
     462   END FUNCTION wrk_use_xz 
     463 
     464 
     465   FUNCTION wrk_release( kdim,    index1,  index2,  index3,  index4,  & 
     466      &                  index5,  index6,  index7,  index8,  index9,  & 
     467      &                  index10, index11, index12, index13, index14, & 
     468      &                  index15, index16, index17, index18, index19, & 
     469      &                  index20, index21, index22, index23, index24, & 
     470      &                  index25, index26, index27) 
     471      !!---------------------------------------------------------------------- 
     472      !!                 ***  FUNCTION wrk_release  *** 
     473      !! 
     474      !! ** Purpose :   Flag that the specified workspace arrays are no-longer in use. 
     475      !!---------------------------------------------------------------------- 
     476      LOGICAL             :: wrk_release ! Return value 
     477      INTEGER, INTENT(in) :: kdim             ! Dimensionality of workspace(s) 
     478      INTEGER, INTENT(in) :: index1           ! Index of 1st workspace to release 
     479      INTEGER, OPTIONAL, INTENT(in) ::            index2 , index3 , index4 , index5 , index6 , index7 , index8 , index9 , index10 
     480      INTEGER, OPTIONAL, INTENT(in) ::   index11, index12, index13, index14, index15, index16, index17, index18, index19, index20 
     481      INTEGER, OPTIONAL, INTENT(in) ::   index21, index22, index23, index24, index25, index26, index27 
     482      ! 
    561483      INTEGER :: iarg, iptr 
    562484      !!---------------------------------------------------------------------- 
    563485 
    564       wrk_use_xz = .TRUE. 
    565  
     486      wrk_release = .TRUE. 
    566487      iptr = index1 
    567488      iarg = 1 
    568       DO WHILE(wrk_use_xz .AND. iarg <= max_num_wrkspaces) 
    569  
    570             IF(iptr > num_xz_wrkspaces)THEN 
    571                CALL ctl_stop('wrk_use_xz - more 2D xz workspace arrays requested than defined in wrk_nemo module') 
    572                wrk_use_xz = .FALSE. 
     489 
     490      DO WHILE( iarg <= max_num_wrkspaces ) 
     491         ! 
     492         IF( kdim == 1 ) THEN 
     493            IF( iptr > num_1d_wrkspaces ) THEN 
     494               CALL ctl_stop( 'wrk_release - ERROR - attempt to release a non-existant 1D workspace array' ) 
     495               wrk_release = .FALSE. 
     496            ELSE 
     497               in_use_1d(iptr) = .FALSE. 
     498            ENDIF 
     499            ! 
     500         ELSE IF(kdim == 2)THEN 
     501            IF( iptr > num_2d_wrkspaces ) THEN 
     502               CALL ctl_stop( 'wrk_release - ERROR - attempt to release a non-existant 2D workspace array' ) 
     503               wrk_release = .FALSE. 
     504            ENDIF 
     505            in_use_2d(iptr) = .FALSE. 
     506            ! 
     507         ELSEIF( kdim == 3 ) THEN 
     508            IF( iptr > num_3d_wrkspaces ) THEN 
     509               CALL ctl_stop('wrk_release - ERROR - attempt to release a non-existant 3D workspace array') 
     510               wrk_release = .FALSE. 
     511            END IF 
     512            in_use_3d(iptr) = .FALSE. 
     513            ! 
     514          ELSEIF( kdim == 4 ) THEN 
     515            IF(iptr > num_4d_wrkspaces)THEN 
     516               CALL ctl_stop('wrk_release - ERROR - attempt to release a non-existant 4D workspace array') 
     517               wrk_release = .FALSE. 
     518            END IF 
     519            in_use_4d(iptr) = .FALSE. 
     520            ! 
     521         ELSE  
     522            IF(lwp) WRITE(numout,*) 'wrk_release: unsupported value of kdim = ',kdim 
     523            CALL ctl_stop('wrk_release: unrecognised value for number of dimensions') 
     524         ENDIF 
     525          
     526         ! Move on to next optional argument 
     527         CALL get_next_arg( iarg  ,  iptr  ,  index2,  index3,  index4,   & 
     528            &               index5,  index6,  index7,  index8,  index9,   & 
     529            &               index10, index11, index12, index13,           & 
     530            &               index14, index15, index16, index17,           & 
     531            &               index18, index19, index20, index21,           & 
     532            &               index22, index23, index24, index25,           & 
     533            &               index26, index27 ) 
     534 
     535         IF( iarg == -1 ) THEN      ! We've checked all of the arguments and are done 
     536            EXIT 
     537         ELSEIF( iarg == -99 ) THEN 
     538             CALL ctl_stop('wrk_release - caught unexpected argument count - BUG')   ;   EXIT 
     539         END IF 
     540         ! 
     541      END DO ! end of DO WHILE() 
     542      ! 
     543   END FUNCTION wrk_release 
     544 
     545 
     546   FUNCTION llwrk_release( kdim, index1, index2, index3, index4, index5,   & 
     547      &                          index6, index7, index8, index9 ) 
     548      !!---------------------------------------------------------------------- 
     549      !!                 ***  FUNCTION wrk_release  *** 
     550      !!---------------------------------------------------------------------- 
     551      INTEGER          , INTENT(in) ::   kdim             ! Dimensionality of workspace(s) 
     552      INTEGER          , INTENT(in) ::   index1           ! Index of 1st workspace to release 
     553      INTEGER, OPTIONAL, INTENT(in) ::   index2, index3, index4, index5, index6, index7, index8, index9 
     554      ! 
     555      LOGICAL ::   llwrk_release   ! Return value 
     556      INTEGER ::   iarg, iptr      ! local integer 
     557      !!---------------------------------------------------------------------- 
     558      ! 
     559      llwrk_release = .TRUE. 
     560      iptr = index1 
     561      iarg = 1 
     562      ! 
     563      DO WHILE(iarg <= max_num_wrkspaces) 
     564         ! 
     565         IF( kdim == 2 ) THEN 
     566            ! 
     567            IF( iptr > num_2d_lwrkspaces ) THEN 
     568               CALL ctl_stop( 'llwrk_release - ERROR - attempt to release a non-existant 2D workspace array' ) 
     569               llwrk_release = .FALSE. 
    573570               EXIT 
    574             ELSE IF( in_use_xz(iptr) )THEN 
    575                wrk_use_xz = .FALSE. 
    576                CALL print_in_use_list(2, REAL_TYPE, in_use_xz) !ARPDBG - bug 
    577             END IF 
    578  
    579             in_use_xz(iptr) = .TRUE. 
    580  
    581          CALL get_next_arg(iarg  , iptr  , index2, index3, index4, & 
    582                            index5, index6, index7, index8, index9) 
    583  
    584          IF(iarg == -1)THEN 
    585             ! We've checked all of the arguments and are done 
    586             EXIT 
    587          ELSE IF(iarg == -99)THEN 
    588             CALL ctl_stop('wrk_use_xz - ERROR, caught unexpected argument count - BUG') 
    589             EXIT 
     571            ENDIF 
     572            in_use_2dll(iptr) = .FALSE. 
     573            ! 
     574         ELSEIF( kdim == 3 ) THEN 
     575            IF( iptr > num_3d_lwrkspaces ) THEN 
     576               CALL ctl_stop('llwrk_release - ERROR - attempt to release a non-existant 3D workspace array') 
     577               llwrk_release = .FALSE. 
     578               EXIT 
     579            ENDIF 
     580            in_use_3dll(iptr) = .FALSE. 
     581            ! 
     582         ELSE  
     583            IF(lwp) WRITE(numout,*) 'llwrk_release: unsupported value of kdim = ', kdim 
     584            CALL ctl_stop( 'llwrk_release: unrecognised value for number of dimensions' ) 
    590585         END IF 
    591  
    592       END DO ! while(wrk_use_xz .AND. iarg <= max_num_wrkspaces) 
    593  
    594     END FUNCTION wrk_use_xz 
    595  
    596  
    597     FUNCTION wrk_release(ndim,    index1,  index2,  index3,  index4,  & 
    598                          index5,  index6,  index7,  index8,  index9,  & 
    599                          index10, index11, index12, index13, index14, & 
    600                          index15, index16, index17, index18, index19, & 
    601                          index20, index21, index22, index23, index24, & 
    602                          index25, index26, index27) 
    603        !!---------------------------------------------------------------------- 
    604        !!                 ***  ROUTINE wrk_release  *** 
    605        !! 
    606        !! ** Purpose :   Flag that the specified workspace arrays are no-longer 
    607        !!                in use. 
    608        !!---------------------------------------------------------------------- 
    609        LOGICAL             :: wrk_release ! Return value 
    610        INTEGER, INTENT(in) :: ndim             ! Dimensionality of workspace(s) 
    611        INTEGER, INTENT(in) :: index1           ! Index of 1st workspace to release 
    612        INTEGER, OPTIONAL, INTENT(in) :: index2,  index3,  index4,  index5,  & 
    613                                         index6,  index7,  index8,  index9,  & 
    614                                         index10, index11, index12, index13, & 
    615                                         index14, index15, index16, index17, & 
    616                                         index18, index19, index20, index21, & 
    617                                         index22, index23, index24, index25, & 
    618                                         index26, index27 
    619        ! Local variables 
    620        INTEGER :: iarg, iptr 
    621        !!---------------------------------------------------------------------- 
    622  
    623        wrk_release = .TRUE. 
    624        iptr = index1 
    625        iarg = 1 
    626  
    627        DO WHILE(iarg <= max_num_wrkspaces) 
    628  
    629           IF(ndim == 1)THEN 
    630  
    631              IF(iptr > num_1d_wrkspaces)THEN 
    632                 CALL ctl_stop('wrk_release - ERROR - attempt to release a non-existant 1D workspace array') 
    633                 wrk_release = .FALSE. 
    634              ELSE 
    635                 in_use_1d(iptr) = .FALSE. 
    636              END IF 
    637  
    638           ELSE IF(ndim == 2)THEN 
    639  
    640              IF(iptr > num_2d_wrkspaces)THEN 
    641                 CALL ctl_stop('wrk_release - ERROR - attempt to release a non-existant 2D workspace array') 
    642                 wrk_release = .FALSE. 
    643              END IF 
    644  
    645              in_use_2d(iptr) = .FALSE. 
    646  
    647           ELSE IF (ndim == 3)THEN 
    648  
    649              IF(iptr > num_3d_wrkspaces)THEN 
    650                 CALL ctl_stop('wrk_release - ERROR - attempt to release a non-existant 3D workspace array') 
    651                 wrk_release = .FALSE. 
    652              END IF 
    653  
    654              in_use_3d(iptr) = .FALSE. 
    655  
    656           ELSE IF (ndim == 4) THEN 
    657  
    658              IF(iptr > num_4d_wrkspaces)THEN 
    659                 CALL ctl_stop('wrk_release - ERROR - attempt to release a non-existant 4D workspace array') 
    660                 wrk_release = .FALSE. 
    661              END IF 
    662  
    663              in_use_4d(iptr) = .FALSE. 
    664  
    665           ELSE  
    666              IF(lwp) WRITE(numout,*) 'wrk_release: unsupported value of ndim = ',ndim 
    667              CALL ctl_stop('wrk_release: unrecognised value for number of dimensions') 
    668           END IF 
    669  
    670           ! Move on to next optional argument 
    671           CALL get_next_arg(iarg  ,  iptr  ,  index2,  index3,  index4, & 
    672                             index5,  index6,  index7,  index8,  index9, & 
    673                             index10, index11, index12, index13,         & 
    674                             index14, index15, index16, index17,         & 
    675                             index18, index19, index20, index21,         & 
    676                             index22, index23, index24, index25,         & 
    677                             index26, index27) 
    678  
    679           IF(iarg == -1)THEN 
    680              ! We've checked all of the arguments and are done 
     586         ! 
     587         ! Move on to next optional argument 
     588         CALL get_next_arg(iarg, iptr, index2, index3, index4,   & 
     589            &                          index5, index6, index7, index8, index9) 
     590         ! 
     591         IF( iarg == -1 ) THEN         ! We've checked all of the arguments and are done 
    681592             EXIT 
    682           ELSE IF(iarg == -99)THEN 
    683              CALL ctl_stop('wrk_release - caught unexpected argument count - BUG') 
    684              EXIT 
    685           END IF 
    686  
     593         ELSEIF( iarg == -99 ) THEN 
     594            CALL ctl_stop( 'llwrk_release - ERROR, caught unexpected argument count - BUG' )   ;   EXIT 
     595         ENDIF 
     596         ! 
     597      END DO ! while (iarg <= max_num_wrkspaces) 
     598      ! 
     599   END FUNCTION llwrk_release 
     600 
     601 
     602   FUNCTION iwrk_release( kdim, index1, index2, index3, index4,   & 
     603      &                         index5, index6, index7 ) 
     604      !!---------------------------------------------------------------------- 
     605      !!                 ***  FUNCTION iwrk_release  *** 
     606      !! 
     607      !! ** Purpose :   Flag that the specified INTEGER workspace arrays are 
     608      !!                no-longer in use. 
     609      !!---------------------------------------------------------------------- 
     610      INTEGER, INTENT(in) ::   kdim             ! Dimensionality of workspace(s) 
     611      INTEGER, INTENT(in) ::   index1           ! Index of 1st workspace to release 
     612      INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, index6, index7 
     613      ! 
     614      LOGICAL :: iwrk_release   ! Return value 
     615      INTEGER :: iarg, iptr     ! local integer 
     616      !!---------------------------------------------------------------------- 
     617      ! 
     618      iwrk_release = .TRUE. 
     619      iptr         = index1 
     620      iarg         = 1 
     621      ! 
     622      DO WHILE(iarg <= max_num_wrkspaces) 
     623         ! 
     624         IF( kdim == 2 ) THEN 
     625            IF( iptr > num_2d_iwrkspaces ) THEN 
     626               CALL ctl_stop('iwrk_release - ERROR - attempt to release a non-existant 2D workspace array') 
     627               iwrk_release = .FALSE. 
     628            ENDIF 
     629            in_use_2di(iptr) = .FALSE. 
     630         ELSE  
     631            IF(lwp) WRITE(numout,*) 'iwrk_release: unsupported value of kdim = ',kdim 
     632            CALL ctl_stop('iwrk_release: unsupported value for number of dimensions') 
     633         ENDIF 
     634         ! 
     635         ! Move on to next optional argument 
     636         SELECT CASE (iarg) 
     637         CASE ( 1 ) 
     638            IF( .NOT. PRESENT(index2) ) THEN   ;   EXIT 
     639            ELSE                               ;   iarg = 2   ;   iptr = index2 
     640            END IF 
     641         CASE ( 2 ) 
     642            IF( .NOT. PRESENT(index3) ) THEN   ;   EXIT 
     643            ELSE                               ;   iarg = 3   ;   iptr = index3 
     644            END IF 
     645         CASE ( 3 ) 
     646            IF( .NOT. PRESENT(index4) ) THEN   ;   EXIT 
     647            ELSE                               ;   iarg = 4   ;   iptr = index4 
     648            END IF 
     649         CASE ( 4 ) 
     650            IF( .NOT. PRESENT(index5) ) THEN   ;   EXIT 
     651            ELSE                               ;   iarg = 5   ;   iptr = index5 
     652            END IF 
     653         CASE ( 5 ) 
     654            IF( .NOT. PRESENT(index6) ) THEN   ;   EXIT 
     655            ELSE                               ;   iarg = 6   ;   iptr = index6 
     656            END IF 
     657         CASE ( 6 ) 
     658            IF( .NOT. PRESENT(index7) ) THEN   ;   EXIT 
     659            ELSE                               ;   iarg = 7   ;   iptr = index7 
     660            END IF 
     661         CASE ( 7 ) 
     662            EXIT 
     663         CASE DEFAULT 
     664            CALL ctl_stop( 'iwrk_release - ERROR, caught unexpected argument count - BUG' ) 
     665            EXIT 
     666         END SELECT 
     667         ! 
    687668      END DO ! end of DO WHILE() 
    688  
    689     END FUNCTION wrk_release 
    690  
    691  
    692     FUNCTION llwrk_release(ndim,   index1, index2, index3, index4, index5, & 
    693                            index6, index7, index8, index9) 
    694        LOGICAL             :: llwrk_release ! Return value 
    695        INTEGER, INTENT(in) :: ndim             ! Dimensionality of workspace(s) 
    696        INTEGER, INTENT(in) :: index1           ! Index of 1st workspace to release 
    697        INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, & 
    698                                         index6, index7, index8, index9 
    699        ! Local variables 
    700        INTEGER :: iarg, iptr 
    701        !!---------------------------------------------------------------------- 
    702  
    703        llwrk_release = .TRUE. 
    704        iptr = index1 
    705        iarg = 1 
    706  
    707        DO WHILE(iarg <= max_num_wrkspaces) 
    708  
    709           IF(ndim == 2)THEN 
    710  
    711              IF(iptr > num_2d_lwrkspaces)THEN 
    712                 CALL ctl_stop('llwrk_release - ERROR - attempt to release a non-existant 2D workspace array') 
    713                 llwrk_release = .FALSE. 
    714                 EXIT 
    715              END IF 
    716  
    717              in_use_2dll(iptr) = .FALSE. 
    718  
    719           ELSE IF (ndim == 3)THEN 
    720  
    721              IF(iptr > num_3d_lwrkspaces)THEN 
    722                 CALL ctl_stop('llwrk_release - ERROR - attempt to release a non-existant 3D workspace array') 
    723                 llwrk_release = .FALSE. 
    724                 EXIT 
    725              END IF 
    726  
    727              in_use_3dll(iptr) = .FALSE. 
    728  
    729           ELSE  
    730              IF(lwp) WRITE(numout,*) 'llwrk_release: unsupported value of ndim = ',ndim 
    731              CALL ctl_stop('llwrk_release: unrecognised value for number of dimensions') 
    732           END IF 
    733  
    734           ! Move on to next optional argument 
    735           CALL get_next_arg(iarg  , iptr  , index2, index3, index4, & 
    736                             index5, index6, index7, index8, index9) 
    737  
    738           IF(iarg == -1)THEN 
    739              ! We've checked all of the arguments and are done 
    740              EXIT 
    741           ELSE IF(iarg == -99)THEN 
    742              CALL ctl_stop('llwrk_release - ERROR, caught unexpected argument count - BUG') 
    743              EXIT 
    744           END IF 
    745  
    746        END DO ! while (iarg <= max_num_wrkspaces) 
    747  
    748     END FUNCTION llwrk_release 
    749  
    750  
    751     FUNCTION iwrk_release(ndim, index1, index2, index3, index4, index5, & 
    752                            index6, index7) 
    753        !!---------------------------------------------------------------------- 
    754        !!                 ***  ROUTINE iwrk_release  *** 
    755        !! 
    756        !! ** Purpose :   Flag that the specified INTEGER workspace arrays are 
    757        !!                no-longer in use. 
    758        !!---------------------------------------------------------------------- 
    759        LOGICAL             :: iwrk_release     ! Return value 
    760        INTEGER, INTENT(in) :: ndim             ! Dimensionality of workspace(s) 
    761        INTEGER, INTENT(in) :: index1           ! Index of 1st workspace to release 
    762        INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, & 
    763                                         index6, index7 
    764        ! Local variables 
    765        INTEGER :: iarg, iptr 
    766        !!---------------------------------------------------------------------- 
    767  
    768        iwrk_release = .TRUE. 
    769        iptr = index1 
    770        iarg = 1 
    771  
    772        DO WHILE(iarg <= max_num_wrkspaces) 
    773  
    774           IF(ndim == 2)THEN 
    775  
    776              IF(iptr > num_2d_iwrkspaces)THEN 
    777                 CALL ctl_stop('iwrk_release - ERROR - attempt to release a non-existant 2D workspace array') 
    778                 iwrk_release = .FALSE. 
    779              END IF 
    780  
    781              in_use_2di(iptr) = .FALSE. 
    782           ELSE  
    783              IF(lwp) WRITE(numout,*) 'iwrk_release: unsupported value of ndim = ',ndim 
    784              CALL ctl_stop('iwrk_release: unsupported value for number of dimensions') 
    785           END IF 
    786  
    787           ! Move on to next optional argument 
    788           SELECT CASE (iarg) 
    789           CASE ( 1 ) 
    790              IF(.not. PRESENT(index2))THEN 
    791                 EXIT 
    792              ELSE 
    793                 iarg = 2 
    794                 iptr = index2 
    795              END IF 
    796           CASE ( 2 ) 
    797              IF(.not. PRESENT(index3))THEN 
    798                 EXIT 
    799              ELSE 
    800                 iarg = 3 
    801                 iptr = index3 
    802              END IF 
    803           CASE ( 3 ) 
    804              IF(.not. PRESENT(index4))THEN 
    805                 EXIT 
    806              ELSE 
    807                 iarg = 4 
    808                 iptr = index4 
    809              END IF 
    810           CASE ( 4 ) 
    811              IF(.not. PRESENT(index5))THEN 
    812                 EXIT 
    813              ELSE 
    814                 iarg = 5 
    815                 iptr = index5 
    816              END IF 
    817           CASE ( 5 ) 
    818              IF(.not. PRESENT(index6))THEN 
    819                 EXIT 
    820              ELSE 
    821                 iarg = 6 
    822                 iptr = index6 
    823              END IF 
    824           CASE ( 6 ) 
    825              IF(.not. PRESENT(index7))THEN 
    826                 EXIT 
    827              ELSE 
    828                 iarg = 7 
    829                 iptr = index7 
    830              END IF 
    831           CASE ( 7 ) 
    832              EXIT 
    833           CASE DEFAULT 
    834              CALL ctl_stop('iwrk_release - ERROR, caught unexpected argument count - BUG') 
    835              EXIT 
    836           END SELECT 
    837  
    838        END DO ! end of DO WHILE() 
    839  
    840     END FUNCTION iwrk_release 
    841  
    842  
    843     FUNCTION wrk_release_xz(index1, index2, index3, index4, index5, & 
    844                             index6, index7, index8, index9) 
    845        LOGICAL             :: wrk_release_xz   ! Return value 
    846        INTEGER, INTENT(in) :: index1           ! Index of 1st workspace to release 
    847        INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, & 
    848                                         index6, index7, index8, index9 
    849        ! Local variables 
    850        INTEGER :: iarg, iptr 
    851        !!---------------------------------------------------------------------- 
    852  
    853        wrk_release_xz = .TRUE. 
    854        iptr = index1 
    855        iarg = 1 
    856  
    857        DO WHILE(iarg <= max_num_wrkspaces) 
    858  
    859              IF(iptr > num_xz_wrkspaces)THEN 
    860                 CALL ctl_stop('wrk_release_xz - ERROR - attempt to release a non-existant 2D xz workspace array') 
    861                 wrk_release_xz = .FALSE. 
    862                 EXIT 
    863              END IF 
    864  
    865              in_use_xz(iptr) = .FALSE. 
    866  
    867  
    868           ! Move on to next optional argument 
    869           CALL get_next_arg(iarg  , iptr  , index2, index3, index4, & 
    870                             index5, index6, index7, index8, index9) 
    871  
    872           IF(iarg == -1)THEN 
    873              ! We've checked all of the arguments and are done 
    874              EXIT 
    875           ELSE IF(iarg == -99)THEN 
    876              CALL ctl_stop('wrk_release_xz - ERROR, caught unexpected argument count - BUG') 
    877              EXIT 
    878           END IF 
    879  
    880        END DO ! while (iarg <= max_num_wrkspaces) 
    881  
    882     END FUNCTION wrk_release_xz 
    883  
    884  
    885     SUBROUTINE print_in_use_list(ndim, itype, in_use_list) 
    886        !!---------------------------------------------------------------------- 
    887        !!                 *** routine print_in_use_list *** 
    888        !! 
    889        !!    Purpose: to print out the table holding which workspace arrays 
    890        !!             are currently marked as in use. 
    891        !!---------------------------------------------------------------------- 
    892        IMPLICIT none 
    893        INTEGER,               INTENT(in) :: ndim 
    894        INTEGER,               INTENT(in) :: itype 
    895        LOGICAL, DIMENSION(:), INTENT(in) :: in_use_list 
    896        ! Locals 
    897        INTEGER          :: ii, icount 
    898        CHARACTER(LEN=7) :: type_string 
    899        !!---------------------------------------------------------------------- 
    900  
    901        IF(.NOT. lwp) RETURN 
    902  
    903        SELECT CASE (ndim) 
    904  
    905        CASE (1) 
    906  
    907           SELECT CASE (itype) 
    908  
    909           CASE (INTEGER_TYPE) 
    910              icount = num_1d_iwrkspaces 
    911           CASE (LOGICAL_TYPE) 
    912              icount = num_1d_lwrkspaces 
    913           CASE (REAL_TYPE) 
    914              icount = num_1d_wrkspaces 
    915           END SELECT 
    916  
    917        CASE (2) 
    918  
    919           SELECT CASE (itype) 
    920  
    921           CASE (INTEGER_TYPE) 
    922              icount = num_2d_iwrkspaces 
    923           CASE (LOGICAL_TYPE) 
    924              icount = num_2d_lwrkspaces 
    925           CASE (REAL_TYPE) 
    926              icount = num_2d_wrkspaces 
    927           END SELECT 
    928  
    929        CASE (3) 
    930  
    931           SELECT CASE (itype) 
    932  
    933           CASE (INTEGER_TYPE) 
    934              icount = num_3d_iwrkspaces 
    935           CASE (LOGICAL_TYPE) 
    936              icount = num_3d_lwrkspaces 
    937           CASE (REAL_TYPE) 
    938              icount = num_3d_wrkspaces 
    939           END SELECT 
    940  
    941        CASE (4) 
    942           SELECT CASE (itype) 
    943  
    944           CASE (INTEGER_TYPE) 
    945              icount = num_4d_iwrkspaces 
    946           CASE (LOGICAL_TYPE) 
    947              icount = num_4d_lwrkspaces 
    948           CASE (REAL_TYPE) 
    949              icount = num_4d_wrkspaces 
    950           END SELECT 
    951  
    952        CASE DEFAULT 
    953           RETURN 
    954  
    955        END SELECT 
    956  
    957        ! Set character string with type of workspace 
    958        SELECT CASE (itype) 
    959  
    960        CASE (INTEGER_TYPE) 
    961           type_string = "INTEGER"  
    962        CASE (LOGICAL_TYPE) 
    963           type_string = "LOGICAL" 
    964        CASE (REAL_TYPE) 
    965           type_string = "REAL"  
    966        END SELECT 
    967  
    968        WRITE(numout,*) 
    969        WRITE(numout,"('------------------------------------------')") 
    970        WRITE(numout,"('Table of ',I1,'D ',(A),' workspaces currently in use:')") ndim, TRIM(type_string) 
    971        WRITE(numout,"('Workspace   In use')") 
    972        DO ii=1,icount, 1 
    973           WRITE(numout,"(4x,I2,8x,L1)") ii, in_use_list(ii) 
    974        END DO 
    975        WRITE(numout,"('------------------------------------------')") 
    976        WRITE(numout,*) 
    977  
    978     END SUBROUTINE print_in_use_list 
    979  
    980  
    981     SUBROUTINE get_next_arg(iargidx, iargval, index2,  index3,  index4,  & 
    982                             index5 , index6,  index7,  index8,  index9,  & 
    983                             index10, index11, index12, index13, index14, & 
    984                             index15, index16, index17, index18, index19, & 
    985                             index20, index21, index22, index23, index24, & 
    986                             index25, index26, index27) 
    987        !!---------------------------------------------------------------------- 
    988        INTEGER, INTENT(inout) :: iargidx ! Index of current arg 
    989        INTEGER, INTENT(inout) :: iargval ! Value of current arg 
    990        INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5,     & 
    991                                         index6, index7, index8, index9,     & 
    992                                         index10, index11, index12, index13, & 
    993                                         index14, index15, index16, index17, & 
    994                                         index18, index19, index20, index21, & 
    995                                         index22, index23, index24, index25, & 
    996                                         index26, index27 
    997        !!---------------------------------------------------------------------- 
    998  
    999        ! Move on to next optional argument 
    1000        SELECT CASE (iargidx) 
    1001        CASE ( 1 ) 
    1002           IF(.not. PRESENT(index2))THEN 
    1003              iargidx = -1 
    1004           ELSE 
    1005              iargidx = 2 
    1006              iargval = index2 
    1007           END IF 
    1008        CASE ( 2 ) 
    1009           IF(.not. PRESENT(index3))THEN 
    1010              iargidx = -1 
    1011           ELSE 
    1012              iargidx = 3 
    1013              iargval = index3 
    1014           END IF 
    1015        CASE ( 3 ) 
    1016           IF(.not. PRESENT(index4))THEN 
    1017              iargidx = -1 
    1018           ELSE 
    1019              iargidx = 4 
    1020              iargval = index4 
    1021           END IF 
    1022        CASE ( 4 ) 
    1023           IF(.not. PRESENT(index5))THEN 
    1024              iargidx = -1 
    1025           ELSE 
    1026              iargidx = 5 
    1027              iargval = index5 
    1028           END IF 
    1029        CASE ( 5 ) 
    1030           IF(.not. PRESENT(index6))THEN 
    1031              iargidx = -1 
    1032           ELSE 
    1033              iargidx = 6 
    1034              iargval = index6 
    1035           END IF 
    1036        CASE ( 6 ) 
    1037           IF(.not. PRESENT(index7))THEN 
    1038              iargidx = -1 
    1039           ELSE 
    1040              iargidx = 7 
    1041              iargval = index7 
    1042           END IF 
    1043        CASE ( 7 ) 
    1044           IF(.not. PRESENT(index8))THEN 
    1045              iargidx = -1 
    1046           ELSE 
    1047              iargidx = 8 
    1048              iargval = index8 
    1049           END IF 
    1050        CASE ( 8 ) 
    1051           IF(.not. PRESENT(index9))THEN 
    1052              iargidx = -1 
    1053           ELSE 
    1054              iargidx = 9 
    1055              iargval = index9 
    1056           END IF 
    1057        CASE ( 9 ) 
    1058           IF(.not. PRESENT(index10))THEN 
    1059              iargidx = -1 
    1060           ELSE 
    1061              iargidx = 10 
    1062              iargval = index10 
    1063           END IF 
    1064        CASE ( 10 ) 
    1065           IF(.not. PRESENT(index11))THEN 
    1066              iargidx = -1 
    1067           ELSE 
    1068              iargidx = 11 
    1069              iargval = index11 
    1070           END IF 
    1071        CASE ( 11 ) 
    1072           IF(.not. PRESENT(index12))THEN 
    1073              iargidx = -1 
    1074           ELSE 
    1075              iargidx = 12 
    1076              iargval = index12 
    1077           END IF 
    1078        CASE ( 12 ) 
    1079           IF(.not. PRESENT(index13))THEN 
    1080              iargidx = -1 
    1081           ELSE 
    1082              iargidx = 13 
    1083              iargval = index13 
    1084           END IF 
    1085        CASE ( 13 ) 
    1086           IF(.not. PRESENT(index14))THEN 
    1087              iargidx = -1 
    1088           ELSE 
    1089              iargidx = 14 
    1090              iargval = index14 
    1091           END IF 
    1092        CASE ( 14 ) 
    1093           IF(.not. PRESENT(index15))THEN 
    1094              iargidx = -1 
    1095           ELSE 
    1096              iargidx = 15 
    1097              iargval = index15 
    1098           END IF 
    1099        CASE ( 15 ) 
    1100           IF(.not. PRESENT(index16))THEN 
    1101              iargidx = -1 
    1102           ELSE 
    1103              iargidx = 16 
    1104              iargval = index16 
    1105           END IF 
    1106        CASE ( 16 ) 
    1107           IF(.not. PRESENT(index17))THEN 
    1108              iargidx = -1 
    1109           ELSE 
    1110              iargidx = 17 
    1111              iargval = index17 
    1112           END IF 
    1113        CASE ( 17 ) 
    1114           IF(.not. PRESENT(index18))THEN 
    1115              iargidx = -1 
    1116           ELSE 
    1117              iargidx = 18 
    1118              iargval = index18 
    1119           END IF 
    1120        CASE ( 18 ) 
    1121           IF(.not. PRESENT(index19))THEN 
    1122              iargidx = -1 
    1123           ELSE 
    1124              iargidx = 19 
    1125              iargval = index19 
    1126           END IF 
    1127        CASE ( 19 ) 
    1128           IF(.not. PRESENT(index20))THEN 
    1129              iargidx = -1 
    1130           ELSE 
    1131              iargidx = 20 
    1132              iargval = index20 
    1133           END IF 
    1134        CASE ( 20 ) 
    1135           IF(.not. PRESENT(index21))THEN 
    1136              iargidx = -1 
    1137           ELSE 
    1138              iargidx = 21 
    1139              iargval = index21 
    1140           END IF 
    1141        CASE ( 21 ) 
    1142           IF(.not. PRESENT(index22))THEN 
    1143              iargidx = -1 
    1144           ELSE 
    1145              iargidx = 22 
    1146              iargval = index22 
    1147           END IF 
    1148        CASE ( 22 ) 
    1149           IF(.not. PRESENT(index23))THEN 
    1150              iargidx = -1 
    1151           ELSE 
    1152              iargidx = 23 
    1153              iargval = index23 
    1154           END IF 
    1155        CASE ( 23 ) 
    1156           IF(.not. PRESENT(index24))THEN 
    1157              iargidx = -1 
    1158           ELSE 
    1159              iargidx = 24 
    1160              iargval = index24 
    1161           END IF 
    1162        CASE ( 24 ) 
    1163           IF(.not. PRESENT(index25))THEN 
    1164              iargidx = -1 
    1165           ELSE 
    1166              iargidx = 25 
    1167              iargval = index25 
    1168           END IF 
    1169        CASE ( 25 ) 
    1170           IF(.not. PRESENT(index26))THEN 
    1171              iargidx = -1 
    1172           ELSE 
    1173              iargidx = 26 
    1174              iargval = index26 
    1175           END IF 
    1176        CASE ( 26 ) 
    1177           IF(.not. PRESENT(index27))THEN 
    1178              iargidx = -1 
    1179           ELSE 
    1180              iargidx = 27 
    1181              iargval = index27 
    1182           END IF 
    1183        CASE ( 27 ) 
    1184           iargidx = -1 
    1185        CASE DEFAULT 
    1186           ! BUG - iargidx shouldn't take any other values! 
    1187           ! Flag error for calling routine 
    1188           iargidx = -99 
    1189        END SELECT 
    1190  
    1191     END SUBROUTINE get_next_arg 
    1192  
    1193  
     669      ! 
     670   END FUNCTION iwrk_release 
     671 
     672 
     673   FUNCTION wrk_release_xz( index1, index2, index3, index4, index5,   & 
     674      &                     index6, index7, index8, index9 ) 
     675      !!---------------------------------------------------------------------- 
     676      !!                 ***  FUNCTION wrk_release_xz  *** 
     677      !! 
     678      !!---------------------------------------------------------------------- 
     679      INTEGER, INTENT(in) :: index1           ! Index of 1st workspace to release 
     680      INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, index6, index7, index8, index9 
     681      ! 
     682      LOGICAL ::   wrk_release_xz   ! Return value 
     683      INTEGER ::   iarg, iptr       ! local integer 
     684      !!---------------------------------------------------------------------- 
     685      ! 
     686      wrk_release_xz = .TRUE. 
     687      iptr           = index1 
     688      iarg           = 1 
     689      ! 
     690      DO WHILE( iarg <= max_num_wrkspaces ) 
     691         ! 
     692         IF( iptr > num_xz_wrkspaces ) THEN 
     693            CALL ctl_stop('wrk_release_xz - ERROR - attempt to release a non-existant 2D xz workspace array') 
     694            wrk_release_xz = .FALSE. 
     695            EXIT 
     696         ENDIF 
     697         in_use_xz(iptr) = .FALSE. 
     698         ! 
     699         ! Move on to next optional argument 
     700         CALL get_next_arg( iarg, iptr, index2, index3, index4,   & 
     701            &                           index5, index6, index7, index8, index9) 
     702         ! 
     703         IF(  iarg == -1 ) THEN     ! We've checked all of the arguments and are done 
     704            EXIT 
     705         ELSEIF( iarg == -99 ) THEN 
     706            CALL ctl_stop('wrk_release_xz - ERROR, caught unexpected argument count - BUG') 
     707            EXIT 
     708         END IF 
     709         ! 
     710      END DO ! while (iarg <= max_num_wrkspaces) 
     711      ! 
     712   END FUNCTION wrk_release_xz 
     713 
     714 
     715   SUBROUTINE print_in_use_list( kdim, itype, in_use_list ) 
     716      !!---------------------------------------------------------------------- 
     717      !!                 *** ROUTINE print_in_use_list *** 
     718      !! 
     719      !!    Purpose: to print out the table holding which workspace arrays 
     720      !!             are currently marked as in use. 
     721      !!---------------------------------------------------------------------- 
     722      INTEGER,               INTENT(in) :: kdim 
     723      INTEGER,               INTENT(in) :: itype 
     724      LOGICAL, DIMENSION(:), INTENT(in) :: in_use_list 
     725      ! 
     726      INTEGER          ::   ji, icount 
     727      CHARACTER(LEN=7) ::   type_string 
     728      !!---------------------------------------------------------------------- 
     729 
     730      IF(.NOT. lwp)   RETURN 
     731 
     732      SELECT CASE ( kdim ) 
     733      ! 
     734      CASE (1) 
     735         SELECT CASE (itype) 
     736         CASE (INTEGER_TYPE)   ;   icount = num_1d_iwrkspaces 
     737         CASE (LOGICAL_TYPE)   ;   icount = num_1d_lwrkspaces 
     738         CASE (REAL_TYPE   )   ;   icount = num_1d_wrkspaces 
     739         END SELECT 
     740         ! 
     741      CASE (2) 
     742         SELECT CASE (itype) 
     743         CASE (INTEGER_TYPE)   ;   icount = num_2d_iwrkspaces 
     744         CASE (LOGICAL_TYPE)   ;   icount = num_2d_lwrkspaces 
     745         CASE (REAL_TYPE   )   ;   icount = num_2d_wrkspaces 
     746         END SELECT 
     747         ! 
     748      CASE (3) 
     749         SELECT CASE (itype) 
     750         CASE (INTEGER_TYPE)   ;   icount = num_3d_iwrkspaces 
     751         CASE (LOGICAL_TYPE)   ;   icount = num_3d_lwrkspaces 
     752         CASE (REAL_TYPE   )   ;   icount = num_3d_wrkspaces 
     753         END SELECT 
     754         ! 
     755      CASE (4) 
     756         SELECT CASE (itype) 
     757         CASE (INTEGER_TYPE)   ;   icount = num_4d_iwrkspaces 
     758         CASE (LOGICAL_TYPE)   ;   icount = num_4d_lwrkspaces 
     759         CASE (REAL_TYPE   )   ;   icount = num_4d_wrkspaces 
     760         END SELECT 
     761         ! 
     762      CASE DEFAULT   ;   RETURN 
     763      ! 
     764      END SELECT 
     765 
     766      ! Set character string with type of workspace 
     767      SELECT CASE (itype) 
     768      CASE (INTEGER_TYPE)   ;   type_string = "INTEGER"  
     769      CASE (LOGICAL_TYPE)   ;   type_string = "LOGICAL" 
     770      CASE (REAL_TYPE   )   ;   type_string = "REAL"  
     771      END SELECT 
     772 
     773      WRITE(numout,*) 
     774      WRITE(numout,"('------------------------------------------')") 
     775      WRITE(numout,"('Table of ',I1,'D ',(A),' workspaces currently in use:')") kdim, TRIM(type_string) 
     776      WRITE(numout,"('Workspace   In use')") 
     777      DO ji = 1, icount, 1 
     778         WRITE(numout,"(4x,I2,8x,L1)") ji, in_use_list(ji) 
     779      END DO 
     780      WRITE(numout,"('------------------------------------------')") 
     781      WRITE(numout,*) 
     782      ! 
     783   END SUBROUTINE print_in_use_list 
     784 
     785 
     786   SUBROUTINE get_next_arg( iargidx, iargval, index2,  index3,  index4,  & 
     787      &                     index5 , index6,  index7,  index8,  index9,  & 
     788      &                     index10, index11, index12, index13, index14, & 
     789      &                     index15, index16, index17, index18, index19, & 
     790      &                     index20, index21, index22, index23, index24, & 
     791      &                     index25, index26, index27 ) 
     792      !!---------------------------------------------------------------------- 
     793      INTEGER, INTENT(inout) :: iargidx ! Index of current arg 
     794      INTEGER, INTENT(inout) :: iargval ! Value of current arg 
     795      INTEGER, OPTIONAL, INTENT(in) ::            index2 , index3 , index4 , index5 , index6 , index7 , index8 , index9 , index10 
     796      INTEGER, OPTIONAL, INTENT(in) ::   index11, index12, index13, index14, index15, index16, index17, index18, index19, index20 
     797      INTEGER, OPTIONAL, INTENT(in) ::   index21, index22, index23, index24, index25, index26, index27 
     798      !!---------------------------------------------------------------------- 
     799 
     800      SELECT CASE (iargidx)       ! Move on to next optional argument 
     801      CASE ( 1 ) 
     802         IF( .NOT. PRESENT(index2 ) ) THEN   ;   iargidx = -1 
     803         ELSE                                ;   iargidx =  2   ;   iargval = index2 
     804         ENDIF 
     805      CASE ( 2 ) 
     806         IF( .NOT. PRESENT(index3 ) ) THEN   ;   iargidx = -1 
     807         ELSE                                ;   iargidx =  3   ;   iargval = index3 
     808         ENDIF 
     809      CASE ( 3 ) 
     810         IF( .NOT. PRESENT(index4 ) ) THEN   ;   iargidx = -1 
     811         ELSE                                ;   iargidx =  4   ;   iargval = index4 
     812         ENDIF 
     813      CASE ( 4 ) 
     814         IF( .NOT. PRESENT(index5 ) ) THEN   ;   iargidx = -1 
     815         ELSE                                ;   iargidx =  5   ;   iargval = index5 
     816         ENDIF 
     817      CASE ( 5 ) 
     818         IF( .NOT. PRESENT(index6 ) ) THEN   ;   iargidx = -1 
     819         ELSE                                ;   iargidx =  6   ;   iargval = index6 
     820         ENDIF 
     821      CASE ( 6 ) 
     822         IF( .NOT. PRESENT(index7 ) ) THEN   ;   iargidx = -1 
     823         ELSE                                ;   iargidx =  7   ;   iargval = index7 
     824         ENDIF 
     825      CASE ( 7 ) 
     826         IF( .NOT. PRESENT(index8 ) ) THEN   ;   iargidx = -1 
     827         ELSE                                ;   iargidx =  8   ;   iargval = index8 
     828         ENDIF 
     829      CASE ( 8 ) 
     830         IF( .NOT. PRESENT(index2 ) ) THEN   ;   iargidx = -1 
     831         ELSE                                ;   iargidx =  9   ;   iargval = index9 
     832         ENDIF 
     833      CASE ( 9 ) 
     834         IF( .NOT. PRESENT(index10) ) THEN   ;   iargidx = -1 
     835         ELSE                                ;   iargidx = 10   ;   iargval = index10 
     836         ENDIF 
     837      CASE ( 10 ) 
     838         IF( .NOT. PRESENT(index11) ) THEN   ;   iargidx = -1 
     839         ELSE                                ;   iargidx = 11   ;   iargval = index11 
     840         ENDIF 
     841      CASE ( 11 ) 
     842         IF( .NOT. PRESENT(index12) ) THEN   ;   iargidx = -1 
     843         ELSE                                ;   iargidx = 12   ;   iargval = index12 
     844         ENDIF 
     845      CASE ( 12 ) 
     846         IF( .NOT. PRESENT(index13) ) THEN   ;   iargidx = -1 
     847         ELSE                                ;   iargidx =  13   ;   iargval = index13 
     848         ENDIF 
     849      CASE ( 13 ) 
     850         IF( .NOT. PRESENT(index14) ) THEN   ;   iargidx = -1 
     851         ELSE                                ;   iargidx = 14   ;   iargval = index14 
     852         ENDIF 
     853      CASE ( 14 ) 
     854         IF( .NOT. PRESENT(index15) ) THEN   ;   iargidx = -1 
     855         ELSE                                ;   iargidx = 15   ;   iargval = index15 
     856         ENDIF 
     857      CASE ( 15 ) 
     858         IF( .NOT. PRESENT(index16) ) THEN   ;   iargidx = -1 
     859         ELSE                                ;   iargidx = 16   ;   iargval = index16 
     860         ENDIF 
     861      CASE ( 16 ) 
     862         IF( .NOT. PRESENT(index17) ) THEN   ;   iargidx = -1 
     863         ELSE                                ;   iargidx = 17   ;   iargval = index17 
     864         END IF 
     865      CASE ( 17 ) 
     866         IF( .NOT. PRESENT(index18) ) THEN   ;   iargidx = -1 
     867         ELSE                                ;   iargidx = 18   ;   iargval = index18 
     868         ENDIF 
     869      CASE ( 18 ) 
     870         IF( .NOT. PRESENT(index19) ) THEN   ;   iargidx = -1 
     871         ELSE                                ;   iargidx = 19   ;   iargval = index19 
     872         ENDIF 
     873      CASE ( 19 ) 
     874         IF( .NOT. PRESENT(index20) ) THEN   ;   iargidx = -1 
     875         ELSE                                ;   iargidx = 20   ;   iargval = index20 
     876         ENDIF 
     877      CASE ( 20 ) 
     878         IF( .NOT. PRESENT(index21) ) THEN   ;   iargidx = -1 
     879         ELSE                                ;   iargidx = 21   ;   iargval = index21 
     880         ENDIF 
     881      CASE ( 21 ) 
     882         IF( .NOT. PRESENT(index22) ) THEN   ;   iargidx = -1 
     883         ELSE                                ;   iargidx = 22   ;   iargval = index22 
     884         ENDIF 
     885      CASE ( 22 ) 
     886         IF( .NOT. PRESENT(index23) ) THEN   ;   iargidx = -1 
     887         ELSE                                ;   iargidx = 23   ;   iargval = index23 
     888         ENDIF 
     889      CASE ( 23 ) 
     890         IF( .NOT. PRESENT(index24) ) THEN   ;   iargidx = -1 
     891         ELSE                                ;   iargidx = 24   ;   iargval = index24 
     892         ENDIF 
     893      CASE ( 24 ) 
     894         IF( .NOT. PRESENT(index25) ) THEN   ;   iargidx = -1 
     895         ELSE                                ;   iargidx = 25   ;   iargval = index25 
     896         ENDIF 
     897      CASE ( 25 ) 
     898         IF( .NOT. PRESENT(index26) ) THEN   ;   iargidx = -1 
     899         ELSE                                ;   iargidx = 26   ;   iargval = index26 
     900         ENDIF 
     901      CASE ( 26 ) 
     902         IF( .NOT. PRESENT(index27) ) THEN   ;   iargidx = -1 
     903         ELSE                                ;   iargidx = 27   ;   iargval = index27 
     904         ENDIF 
     905      CASE ( 27 ) 
     906         iargidx = -1 
     907      CASE DEFAULT 
     908         ! BUG - iargidx shouldn't take any other values! 
     909         ! Flag error for calling routine 
     910         iargidx = -99 
     911      END SELECT 
     912      ! 
     913   END SUBROUTINE get_next_arg 
     914 
     915   !!===================================================================== 
    1194916END MODULE wrk_nemo 
Note: See TracChangeset for help on using the changeset viewer.