Index: /branches/2011/dev_r2769_LOCEAN_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/wrk_nemo_2.F90
===================================================================
--- /branches/2011/dev_r2769_LOCEAN_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/wrk_nemo_2.F90	(revision 2775)
+++ /branches/2011/dev_r2769_LOCEAN_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/wrk_nemo_2.F90	(revision 2776)
@@ -21,4 +21,5 @@
    PRIVATE
    
+   PUBLIC wrk_alloc_2, nemo_allocate, nemo_deallocate,wrk_list
 
    INTERFACE nemo_allocate
@@ -31,27 +32,4 @@
       &                nemo_deallocate_1d, nemo_deallocate_2d_i
    END INTERFACE
-   PUBLIC wrk_alloc_2, nemo_allocate, nemo_deallocate
-
-
-   INTEGER, PARAMETER :: num_1d_wrkspaces  = 27   ! No. of 1D workspace arrays ( MAX(jpi*jpj,jpi*jpk,jpj*jpk) )
-   INTEGER, PARAMETER :: num_2d_wrkspaces  = 35   ! No. of 2D workspace arrays (jpi,jpj)
-   INTEGER, PARAMETER :: num_3d_wrkspaces  = 15   ! No. of 3D workspace arrays (jpi,jpj,jpk)
-   INTEGER, PARAMETER :: num_4d_wrkspaces  = 4    ! No. of 4D workspace arrays (jpi,jpj,jpk,jpts)
-
-
-   INTEGER, PARAMETER :: num_xz_wrkspaces  = 4   ! No. of 2D, xz workspace arrays (jpi,jpk)
-
-   INTEGER, PARAMETER :: num_1d_lwrkspaces = 0   ! No. of 1D logical workspace arrays
-   INTEGER, PARAMETER :: num_2d_lwrkspaces = 3   ! No. of 2D logical workspace arrays
-   INTEGER, PARAMETER :: num_3d_lwrkspaces = 1   ! No. of 3D logical workspace arrays
-   INTEGER, PARAMETER :: num_4d_lwrkspaces = 0   ! No. of 4D logical workspace arrays
-
-   INTEGER, PARAMETER :: num_1d_iwrkspaces = 0   ! No. of 1D integer workspace arrays
-   INTEGER, PARAMETER :: num_2d_iwrkspaces = 1   ! No. of 2D integer workspace arrays
-   INTEGER, PARAMETER :: num_3d_iwrkspaces = 0   ! No. of 3D integer workspace arrays
-   INTEGER, PARAMETER :: num_4d_iwrkspaces = 0   ! No. of 4D integer workspace arrays
-   ! Maximum no. of workspaces of any one dimensionality that can be
-   ! requested - MAX(num_1d_wrkspaces, num_2d_wrkspaces, num_3d_wrkspaces, num_4d_wrkspaces) 
-   INTEGER :: max_num_wrkspaces = 35
 
    ! If adding more arrays here, remember to increment the appropriate 
@@ -59,43 +37,58 @@
    TYPE work_space_1d
      LOGICAL ::  in_use
-     REAL(wp), DIMENSION(:), POINTER :: wrk    
-   END TYPE
-   TYPE(work_space_1d), DIMENSION(num_1d_wrkspaces) :: s_wrk_1d
-   INTEGER :: n_wrk_1d 
-
+     INTEGER :: indic
+     REAL(wp), DIMENSION(:), POINTER :: wrk
+     TYPE(work_space_1d), POINTER :: next => NULL()  
+     TYPE(work_space_1d), POINTER :: prev => NULL()
+   END TYPE
+   TYPE(work_space_1d), POINTER :: s_wrk_1d_root, s_wrk_1d
+ 
    TYPE work_space_2d
      LOGICAL ::  in_use
+     INTEGER :: indic
      REAL(wp), DIMENSION(:,:), POINTER:: wrk    
-   END TYPE
-   TYPE(work_space_2d), DIMENSION(num_2d_wrkspaces) :: s_wrk_2d 
-   INTEGER :: n_wrk_2d 
+     TYPE (work_space_2d), POINTER :: next => NULL()  
+     TYPE (work_space_2d), POINTER :: prev => NULL()  
+   END TYPE
+   TYPE(work_space_2d), POINTER:: s_wrk_2d_root, s_wrk_2d
 
    TYPE work_space_xz
      LOGICAL ::  in_use
+     INTEGER :: indic
      REAL(wp), DIMENSION(:,:), POINTER :: wrk    
-   END TYPE
-   TYPE(work_space_xz), DIMENSION(num_xz_wrkspaces) :: s_wrk_xz 
-   INTEGER :: n_wrk_xz
+     TYPE (work_space_xz), POINTER :: next => NULL()  
+     TYPE (work_space_xz), POINTER :: prev => NULL()  
+   END TYPE
+   TYPE(work_space_xz), POINTER :: s_wrk_xz_root, s_wrk_xz 
 
    TYPE work_space_3d
      LOGICAL ::  in_use
+     INTEGER :: indic
      REAL(wp), DIMENSION(:,:,:), POINTER :: wrk    
-   END TYPE
-   TYPE(work_space_3d), DIMENSION(num_3d_wrkspaces) :: s_wrk_3d 
-   INTEGER :: n_wrk_3d
+     TYPE (work_space_3d), POINTER :: next => NULL() 
+     TYPE (work_space_3d), POINTER :: prev => NULL() 
+   END TYPE
+   TYPE(work_space_3d), POINTER :: s_wrk_3d_root, s_wrk_3d 
 
    TYPE work_space_4d
      LOGICAL ::  in_use
+     INTEGER :: indic
      REAL(wp), DIMENSION(:,:,:,:), POINTER :: wrk    
-   END TYPE
-   TYPE(work_space_4d), DIMENSION(num_4d_wrkspaces) :: s_wrk_4d 
-   INTEGER :: n_wrk_4d 
+     TYPE   (work_space_4d), POINTER :: next => NULL()  
+     TYPE   (work_space_4d), POINTER :: prev => NULL()  
+   END TYPE
+   TYPE(work_space_4d), POINTER :: s_wrk_4d_root, s_wrk_4d 
 
    TYPE work_space_2d_i
      LOGICAL ::  in_use
