Changeset 3155 for branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

Timestamp:

2011-11-18T12:40:14+01:00 (13 years ago)

Author:

smasson

Message:

dev_NEMO_MERGE_2011: new dynamical allocation in LDF and ZDF

File:

• branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90 (modified) (10 diffs)

branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

@@ -31 +31 @@
    USE in_out_manager  ! I/O manager
    USE prtctl          ! Print control
+   USE wrk_nemo_2      ! work arrays
 
    IMPLICIT NONE
@@ -56 +57 @@
 
    REAL(wp) ::   repsln = 1.e-25_wp       ! tiny value used as minium of di(rho), dj(rho) and dk(rho)
-
-   ! Workspace arrays for ldf_slp_grif. These could be replaced by several 3D and 2D workspace
-   ! arrays from the wrk_nemo module with a bit of code re-writing. The 4D workspace
-   ! arrays can't be used here because of the zero-indexing of some of the ranks. ARPDBG.
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   zdzrho , zdyrho, zdxrho     ! Horizontal and vertical density gradients
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb            ! for Griffies operator only
 
    !! * Substitutions
@@ -74 +69 @@
    !!----------------------------------------------------------------------
 CONTAINS
-
-   INTEGER FUNCTION ldf_slp_alloc()
-      !!----------------------------------------------------------------------
-      !!              ***  FUNCTION ldf_slp_alloc  ***
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( zdxrho (jpi,jpj,jpk,0:1) , zti_mlb(jpi,jpj,0:1,0:1) ,     &
-         &      zdyrho (jpi,jpj,jpk,0:1) , ztj_mlb(jpi,jpj,0:1,0:1) ,     &
-         &      zdzrho (jpi,jpj,jpk,0:1)                            , STAT=ldf_slp_alloc )
-         !
-      IF( lk_mpp             )   CALL mpp_sum ( ldf_slp_alloc )
-      IF( ldf_slp_alloc /= 0 )   CALL ctl_warn('ldf_slp_alloc : failed to allocate arrays.')
-      !
-   END FUNCTION ldf_slp_alloc
-
 
    SUBROUTINE ldf_slp( kt, prd, pn2 )
@@ -115 +95 @@
       !!               of now neutral surfaces at u-, w- and v- w-points, resp.
       !!----------------------------------------------------------------------
-      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
       USE oce     , ONLY:   zwz => ua       , zww => va   ! (ua,va) used as workspace
       USE oce     , ONLY:   tsa                           ! (tsa) used as workspace
-      USE wrk_nemo, ONLY:   zdzr => wrk_3d_1              ! 3D workspace
       !!
       INTEGER , INTENT(in)                   ::   kt    ! ocean time-step index
@@ -131 +109 @@
       REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      -
       REAL(wp) ::   zck, zfk,      zbw             !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zgru, zgrv
-      !!----------------------------------------------------------------------
-
-      IF( wrk_in_use(3, 1) ) THEN
-         CALL ctl_stop('ldf_slp: requested workspace arrays are unavailable')   ;   RETURN
-      ENDIF
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zgru, zgrv, zdzr
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj,jpk, zdzr )
       !
       zgru => tsa(:,:,:,1)
@@ -386 +362 @@
       ENDIF
       !
-      IF( wrk_not_released(3, 1) )  CALL ctl_stop('ldf_slp: failed to release workspace arrays.')
+      CALL wrk_dealloc( jpi,jpj,jpk, zdzr )
       !
    END SUBROUTINE ldf_slp
@@ -405 +381 @@
       !!             - wslp2              squared slope of neutral surfaces at w-points.
       !!----------------------------------------------------------------------
-      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
       USE oce     , ONLY:   zalbet  => ua       ! use ua as workspace
-      USE wrk_nemo, ONLY:   z1_mlbw => wrk_2d_1
       !!
       INTEGER, INTENT( in ) ::   kt             ! ocean time-step index
@@ -420 +394 @@
       REAL(wp) ::   zdzrho_raw
       REAL(wp) ::   zbeta0
-      !!----------------------------------------------------------------------
-
-      IF( wrk_in_use(4, 1,2,3) .OR. wrk_in_use(3, 2,3) .OR. wrk_in_use(2, 1) ) THEN
-         CALL ctl_stop('ldf_slp_grif: ERROR: requested workspace arrays are unavailable.')   ;   RETURN
-      END IF
+      REAL(wp), POINTER, DIMENSION(:,:)     ::   z1_mlbw
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zdxrho , zdyrho, zdzrho     ! Horizontal and vertical density gradients
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb            ! for Griffies operator only
+      !!----------------------------------------------------------------------
+      
+      CALL wrk_alloc( jpi,jpj, z1_mlbw )
+      CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  )
+      CALL wrk_alloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  )
       !
       !--------------------------------!
@@ -616 +593 @@
       CALL lbc_lnk( wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked
       !
-      IF( wrk_not_released(4, 1,2,3) .OR.   &
-          wrk_not_released(3, 2,3  ) .OR.   &
-          wrk_not_released(2, 1    )        )   CALL ctl_stop('ldf_slp_grif: ERROR: failed to release workspace arrays.')
+      CALL wrk_dealloc( jpi,jpj, z1_mlbw )
+      CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  )
+      CALL wrk_dealloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  )
       !
    END SUBROUTINE ldf_slp_grif
@@ -768 +745 @@
          ALLOCATE( triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1)                      , STAT=ierr )
          IF( ierr > 0             )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' )
-         IF( ldf_slp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate workspace arrays' )
          !
          IF( ln_dynldf_iso )   CALL ctl_stop( 'ldf_slp_init: Griffies operator on momentum not supported' )