Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

Timestamp:

2011-03-30T17:58:35+02:00 (13 years ago)

Author:

rblod

Message:

First attempt to put dynamic allocation on the trunk

File:

• trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90 (modified) (8 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

@@ -16 +16 @@
    USE oce             ! ocean dynamics and active tracers
    USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
    USE trc_oce         ! share passive tracers/Ocean variables
    USE zdf_oce         ! ocean vertical physics
@@ -23 +24 @@
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O library
-#if defined key_diaar5
-   USE phycst          ! physical constants
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-#endif
+   USE lib_mpp         ! MPP library
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC tra_ldf_iso_grif   ! routine called by traldf.F90
-
-   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   psix_eiv
-   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   psiy_eiv
-   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   ah_wslp2
+   PUBLIC   tra_ldf_iso_grif   ! routine called by traldf.F90
+
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   psix_eiv, psiy_eiv   !: eiv stream function (diag only)
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   ah_wslp2             !: aeiv*w-slope^2
+   REAL(wp),         DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt                 !  atypic workspace
 
    !! * Substitutions
@@ -90 +89 @@
       !! ** Action :   Update pta arrays with the before rotated diffusion
       !!----------------------------------------------------------------------
-      USE oce,   zftu => ua   ! use ua as workspace
-      USE oce,   zftv => va   ! use va as workspace
-      !!
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE oce     , ONLY:   zftu => ua       , zftv => va            ! (ua,va) used as 3D workspace
+      USE wrk_nemo, ONLY:   zdit => wrk_3d_6 , zdjt => wrk_3d_7 , ztfw => wrk_3d_8   ! 3D workspace
+      USE wrk_nemo, ONLY:   z2d  => wrk_2d_1                                         ! 2D workspace
+      !
       INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
@@ -100 +101 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
       REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef
-      !!
+      !
       INTEGER  ::  ji, jj, jk,jn   ! dummy loop indices
       INTEGER  ::  ip,jp,kp        ! dummy loop indices
@@ -107 +108 @@
       REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      -
       REAL(wp) ::  zcoef0, zbtr                  !   -      -
-      REAL(wp), DIMENSION(jpi,jpj,0:1) ::   zdkt               ! 2D+1 workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, ztfw   ! 3D workspace
+      !REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdkt           ! 2D+1 workspace
       !
       REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv
@@ -114 +114 @@
       REAL(wp) ::   zah, zah_slp, zaei_slp
 #if defined key_diaar5
-      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                ! 2D workspace
-      REAL(wp)                         ::   zztmp              ! local scalar
+      REAL(wp) ::   zztmp              ! local scalar
 #endif
       !!----------------------------------------------------------------------
+
+      IF( wrk_in_use(3, 6,7,8) .OR. wrk_in_use(2, 1) ) THEN
+         CALL ctl_stop('tra_ldf_iso_grif: requested workspace arrays unavailable.')   ;   RETURN
+      ENDIF
+      ! ARP - line below uses 'bounds re-mapping' which is only defined in
+      ! Fortran 2003 and up. We would be OK if code was written to use
+      ! zdkt(:,:,1:2) instead as then wouldn't need to re-map bounds.
+      ! As it is, we make zdkt a module array and allocate it in _alloc().
+      !zdkt(1:jpi,1:jpj,0:1) => wrk_3d_9(:,:,1:2)
 
       IF( kt == nit000 )  THEN
@@ -124 +132 @@
          IF(lwp) WRITE(numout,*) '                   WARNING: STILL UNDER TEST, NOT RECOMMENDED. USE AT YOUR OWN PERIL'
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-         ALLOCATE( ah_wslp2(jpi,jpj,jpk) , STAT=ierr )
-         IF( ierr > 0 ) THEN
-            CALL ctl_stop( 'tra_ldf_iso_grif : unable to allocate Griffies operator ah_wslp2 ' )   ;   RETURN
-         ENDIF
+         ALLOCATE( ah_wslp2(jpi,jpj,jpk) , zdkt(jpi,jpj,0:1), STAT=ierr )
+         IF( lk_mpp   )   CALL mpp_sum ( ierr )
+         IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate arrays')
          IF( ln_traldf_gdia ) THEN
             ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr )
-            IF( ierr > 0 ) THEN
-               CALL ctl_stop( 'tra_ldf_iso_grif : unable to allocate Griffies operator diagnostics ' )   ;   RETURN
-            ENDIF
+            IF( lk_mpp   )   CALL mpp_sum ( ierr )
+            IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate diagnostics')
          ENDIF
       ENDIF
@@ -342 +348 @@
       END DO
       !
+      IF( wrk_not_released(3, 6,7,8) .OR.   &
+          wrk_not_released(2, 1)       )   CALL ctl_stop('tra_ldf_iso_grif: failed to release workspace arrays')
+      !
   END SUBROUTINE tra_ldf_iso_grif