+     INTEGER :: indic
      INTEGER, DIMENSION(:,:), POINTER :: wrk    
-   END TYPE
-   TYPE(work_space_2d_i), DIMENSION(num_2d_iwrkspaces) :: s_wrk_2d_i 
-   INTEGER :: n_wrk_2d_i 
+     TYPE   (work_space_2d_i), POINTER :: next => NULL() 
+     TYPE   (work_space_2d_i), POINTER :: prev => NULL()  
+   END TYPE
+   TYPE(work_space_2d_i), POINTER :: s_wrk_2d_i_root, s_wrk_2d_i 
+
+   ! Extent to allocate for 1D arrays
+   INTEGER ::   extent_1d   
    
 
@@ -118,4 +111,21 @@
 CONTAINS
 
+   SUBROUTINE wrk_list
+      ! to list 3d arrays in use, to be duplicated for all cases 
+      WRITE(*,*) 'Arrays in use :'
+      CALL listage(s_wrk_3d_root)
+      WRITE(*,*) ''
+   
+   END SUBROUTINE wrk_list
+
+  RECURSIVE SUBROUTINE listage(ptr)
+   
+      TYPE(work_space_3d), POINTER, INTENT(in) :: ptr
+      !
+      IF( ASSOCIATED(ptr%next) ) CALL listage(ptr%next)
+      WRITE(*,*) ptr%in_use, ptr%indic   
+   
+  END SUBROUTINE listage
+
   FUNCTION wrk_alloc_2(iunit, lwp_arg)
       !!----------------------------------------------------------------------
@@ -130,5 +140,4 @@
       INTEGER :: ji
       INTEGER ::   wrk_alloc_2   ! Return value
-      INTEGER ::   extent_1d   ! Extent to allocate for 1D arrays
       INTEGER, DIMENSION(:), ALLOCATABLE ::   ierror   ! local integer
       !!----------------------------------------------------------------------
@@ -139,6 +148,5 @@
       llwp = lwp_arg
       ! 
-      ALLOCATE(ierror(num_1d_wrkspaces+num_2d_wrkspaces+num_3d_wrkspaces &
-                   & + num_4d_wrkspaces+num_xz_wrkspaces+num_2d_iwrkspaces) )
+      ALLOCATE(ierror(6))
       !
       ! Extent to use for 1D work arrays - find the maximum product of 
@@ -149,37 +157,52 @@
       ENDIF
       !
-      ierror(:) = 0
-      !
-      n_wrk_1d   = 1
-      n_wrk_2d   = 1 
-      n_wrk_3d   = 1
-      n_wrk_4d   = 1 
-      n_wrk_xz   = 1
-      n_wrk_2d_i = 1 
-      
-      DO ji = 1, num_1d_wrkspaces
-       s_wrk_1d(ji)%in_use = .FALSE. 
-       ALLOCATE( s_wrk_1d(ji)%wrk(extent_1d), STAT=ierror(ji) )
-      END DO
-      DO ji = 1, num_2d_wrkspaces
-       s_wrk_2d(ji)%in_use = .FALSE. 
-       ALLOCATE( s_wrk_2d(ji)%wrk(jpi,jpj), STAT=ierror(ji+num_1d_wrkspaces) )
-      END DO
-      DO ji = 1, num_3d_wrkspaces
-       s_wrk_3d(ji)%in_use = .FALSE. 
-       ALLOCATE( s_wrk_3d(ji)%wrk(jpi,jpj,jpk), STAT=ierror(ji+num_2d_wrkspaces) )
-      END DO
-      DO ji = 1, num_4d_wrkspaces
-       s_wrk_4d(ji)%in_use = .FALSE. 
-       ALLOCATE( s_wrk_4d(ji)%wrk(jpi,jpj,jpk,jpts), STAT=ierror(ji+num_3d_wrkspaces) )
-      END DO
-      DO ji = 1, num_xz_wrkspaces
-       s_wrk_xz(ji)%in_use = .FALSE. 
-       ALLOCATE( s_wrk_xz(ji)%wrk(jpi,jpk), STAT=ierror(ji+num_4d_wrkspaces) )
-      END DO
-      DO ji = 1, num_2d_iwrkspaces
-       s_wrk_2d_i(ji)%in_use = .FALSE. 
-       ALLOCATE( s_wrk_2d_i(ji)%wrk(jpi,jpj), STAT=ierror(ji+num_xz_wrkspaces) )
-      END DO
+      
+      ALLOCATE(s_wrk_1d_root)
+      s_wrk_1d_root%in_use = .FALSE. 
+      s_wrk_1d_root%indic = 1 
+      ALLOCATE( s_wrk_1d_root%wrk(extent_1d), STAT=ierror(1) )
+      NULLIFY(s_wrk_1d_root%next)
+      NULLIFY(s_wrk_1d_root%prev)
+      s_wrk_1d => s_wrk_1d_root
+
+      ALLOCATE(s_wrk_2d_root)
+      s_wrk_2d_root%in_use = .FALSE. 
+      s_wrk_2d_root%indic = 1 
+      ALLOCATE( s_wrk_2d_root%wrk(jpi,jpj), STAT=ierror(2) )
+      NULLIFY(s_wrk_2d_root%next)
+      NULLIFY(s_wrk_2d_root%prev)
+      s_wrk_2d => s_wrk_2d_root
+
+      ALLOCATE(s_wrk_3d_root)
+      s_wrk_3d_root%in_use = .FALSE. 
+      s_wrk_3d_root%indic = 1 
+      ALLOCATE( s_wrk_3d_root%wrk(jpi,jpj,jpk), STAT=ierror(3) )
+      NULLIFY(s_wrk_3d_root%next)
+      NULLIFY(s_wrk_3d_root%prev)  
+      s_wrk_3d => s_wrk_3d_root
+      
+      ALLOCATE(s_wrk_4d_root)
+      s_wrk_4d_root%in_use = .FALSE. 
+      s_wrk_4d_root%indic = 1 
+      ALLOCATE( s_wrk_4d_root%wrk(jpi,jpj,jpk,jpts), STAT=ierror(4) )
+      NULLIFY(s_wrk_4d_root%next)
+      NULLIFY(s_wrk_4d_root%prev)
+      s_wrk_4d => s_wrk_4d_root
+      
+      ALLOCATE(s_wrk_xz_root)
+      s_wrk_xz_root%in_use = .FALSE. 
+      s_wrk_xz_root%indic = 1 
+      ALLOCATE( s_wrk_xz_root%wrk(jpi,jpk), STAT=ierror(5) )
+      NULLIFY(s_wrk_xz_root%next)
+      NULLIFY(s_wrk_xz_root%prev)
+      s_wrk_xz => s_wrk_xz_root
+
+      ALLOCATE(s_wrk_2d_i_root)
+      s_wrk_2d_i_root%in_use = .FALSE. 
+      s_wrk_2d_i_root%indic = 1 
+      ALLOCATE( s_wrk_2d_i_root%wrk(jpi,jpj), STAT=ierror(6) )
+      NULLIFY(s_wrk_2d_i_root%next)
+      NULLIFY(s_wrk_2d_i_root%prev)
+      s_wrk_2d_i => s_wrk_2d_i_root
       !
       wrk_alloc_2 = MAXVAL( ierror )
