Index: /branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90
===================================================================
--- /branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90	(revision 2687)
+++ /branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90	(revision 2688)
@@ -10,7 +10,6 @@
    !!----------------------------------------------------------------------
    !!   wrk_alloc         : define in memory the work space arrays
-   !!   wrk_in_use, llwrk_in_use, iwrk_in_use, wrk_in_use_xz :
-   !!                       check whether the requested workspace is already used or not
-   !!   wrk_not_released, llwrk_not_released, iwrk_not_released, wrk_not_released_xz : release the workspace
+   !!   wrk_in_use, iwrk_in_use, wrk_in_use_xz : check the availability of a workspace 
+   !!   wrk_not_released, iwrk_not_released, wrk_not_released_xz : release the workspace
    !!   print_in_use_list : print out the table holding which workspace arrays are currently marked as in use
    !!   get_next_arg      : get the next argument
@@ -23,6 +22,6 @@
 
    PUBLIC   wrk_alloc   ! function called in nemogcm module (nemo_init routine)
-   PUBLIC   wrk_in_use, llwrk_in_use, iwrk_in_use, wrk_in_use_xz                           ! function called almost everywhere
-   PUBLIC   wrk_not_released, llwrk_not_released, iwrk_not_released, wrk_not_released_xz   ! function called almost everywhere
+   PUBLIC   wrk_in_use, iwrk_in_use, wrk_in_use_xz                     ! function called almost everywhere
+   PUBLIC   wrk_not_released, iwrk_not_released, wrk_not_released_xz   ! function called almost everywhere
 
    INTEGER, PARAMETER :: num_1d_wrkspaces  = 27   ! No. of 1D workspace arrays ( MAX(jpi*jpj,jpi*jpk,jpj*jpk) )
@@ -76,8 +75,4 @@
    !                                                               !!**  4D, x-y-z-tra, REAL(wp) workspaces  **
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:), TARGET, PUBLIC ::   wrk_4d_1, wrk_4d_2, wrk_4d_3, wrk_4d_4 
-
-!!gm   !                                                               !!**  2D-3D logical workspace  **
-!!gm   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)            , PUBLIC ::   llwrk_2d_1, llwrk_2d_2, llwrk_2d_3 
-!!gm   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   llwrk_3d_1 !: 3D logical workspace
    
    !                                                               !!** 2D integer workspace  **
@@ -106,5 +101,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
-   !! $Id$
+   !! $Id:$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -123,5 +118,5 @@
       INTEGER ::   wrk_alloc   ! Return value
       INTEGER ::   extent_1d   ! Extent to allocate for 1D arrays
-      INTEGER ::   ierror(8)   ! local integer
+      INTEGER ::   ierror(6)   ! local integer
       !!----------------------------------------------------------------------
       !
@@ -136,5 +131,5 @@
       ELSEIF( jpj < jpi .AND. jpj < jpk ) THEN   ;   extent_1d = jpi*jpk
       ELSE                                       ;   extent_1d = jpi*jpj
-      END IF
+      ENDIF
       !
       ! Initialise the 'in use' flags for each work-space array
@@ -147,7 +142,7 @@
       in_use_3dll(:) = .FALSE.
       in_use_2di (:) = .FALSE.
-      
+      !
       ierror(:) = 0
