Changeset 2594 for branches/dev_r2586_dynamic_mem

Timestamp:

2011-02-18T18:31:18+01:00 (13 years ago)

Author:

trackstand2

Message:

Removed F2003-only bounds-remapping and added _alloc routine instead

File:

• branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90 (modified) (5 diffs)

branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

@@ -31 +31 @@
    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
+   PUBLIC tra_ldf_iso_grif_alloc ! routine called by nemogcm.F90
+
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE       ::   psix_eiv
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE       ::   psiy_eiv
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE       ::   ah_wslp2
+   REAL(wp),         DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt  ! 2D+1 workspace
 
    !! * Substitutions
@@ -48 +50 @@
    !!----------------------------------------------------------------------
 CONTAINS
+
+  FUNCTION tra_ldf_iso_grif_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE tra_ldf_iso_grif_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: tra_ldf_iso_grif_alloc
+      !!----------------------------------------------------------------------
+
+      ALLOCATE(zdkt(jpi,jpj,0:1), Stat=tra_ldf_iso_grif_alloc)
+
+      IF(tra_ldf_iso_grif_alloc /= 0)THEN
+         CALL ctl_warn('tra_ldf_iso_grif_alloc : allocation of arrays failed.')
+      END IF
+
+  END FUNCTION tra_ldf_iso_grif_alloc
+
 
   SUBROUTINE tra_ldf_iso_grif( kt, cdtype, pgu, pgv,              &
@@ -94 +112 @@
       USE wrk_nemo, ONLY: wrk_use, wrk_release
       USE wrk_nemo, ONLY: zdit => wrk_3d_1, zdjt => wrk_3d_2, ztfw => wrk_3d_3
-      USE wrk_nemo, ONLY: wrk_3d_4 ! For 2D+1 workspace
+      !USE wrk_nemo, ONLY: wrk_3d_4 ! For 2D+1 workspace
       USE wrk_nemo, ONLY: z2d => wrk_2d_1 ! Only used if key_diaar5 defined
       !!
@@ -111 +129 @@
       REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      -
       REAL(wp) ::  zcoef0, zbtr                  !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdkt           ! 2D+1 workspace
+      !REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdkt           ! 2D+1 workspace
       !
       REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv
@@ -121 +139 @@
       !!----------------------------------------------------------------------
 
-      ! Check that workspace arrays are free for use and set-up pointer into
-      ! sub-array of a 3D workspace
-      IF( (.NOT. wrk_use(3, 1,2,3,4)) .OR. (.NOT. wrk_use(2, 1)))THEN
+      ! Check that workspace arrays are free for use
+      IF( (.NOT. wrk_use(3, 1,2,3)) .OR. (.NOT. wrk_use(2, 1)))THEN
          CALL ctl_stop('tra_ldf_iso_grif : requested workspace arrays unavailable.')
          RETURN
       END IF
-      zdkt(1:jpi,1:jpj,0:1) => wrk_3d_4(:,:,1:2)
+      ! 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_4(:,:,1:2)
 
       IF( kt == nit000 )  THEN