@@ -193,5 +216,4 @@
       !
    END FUNCTION wrk_alloc_2
-
 
    SUBROUTINE nemo_allocate_4d( ptab4d, pidim, pjdim, pkdim, pldim )
@@ -212,9 +234,19 @@
          jt = jpts    
       ENDIF
-      
-      ptab4d => s_wrk_4d(n_wrk_4d)%wrk(1:jx,1:jy,1:jz,1:jt)
-      s_wrk_4d(n_wrk_4d)%in_use = .TRUE.         
-      n_wrk_4d = n_wrk_4d + 1
-      
+ 
+      ptab4d => s_wrk_4d%wrk(1:jx,1:jy,1:jz,1:jt)
+      s_wrk_4d%in_use = .TRUE. 
+      ! 
+      IF( .NOT. ASSOCIATED(s_wrk_4d%next) ) THEN
+         ALLOCATE(s_wrk_4d%next)
+         ALLOCATE(s_wrk_4d%next%wrk(jpi,jpj,jpk,jpts))
+         s_wrk_4d%next%next => NULL()
+         s_wrk_4d%next%prev => s_wrk_4d
+         s_wrk_4d%next%indic = s_wrk_4d%indic + 1        
+         s_wrk_4d%next%in_use = .FALSE. 
+      ENDIF   
+      !
+      s_wrk_4d => s_wrk_4d%next         
+      !     
    END SUBROUTINE nemo_allocate_4d
    
@@ -235,7 +267,17 @@
       ENDIF
       
-      ptab3d => s_wrk_3d(n_wrk_3d)%wrk(1:jx,1:jy,1:jz)
-      s_wrk_3d(n_wrk_3d)%in_use = .TRUE.         
-      n_wrk_3d = n_wrk_3d + 1
+      ptab3d => s_wrk_3d%wrk(1:jx,1:jy,1:jz)
+      s_wrk_3d%in_use = .TRUE.         
+      ! 
+      IF( .NOT. ASSOCIATED(s_wrk_3d%next) ) THEN
+         ALLOCATE(s_wrk_3d%next)
+         ALLOCATE(s_wrk_3d%next%wrk(jpi,jpj,jpk))
+         s_wrk_3d%next%next => NULL()
+         s_wrk_3d%next%prev => s_wrk_3d
+         s_wrk_3d%next%indic = s_wrk_3d%indic + 1        
+         s_wrk_3d%next%in_use = .FALSE. 
+      ENDIF   
+      !       
+      s_wrk_3d => s_wrk_3d%next
      
    END SUBROUTINE nemo_allocate_3d
@@ -250,24 +292,62 @@
          jx = pidim
          jy = pjdim
-         ptab2d => s_wrk_xz(n_wrk_xz)%wrk(1:jx,1:jy)
-         s_wrk_xz(n_wrk_xz)%in_use = .TRUE.         
-         n_wrk_xz = n_wrk_xz + 1
+         ptab2d => s_wrk_xz%wrk(1:jx,1:jy)
+         s_wrk_xz%in_use = .TRUE.         
+         !
+         IF( .NOT. ASSOCIATED(s_wrk_xz%next) ) THEN
+            ALLOCATE(s_wrk_xz%next)
+            ALLOCATE(s_wrk_xz%next%wrk(jx,jy))
+            s_wrk_xz%next%next => NULL()
+            s_wrk_xz%next%prev => s_wrk_xz
+            s_wrk_xz%next%indic = s_wrk_xz%indic + 1        
+            s_wrk_xz%next%in_use = .FALSE.            
+         ENDIF   
+         !
+         s_wrk_xz => s_wrk_xz%next         
       ELSE
          jx = jpi
          jy = jpj    
-         ptab2d => s_wrk_2d(n_wrk_2d)%wrk(:,:)
-         s_wrk_2d(n_wrk_2d)%in_use = .TRUE.         
-         n_wrk_2d = n_wrk_2d + 1
+         ptab2d => s_wrk_2d%wrk(1:jx,1:jy)
+         s_wrk_2d%in_use = .TRUE.         
+         !
+         IF( .NOT. ASSOCIATED(s_wrk_2d%next) ) THEN
+            ALLOCATE(s_wrk_2d%next)
+            ALLOCATE(s_wrk_2d%next%wrk(jx,jy))
+            s_wrk_2d%next%next => NULL()
+            s_wrk_2d%next%prev => s_wrk_2d
+            s_wrk_2d%next%indic = s_wrk_2d%indic + 1        
+            s_wrk_2d%next%in_use = .FALSE.            
+         ENDIF   
+         !
+         s_wrk_2d => s_wrk_2d%next         
       ENDIF
                 
    END SUBROUTINE nemo_allocate_2d
 