-
+      !
       ALLOCATE( wrk_1d_1 (extent_1d) , wrk_1d_2 (extent_1d) , wrk_1d_3 (extent_1d) , wrk_1d_4 (extent_1d) ,     &
          &      wrk_1d_5 (extent_1d) , wrk_1d_6 (extent_1d) , wrk_1d_7 (extent_1d) , wrk_1d_8 (extent_1d) ,     &
@@ -182,9 +177,5 @@
       ALLOCATE( wrk_xz_1(jpi,jpk) , wrk_xz_2(jpi,jpk) , wrk_xz_3(jpi,jpk) , wrk_xz_4(jpi,jpk) , STAT=ierror(5) )
          !
-!!gm      ALLOCATE( llwrk_2d_1(jpi,jpj) , llwrk_2d_2(jpi,jpj) , llwrk_2d_3(jpi,jpj)               , STAT=ierror(6) )
-         !
-!!gm      ALLOCATE( llwrk_3d_1(jpi,jpj,jpk) , STAT=ierror(7) )
-         !
-      ALLOCATE( iwrk_2d_1(jpi,jpj)      , STAT=ierror(8) )
+      ALLOCATE( iwrk_2d_1(jpi,jpj)      , STAT=ierror(6) )
       !
       wrk_alloc = MAXVAL( ierror )
@@ -195,5 +186,5 @@
          WRITE(kumout,cform_war2)
          WRITE(kumout,*) 'wrk_alloc: allocation of workspace arrays failed'
-      END IF
+      ENDIF
       !
    END FUNCTION wrk_alloc
@@ -225,12 +216,14 @@
       INTEGER ::   iarg, iptr   ! local integer
       !!----------------------------------------------------------------------
-
+      !
       wrk_in_use = .FALSE.
-      
-#if ! defined   key_no_workspace_check || ! defined key_agrif
+      !
+#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif
+      ! NB: check not available with AGRIF
+      !
       iptr    = index1
       iarg    = 1
-      
-      DO WHILE( (.NOT. wrk_in_use) .AND. iarg <= max_num_wrkspaces )
+      !
+      DO WHILE( .NOT. wrk_in_use .AND. iarg <= max_num_wrkspaces )
          !
          IF( kdim == 1 ) THEN
@@ -282,5 +275,5 @@
             IF(llwp) WRITE(kumout,*) 'wrk_in_use: unsupported value of kdim = ',kdim
             CALL wrk_stop( 'wrk_in_use: unrecognised value for number of dimensions' )
-         END IF
+         ENDIF
 
          CALL get_next_arg( iarg  ,  iptr  ,  index2,  index3,  index4,    &
@@ -296,83 +289,10 @@
             CALL wrk_stop( 'wrk_in_use : caught unexpected argument count - BUG' )
             EXIT
-         END IF
+         ENDIF
          !
       END DO ! end of DO WHILE()
 #endif
       !
-    END FUNCTION wrk_in_use
-
-
-   FUNCTION llwrk_in_use( kdim,   index1, index2, index3, index4,   &
-      &                   index5, index6, index7, index8, index9)
-      !!----------------------------------------------------------------------
-      !!                   ***  FUNCTION llwrk_in_use  ***
-      !!
-      !! ** Purpose :   Request a set of LOGICAL workspaces to use. Returns 
-      !!                .TRUE. if any of those requested are already in use, 
-      !!                .FALSE. otherwise. 
-      !!
-      !! ** Method  :   Sets internal flags to signal that requested workspaces
-      !!                are in use.
-      !!----------------------------------------------------------------------
-      INTEGER          , INTENT(in) ::   kdim     ! Dimensionality of requested workspace(s)
-      INTEGER          , INTENT(in) ::   index1   ! Index of first requested workspace
-      INTEGER, OPTIONAL, INTENT(in) ::   index2, index3, index4, index5, index6, index7, index8, index9
-      !
-      LOGICAL ::   llwrk_in_use  ! Return value
-      INTEGER ::   iarg, iptr    ! local integers
-      !!----------------------------------------------------------------------
-      !
-      llwrk_in_use = .FALSE.
-      !
-#if ! defined   key_no_workspace_check || ! defined key_agrif
-      !
-      iptr      = index1
-      iarg      = 1
-      !
-      DO WHILE( (.NOT. llwrk_in_use) .AND. iarg <= max_num_wrkspaces )
-         !
-         IF( kdim == 2 ) THEN
-            IF(iptr > num_2d_lwrkspaces)THEN
-               CALL wrk_stop('llwrk_in_use - more 2D workspace arrays requested than defined in wrk_nemo module')
-               llwrk_in_use = .TRUE.
-               EXIT
-            ELSE IF( in_use_2dll(iptr) )THEN
-               llwrk_in_use = .TRUE.
-               CALL print_in_use_list(2, REAL_TYPE, in_use_2d)
-            END IF
-            in_use_2dll(iptr) = .TRUE.
-            !
-         ELSE IF (kdim == 3)THEN
-            !
-            IF(iptr > num_3d_lwrkspaces)THEN
-               CALL wrk_stop('llwrk_in_use - more 3D workspace arrays requested than defined in wrk_nemo module')
-               llwrk_in_use = .TRUE.
-               EXIT
-            ELSE IF( in_use_3dll(iptr) )THEN
-               llwrk_in_use = .TRUE.
-               CALL print_in_use_list(3, REAL_TYPE, in_use_3d)
-            END IF
-            !
-            in_use_3dll(iptr) = .TRUE.
-         ELSE 
-            IF(llwp) WRITE(kumout,*) 'llwrk_in_use: unsupported value of kdim = ',kdim
-            CALL wrk_stop('llwrk_in_use: unrecognised value for number of dimensions')
-         END IF
-
-         CALL get_next_arg( iarg  , iptr  , index2, index3, index4, &
-            &               index5, index6, index7, index8, index9)
-
-         IF( iarg == -1 ) THEN      ! We've checked all of the arguments and are done
-            EXIT
-         ELSEIF( iarg == -99 ) THEN
-            CALL wrk_stop( 'llwrk_in_use - ERROR, caught unexpected argument count - BUG' )
-            EXIT
-         ENDIF
-         !
-      END DO ! while( (.NOT. llwrk_in_use) .AND. iarg <= max_num_wrkspaces)
-#endif
-      !
-   END FUNCTION llwrk_in_use
+   END FUNCTION wrk_in_use
 
 
@@ -399,10 +319,11 @@
       iwrk_in_use = .FALSE.
       !
-#if ! defined   key_no_workspace_check
+#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif
+      ! NB: check not available with AGRIF
       !
       iptr     = index1
       iarg     = 1
-      
-      DO WHILE( (.NOT. iwrk_in_use) .AND. iarg <= max_num_wrkspaces )
+      !
+      DO WHILE( .NOT.iwrk_in_use .AND. iarg <= max_num_wrkspaces )
          !
          IF( kdim == 2 ) THEN
@@ -413,5 +334,5 @@
                iwrk_in_use = .TRUE.
                CALL print_in_use_list( 2, INTEGER_TYPE, in_use_2di )
-            END IF
+            ENDIF
             in_use_2di(iptr) = .TRUE.
             !
@@ -419,32 +340,31 @@
             IF(llwp) WRITE(kumout,*) 'iwrk_in_use: unsupported value of kdim = ',kdim
             CALL wrk_stop('iwrk_in_use: unsupported value for number of dimensions')
-         END IF
-
-         ! Move on to next optional argument
-         SELECT CASE (iarg)
+         ENDIF
+         !
+         SELECT CASE (iarg)         ! Move on to next optional argument
          CASE ( 1 )
             IF( .NOT. PRESENT(index2) ) THEN   ;   EXIT
             ELSE                               ;   iarg = 2   ;   iptr = index2
-            END IF
+            ENDIF
          CASE ( 2 )
             IF( .NOT. PRESENT(index3) ) THEN   ;   EXIT
             ELSE                               ;   iarg = 3   ;   iptr = index3
-            END IF
+            ENDIF
          CASE ( 3 )
             IF( .NOT. PRESENT(index4) ) THEN   ;   EXIT
             ELSE                               ;   iarg = 4   ;   iptr = index4
-            END IF
+            ENDIF
          CASE ( 4 )
             IF( .NOT. PRESENT(index5) ) THEN   ;   EXIT
             ELSE                               ;   iarg = 5   ;   iptr = index5
-            END IF
+            ENDIF
          CASE ( 5 )
             IF( .NOT. PRESENT(index6) ) THEN   ;   EXIT
             ELSE                               ;   iarg = 6   ;   iptr = index6
-            END IF
+            ENDIF
          CASE ( 6 )
             IF( .NOT. PRESENT(index7) ) THEN   ;   EXIT
             ELSE                               ;   iarg = 7   ;   iptr = index7
-            END IF
+            ENDIF
          CASE ( 7 )
             EXIT
@@ -457,5 +377,5 @@
 #endif
       !
-    END FUNCTION iwrk_in_use
+   END FUNCTION iwrk_in_use
 
 
@@ -482,12 +402,13 @@
       wrk_in_use_xz = .FALSE.
       !
-#if ! defined   key_no_workspace_check
-      !
-      iptr       = index1
-      iarg       = 1
-       
-      DO WHILE( (.NOT. wrk_in_use_xz) .AND. iarg <= max_num_wrkspaces )
-         !
-         IF(iptr > num_xz_wrkspaces) THEN
+#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif
+      ! NB: check not available with AGRIF
+      !
+      iptr = index1
+      iarg = 1
+      !
+      DO WHILE( .NOT. wrk_in_use_xz .AND. iarg <= max_num_wrkspaces )
+         !
+         IF( iptr > num_xz_wrkspaces ) THEN
             CALL wrk_stop('wrk_in_use_xz - more 2D xz workspace arrays requested than defined in wrk_nemo module')
             wrk_in_use_xz = .TRUE.
@@ -496,10 +417,10 @@
             wrk_in_use_xz = .TRUE.
             CALL print_in_use_list(2, REAL_TYPE, in_use_xz) !ARPDBG - bug
-         END IF
+         ENDIF
          !
          in_use_xz(iptr) = .TRUE.
          !
-         CALL get_next_arg(iarg  , iptr  , index2, index3, index4, &
-            &              index5, index6, index7, index8, index9)
+         CALL get_next_arg( iarg  , iptr  , index2, index3, index4,   &
+            &               index5, index6, index7, index8, index9 )
          !
          IF( iarg == -1 ) THEN      ! We've checked all of the arguments and are done
@@ -507,5 +428,5 @@
          ELSEIF( iarg == -99 ) THEN
             CALL wrk_stop( 'wrk_in_use_xz : caught unexpected argument count - BUG' )   ;   EXIT
-         END IF
+         ENDIF
          !
       END DO ! while( (.NOT. wrk_in_use_xz) .AND. iarg <= max_num_wrkspaces)
@@ -539,9 +460,10 @@
       wrk_not_released = .FALSE.
       !
-#if ! defined   key_no_workspace_check
+#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif
+      ! NB: check not available with AGRIF
       !
       iptr = index1
       iarg = 1
-
+      !
       DO WHILE( iarg <= max_num_wrkspaces )
          !
@@ -554,5 +476,5 @@
             ENDIF
             !
-         ELSE IF(kdim == 2)THEN
+         ELSE IF(kdim == 2) THEN
             IF( iptr > num_2d_wrkspaces ) THEN
                CALL wrk_stop( 'wrk_not_released : attempt to release a non-existent 2D workspace array' )
@@ -565,12 +487,12 @@
                CALL wrk_stop('wrk_not_released : attempt to release a non-existent 3D workspace array')
                wrk_not_released = .TRUE.
-            END IF
+            ENDIF
             in_use_3d(iptr) = .FALSE.
             !
           ELSEIF( kdim == 4 ) THEN
-            IF(iptr > num_4d_wrkspaces) THEN
+            IF( iptr > num_4d_wrkspaces ) THEN
                CALL wrk_stop('wrk_not_released : attempt to release a non-existent 4D workspace array')
                wrk_not_released = .TRUE.
-            END IF
+            ENDIF
             in_use_4d(iptr) = .FALSE.
             !
@@ -579,5 +501,5 @@
             CALL wrk_stop('wrk_not_released: unrecognised value for number of dimensions')
          ENDIF
-         
+         !
          ! Move on to next optional argument
          CALL get_next_arg( iarg  ,  iptr  ,  index2,  index3,  index4,   &
@@ -593,5 +515,5 @@
          ELSEIF( iarg == -99 ) THEN
              CALL wrk_stop('wrk_not_released - caught unexpected argument count - BUG')   ;   EXIT
-         END IF
+         ENDIF
          !
       END DO ! end of DO WHILE()
@@ -599,64 +521,4 @@
       !
    END FUNCTION wrk_not_released
-
-
-   FUNCTION llwrk_not_released( kdim, index1, index2, index3, index4, index5,   &
-      &                               index6, index7, index8, index9 )
-      !!----------------------------------------------------------------------
-      !!                 ***  FUNCTION wrk_not_released  ***
-      !!----------------------------------------------------------------------
-      INTEGER          , INTENT(in) ::   kdim             ! Dimensionality of workspace(s)
-      INTEGER          , INTENT(in) ::   index1           ! Index of 1st workspace to release
-      INTEGER, OPTIONAL, INTENT(in) ::   index2, index3, index4, index5, index6, index7, index8, index9
-      !
-      LOGICAL ::   llwrk_not_released   ! Return value
-      INTEGER ::   iarg, iptr           ! local integer
-      !!----------------------------------------------------------------------
-      !
-      llwrk_not_released = .FALSE.
-      !
-#if ! defined   key_no_workspace_check
-      !
-      iptr = index1
-      iarg = 1
-      !
-      DO WHILE(iarg <= max_num_wrkspaces)
-         !
-         IF( kdim == 2 ) THEN
-            !
-            IF( iptr > num_2d_lwrkspaces ) THEN
-               CALL wrk_stop( 'llwrk_not_released : attempt to release a non-existent 2D workspace array' )
-               llwrk_not_released = .TRUE.
-               EXIT
-            ENDIF
-            in_use_2dll(iptr) = .FALSE.
-            !
-         ELSEIF( kdim == 3 ) THEN
-            IF( iptr > num_3d_lwrkspaces ) THEN
-               CALL wrk_stop('llwrk_not_released : attempt to release a non-existent 3D workspace array')
-               llwrk_not_released = .TRUE.
-               EXIT
-            ENDIF
-            in_use_3dll(iptr) = .FALSE.
-            !
-         ELSE 
-            IF(llwp) WRITE(kumout,*) 'llwrk_not_released: unsupported value of kdim = ', kdim
-            CALL wrk_stop( 'llwrk_not_released : unrecognised value for number of dimensions' )
-         END IF
-         !
-         ! Move on to next optional argument
-         CALL get_next_arg(iarg, iptr, index2, index3, index4,   &
-            &                          index5, index6, index7, index8, index9)
-         !
-         IF( iarg == -1 ) THEN         ! We've checked all of the arguments and are done
-             EXIT
-         ELSEIF( iarg == -99 ) THEN
-            CALL wrk_stop( 'llwrk_not_released : caught unexpected argument count - BUG' )   ;   EXIT
-         ENDIF
-         !
-      END DO ! while (iarg <= max_num_wrkspaces)
-#endif
-      !
-   END FUNCTION llwrk_not_released
 
 
@@ -679,8 +541,9 @@
       iwrk_not_released = .FALSE.
       !
-#if ! defined   key_no_workspace_check
-      !
-      iptr         = index1
-      iarg         = 1
+#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif
+      ! NB: check not available with AGRIF
+      !
+      iptr = index1
+      iarg = 1
       !
       DO WHILE(iarg <= max_num_wrkspaces)
@@ -702,25 +565,25 @@
             IF( .NOT. PRESENT(index2) ) THEN   ;   EXIT
             ELSE                               ;   iarg = 2   ;   iptr = index2
-            END IF
+            ENDIF
          CASE ( 2 )
             IF( .NOT. PRESENT(index3) ) THEN   ;   EXIT
             ELSE                               ;   iarg = 3   ;   iptr = index3
-            END IF
+            ENDIF
          CASE ( 3 )
             IF( .NOT. PRESENT(index4) ) THEN   ;   EXIT
             ELSE                               ;   iarg = 4   ;   iptr = index4
-            END IF
+            ENDIF
          CASE ( 4 )
             IF( .NOT. PRESENT(index5) ) THEN   ;   EXIT
             ELSE                               ;   iarg = 5   ;   iptr = index5
-            END IF
+            ENDIF
          CASE ( 5 )
             IF( .NOT. PRESENT(index6) ) THEN   ;   EXIT
             ELSE                               ;   iarg = 6   ;   iptr = index6
-            END IF
+            ENDIF
          CASE ( 6 )
             IF( .NOT. PRESENT(index7) ) THEN   ;   EXIT
             ELSE                               ;   iarg = 7   ;   iptr = index7
-            END IF
+            ENDIF
          CASE ( 7 )
             EXIT
@@ -751,5 +614,6 @@
       wrk_not_released_xz = .FALSE.
       !
-#if ! defined   key_no_workspace_check
+#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif
+      ! NB: check not available with AGRIF
       !
       iptr           = index1
@@ -774,5 +638,5 @@
             CALL wrk_stop('wrk_not_released_xz : caught unexpected argument count - BUG')
             EXIT
-         END IF
+         ENDIF
          !
       END DO ! while (iarg <= max_num_wrkspaces)
@@ -796,7 +660,7 @@
       CHARACTER(LEN=7) ::   type_string
       !!----------------------------------------------------------------------
-
+      !
       IF(.NOT. llwp)   RETURN
-
+      !
       SELECT CASE ( kdim )
       !
@@ -832,5 +696,5 @@
       !
       END SELECT
-
+      !
       ! Set character string with type of workspace
       SELECT CASE (itype)
@@ -839,5 +703,5 @@
       CASE (REAL_TYPE   )   ;   type_string = "REAL" 
       END SELECT
-
+      !
       WRITE(kumout,*)
       WRITE(kumout,"('------------------------------------------')")
@@ -866,5 +730,5 @@
       INTEGER, OPTIONAL, INTENT(in   ) ::   index21, index22, index23, index24, index25, index26, index27
       !!----------------------------------------------------------------------
-
+      !
       SELECT CASE (iargidx)       ! Move on to next optional argument
       CASE ( 1 )
@@ -931,5 +795,5 @@
          IF( .NOT. PRESENT(index17) ) THEN   ;   iargidx = -1
          ELSE                                ;   iargidx = 17   ;   iargval = index17
-         END IF
+         ENDIF
       CASE ( 17 )
          IF( .NOT. PRESENT(index18) ) THEN   ;   iargidx = -1
@@ -991,5 +855,5 @@
       CHARACTER(LEN=*), INTENT(in) :: cmsg
       !!----------------------------------------------------------------------
-
+      !
       WRITE(kumout, cform_err2)
       WRITE(kumout,*) TRIM(cmsg)
@@ -999,5 +863,5 @@
       ! deal with the error passed back from the wrk_X routine?
       !CALL mppstop
-
+      !
    END SUBROUTINE wrk_stop
 
