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.
wrk_nemo.F90 in trunk/NEMOGCM/NEMO/OPA_SRC – NEMO

source: trunk/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90 @ 2715

Last change on this file since 2715 was 2715, checked in by rblod, 13 years ago

First attempt to put dynamic allocation on the trunk

File size: 41.5 KB
Line 
1MODULE wrk_nemo
2   !!======================================================================
3   !!                       ***  MODULE  wrk_nemo  ***
4   !! NEMO work space:  define and allocate work-space arrays used in
5   !! all components of NEMO
6   !!======================================================================
7   !! History :  4.0  !  2011-01  (A Porter)  Original code
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   wrk_alloc         : define in memory the work space arrays
12   !!   wrk_in_use, iwrk_in_use, wrk_in_use_xz : check the availability of a workspace
13   !!   wrk_not_released, iwrk_not_released, wrk_not_released_xz : release the workspace
14   !!   print_in_use_list : print out the table holding which workspace arrays are currently marked as in use
15   !!   get_next_arg      : get the next argument
16   !!   wrk_stop          : act as local alternative to ctl_stop
17   !!----------------------------------------------------------------------
18   USE par_oce        ! ocean parameters
19
20   IMPLICIT NONE
21   PRIVATE
22
23   PUBLIC   wrk_alloc   ! function called in nemogcm module (nemo_init routine)
24   PUBLIC   wrk_in_use, iwrk_in_use, wrk_in_use_xz                     ! function called almost everywhere
25   PUBLIC   wrk_not_released, iwrk_not_released, wrk_not_released_xz   ! function called almost everywhere
26
27   INTEGER, PARAMETER :: num_1d_wrkspaces  = 27   ! No. of 1D workspace arrays ( MAX(jpi*jpj,jpi*jpk,jpj*jpk) )
28   INTEGER, PARAMETER :: num_2d_wrkspaces  = 35   ! No. of 2D workspace arrays (jpi,jpj)
29   INTEGER, PARAMETER :: num_3d_wrkspaces  = 15   ! No. of 3D workspace arrays (jpi,jpj,jpk)
30   INTEGER, PARAMETER :: num_4d_wrkspaces  = 4    ! No. of 4D workspace arrays (jpi,jpj,jpk,jpts)
31
32   INTEGER, PARAMETER :: num_xz_wrkspaces  = 4   ! No. of 2D, xz workspace arrays (jpi,jpk)
33
34   INTEGER, PARAMETER :: num_1d_lwrkspaces = 0   ! No. of 1D logical workspace arrays
35   INTEGER, PARAMETER :: num_2d_lwrkspaces = 3   ! No. of 2D logical workspace arrays
36   INTEGER, PARAMETER :: num_3d_lwrkspaces = 1   ! No. of 3D logical workspace arrays
37   INTEGER, PARAMETER :: num_4d_lwrkspaces = 0   ! No. of 4D logical workspace arrays
38
39   INTEGER, PARAMETER :: num_1d_iwrkspaces = 0   ! No. of 1D integer workspace arrays
40   INTEGER, PARAMETER :: num_2d_iwrkspaces = 1   ! No. of 2D integer workspace arrays
41   INTEGER, PARAMETER :: num_3d_iwrkspaces = 0   ! No. of 3D integer workspace arrays
42   INTEGER, PARAMETER :: num_4d_iwrkspaces = 0   ! No. of 4D integer workspace arrays
43   ! Maximum no. of workspaces of any one dimensionality that can be
44   ! requested - MAX(num_1d_wrkspaces, num_2d_wrkspaces, num_3d_wrkspaces, num_4d_wrkspaces)
45   INTEGER :: max_num_wrkspaces = 35
46
47   ! If adding more arrays here, remember to increment the appropriate
48   ! num_Xd_wrkspaces parameter above and to allocate them in wrk_alloc()
49
50   !                                                               !!**  1D, REAL(wp) workspaces  **
51   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)      , TARGET, PUBLIC ::   wrk_1d_1 , wrk_1d_2 , wrk_1d_3 , wrk_1d_4 , wrk_1d_5
52   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)      , TARGET, PUBLIC ::   wrk_1d_6 , wrk_1d_7 , wrk_1d_8 , wrk_1d_9 , wrk_1d_10
53   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)      , TARGET, PUBLIC ::   wrk_1d_11, wrk_1d_12, wrk_1d_13, wrk_1d_14, wrk_1d_15
54   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)      , TARGET, PUBLIC ::   wrk_1d_16, wrk_1d_17, wrk_1d_18, wrk_1d_19, wrk_1d_20
55   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)      , TARGET, PUBLIC ::   wrk_1d_21, wrk_1d_22, wrk_1d_23, wrk_1d_24, wrk_1d_25
56   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)      , TARGET, PUBLIC ::   wrk_1d_26, wrk_1d_27
57
58   !                                                               !!**  2D, x-y, REAL(wp) workspaces  **
59   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_1 , wrk_2d_2 , wrk_2d_3 , wrk_2d_4 , wrk_2d_5
60   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_6 , wrk_2d_7 , wrk_2d_8 , wrk_2d_9 , wrk_2d_10
61   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_11, wrk_2d_12, wrk_2d_13, wrk_2d_14, wrk_2d_15
62   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_16, wrk_2d_17, wrk_2d_18, wrk_2d_19, wrk_2d_20
63   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_21, wrk_2d_22, wrk_2d_23, wrk_2d_24, wrk_2d_25
64   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_26, wrk_2d_27, wrk_2d_28, wrk_2d_29, wrk_2d_30
65   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_31, wrk_2d_32, wrk_2d_33, wrk_2d_34, wrk_2d_35
66
67   !                                                               !!**  2D, x-z, REAL(wp) workspaces  **
68   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)            , PUBLIC ::   wrk_xz_1, wrk_xz_2, wrk_xz_3, wrk_xz_4 
69   
70   !                                                               !!**  3D, x-y-z, REAL(wp) workspaces  **
71   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   wrk_3d_1 , wrk_3d_2 , wrk_3d_3 , wrk_3d_4 , wrk_3d_5
72   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   wrk_3d_6 , wrk_3d_7 , wrk_3d_8 , wrk_3d_9 , wrk_3d_10
73   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   wrk_3d_11, wrk_3d_12, wrk_3d_13, wrk_3d_14, wrk_3d_15
74
75   !                                                               !!**  4D, x-y-z-tra, REAL(wp) workspaces  **
76   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:), TARGET, PUBLIC ::   wrk_4d_1, wrk_4d_2, wrk_4d_3, wrk_4d_4 
77   
78   !                                                               !!** 2D integer workspace  **
79   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)            , PUBLIC ::   iwrk_2d_1
80
81   LOGICAL, DIMENSION(num_1d_wrkspaces)  ::   in_use_1d     !: Flags to track which 1D workspace arrays are in use 
82   LOGICAL, DIMENSION(num_2d_wrkspaces)  ::   in_use_2d     !: Flags to track which 2D workspace arrays are in use
83   LOGICAL, DIMENSION(num_3d_wrkspaces)  ::   in_use_3d     !: Flags to track which 3D workspace arrays are in use
84   LOGICAL, DIMENSION(num_4d_wrkspaces)  ::   in_use_4d     !: Flags to track which 4D workspace arrays are in use
85   LOGICAL, DIMENSION(num_xz_wrkspaces)  ::   in_use_xz     !: Flags to track which 2D, xz workspace arrays are in use
86   LOGICAL, DIMENSION(num_2d_lwrkspaces) ::   in_use_2dll   !: Flags to track which 2D, logical workspace arrays are in use
87   LOGICAL, DIMENSION(num_3d_lwrkspaces) ::   in_use_3dll   !: Flags to track which 3D, logical workspace arrays are in use
88   LOGICAL, DIMENSION(num_2d_iwrkspaces) ::   in_use_2di    !: Flags to track which 2D, integer workspace arrays are in use
89
90   ! Labels for specifying workspace type in call to print_in_use_list()
91   INTEGER, PARAMETER ::   INTEGER_TYPE = 0
92   INTEGER, PARAMETER ::   LOGICAL_TYPE = 1
93   INTEGER, PARAMETER ::   REAL_TYPE    = 2
94
95   INTEGER :: kumout  ! Local copy of numout unit number for error/warning messages
96   LOGICAL :: llwp    ! Local copy of lwp - whether we are master PE or not
97
98   CHARACTER(LEN=*), PARAMETER ::   cform_err2 = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !:
99   CHARACTER(LEN=*), PARAMETER ::   cform_war2 = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !:
100
101   !!----------------------------------------------------------------------
102   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
103   !! $Id:$
104   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
105   !!----------------------------------------------------------------------
106CONTAINS
107
108  FUNCTION wrk_alloc(iunit, lwp_arg)
109      !!----------------------------------------------------------------------
110      !!                   ***  FUNCTION wrk_alloc  ***
111      !!
112      !! ** Purpose :   Define in memory once for all the NEMO 2D, 3D and 4d
113      !!                work space arrays
114      !!----------------------------------------------------------------------
115      INTEGER, INTENT(in) ::   iunit         ! Unit no. to use for error/warning messages in this module
116      LOGICAL, INTENT(in) ::   lwp_arg       ! Value of lwp
117      !
118      INTEGER ::   wrk_alloc   ! Return value
119      INTEGER ::   extent_1d   ! Extent to allocate for 1D arrays
120      INTEGER ::   ierror(6)   ! local integer
121      !!----------------------------------------------------------------------
122      !
123      ! Save the unit number to use for err/warning messages
124      kumout = iunit
125      ! Save whether we are master PE or not (for output messages)
126      llwp = lwp_arg
127      !
128      ! Extent to use for 1D work arrays - find the maximum product of
129      ! jpi*jpj, jpi*jpk and jpj*jpk and use that
130      IF    ( jpi < jpj .AND. jpi < jpk ) THEN   ;   extent_1d = jpj*jpk
131      ELSEIF( jpj < jpi .AND. jpj < jpk ) THEN   ;   extent_1d = jpi*jpk
132      ELSE                                       ;   extent_1d = jpi*jpj
133      ENDIF
134      !
135      ! Initialise the 'in use' flags for each work-space array
136      in_use_1d  (:) = .FALSE.
137      in_use_2d  (:) = .FALSE.
138      in_use_3d  (:) = .FALSE.
139      in_use_4d  (:) = .FALSE.
140      in_use_xz  (:) = .FALSE.
141      in_use_2dll(:) = .FALSE.
142      in_use_3dll(:) = .FALSE.
143      in_use_2di (:) = .FALSE.
144      !
145      ierror(:) = 0
146      !
147      ALLOCATE( wrk_1d_1 (extent_1d) , wrk_1d_2 (extent_1d) , wrk_1d_3 (extent_1d) , wrk_1d_4 (extent_1d) ,     &
148         &      wrk_1d_5 (extent_1d) , wrk_1d_6 (extent_1d) , wrk_1d_7 (extent_1d) , wrk_1d_8 (extent_1d) ,     &
149         &      wrk_1d_9 (extent_1d) , wrk_1d_10(extent_1d)                                               ,     &
150         &      wrk_1d_11(extent_1d) , wrk_1d_12(extent_1d) , wrk_1d_13(extent_1d) , wrk_1d_14(extent_1d) ,     &
151         &      wrk_1d_15(extent_1d) , wrk_1d_16(extent_1d) , wrk_1d_17(extent_1d) , wrk_1d_18(extent_1d) ,     &
152         &      wrk_1d_19(extent_1d) , wrk_1d_20(extent_1d)                                               ,     &
153         &      wrk_1d_21(extent_1d) , wrk_1d_22(extent_1d) , wrk_1d_23(extent_1d) , wrk_1d_24(extent_1d) ,     &
154         &      wrk_1d_25(extent_1d) , wrk_1d_26(extent_1d) , wrk_1d_27(extent_1d)                        , STAT=ierror(1) )
155         !
156      ALLOCATE( wrk_2d_1 (jpi,jpj) , wrk_2d_2 (jpi,jpj) , wrk_2d_3 (jpi,jpj) , wrk_2d_4 (jpi,jpj) ,     & 
157         &      wrk_2d_5 (jpi,jpj) , wrk_2d_6 (jpi,jpj) , wrk_2d_7 (jpi,jpj) , wrk_2d_8 (jpi,jpj) ,     &
158         &      wrk_2d_9 (jpi,jpj) , wrk_2d_10(jpi,jpj)                                           ,     &
159         &      wrk_2d_11(jpi,jpj) , wrk_2d_12(jpi,jpj) , wrk_2d_13(jpi,jpj) , wrk_2d_14(jpi,jpj) ,     &
160         &      wrk_2d_15(jpi,jpj) , wrk_2d_16(jpi,jpj) , wrk_2d_17(jpi,jpj) , wrk_2d_18(jpi,jpj) ,     &
161         &      wrk_2d_19(jpi,jpj) , wrk_2d_20(jpi,jpj)                                           ,     &
162         &      wrk_2d_21(jpi,jpj) , wrk_2d_22(jpi,jpj) , wrk_2d_23(jpi,jpj) , wrk_2d_24(jpi,jpj) ,     &
163         &      wrk_2d_25(jpi,jpj) , wrk_2d_26(jpi,jpj) , wrk_2d_27(jpi,jpj) , wrk_2d_28(jpi,jpj) ,     &
164         &      wrk_2d_29(jpi,jpj) , wrk_2d_30(jpi,jpj)                                           ,     &
165         &      wrk_2d_31(jpi,jpj) , wrk_2d_32(jpi,jpj) , wrk_2d_33(jpi,jpj) , wrk_2d_34(jpi,jpj) ,     &
166         &      wrk_2d_35(jpi,jpj)                                                                , STAT=ierror(2) )
167         !
168      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) ,     &
169         &      wrk_3d_5 (jpi,jpj,jpk) , wrk_3d_6 (jpi,jpj,jpk) , wrk_3d_7 (jpi,jpj,jpk) , wrk_3d_8 (jpi,jpj,jpk) ,     &
170         &      wrk_3d_9 (jpi,jpj,jpk) , wrk_3d_10(jpi,jpj,jpk)                                                   ,     & 
171         &      wrk_3d_11(jpi,jpj,jpk) , wrk_3d_12(jpi,jpj,jpk) , wrk_3d_13(jpi,jpj,jpk) , wrk_3d_14(jpi,jpj,jpk) ,     & 
172         &      wrk_3d_15(jpi,jpj,jpk)                                                                            , STAT=ierror(3) )
173         !
174      ALLOCATE( wrk_4d_1(jpi,jpj,jpk,jpts) , wrk_4d_2(jpi,jpj,jpk,jpts),     &
175         &      wrk_4d_3(jpi,jpj,jpk,jpts) , wrk_4d_4(jpi,jpj,jpk,jpts), STAT=ierror(4) )
176         !
177      ALLOCATE( wrk_xz_1(jpi,jpk) , wrk_xz_2(jpi,jpk) , wrk_xz_3(jpi,jpk) , wrk_xz_4(jpi,jpk) , STAT=ierror(5) )
178         !
179      ALLOCATE( iwrk_2d_1(jpi,jpj)      , STAT=ierror(6) )
180      !
181      wrk_alloc = MAXVAL( ierror )
182      !
183      ! Calling routine, nemo_alloc(), checks for errors and takes
184      ! appropriate action - we just print a warning message
185      IF( wrk_alloc /= 0 ) THEN
186         WRITE(kumout,cform_war2)
187         WRITE(kumout,*) 'wrk_alloc: allocation of workspace arrays failed'
188      ENDIF
189      !
190   END FUNCTION wrk_alloc
191
192
193   FUNCTION wrk_in_use( kdim,    index1,  index2,  index3,  index4,    &
194      &                 index5,  index6,  index7,  index8,  index9,    &
195      &                 index10, index11, index12, index13, index14,   &
196      &                 index15, index16, index17, index18, index19,   &
197      &                 index20, index21, index22, index23, index24,   &
198      &                 index25, index26, index27)
199      !!----------------------------------------------------------------------
200      !!                   ***  FUNCTION wrk_in_use  ***
201      !!
202      !! ** Purpose :   Request a set of KIND(wp) workspaces to use. Returns
203      !!                .TRUE. if any of those requested are already in use,
204      !!                .FALSE. otherwise.
205      !!
206      !! ** Method  :   Sets internal flags to signal that requested workspaces are in use.
207      !!                key_no_workspace_check defined ==> always return FALSE
208      !!----------------------------------------------------------------------
209      INTEGER          , INTENT(in) ::   kdim        ! Dimensionality of requested workspace(s)
210      INTEGER          , INTENT(in) ::   index1      ! Index of first requested workspace
211      INTEGER, OPTIONAL, INTENT(in) ::             index2 , index3 , index4 , index5 , index6 , index7 , index8 , index9, index10
212      INTEGER, OPTIONAL, INTENT(in) ::   index11, index12, index13, index14, index15, index16, index17, index18, index19, index20
213      INTEGER, OPTIONAL, INTENT(in) ::   index21, index22, index23, index24, index25, index26, index27
214      !
215      LOGICAL ::   wrk_in_use      ! Return value
216      INTEGER ::   iarg, iptr   ! local integer
217      !!----------------------------------------------------------------------
218      !
219      wrk_in_use = .FALSE.
220      !
221#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif
222      ! NB: check not available with AGRIF
223      !
224      iptr    = index1
225      iarg    = 1
226      !
227      DO WHILE( .NOT. wrk_in_use .AND. iarg <= max_num_wrkspaces )
228         !
229         IF( kdim == 1 ) THEN
230            IF( iptr > num_1d_wrkspaces ) THEN
231               CALL wrk_stop('wrk_in_use - more 1D workspace arrays requested than defined in wrk_nemo module')
232               wrk_in_use = .TRUE.
233               EXIT
234            ELSEIF( in_use_1d(iptr) ) THEN
235               wrk_in_use = .TRUE.
236               CALL print_in_use_list(1, REAL_TYPE, in_use_1d)
237            ENDIF
238            in_use_1d(iptr) = .TRUE.
239            !
240         ELSEIF( kdim == 2 ) THEN
241            IF( iptr > num_2d_wrkspaces ) THEN
242               CALL wrk_stop('wrk_in_use - more 2D workspace arrays requested than defined in wrk_nemo module')
243               wrk_in_use = .TRUE.
244               EXIT
245            ELSEIF( in_use_2d(iptr) ) THEN
246               wrk_in_use = .TRUE.
247               CALL print_in_use_list(2, REAL_TYPE, in_use_2d)
248            ENDIF
249            in_use_2d(iptr) = .TRUE.
250            !
251         ELSEIF( kdim == 3 ) THEN
252            IF( iptr > num_3d_wrkspaces ) THEN
253               CALL wrk_stop( 'wrk_in_use - more 3D workspace arrays requested than defined in wrk_nemo module' )
254               wrk_in_use = .TRUE.
255               EXIT
256            ELSEIF( in_use_3d(iptr) ) THEN
257               wrk_in_use = .TRUE.
258               CALL print_in_use_list(3, REAL_TYPE, in_use_3d)
259            ENDIF
260            in_use_3d(iptr) = .TRUE.
261            !
262         ELSEIF( kdim == 4 ) THEN
263            IF(iptr > num_4d_wrkspaces)THEN
264               CALL wrk_stop( 'wrk_in_use - more 4D workspace arrays requested than defined in wrk_nemo module' )
265               wrk_in_use = .TRUE.
266               EXIT
267            ELSEIF( in_use_4d(iptr) ) THEN
268               wrk_in_use = .TRUE.
269               CALL print_in_use_list( 4, REAL_TYPE, in_use_4d )
270            ENDIF
271            !
272            in_use_4d(iptr) = .TRUE.
273            !
274         ELSE
275            IF(llwp) WRITE(kumout,*) 'wrk_in_use: unsupported value of kdim = ',kdim
276            CALL wrk_stop( 'wrk_in_use: unrecognised value for number of dimensions' )
277         ENDIF
278
279         CALL get_next_arg( iarg  ,  iptr  ,  index2,  index3,  index4,    &
280            &               index5,  index6,  index7,  index8,  index9,    &
281            &               index10, index11, index12, index13, index14,   &
282            &               index15, index16, index17, index18, index19,   &
283            &               index20, index21, index22, index23, index24,   &
284            &               index25, index26, index27)
285
286         IF( iarg == -1 ) THEN      ! We've checked all of the arguments and are done
287            EXIT
288         ELSEIF( iarg == -99 ) THEN
289            CALL wrk_stop( 'wrk_in_use : caught unexpected argument count - BUG' )
290            EXIT
291         ENDIF
292         !
293      END DO ! end of DO WHILE()
294#endif
295      !
296   END FUNCTION wrk_in_use
297
298
299   FUNCTION iwrk_in_use( kdim, index1, index2, index3, index4,   &
300      &                        index5, index6, index7 )
301      !!----------------------------------------------------------------------
302      !!                   ***  FUNCTION iwrk_in_use  ***
303      !!
304      !! ** Purpose :   Request a set of INTEGER workspaces to use. Returns
305      !!                .TRUE. if any of those requested are already in use,
306      !!                .FALSE. otherwise.
307      !!
308      !! ** Method  :   Sets internal flags to signal that requested workspaces
309      !!                are in use.
310      !!----------------------------------------------------------------------
311      INTEGER          , INTENT(in) ::   kdim        ! Dimensionality of requested workspace(s)
312      INTEGER          , INTENT(in) ::   index1      ! Index of first requested workspace
313      INTEGER, OPTIONAL, INTENT(in) ::   index2, index3, index4, index5, index6, index7
314      !
315      LOGICAL ::   iwrk_in_use    ! Return value
316      INTEGER ::   iarg, iptr
317      !!----------------------------------------------------------------------
318      !
319      iwrk_in_use = .FALSE.
320      !
321#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif
322      ! NB: check not available with AGRIF
323      !
324      iptr     = index1
325      iarg     = 1
326      !
327      DO WHILE( .NOT.iwrk_in_use .AND. iarg <= max_num_wrkspaces )
328         !
329         IF( kdim == 2 ) THEN
330            IF( iptr > num_2d_wrkspaces ) THEN
331               CALL wrk_stop( 'wrk_in_use - more 2D workspace arrays requested than defined in wrk_nemo module' )
332               iwrk_in_use = .TRUE.
333            ELSEIF( in_use_2di(iptr) ) THEN
334               iwrk_in_use = .TRUE.
335               CALL print_in_use_list( 2, INTEGER_TYPE, in_use_2di )
336            ENDIF
337            in_use_2di(iptr) = .TRUE.
338            !
339         ELSE
340            IF(llwp) WRITE(kumout,*) 'iwrk_in_use: unsupported value of kdim = ',kdim
341            CALL wrk_stop('iwrk_in_use: unsupported value for number of dimensions')
342         ENDIF
343         !
344         SELECT CASE (iarg)         ! Move on to next optional argument
345         CASE ( 1 )
346            IF( .NOT. PRESENT(index2) ) THEN   ;   EXIT
347            ELSE                               ;   iarg = 2   ;   iptr = index2
348            ENDIF
349         CASE ( 2 )
350            IF( .NOT. PRESENT(index3) ) THEN   ;   EXIT
351            ELSE                               ;   iarg = 3   ;   iptr = index3
352            ENDIF
353         CASE ( 3 )
354            IF( .NOT. PRESENT(index4) ) THEN   ;   EXIT
355            ELSE                               ;   iarg = 4   ;   iptr = index4
356            ENDIF
357         CASE ( 4 )
358            IF( .NOT. PRESENT(index5) ) THEN   ;   EXIT
359            ELSE                               ;   iarg = 5   ;   iptr = index5
360            ENDIF
361         CASE ( 5 )
362            IF( .NOT. PRESENT(index6) ) THEN   ;   EXIT
363            ELSE                               ;   iarg = 6   ;   iptr = index6
364            ENDIF
365         CASE ( 6 )
366            IF( .NOT. PRESENT(index7) ) THEN   ;   EXIT
367            ELSE                               ;   iarg = 7   ;   iptr = index7
368            ENDIF
369         CASE ( 7 )
370            EXIT
371         CASE DEFAULT
372            CALL wrk_stop( 'iwrk_in_use : caught unexpected argument count - BUG' )
373            EXIT
374         END SELECT
375         !
376      END DO ! end of DO WHILE()
377#endif
378      !
379   END FUNCTION iwrk_in_use
380
381
382   FUNCTION wrk_in_use_xz( index1, index2, index3, index4,   &
383      &                    index5, index6, index7, index8, index9 )
384      !!----------------------------------------------------------------------
385      !!                   ***  FUNCTION wrk_in_use_xz  ***
386      !!
387      !! ** Purpose :   Request a set of 2D, xz (jpi,jpk) workspaces to use.
388      !!                Returns .TRUE. if any of those requested are already in
389      !!                use, .FALSE. otherwise.
390      !!
391      !! ** Method  :   Sets internal flags to signal that requested workspaces
392      !!                are in use.
393      !!----------------------------------------------------------------------
394      INTEGER          , INTENT(in) ::   index1      ! Index of first requested workspace
395      INTEGER, OPTIONAL, INTENT(in) ::   index2, index3, index4, index5
396      INTEGER, OPTIONAL, INTENT(in) ::   index6, index7, index8, index9
397      !
398      LOGICAL ::   wrk_in_use_xz   ! Return value
399      INTEGER ::   iarg, iptr      ! local integer
400      !!----------------------------------------------------------------------
401      !
402      wrk_in_use_xz = .FALSE.
403      !
404#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif
405      ! NB: check not available with AGRIF
406      !
407      iptr = index1
408      iarg = 1
409      !
410      DO WHILE( .NOT. wrk_in_use_xz .AND. iarg <= max_num_wrkspaces )
411         !
412         IF( iptr > num_xz_wrkspaces ) THEN
413            CALL wrk_stop('wrk_in_use_xz - more 2D xz workspace arrays requested than defined in wrk_nemo module')
414            wrk_in_use_xz = .TRUE.
415            EXIT
416         ELSE IF( in_use_xz(iptr) ) THEN
417            wrk_in_use_xz = .TRUE.
418            CALL print_in_use_list(2, REAL_TYPE, in_use_xz) !ARPDBG - bug
419         ENDIF
420         !
421         in_use_xz(iptr) = .TRUE.
422         !
423         CALL get_next_arg( iarg  , iptr  , index2, index3, index4,   &
424            &               index5, index6, index7, index8, index9 )
425         !
426         IF( iarg == -1 ) THEN      ! We've checked all of the arguments and are done
427            EXIT
428         ELSEIF( iarg == -99 ) THEN
429            CALL wrk_stop( 'wrk_in_use_xz : caught unexpected argument count - BUG' )   ;   EXIT
430         ENDIF
431         !
432      END DO ! while( (.NOT. wrk_in_use_xz) .AND. iarg <= max_num_wrkspaces)
433#endif
434      !
435   END FUNCTION wrk_in_use_xz
436
437
438   FUNCTION wrk_not_released( kdim,    index1,  index2,  index3,  index4,  &
439      &                       index5,  index6,  index7,  index8,  index9,  &
440      &                       index10, index11, index12, index13, index14, &
441      &                       index15, index16, index17, index18, index19, &
442      &                       index20, index21, index22, index23, index24, &
443      &                       index25, index26, index27)
444      !!----------------------------------------------------------------------
445      !!                 ***  FUNCTION wrk_not_released  ***
446      !!
447      !! ** Purpose :   Flag that the specified workspace arrays are no-longer
448      !!                in use.
449      !!----------------------------------------------------------------------
450      INTEGER          , INTENT(in) ::   kdim             ! Dimensionality of workspace(s)
451      INTEGER          , INTENT(in) ::   index1           ! Index of 1st workspace to release
452      INTEGER, OPTIONAL, INTENT(in) ::            index2 , index3 , index4 , index5 , index6 , index7 , index8 , index9 , index10
453      INTEGER, OPTIONAL, INTENT(in) ::   index11, index12, index13, index14, index15, index16, index17, index18, index19, index20
454      INTEGER, OPTIONAL, INTENT(in) ::   index21, index22, index23, index24, index25, index26, index27
455      !
456      LOGICAL ::   wrk_not_released   ! Return value
457      INTEGER ::   iarg, iptr
458      !!----------------------------------------------------------------------
459      !
460      wrk_not_released = .FALSE.
461      !
462#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif
463      ! NB: check not available with AGRIF
464      !
465      iptr = index1
466      iarg = 1
467      !
468      DO WHILE( iarg <= max_num_wrkspaces )
469         !
470         IF( kdim == 1 ) THEN
471            IF( iptr > num_1d_wrkspaces ) THEN
472               CALL wrk_stop( 'wrk_not_released : attempt to release a non-existent 1D workspace array' )
473               wrk_not_released = .TRUE.
474            ELSE
475               in_use_1d(iptr) = .FALSE.
476            ENDIF
477            !
478         ELSE IF(kdim == 2) THEN
479            IF( iptr > num_2d_wrkspaces ) THEN
480               CALL wrk_stop( 'wrk_not_released : attempt to release a non-existent 2D workspace array' )
481               wrk_not_released = .TRUE.
482            ENDIF
483            in_use_2d(iptr) = .FALSE.
484            !
485         ELSEIF( kdim == 3 ) THEN
486            IF( iptr > num_3d_wrkspaces ) THEN
487               CALL wrk_stop('wrk_not_released : attempt to release a non-existent 3D workspace array')
488               wrk_not_released = .TRUE.
489            ENDIF
490            in_use_3d(iptr) = .FALSE.
491            !
492          ELSEIF( kdim == 4 ) THEN
493            IF( iptr > num_4d_wrkspaces ) THEN
494               CALL wrk_stop('wrk_not_released : attempt to release a non-existent 4D workspace array')
495               wrk_not_released = .TRUE.
496            ENDIF
497            in_use_4d(iptr) = .FALSE.
498            !
499         ELSE
500            IF(llwp) WRITE(kumout,*) 'wrk_not_released: unsupported value of kdim = ',kdim
501            CALL wrk_stop('wrk_not_released: unrecognised value for number of dimensions')
502         ENDIF
503         !
504         ! Move on to next optional argument
505         CALL get_next_arg( iarg  ,  iptr  ,  index2,  index3,  index4,   &
506            &               index5,  index6,  index7,  index8,  index9,   &
507            &               index10, index11, index12, index13,           &
508            &               index14, index15, index16, index17,           &
509            &               index18, index19, index20, index21,           &
510            &               index22, index23, index24, index25,           &
511            &               index26, index27 )
512
513         IF( iarg == -1 ) THEN      ! We've checked all of the arguments and are done
514            EXIT
515         ELSEIF( iarg == -99 ) THEN
516             CALL wrk_stop('wrk_not_released - caught unexpected argument count - BUG')   ;   EXIT
517         ENDIF
518         !
519      END DO ! end of DO WHILE()
520#endif
521      !
522   END FUNCTION wrk_not_released
523
524
525   FUNCTION iwrk_not_released( kdim, index1, index2, index3, index4,   &
526      &                              index5, index6, index7 )
527      !!----------------------------------------------------------------------
528      !!                 ***  FUNCTION iwrk_not_released  ***
529      !!
530      !! ** Purpose :   Flag that the specified INTEGER workspace arrays are
531      !!                no-longer in use.
532      !!----------------------------------------------------------------------
533      INTEGER          , INTENT(in) ::   kdim             ! Dimensionality of workspace(s)
534      INTEGER          , INTENT(in) ::   index1           ! Index of 1st workspace to release
535      INTEGER, OPTIONAL, INTENT(in) ::   index2, index3, index4, index5, index6, index7
536      !
537      LOGICAL :: iwrk_not_released   ! Return value
538      INTEGER :: iarg, iptr          ! local integer
539      !!----------------------------------------------------------------------
540      !
541      iwrk_not_released = .FALSE.
542      !
543#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif
544      ! NB: check not available with AGRIF
545      !
546      iptr = index1
547      iarg = 1
548      !
549      DO WHILE(iarg <= max_num_wrkspaces)
550         !
551         IF( kdim == 2 ) THEN
552            IF( iptr > num_2d_iwrkspaces ) THEN
553               CALL wrk_stop('iwrk_not_released : attempt to release a non-existant 2D workspace array')
554               iwrk_not_released = .TRUE.
555            ENDIF
556            in_use_2di(iptr) = .FALSE.
557         ELSE
558            IF(llwp) WRITE(kumout,*) 'iwrk_not_released: unsupported value of kdim = ',kdim
559            CALL wrk_stop('iwrk_not_released: unsupported value for number of dimensions')
560         ENDIF
561         !
562         ! Move on to next optional argument
563         SELECT CASE (iarg)
564         CASE ( 1 )
565            IF( .NOT. PRESENT(index2) ) THEN   ;   EXIT
566            ELSE                               ;   iarg = 2   ;   iptr = index2
567            ENDIF
568         CASE ( 2 )
569            IF( .NOT. PRESENT(index3) ) THEN   ;   EXIT
570            ELSE                               ;   iarg = 3   ;   iptr = index3
571            ENDIF
572         CASE ( 3 )
573            IF( .NOT. PRESENT(index4) ) THEN   ;   EXIT
574            ELSE                               ;   iarg = 4   ;   iptr = index4
575            ENDIF
576         CASE ( 4 )
577            IF( .NOT. PRESENT(index5) ) THEN   ;   EXIT
578            ELSE                               ;   iarg = 5   ;   iptr = index5
579            ENDIF
580         CASE ( 5 )
581            IF( .NOT. PRESENT(index6) ) THEN   ;   EXIT
582            ELSE                               ;   iarg = 6   ;   iptr = index6
583            ENDIF
584         CASE ( 6 )
585            IF( .NOT. PRESENT(index7) ) THEN   ;   EXIT
586            ELSE                               ;   iarg = 7   ;   iptr = index7
587            ENDIF
588         CASE ( 7 )
589            EXIT
590         CASE DEFAULT
591            CALL wrk_stop( 'iwrk_not_released : caught unexpected argument count - BUG' )
592            EXIT
593         END SELECT
594         !
595      END DO ! end of DO WHILE()
596#endif
597      !
598   END FUNCTION iwrk_not_released
599
600
601   FUNCTION wrk_not_released_xz( index1, index2, index3, index4, index5,   &
602      &                          index6, index7, index8, index9 )
603      !!----------------------------------------------------------------------
604      !!                 ***  FUNCTION wrk_not_released_xz  ***
605      !!
606      !!----------------------------------------------------------------------
607      INTEGER          , INTENT(in) ::   index1   ! Index of 1st workspace to release
608      INTEGER, OPTIONAL, INTENT(in) ::   index2, index3, index4, index5, index6, index7, index8, index9
609      !
610      LOGICAL ::   wrk_not_released_xz   ! Return value
611      INTEGER ::   iarg, iptr            ! local integer
612      !!----------------------------------------------------------------------
613      !
614      wrk_not_released_xz = .FALSE.
615      !
616#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif
617      ! NB: check not available with AGRIF
618      !
619      iptr           = index1
620      iarg           = 1
621      !
622      DO WHILE( iarg <= max_num_wrkspaces )
623         !
624         IF( iptr > num_xz_wrkspaces ) THEN
625            CALL wrk_stop('wrk_not_released_xz : attempt to release a non-existant 2D xz workspace array')
626            wrk_not_released_xz = .TRUE.
627            EXIT
628         ENDIF
629         in_use_xz(iptr) = .FALSE.
630         !
631         ! Move on to next optional argument
632         CALL get_next_arg( iarg, iptr, index2, index3, index4,   &
633            &                           index5, index6, index7, index8, index9)
634         !
635         IF(  iarg == -1 ) THEN     ! We've checked all of the arguments and are done
636            EXIT
637         ELSEIF( iarg == -99 ) THEN
638            CALL wrk_stop('wrk_not_released_xz : caught unexpected argument count - BUG')
639            EXIT
640         ENDIF
641         !
642      END DO ! while (iarg <= max_num_wrkspaces)
643#endif
644      !
645   END FUNCTION wrk_not_released_xz
646
647
648   SUBROUTINE print_in_use_list( kdim, itype, in_use_list )
649      !!----------------------------------------------------------------------
650      !!                 *** ROUTINE print_in_use_list ***
651      !!
652      !! ** Purpose:   to print out the table holding which workspace arrays
653      !!             are currently marked as in use.
654      !!----------------------------------------------------------------------
655      INTEGER,               INTENT(in) :: kdim
656      INTEGER,               INTENT(in) :: itype
657      LOGICAL, DIMENSION(:), INTENT(in) :: in_use_list
658      !
659      INTEGER          ::   ji, icount
660      CHARACTER(LEN=7) ::   type_string
661      !!----------------------------------------------------------------------
662      !
663      IF(.NOT. llwp)   RETURN
664      !
665      SELECT CASE ( kdim )
666      !
667      CASE (1)
668         SELECT CASE (itype)
669         CASE (INTEGER_TYPE)   ;   icount = num_1d_iwrkspaces
670         CASE (LOGICAL_TYPE)   ;   icount = num_1d_lwrkspaces
671         CASE (REAL_TYPE   )   ;   icount = num_1d_wrkspaces
672         END SELECT
673         !
674      CASE (2)
675         SELECT CASE (itype)
676         CASE (INTEGER_TYPE)   ;   icount = num_2d_iwrkspaces
677         CASE (LOGICAL_TYPE)   ;   icount = num_2d_lwrkspaces
678         CASE (REAL_TYPE   )   ;   icount = num_2d_wrkspaces
679         END SELECT
680         !
681      CASE (3)
682         SELECT CASE (itype)
683         CASE (INTEGER_TYPE)   ;   icount = num_3d_iwrkspaces
684         CASE (LOGICAL_TYPE)   ;   icount = num_3d_lwrkspaces
685         CASE (REAL_TYPE   )   ;   icount = num_3d_wrkspaces
686         END SELECT
687         !
688      CASE (4)
689         SELECT CASE (itype)
690         CASE (INTEGER_TYPE)   ;   icount = num_4d_iwrkspaces
691         CASE (LOGICAL_TYPE)   ;   icount = num_4d_lwrkspaces
692         CASE (REAL_TYPE   )   ;   icount = num_4d_wrkspaces
693         END SELECT
694         !
695      CASE DEFAULT   ;   RETURN
696      !
697      END SELECT
698      !
699      ! Set character string with type of workspace
700      SELECT CASE (itype)
701      CASE (INTEGER_TYPE)   ;   type_string = "INTEGER" 
702      CASE (LOGICAL_TYPE)   ;   type_string = "LOGICAL"
703      CASE (REAL_TYPE   )   ;   type_string = "REAL" 
704      END SELECT
705      !
706      WRITE(kumout,*)
707      WRITE(kumout,"('------------------------------------------')")
708      WRITE(kumout,"('Table of ',I1,'D ',(A),' workspaces currently in use:')") kdim, TRIM(type_string)
709      WRITE(kumout,"('Workspace   In use')")
710      DO ji = 1, icount, 1
711         WRITE(kumout,"(4x,I2,8x,L1)") ji, in_use_list(ji)
712      END DO
713      WRITE(kumout,"('------------------------------------------')")
714      WRITE(kumout,*)
715      !
716   END SUBROUTINE print_in_use_list
717
718
719   SUBROUTINE get_next_arg( iargidx, iargval, index2,  index3,  index4,  &
720      &                     index5 , index6,  index7,  index8,  index9,  &
721      &                     index10, index11, index12, index13, index14, &
722      &                     index15, index16, index17, index18, index19, &
723      &                     index20, index21, index22, index23, index24, &
724      &                     index25, index26, index27 )
725      !!----------------------------------------------------------------------
726      INTEGER          , INTENT(inout) ::   iargidx   ! Index of current arg
727      INTEGER          , INTENT(inout) ::   iargval   ! Value of current arg
728      INTEGER, OPTIONAL, INTENT(in   ) ::            index2 , index3 , index4 , index5 , index6 , index7 , index8 , index9 , index10
729      INTEGER, OPTIONAL, INTENT(in   ) ::   index11, index12, index13, index14, index15, index16, index17, index18, index19, index20
730      INTEGER, OPTIONAL, INTENT(in   ) ::   index21, index22, index23, index24, index25, index26, index27
731      !!----------------------------------------------------------------------
732      !
733      SELECT CASE (iargidx)       ! Move on to next optional argument
734      CASE ( 1 )
735         IF( .NOT. PRESENT(index2 ) ) THEN   ;   iargidx = -1
736         ELSE                                ;   iargidx =  2   ;   iargval = index2
737         ENDIF
738      CASE ( 2 )
739         IF( .NOT. PRESENT(index3 ) ) THEN   ;   iargidx = -1
740         ELSE                                ;   iargidx =  3   ;   iargval = index3
741         ENDIF
742      CASE ( 3 )
743         IF( .NOT. PRESENT(index4 ) ) THEN   ;   iargidx = -1
744         ELSE                                ;   iargidx =  4   ;   iargval = index4
745         ENDIF
746      CASE ( 4 )
747         IF( .NOT. PRESENT(index5 ) ) THEN   ;   iargidx = -1
748         ELSE                                ;   iargidx =  5   ;   iargval = index5
749         ENDIF
750      CASE ( 5 )
751         IF( .NOT. PRESENT(index6 ) ) THEN   ;   iargidx = -1
752         ELSE                                ;   iargidx =  6   ;   iargval = index6
753         ENDIF
754      CASE ( 6 )
755         IF( .NOT. PRESENT(index7 ) ) THEN   ;   iargidx = -1
756         ELSE                                ;   iargidx =  7   ;   iargval = index7
757         ENDIF
758      CASE ( 7 )
759         IF( .NOT. PRESENT(index8 ) ) THEN   ;   iargidx = -1
760         ELSE                                ;   iargidx =  8   ;   iargval = index8
761         ENDIF
762      CASE ( 8 )
763         IF( .NOT. PRESENT(index9 ) ) THEN   ;   iargidx = -1
764         ELSE                                ;   iargidx =  9   ;   iargval = index9
765         ENDIF
766      CASE ( 9 )
767         IF( .NOT. PRESENT(index10) ) THEN   ;   iargidx = -1
768         ELSE                                ;   iargidx = 10   ;   iargval = index10
769         ENDIF
770      CASE ( 10 )
771         IF( .NOT. PRESENT(index11) ) THEN   ;   iargidx = -1
772         ELSE                                ;   iargidx = 11   ;   iargval = index11
773         ENDIF
774      CASE ( 11 )
775         IF( .NOT. PRESENT(index12) ) THEN   ;   iargidx = -1
776         ELSE                                ;   iargidx = 12   ;   iargval = index12
777         ENDIF
778      CASE ( 12 )
779         IF( .NOT. PRESENT(index13) ) THEN   ;   iargidx = -1
780         ELSE                                ;   iargidx =  13   ;   iargval = index13
781         ENDIF
782      CASE ( 13 )
783         IF( .NOT. PRESENT(index14) ) THEN   ;   iargidx = -1
784         ELSE                                ;   iargidx = 14   ;   iargval = index14
785         ENDIF
786      CASE ( 14 )
787         IF( .NOT. PRESENT(index15) ) THEN   ;   iargidx = -1
788         ELSE                                ;   iargidx = 15   ;   iargval = index15
789         ENDIF
790      CASE ( 15 )
791         IF( .NOT. PRESENT(index16) ) THEN   ;   iargidx = -1
792         ELSE                                ;   iargidx = 16   ;   iargval = index16
793         ENDIF
794      CASE ( 16 )
795         IF( .NOT. PRESENT(index17) ) THEN   ;   iargidx = -1
796         ELSE                                ;   iargidx = 17   ;   iargval = index17
797         ENDIF
798      CASE ( 17 )
799         IF( .NOT. PRESENT(index18) ) THEN   ;   iargidx = -1
800         ELSE                                ;   iargidx = 18   ;   iargval = index18
801         ENDIF
802      CASE ( 18 )
803         IF( .NOT. PRESENT(index19) ) THEN   ;   iargidx = -1
804         ELSE                                ;   iargidx = 19   ;   iargval = index19
805         ENDIF
806      CASE ( 19 )
807         IF( .NOT. PRESENT(index20) ) THEN   ;   iargidx = -1
808         ELSE                                ;   iargidx = 20   ;   iargval = index20
809         ENDIF
810      CASE ( 20 )
811         IF( .NOT. PRESENT(index21) ) THEN   ;   iargidx = -1
812         ELSE                                ;   iargidx = 21   ;   iargval = index21
813         ENDIF
814      CASE ( 21 )
815         IF( .NOT. PRESENT(index22) ) THEN   ;   iargidx = -1
816         ELSE                                ;   iargidx = 22   ;   iargval = index22
817         ENDIF
818      CASE ( 22 )
819         IF( .NOT. PRESENT(index23) ) THEN   ;   iargidx = -1
820         ELSE                                ;   iargidx = 23   ;   iargval = index23
821         ENDIF
822      CASE ( 23 )
823         IF( .NOT. PRESENT(index24) ) THEN   ;   iargidx = -1
824         ELSE                                ;   iargidx = 24   ;   iargval = index24
825         ENDIF
826      CASE ( 24 )
827         IF( .NOT. PRESENT(index25) ) THEN   ;   iargidx = -1
828         ELSE                                ;   iargidx = 25   ;   iargval = index25
829         ENDIF
830      CASE ( 25 )
831         IF( .NOT. PRESENT(index26) ) THEN   ;   iargidx = -1
832         ELSE                                ;   iargidx = 26   ;   iargval = index26
833         ENDIF
834      CASE ( 26 )
835         IF( .NOT. PRESENT(index27) ) THEN   ;   iargidx = -1
836         ELSE                                ;   iargidx = 27   ;   iargval = index27
837         ENDIF
838      CASE ( 27 )
839         iargidx = -1
840      CASE DEFAULT
841         ! BUG - iargidx shouldn't take any other values!
842         ! Flag error for calling routine
843         iargidx = -99
844      END SELECT
845      !
846   END SUBROUTINE get_next_arg
847
848
849   SUBROUTINE wrk_stop(cmsg)
850      !!----------------------------------------------------------------------
851      !!               ***  ROUTINE wrk_stop  ***
852      !! ** Purpose :   to act as local alternative to ctl_stop.
853      !!                Avoids dependency on in_out_manager module.
854      !!----------------------------------------------------------------------
855      CHARACTER(LEN=*), INTENT(in) :: cmsg
856      !!----------------------------------------------------------------------
857      !
858      WRITE(kumout, cform_err2)
859      WRITE(kumout,*) TRIM(cmsg)
860      ! ARPDBG - would like to call mppstop here to force a stop but that
861      ! introduces a dependency on lib_mpp. Could call mpi_abort() directly
862      ! but that's fairly brutal. Better to rely on calling routine to
863      ! deal with the error passed back from the wrk_X routine?
864      !CALL mppstop
865      !
866   END SUBROUTINE wrk_stop
867
868   !!=====================================================================
869END MODULE wrk_nemo
Note: See TracBrowser for help on using the repository browser.