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

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

@@ -6 +6 @@
    !! History :   1.0  !  2004     (O. Aumont) Original code
    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
-   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  optimisaion
+   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  optimisation
    !!----------------------------------------------------------------------
 #if defined  key_pisces
@@ -24 +24 @@
    PUBLIC   p4z_opt        ! called in p4zbio.F90 module
    PUBLIC   p4z_opt_init   ! called in trcsms_pisces.F90 module
-
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   etot, enano, ediat   !: PAR for phyto, nano and diat 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   emoy                 !: averaged PAR in the mixed layer
-
-   INTEGER  ::  nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m)
-   REAL(wp) ::  parlux = 0.43 / 3.e0
-
-   REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb  !: tabulated attenuation coefficients for RGB absorption
+   PUBLIC   p4z_opt_alloc
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot, enano, ediat   !: PAR for phyto, nano and diat 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy                 !: averaged PAR in the mixed layer
+
+   INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m)
+   REAL(wp) ::   parlux = 0.43_wp / 3._wp
+
+   REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption
    
    !!* Substitution
@@ -38 +39 @@
    !! 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
 
@@ -52 +52 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY:   zdepmoy => wrk_2d_1 , zetmp => wrk_2d_2
+      USE wrk_nemo, ONLY:   zekg    => wrk_3d_2 , zekr  => wrk_3d_3 , zekb => wrk_3d_4
+      USE wrk_nemo, ONLY:   ze0     => wrk_3d_5 , ze1   => wrk_3d_6
+      USE wrk_nemo, ONLY:   ze2     => wrk_3d_7 , ze3   => wrk_3d_8
+      !
+      INTEGER, INTENT(in) ::   kt, jnt   ! ocean time step
+      !
       INTEGER  ::   ji, jj, jk
       INTEGER  ::   irgb
       REAL(wp) ::   zchl, zxsi0r
       REAL(wp) ::   zc0 , zc1 , zc2, zc3
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zdepmoy, zetmp
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zekg, zekr, zekb
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze1 , ze2 , ze3, ze0
       !!---------------------------------------------------------------------
 
+      IF(  wrk_in_use(2, 1,2)   .OR.   wrk_in_use(3, 2,3,4,5,6,7,8)   ) THEN
+         CALL ctl_stop('p4z_opt: requested workspace arrays unavailable')   ;   RETURN
+      ENDIF
 
       !     Initialisation of variables used to compute PAR
       !     -----------------------------------------------
-      ze1 (:,:,jpk) = 0.e0
-      ze2 (:,:,jpk) = 0.e0
-      ze3 (:,:,jpk) = 0.e0
+      ze1 (:,:,jpk) = 0._wp
+      ze2 (:,:,jpk) = 0._wp
+      ze3 (:,:,jpk) = 0._wp
 
       !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue)
@@ -203 +210 @@
 !CDIR NOVERRCHK
             DO ji = 1, jpi
-               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) &
-       &           emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn )
+               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) )   emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn )
             END DO
          END DO
@@ -223 +229 @@
 #endif
       !
+      IF(  wrk_not_released(2, 1,2)           .OR.   &
+           wrk_not_released(3, 2,3,4,5,6,7,8)   )   CALL ctl_stop('p4z_opt: failed to release workspace arrays')
+      !
    END SUBROUTINE p4z_opt
+
 
    SUBROUTINE p4z_opt_init
@@ -230 +240 @@
       !!
       !! ** Purpose :   Initialization of tabulated attenuation coef
-      !!
-      !!
-      !!----------------------------------------------------------------------
-
+      !!----------------------------------------------------------------------
+      !
       CALL trc_oce_rgb( xkrgb )                  ! tabulated attenuation coefficients
-!!      CALL trc_oce_rgb_read( xkrgb )               ! tabulated attenuation coefficients
       nksrp = trc_oce_ext_lev( r_si2, 0.33e2 )     ! max level of light extinction (Blue Chl=0.01)
+      !
       IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m'
       !
-                         etot (:,:,:) = 0.e0
-                         enano(:,:,:) = 0.e0
-                         ediat(:,:,:) = 0.e0
-      IF( ln_qsr_bio )   etot3(:,:,:) = 0.e0
+                         etot (:,:,:) = 0._wp
+                         enano(:,:,:) = 0._wp
+                         ediat(:,:,:) = 0._wp
+      IF( ln_qsr_bio )   etot3(:,:,:) = 0._wp
       ! 
    END SUBROUTINE p4z_opt_init
+
+
+   INTEGER FUNCTION p4z_opt_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_opt_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( etot (jpi,jpj,jpk) , enano(jpi,jpj,jpk) ,     &
+         &      ediat(jpi,jpj,jpk) , emoy (jpi,jpj,jpk) , STAT=p4z_opt_alloc )
+         !
+      IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION p4z_opt_alloc
+
 #else
    !!----------------------------------------------------------------------