Changeset 2593

Timestamp:

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

Author:

trackstand2

Message:

Made module vars dynamic and added _alloc() routine

Location:

branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC

Files:

• prtctl_trc.F90 (modified) (3 diffs)
• trc.F90 (modified) (2 diffs)
• trcdia.F90 (modified) (3 diffs)
• trcdta.F90 (modified) (2 diffs)

branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90

@@ -62 +62 @@
       !!                it must looks like: CALL prt_ctl( mask=tmask ).
       !!----------------------------------------------------------------------
+      USE wrk_nemo, ONLY: wrk_use, wrk_release
+      USE wrk_nemo, ONLY: zmask => wrk_3d_1, ztab3d => wrk_3d_2
+      !!
       REAL(wp)         , DIMENSION(:,:,:,:), INTENT(in), OPTIONAL ::   tab4d     ! 4D array
       REAL(wp)         , DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask      ! 3D mask to apply to the tab4d array
@@ -71 +74 @@
       INTEGER  ::   overlap, jn, js, sind, eind, kdir, j_id
       REAL(wp) ::   zsum, zvctl
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask, ztab3d
       CHARACTER (len=20), DIMENSION(jptra) ::   cl
       CHARACTER (len=10) ::   cl2
       !!----------------------------------------------------------------------
+
+      IF(.NOT. wrk_use(3, 1,2))THEN
+         CALL ctl_stop('prt_ctl_trc : requested workspace arrays unavailable.')
+         RETURN
+      END IF
 
       !                                      ! Arrays, scalars initialization 
@@ -178 +185 @@
          WRITE(j_id,*) clinfo
       END DO
+      !
+      IF(.NOT. wrk_release(3, 1,2))THEN
+         CALL ctl_stop('prt_ctl_trc : failed to release workspace arrays.')
+      END IF
       !
    END SUBROUTINE prt_ctl_trc_info

branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trc.F90

@@ -18 +18 @@
    IMPLICIT NONE
    PUBLIC
+
+   PUBLIC    trc_alloc          ! called by nemogcm.F90
 
    !! passive tracers names and units (read in namelist)
@@ -110 +112 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
+#if defined key_top
+CONTAINS
+
+   FUNCTION trc_alloc()
+      !!-------------------------------------------------------------------
+      !!                    *** ROUTINE trc_alloc ***
+      !!-------------------------------------------------------------------
+      INTEGER :: trc_alloc
+      !!-------------------------------------------------------------------
+
+      ALLOCATE(cvol(jpi,jpj,jpk),                                  &
+               trn(jpi,jpj,jpk,jptra),                             &
+               tra(jpi,jpj,jpk,jptra),                             &
+               trb(jpi,jpj,jpk,jptra),                             &
+               gtru(jpi,jpj,jptra), gtrv(jpi,jpj,jptra),           &
+               rdttrc(jpk),                                        &
+# if defined key_diatrc && ! defined key_iomput
+               trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), &
+#endif
+# if defined key_diabio
+               trbio(jpi,jpj,jpk,jpdiabio),                        &
+#endif
+               Stat=trc_alloc)
+
+      IF(trc_alloc /= 0)THEN
+         CALL ctl_warn('trc_alloc: failed to allocate arrays.')
+      END IF
+
+   END FUNCTION trc_alloc
+#endif
+
 END MODULE trc

branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcdia.F90

@@ -32 +32 @@
    PRIVATE
 
-   PUBLIC   trc_dia   ! called by XXX module 
+   PUBLIC   trc_dia        ! called by XXX module 
+   PUBLIC   trc_dia_alloc  ! called by nemogcm.F90
 
    INTEGER  ::   nit5      !: id for tracer output file
@@ -40 +41 @@
    INTEGER  ::   ndimt51   !: number of ocean points in index array
    REAL(wp) ::   zjulian   !: ????   not DOCTOR !
-   INTEGER , DIMENSION (jpij*jpk) ::   ndext50   !: integer arrays for ocean 3D index
-   INTEGER , DIMENSION (jpij)     ::   ndext51   !: integer arrays for ocean surface index
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION (:) ::   ndext50   !: integer arrays for ocean 3D index
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION (:) ::   ndext51   !: integer arrays for ocean surface index
 # if defined key_diatrc
    INTEGER  ::   nitd      !: id for additional array output file
@@ -61 +62 @@
    !!----------------------------------------------------------------------
 CONTAINS
+
+   FUNCTION trc_dia_alloc()
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_dia_alloc  ***
+      !!---------------------------------------------------------------------
+      INTEGER :: trc_dia_alloc
+      !!---------------------------------------------------------------------
+
+      ALLOCATE(ndext50(jpij*jpk), ndext51(jpij), Stat=trc_dia_alloc)
+
+      IF(trc_dia_alloc /= 0)THEN
+         CALL ctl_warn('trc_dia_alloc : failed to allocate arrays.')
+      END IF
+
+   END FUNCTION trc_dia_alloc
+
 
    SUBROUTINE trc_dia( kt )  

branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

@@ -23 +23 @@
    PRIVATE
 
-   PUBLIC trc_dta   ! called in trcini.F90 and trcdmp.F90
+   PUBLIC trc_dta         ! called in trcini.F90 and trcdmp.F90
+   PUBLIC trc_dta_alloc   ! called in nemogcm.F90
 
    LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .TRUE.   !: temperature data flag
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jptra) ::   trdta   !: tracer data at given time-step
-
-   REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,2) ::   tracdta            ! tracer data at two consecutive times
-   INTEGER , DIMENSION(jptra) ::   nlectr      !: switch for reading once
-   INTEGER , DIMENSION(jptra) ::   ntrc1       !: number of first month when reading 12 monthly value
-   INTEGER , DIMENSION(jptra) ::   ntrc2       !: number of second month when reading 12 monthly value
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trdta   !: tracer data at given time-step
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   tracdta       ! tracer data at two consecutive times
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   nlectr      !: switch for reading once
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc1       !: number of first month when reading 12 monthly value
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc2       !: number of second month when reading 12 monthly value
 
    !! * Substitutions
@@ -41 +42 @@
    !!----------------------------------------------------------------------
 CONTAINS
+
+   FUNCTION trc_dta_alloc()
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_dta_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: trc_dta_alloc
+      !!----------------------------------------------------------------------
+
+      ALLOCATE(trdta(jpi,jpj,jpk,jptra),                   &
+               tracdta(jpi,jpj,jpk,jptra,2),               &
+               nlectr(jptra), ntrc1(jptra), ntrc2,(jptra), & 
+               !
+               Stat = trc_dta_alloc)
+
+      IF(trc_dta_alloc /= 0)THEN
+         CALL ctl_warn('trc_dta_alloc : failed to allocate arrays.')
+      END IF
+
+   END FUNCTION trc_dta_alloc
+
 
    SUBROUTINE trc_dta( kt )