-   SUBROUTINE nemo_allocate_1d( ptab1d )
+   SUBROUTINE nemo_allocate_1d( ptab1d, pidim )
       REAL(wp), POINTER, DIMENSION(:), INTENT(inout) :: ptab1d
-      !
-      
-      ptab1d => s_wrk_1d(n_wrk_1d)%wrk(:)
-      s_wrk_1d(n_wrk_1d)%in_use = .TRUE.         
-      n_wrk_1d = n_wrk_1d + 1
+      INTEGER, OPTIONAL, INTENT(in) :: pidim    
+      !
+      INTEGER :: ji, jx, jy, jz
+
+      IF( PRESENT(pidim) ) THEN
+         jx = pidim
+      ELSE
+         jx = jpi
+      ENDIF
+      
+      ptab1d => s_wrk_1d%wrk(1:jx)
+      s_wrk_1d%in_use = .TRUE.         
+      ! 
+      IF( .NOT. ASSOCIATED(s_wrk_1d%next) ) THEN
+         ALLOCATE(s_wrk_1d%next)
+         ALLOCATE(s_wrk_1d%next%wrk(jpi))
+         s_wrk_1d%next%next => NULL()
+         s_wrk_1d%next%prev => s_wrk_1d
+         s_wrk_1d%next%indic = s_wrk_1d%indic + 1        
+         s_wrk_1d%next%in_use = .FALSE. 
+      ENDIF   
+      !       
+      s_wrk_1d => s_wrk_1d%next
    
    END SUBROUTINE nemo_allocate_1d
@@ -279,7 +359,17 @@
       LOGICAL :: l_in_use
       
-      ptab2d => s_wrk_2d_i(n_wrk_2d_i)%wrk(:,:)
-      s_wrk_2d_i(n_wrk_2d)%in_use = .TRUE.         
-      n_wrk_2d_i = n_wrk_2d_i + 1
+      ptab2d => s_wrk_2d_i%wrk(:,:)
+      s_wrk_2d_i%in_use = .TRUE.         
+      !
+      IF( .NOT. ASSOCIATED(s_wrk_2d_i%next) ) THEN
+         ALLOCATE(s_wrk_2d_i%next)
+         ALLOCATE(s_wrk_2d_i%next%wrk(jpi,jpj))
+         s_wrk_2d_i%next%next => NULL()
+         s_wrk_2d_i%next%prev => s_wrk_2d_i
+         s_wrk_2d_i%next%indic = s_wrk_2d_i%indic + 1        
+         s_wrk_2d_i%next%in_use = .FALSE. 
+      ENDIF   
+      !       
+      s_wrk_2d_i => s_wrk_2d_i%next
             
    END SUBROUTINE nemo_allocate_2d_i
@@ -287,39 +377,28 @@
    SUBROUTINE nemo_deallocate_4d( ptab4d )
       REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout) :: ptab4d 
-      
-      NULLIFY(ptab4d)
-      s_wrk_4d(n_wrk_4d)%in_use = .FALSE.        
-      n_wrk_4d = n_wrk_4d - 1
+      !
+      s_wrk_4d => s_wrk_4d%prev
+      s_wrk_4d%in_use = .FALSE.
       
    END SUBROUTINE nemo_deallocate_4d
-   
+
    SUBROUTINE nemo_deallocate_3d( ptab3d)
       REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout) :: ptab3d  
       !
-      
-      NULLIFY(ptab3d)
-      s_wrk_3d(n_wrk_3d)%in_use = .FALSE.         
-      n_wrk_3d = n_wrk_3d - 1
-     
-   END SUBROUTINE nemo_deallocate_3d
+      s_wrk_3d => s_wrk_3d%prev
+      s_wrk_3d%in_use = .FALSE.
+      
+   END SUBROUTINE nemo_deallocate_3d   
 
    SUBROUTINE nemo_deallocate_2d( ptab2d, pidim, pjdim )
       REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout) :: ptab2d
       INTEGER, OPTIONAL, INTENT(in) :: pidim, pjdim    
-      !
-      INTEGER :: jx, jy
-      
+      !      
       IF( PRESENT(pidim) ) THEN
-         jx = pidim
-         jy = pjdim
-         NULLIFY(ptab2d)
-         s_wrk_xz(n_wrk_xz)%in_use = .FALSE.         
-         n_wrk_xz = n_wrk_xz - 1
+         s_wrk_xz => s_wrk_xz%prev
+         s_wrk_xz%in_use = .FALSE.
       ELSE
-         jx = jpi
-         jy = jpj    
-         NULLIFY(ptab2d) 
-         s_wrk_2d(n_wrk_2d)%in_use = .FALSE.         
-         n_wrk_2d = n_wrk_2d - 1
+         s_wrk_2d => s_wrk_2d%prev
+         s_wrk_2d%in_use = .FALSE.
       ENDIF
                 
@@ -328,9 +407,7 @@
    SUBROUTINE nemo_deallocate_1d( ptab1d )
       REAL(wp), POINTER, DIMENSION(:), INTENT(inout) :: ptab1d
-      !
-      
-      NULLIFY(ptab1d)
-      s_wrk_1d(n_wrk_1d)%in_use = .FALSE.         
-      n_wrk_1d = n_wrk_1d - 1
+      !     
+      s_wrk_1d => s_wrk_1d%prev
+      s_wrk_1d%in_use = .FALSE.
    
    END SUBROUTINE nemo_deallocate_1d
@@ -338,83 +415,9 @@
    SUBROUTINE nemo_deallocate_2d_i( ptab2d )
       INTEGER, POINTER, DIMENSION(:,:), INTENT(inout) :: ptab2d   
-      !
-      
-      NULLIFY(ptab2d)
-      s_wrk_2d_i(n_wrk_2d)%in_use = .FALSE.         
-      n_wrk_2d_i = n_wrk_2d_i - 1
+      !      
+      s_wrk_2d_i => s_wrk_2d_i%prev
+      s_wrk_2d_i%in_use = .FALSE.
             
    END SUBROUTINE nemo_deallocate_2d_i
