Changeset 2715 for trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.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/TOP_SRC/PISCES/p4zprod.F90 (modified) (11 diffs)

trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90

@@ -22 +22 @@
    USE iom
 
-   USE lib_mpp
-   USE lib_fortran
-
    IMPLICIT NONE
    PRIVATE
@@ -30 +27 @@
    PUBLIC   p4z_prod         ! called in p4zbio.F90
    PUBLIC   p4z_prod_init    ! called in trcsms_pisces.F90
-
-   !! * Shared module variables
+   PUBLIC   p4z_prod_alloc
+
    REAL(wp), PUBLIC ::   &
      pislope   = 3.0_wp          ,  &  !:
@@ -43 +40 @@
      grosip    = 0.151_wp
 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)  ::  prmax 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmax   !:
    
    REAL(wp) ::   &
@@ -56 +53 @@
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -70 +66 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY:   zmixnano   => wrk_2d_1  , zmixdiat    => wrk_2d_2  , zstrn  => wrk_2d_3
+      USE wrk_nemo, ONLY:   zpislopead => wrk_3d_2  , zpislopead2 => wrk_3d_3
+      USE wrk_nemo, ONLY:   zprdia     => wrk_3d_4  , zprbio      => wrk_3d_5  , zysopt => wrk_3d_6
+      USE wrk_nemo, ONLY:   zprorca    => wrk_3d_7  , zprorcad    => wrk_3d_8
+      USE wrk_nemo, ONLY:   zprofed    => wrk_3d_9  , zprofen     => wrk_3d_10
+      USE wrk_nemo, ONLY:   zprochln   => wrk_3d_11 , zprochld    => wrk_3d_12
+      USE wrk_nemo, ONLY:   zpronew    => wrk_3d_13 , zpronewd    => wrk_3d_14
+      !
       INTEGER, INTENT(in) :: kt, jnt
+      !
       INTEGER  ::   ji, jj, jk
       REAL(wp) ::   zsilfac, zfact
@@ -81 +87 @@
       REAL(wp) ::   zrfact2
 #endif
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zmixnano   , zmixdiat, zstrn
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpislopead , zpislopead2
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zprdia     , zprbio, zysopt
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zprorca    , zprorcad, zprofed
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zprofen   , zprochln, zprochld
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpronew    , zpronewd
       CHARACTER (len=25) :: charout
       !!---------------------------------------------------------------------
 
-      zprorca (:,:,:) = 0.0
-      zprorcad(:,:,:) = 0.0
-      zprofed(:,:,:) = 0.0
-      zprofen(:,:,:) = 0.0
-      zprochln(:,:,:) = 0.0
-      zprochld(:,:,:) = 0.0
-      zpronew (:,:,:) = 0.0
-      zpronewd(:,:,:) = 0.0
-      zprdia  (:,:,:) = 0.0
-      zprbio  (:,:,:) = 0.0
-      zysopt  (:,:,:) = 0.0
+      IF( wrk_in_use(2, 1,2,3)                             .OR.  &
+          wrk_in_use(3, 2,3,4,5,6,7,8,9,10,11,12,13,14)  ) THEN
+          CALL ctl_stop('p4z_prod: requested workspace arrays unavailable')   ;   RETURN
+      ENDIF
+
+      zprorca (:,:,:) = 0._wp
+      zprorcad(:,:,:) = 0._wp
+      zprofed (:,:,:) = 0._wp
+      zprofen (:,:,:) = 0._wp
+      zprochln(:,:,:) = 0._wp
+      zprochld(:,:,:) = 0._wp
+      zpronew (:,:,:) = 0._wp
+      zpronewd(:,:,:) = 0._wp
+      zprdia  (:,:,:) = 0._wp
+      zprbio  (:,:,:) = 0._wp
+      zysopt  (:,:,:) = 0._wp
 
       ! Computation of the optimal production
-
 # if defined key_degrad
       prmax(:,:,:) = rday1 * tgfunc(:,:,:) * facvol(:,:,:)
@@ -111 +115 @@
 
       ! compute the day length depending on latitude and the day
-      zrum = FLOAT( nday_year - 80 ) / REAL(nyear_len(1), wp)
-      zcodel = ASIN(  SIN( zrum * rpi * 2. ) * SIN( rad * 23.5 )  )
+      zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp )
+      zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  )
 
       ! day length in hours
-      zstrn(:,:) = 0.
+      zstrn(:,:) = 0._wp
       DO jj = 1, jpj
          DO ji = 1, jpi
@@ -187 +191 @@
                   zsilfac = MIN( 6.4,zsilfac * zsilfac2)
                   zysopt(ji,jj,jk) = grosip * zlim1 * zsilfac
-
               ENDIF
             END DO
@@ -357 +360 @@
 #endif
 
-       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('prod')")
          CALL prt_ctl_trc_info(charout)
          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
-       ENDIF
-
+      ENDIF
+
+      IF(  wrk_not_released(2, 1,2,3)                          .OR.  &
+           wrk_not_released(3, 2,3,4,5,6,7,8,9,10,11,12,13,14)   )   &
+           CALL ctl_stop('p4z_prod: failed to release workspace arrays')
+      !
    END SUBROUTINE p4z_prod
 
+
    SUBROUTINE p4z_prod_init
-
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE p4z_prod_init  ***
@@ -376 +383 @@
       !!
       !! ** input   :   Namelist nampisprod
-      !!
       !!----------------------------------------------------------------------
-
       NAMELIST/nampisprod/ pislope, pislope2, excret, excret2, chlcnm, chlcdm,   &
          &              fecnm, fecdm, grosip
+      !!----------------------------------------------------------------------
 
       REWIND( numnat )                     ! read numnat
@@ -399 +405 @@
          WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm     =', fecdm
       ENDIF
-
+      !
       rday1     = 0.6 / rday 
       texcret   = 1.0 - excret
       texcret2  = 1.0 - excret2
       tpp       = 0.
-
+      !
    END SUBROUTINE p4z_prod_init
 
 
+   INTEGER FUNCTION p4z_prod_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_prod_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( prmax(jpi,jpj,jpk), STAT=p4z_prod_alloc )
+      !
+      IF( p4z_prod_alloc /= 0 ) CALL ctl_warn('p4z_prod_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION p4z_prod_alloc
 
 #else