-
-
-   SUBROUTINE print_in_use_list( kdim, itype, in_use_list )
-      !!----------------------------------------------------------------------
-      !!                 *** ROUTINE print_in_use_list ***
-      !!
-      !! ** Purpose:   to print out the table holding which workspace arrays
-      !!             are currently marked as in use.
-      !!----------------------------------------------------------------------
-      INTEGER,               INTENT(in) :: kdim
-      INTEGER,               INTENT(in) :: itype
-      LOGICAL, DIMENSION(:), INTENT(in) :: in_use_list
-      !
-      INTEGER          ::   ji, icount
-      CHARACTER(LEN=7) ::   type_string
-      !!----------------------------------------------------------------------
-      !
-      IF(.NOT. llwp)   RETURN
-      !
-      SELECT CASE ( kdim )
-      !
-      CASE (1)
-         SELECT CASE (itype)
-         CASE (INTEGER_TYPE)   ;   icount = num_1d_iwrkspaces
-         CASE (LOGICAL_TYPE)   ;   icount = num_1d_lwrkspaces
-         CASE (REAL_TYPE   )   ;   icount = num_1d_wrkspaces
-         END SELECT
-         !
-      CASE (2)
-         SELECT CASE (itype)
-         CASE (INTEGER_TYPE)   ;   icount = num_2d_iwrkspaces
-         CASE (LOGICAL_TYPE)   ;   icount = num_2d_lwrkspaces
-         CASE (REAL_TYPE   )   ;   icount = num_2d_wrkspaces
-         END SELECT
-         !
-      CASE (3)
-         SELECT CASE (itype)
-         CASE (INTEGER_TYPE)   ;   icount = num_3d_iwrkspaces
-         CASE (LOGICAL_TYPE)   ;   icount = num_3d_lwrkspaces
-         CASE (REAL_TYPE   )   ;   icount = num_3d_wrkspaces
-         END SELECT
-         !
-      CASE (4)
-         SELECT CASE (itype)
-         CASE (INTEGER_TYPE)   ;   icount = num_4d_iwrkspaces
-         CASE (LOGICAL_TYPE)   ;   icount = num_4d_lwrkspaces
-         CASE (REAL_TYPE   )   ;   icount = num_4d_wrkspaces
-         END SELECT
-         !
-      CASE DEFAULT   ;   RETURN
-      !
-      END SELECT
-      !
-      ! Set character string with type of workspace
-      SELECT CASE (itype)
-      CASE (INTEGER_TYPE)   ;   type_string = "INTEGER" 
-      CASE (LOGICAL_TYPE)   ;   type_string = "LOGICAL"
-      CASE (REAL_TYPE   )   ;   type_string = "REAL" 
-      END SELECT
-      !
-      WRITE(kumout,*)
-      WRITE(kumout,"('------------------------------------------')")
-      WRITE(kumout,"('Table of ',I1,'D ',(A),' workspaces currently in use:')") kdim, TRIM(type_string)
-      WRITE(kumout,"('Workspace   In use')")
-      DO ji = 1, icount, 1
-         WRITE(kumout,"(4x,I2,8x,L1)") ji, in_use_list(ji)
-      END DO
-      WRITE(kumout,"('------------------------------------------')")
-      WRITE(kumout,*)
-      !
-   END SUBROUTINE print_in_use_list
-
 
    SUBROUTINE wrk_stop(cmsg)
Index: /branches/2011/dev_r2769_LOCEAN_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/wrk_nemo_2.F90_simple
===================================================================
--- /branches/2011/dev_r2769_LOCEAN_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/wrk_nemo_2.F90_simple	(revision 2776)
+++ /branches/2011/dev_r2769_LOCEAN_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/wrk_nemo_2.F90_simple	(revision 2776)
@@ -0,0 +1,440 @@
+MODULE wrk_nemo_2
+   !!======================================================================
+   !!                       ***  MODULE  wrk_nemo  ***
+   !! NEMO work space:  define and allocate work-space arrays used in 
+   !! all components of NEMO
+   !!======================================================================
+   !! History :  4.0  !  2011-01  (A Porter)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   wrk_alloc         : define in memory the work space arrays
+   !!   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
+   !!   wrk_stop          : act as local alternative to ctl_stop
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+
+   IMPLICIT NONE
+   PRIVATE
+   
+
+   INTERFACE nemo_allocate
+      MODULE PROCEDURE nemo_allocate_4d, nemo_allocate_3d, nemo_allocate_2d, &
+      &                nemo_allocate_1d, nemo_allocate_2d_i
+   END INTERFACE
+
+   INTERFACE nemo_deallocate
+      MODULE PROCEDURE nemo_deallocate_4d, nemo_deallocate_3d, nemo_deallocate_2d, &
+      &                nemo_deallocate_1d, nemo_deallocate_2d_i
+   END INTERFACE
+   PUBLIC wrk_alloc_2, nemo_allocate, nemo_deallocate
+
+
+   INTEGER, PARAMETER :: num_1d_wrkspaces  = 27   ! No. of 1D workspace arrays ( MAX(jpi*jpj,jpi*jpk,jpj*jpk) )
+   INTEGER, PARAMETER :: num_2d_wrkspaces  = 35   ! No. of 2D workspace arrays (jpi,jpj)
+   INTEGER, PARAMETER :: num_3d_wrkspaces  = 15   ! No. of 3D workspace arrays (jpi,jpj,jpk)
+   INTEGER, PARAMETER :: num_4d_wrkspaces  = 4    ! No. of 4D workspace arrays (jpi,jpj,jpk,jpts)
+
+
+   INTEGER, PARAMETER :: num_xz_wrkspaces  = 4   ! No. of 2D, xz workspace arrays (jpi,jpk)
+
+   INTEGER, PARAMETER :: num_1d_lwrkspaces = 0   ! No. of 1D logical workspace arrays
+   INTEGER, PARAMETER :: num_2d_lwrkspaces = 3   ! No. of 2D logical workspace arrays
+   INTEGER, PARAMETER :: num_3d_lwrkspaces = 1   ! No. of 3D logical workspace arrays
+   INTEGER, PARAMETER :: num_4d_lwrkspaces = 0   ! No. of 4D logical workspace arrays
+
+   INTEGER, PARAMETER :: num_1d_iwrkspaces = 0   ! No. of 1D integer workspace arrays
+   INTEGER, PARAMETER :: num_2d_iwrkspaces = 1   ! No. of 2D integer workspace arrays
+   INTEGER, PARAMETER :: num_3d_iwrkspaces = 0   ! No. of 3D integer workspace arrays
+   INTEGER, PARAMETER :: num_4d_iwrkspaces = 0   ! No. of 4D integer workspace arrays
+   ! Maximum no. of workspaces of any one dimensionality that can be
+   ! requested - MAX(num_1d_wrkspaces, num_2d_wrkspaces, num_3d_wrkspaces, num_4d_wrkspaces) 
+   INTEGER :: max_num_wrkspaces = 35
+
+   ! If adding more arrays here, remember to increment the appropriate 
+   ! num_Xd_wrkspaces parameter above and to allocate them in wrk_alloc()
+   TYPE work_space_1d
+     LOGICAL ::  in_use
+     REAL(wp), DIMENSION(:), POINTER :: wrk    
+   END TYPE
+   TYPE(work_space_1d), DIMENSION(num_1d_wrkspaces) :: s_wrk_1d
+   INTEGER :: n_wrk_1d 
+
+   TYPE work_space_2d
+     LOGICAL ::  in_use
+     REAL(wp), DIMENSION(:,:), POINTER:: wrk    
+   END TYPE
+   TYPE(work_space_2d), DIMENSION(num_2d_wrkspaces) :: s_wrk_2d 
+   INTEGER :: n_wrk_2d 
+
+   TYPE work_space_xz
+     LOGICAL ::  in_use
+     REAL(wp), DIMENSION(:,:), POINTER :: wrk    
+   END TYPE
+   TYPE(work_space_xz), DIMENSION(num_xz_wrkspaces) :: s_wrk_xz 
+   INTEGER :: n_wrk_xz
+
+   TYPE work_space_3d
+     LOGICAL ::  in_use
+     REAL(wp), DIMENSION(:,:,:), POINTER :: wrk    
+   END TYPE
+   TYPE(work_space_3d), DIMENSION(num_3d_wrkspaces) :: s_wrk_3d 
+   INTEGER :: n_wrk_3d
+
+   TYPE work_space_4d
+     LOGICAL ::  in_use
+     REAL(wp), DIMENSION(:,:,:,:), POINTER :: wrk    
+   END TYPE
+   TYPE(work_space_4d), DIMENSION(num_4d_wrkspaces) :: s_wrk_4d 
+   INTEGER :: n_wrk_4d 
+
+   TYPE work_space_2d_i
+     LOGICAL ::  in_use
+     INTEGER, DIMENSION(:,:), POINTER :: wrk    
+   END TYPE
+   TYPE(work_space_2d_i), DIMENSION(num_2d_iwrkspaces) :: s_wrk_2d_i 
+   INTEGER :: n_wrk_2d_i 
+   
+
+   ! Labels for specifying workspace type in call to print_in_use_list()
+   INTEGER, PARAMETER ::   INTEGER_TYPE = 0
+   INTEGER, PARAMETER ::   LOGICAL_TYPE = 1
+   INTEGER, PARAMETER ::   REAL_TYPE    = 2
+
+   INTEGER :: kumout  ! Local copy of numout unit number for error/warning messages
+   LOGICAL :: llwp    ! Local copy of lwp - whether we are master PE or not
+
+   CHARACTER(LEN=*), PARAMETER ::   cform_err2 = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !:
+   CHARACTER(LEN=*), PARAMETER ::   cform_war2 = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !:
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id:$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+  FUNCTION wrk_alloc_2(iunit, lwp_arg)
+      !!----------------------------------------------------------------------
+      !!                   ***  FUNCTION wrk_alloc  ***
+      !!
+      !! ** Purpose :   Define in memory once for all the NEMO 2D, 3D and 4d 
+      !!                work space arrays
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   iunit         ! Unit no. to use for error/warning messages in this module
+      LOGICAL, INTENT(in) ::   lwp_arg       ! Value of lwp
+      !
+      INTEGER :: ji
+      INTEGER ::   wrk_alloc_2   ! Return value
+      INTEGER ::   extent_1d   ! Extent to allocate for 1D arrays
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   ierror   ! local integer
+      !!----------------------------------------------------------------------
+      !
+      ! Save the unit number to use for err/warning messages
+      kumout = iunit
+      ! Save whether we are master PE or not (for output messages)
+      llwp = lwp_arg
+      ! 
+      ALLOCATE(ierror(num_1d_wrkspaces+num_2d_wrkspaces+num_3d_wrkspaces &
+                   & + num_4d_wrkspaces+num_xz_wrkspaces+num_2d_iwrkspaces) )
+      !
+      ! Extent to use for 1D work arrays - find the maximum product of 
+      ! jpi*jpj, jpi*jpk and jpj*jpk and use that
+      IF    ( jpi < jpj .AND. jpi < jpk ) THEN   ;   extent_1d = jpj*jpk
+      ELSEIF( jpj < jpi .AND. jpj < jpk ) THEN   ;   extent_1d = jpi*jpk
+      ELSE                                       ;   extent_1d = jpi*jpj
+      ENDIF
+      !
+      ierror(:) = 0
+      !
+      n_wrk_1d   = 1
+      n_wrk_2d   = 1 
+      n_wrk_3d   = 1
+      n_wrk_4d   = 1 
+      n_wrk_xz   = 1
+      n_wrk_2d_i = 1 
+      
+      DO ji = 1, num_1d_wrkspaces
+       s_wrk_1d(ji)%in_use = .FALSE. 
+       ALLOCATE( s_wrk_1d(ji)%wrk(extent_1d), STAT=ierror(ji) )
+      END DO
+      DO ji = 1, num_2d_wrkspaces
+       s_wrk_2d(ji)%in_use = .FALSE. 
+       ALLOCATE( s_wrk_2d(ji)%wrk(jpi,jpj), STAT=ierror(ji+num_1d_wrkspaces) )
+      END DO
+      DO ji = 1, num_3d_wrkspaces
+       s_wrk_3d(ji)%in_use = .FALSE. 
+       ALLOCATE( s_wrk_3d(ji)%wrk(jpi,jpj,jpk), STAT=ierror(ji+num_2d_wrkspaces) )
+      END DO
+      DO ji = 1, num_4d_wrkspaces
+       s_wrk_4d(ji)%in_use = .FALSE. 
+       ALLOCATE( s_wrk_4d(ji)%wrk(jpi,jpj,jpk,jpts), STAT=ierror(ji+num_3d_wrkspaces) )
+      END DO
+      DO ji = 1, num_xz_wrkspaces
+       s_wrk_xz(ji)%in_use = .FALSE. 
+       ALLOCATE( s_wrk_xz(ji)%wrk(jpi,jpk), STAT=ierror(ji+num_4d_wrkspaces) )
+      END DO
+      DO ji = 1, num_2d_iwrkspaces
+       s_wrk_2d_i(ji)%in_use = .FALSE. 
+       ALLOCATE( s_wrk_2d_i(ji)%wrk(jpi,jpj), STAT=ierror(ji+num_xz_wrkspaces) )
+      END DO
+      !
+      wrk_alloc_2 = MAXVAL( ierror )
+      !
+      ! Calling routine, nemo_alloc(), checks for errors and takes 
+      ! appropriate action - we just print a warning message
+      IF( wrk_alloc_2 /= 0 ) THEN
+         WRITE(kumout,cform_war2)
+         WRITE(kumout,*) 'wrk_alloc: allocation of workspace arrays failed'
+      ENDIF
+      !
+   END FUNCTION wrk_alloc_2
+
+
+   SUBROUTINE nemo_allocate_4d( ptab4d, pidim, pjdim, pkdim, pldim )
+      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout) :: ptab4d 
+      INTEGER, OPTIONAL, INTENT(in) :: pidim, pjdim, pkdim, pldim    
+      !
+      INTEGER :: ji, jx, jy, jz, jt
+      
+      IF( PRESENT(pidim) ) THEN
+         jx = pidim
+         jy = pjdim
+         jz = pkdim
+         jt = pldim
+      ELSE
+         jx = jpi
+         jy = jpj    
+         jz = jpk
+         jt = jpts    
+      ENDIF
+      
+      ptab4d => s_wrk_4d(n_wrk_4d)%wrk(1:jx,1:jy,1:jz,1:jt)
+      s_wrk_4d(n_wrk_4d)%in_use = .TRUE.         
+      n_wrk_4d = n_wrk_4d + 1
+      
+   END SUBROUTINE nemo_allocate_4d
+   
+   SUBROUTINE nemo_allocate_3d( ptab3d, pidim, pjdim, pkdim )
+      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout) :: ptab3d  
+      INTEGER, OPTIONAL, INTENT(in) :: pidim, pjdim, pkdim    
+      !
+      INTEGER :: ji, jx, jy, jz
+
+      IF( PRESENT(pidim) ) THEN
+         jx = pidim
+         jy = pjdim
+         jz = pkdim
+      ELSE
+         jx = jpi
+         jy = jpj    
+         jz = jpk    
+      ENDIF
+      
+      ptab3d => s_wrk_3d(n_wrk_3d)%wrk(1:jx,1:jy,1:jz)
+      s_wrk_3d(n_wrk_3d)%in_use = .TRUE.         
+      n_wrk_3d = n_wrk_3d + 1
+     
+   END SUBROUTINE nemo_allocate_3d
+
+   SUBROUTINE nemo_allocate_2d( ptab2d, pidim, pjdim )
+      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout) :: ptab2d
+      INTEGER, OPTIONAL, INTENT(in) :: pidim, pjdim    
+      !
+      INTEGER :: jx, jy
+      
+      IF( PRESENT(pidim) ) THEN
+         jx = pidim
+         jy = pjdim
+         ptab2d => s_wrk_xz(n_wrk_xz)%wrk(1:jx,1:jy)
+         s_wrk_xz(n_wrk_xz)%in_use = .TRUE.         
+         n_wrk_xz = n_wrk_xz + 1
+      ELSE
+         jx = jpi
+         jy = jpj    
+         ptab2d => s_wrk_2d(n_wrk_2d)%wrk(:,:)
+         s_wrk_2d(n_wrk_2d)%in_use = .TRUE.         
+         n_wrk_2d = n_wrk_2d + 1
+      ENDIF
+                
+   END SUBROUTINE nemo_allocate_2d
+
+   SUBROUTINE nemo_allocate_1d( ptab1d )
+      REAL(wp), POINTER, DIMENSION(:), INTENT(inout) :: ptab1d
+      !
+      
+      ptab1d => s_wrk_1d(n_wrk_1d)%wrk(:)
+      s_wrk_1d(n_wrk_1d)%in_use = .TRUE.         
+      n_wrk_1d = n_wrk_1d + 1
+   
+   END SUBROUTINE nemo_allocate_1d
+
+   SUBROUTINE nemo_allocate_2d_i( ptab2d )
+      INTEGER, POINTER, DIMENSION(:,:), INTENT(inout) :: ptab2d   
+      !
+      INTEGER :: ji
+      LOGICAL :: l_in_use
+      
+      ptab2d => s_wrk_2d_i(n_wrk_2d_i)%wrk(:,:)
+      s_wrk_2d_i(n_wrk_2d)%in_use = .TRUE.         
+      n_wrk_2d_i = n_wrk_2d_i + 1
+            
+   END SUBROUTINE nemo_allocate_2d_i
+
+   SUBROUTINE nemo_deallocate_4d( ptab4d )
+      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout) :: ptab4d 
+      
+      NULLIFY(ptab4d)
+      s_wrk_4d(n_wrk_4d)%in_use = .FALSE.        
+      n_wrk_4d = n_wrk_4d - 1
+      
+   END SUBROUTINE nemo_deallocate_4d
+   
+   SUBROUTINE nemo_deallocate_3d( ptab3d)
+      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout) :: ptab3d  
+      !
+      
+      NULLIFY(ptab3d)
+      s_wrk_3d(n_wrk_3d)%in_use = .FALSE.         
+      n_wrk_3d = n_wrk_3d - 1
+     
+   END SUBROUTINE nemo_deallocate_3d
+
+   SUBROUTINE nemo_deallocate_2d( ptab2d, pidim, pjdim )
+      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout) :: ptab2d
+      INTEGER, OPTIONAL, INTENT(in) :: pidim, pjdim    
+      !
+      INTEGER :: jx, jy
+      
+      IF( PRESENT(pidim) ) THEN
+         jx = pidim
+         jy = pjdim
+         NULLIFY(ptab2d)
+         s_wrk_xz(n_wrk_xz)%in_use = .FALSE.         
+         n_wrk_xz = n_wrk_xz - 1
+      ELSE
+         jx = jpi
+         jy = jpj    
+         NULLIFY(ptab2d) 
+         s_wrk_2d(n_wrk_2d)%in_use = .FALSE.         
+         n_wrk_2d = n_wrk_2d - 1
+      ENDIF
+                
+   END SUBROUTINE nemo_deallocate_2d
+
+   SUBROUTINE nemo_deallocate_1d( ptab1d )
+      REAL(wp), POINTER, DIMENSION(:), INTENT(inout) :: ptab1d
+      !
+      
+      NULLIFY(ptab1d)
+      s_wrk_1d(n_wrk_1d)%in_use = .FALSE.         
+      n_wrk_1d = n_wrk_1d - 1
+   
+   END SUBROUTINE nemo_deallocate_1d
+
+   SUBROUTINE nemo_deallocate_2d_i( ptab2d )
+      INTEGER, POINTER, DIMENSION(:,:), INTENT(inout) :: ptab2d   
+      !
+      
+      NULLIFY(ptab2d)
+      s_wrk_2d_i(n_wrk_2d)%in_use = .FALSE.         
+      n_wrk_2d_i = n_wrk_2d_i - 1
+            
+   END SUBROUTINE nemo_deallocate_2d_i
+
+
+   SUBROUTINE print_in_use_list( kdim, itype, in_use_list )
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE print_in_use_list ***
+      !!
+      !! ** Purpose:   to print out the table holding which workspace arrays
+      !!             are currently marked as in use.
+      !!----------------------------------------------------------------------
+      INTEGER,               INTENT(in) :: kdim
+      INTEGER,               INTENT(in) :: itype
+      LOGICAL, DIMENSION(:), INTENT(in) :: in_use_list
+      !
+      INTEGER          ::   ji, icount
+      CHARACTER(LEN=7) ::   type_string
+      !!----------------------------------------------------------------------
+      !
+      IF(.NOT. llwp)   RETURN
+      !
+      SELECT CASE ( kdim )
+      !
+      CASE (1)
+         SELECT CASE (itype)
+         CASE (INTEGER_TYPE)   ;   icount = num_1d_iwrkspaces
+         CASE (LOGICAL_TYPE)   ;   icount = num_1d_lwrkspaces
+         CASE (REAL_TYPE   )   ;   icount = num_1d_wrkspaces
+         END SELECT
+         !
+      CASE (2)
+         SELECT CASE (itype)
+         CASE (INTEGER_TYPE)   ;   icount = num_2d_iwrkspaces
+         CASE (LOGICAL_TYPE)   ;   icount = num_2d_lwrkspaces
+         CASE (REAL_TYPE   )   ;   icount = num_2d_wrkspaces
+         END SELECT
+         !
+      CASE (3)
+         SELECT CASE (itype)
+         CASE (INTEGER_TYPE)   ;   icount = num_3d_iwrkspaces
+         CASE (LOGICAL_TYPE)   ;   icount = num_3d_lwrkspaces
+         CASE (REAL_TYPE   )   ;   icount = num_3d_wrkspaces
+         END SELECT
+         !
+      CASE (4)
+         SELECT CASE (itype)
+         CASE (INTEGER_TYPE)   ;   icount = num_4d_iwrkspaces
+         CASE (LOGICAL_TYPE)   ;   icount = num_4d_lwrkspaces
+         CASE (REAL_TYPE   )   ;   icount = num_4d_wrkspaces
+         END SELECT
+         !
+      CASE DEFAULT   ;   RETURN
+      !
+      END SELECT
+      !
+      ! Set character string with type of workspace
+      SELECT CASE (itype)
+      CASE (INTEGER_TYPE)   ;   type_string = "INTEGER" 
+      CASE (LOGICAL_TYPE)   ;   type_string = "LOGICAL"
+      CASE (REAL_TYPE   )   ;   type_string = "REAL" 
+      END SELECT
+      !
+      WRITE(kumout,*)
+      WRITE(kumout,"('------------------------------------------')")
+      WRITE(kumout,"('Table of ',I1,'D ',(A),' workspaces currently in use:')") kdim, TRIM(type_string)
+      WRITE(kumout,"('Workspace   In use')")
+      DO ji = 1, icount, 1
+         WRITE(kumout,"(4x,I2,8x,L1)") ji, in_use_list(ji)
+      END DO
+      WRITE(kumout,"('------------------------------------------')")
+      WRITE(kumout,*)
+      !
+   END SUBROUTINE print_in_use_list
+
+
+   SUBROUTINE wrk_stop(cmsg)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wrk_stop  ***
+      !! ** Purpose :   to act as local alternative to ctl_stop. 
+      !!                Avoids dependency on in_out_manager module.
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*), INTENT(in) :: cmsg
+      !!----------------------------------------------------------------------
+      !
+      WRITE(kumout, cform_err2)
+      WRITE(kumout,*) TRIM(cmsg)
+      ! ARPDBG - would like to call mppstop here to force a stop but that
+      ! introduces a dependency on lib_mpp. Could call mpi_abort() directly
+      ! but that's fairly brutal. Better to rely on calling routine to
+      ! deal with the error passed back from the wrk_X routine?
+      !CALL mppstop
+      !
+   END SUBROUTINE wrk_stop
+
+   !!=====================================================================
+END MODULE wrk_nemo_2
