Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.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/ZDF/zdfric.F90 (modified) (8 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90

@@ -25 +25 @@
    USE in_out_manager  ! I/O manager
    USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+   USE lib_mpp         ! MPP library
 
    IMPLICIT NONE
@@ -39 +40 @@
    REAL(wp) ::   rn_alp   =   5._wp      ! coefficient of the parameterization
 
-   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   tmric                    ! coef. for the horizontal mean at t-point
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tmric   !: coef. for the horizontal mean at t-point
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
    !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
+
+   INTEGER FUNCTION zdf_ric_alloc()
+      !!----------------------------------------------------------------------
+      !!                 ***  FUNCTION zdf_ric_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( tmric(jpi,jpj,jpk)   , STAT= zdf_ric_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( zdf_ric_alloc )
+      IF( zdf_ric_alloc /= 0 )   CALL ctl_warn('zdf_ric_alloc: failed to allocate arrays')
+   END FUNCTION zdf_ric_alloc
+
 
    SUBROUTINE zdf_ric( kt )
@@ -77 +89 @@
       !! References : Pacanowski & Philander 1981, JPO, 1441-1451.
       !!----------------------------------------------------------------------
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY:   zwx => wrk_2d_1     ! 2D workspace
+      !!
       INTEGER, INTENT( in ) ::   kt         ! ocean time-step indexocean time step
       !!
       INTEGER  ::   ji, jj, jk               ! dummy loop indices
       REAL(wp) ::   zcoef, zdku, zdkv, zri, z05alp     ! temporary scalars
-      REAL(wp), DIMENSION(jpi,jpj) ::   zwx ! temporary workspace
-      !!----------------------------------------------------------------------
-
+      !!----------------------------------------------------------------------
+
+      IF( wrk_in_use(2, 1) ) THEN
+         CALL ctl_stop('zdf_ric : requested workspace array unavailable')   ;   RETURN
+      ENDIF
       !                                                ! ===============
       DO jk = 2, jpkm1                                 ! Horizontal slab
@@ -104 +121 @@
          CALL lbc_lnk( zwx, 'W', 1. )                       ! Boundary condition   (sign unchanged)
 
-
          ! Vertical eddy viscosity and diffusivity coefficients
          ! -------------------------------------------------------
-         z05alp = 0.5 * rn_alp
+         z05alp = 0.5_wp * rn_alp
          DO jj = 1, jpjm1                                   ! Eddy viscosity coefficients (avm)
             DO ji = 1, jpim1
-               avmu(ji,jj,jk) = umask(ji,jj,jk)   &
-                  &           * rn_avmri / ( 1. + z05alp*( zwx(ji+1,jj)+zwx(ji,jj) ) )**nn_ric
-               avmv(ji,jj,jk) = vmask(ji,jj,jk)   &
-                  &           * rn_avmri / ( 1. + z05alp*( zwx(ji,jj+1)+zwx(ji,jj) ) )**nn_ric
+               avmu(ji,jj,jk) = umask(ji,jj,jk) * rn_avmri / ( 1. + z05alp*( zwx(ji+1,jj)+zwx(ji,jj) ) )**nn_ric
+               avmv(ji,jj,jk) = vmask(ji,jj,jk) * rn_avmri / ( 1. + z05alp*( zwx(ji,jj+1)+zwx(ji,jj) ) )**nn_ric
             END DO
          END DO
          DO jj = 2, jpjm1                                   ! Eddy diffusivity coefficients (avt)
             DO ji = 2, jpim1
-               avt(ji,jj,jk) = tmric(ji,jj,jk) / ( 1. + rn_alp * zwx(ji,jj) )   &
-                  &          * (  avmu(ji,jj,jk) + avmu(ji-1, jj ,jk)        &
-                  &             + avmv(ji,jj,jk) + avmv( ji ,jj-1,jk)  )     &
+               avt(ji,jj,jk) = tmric(ji,jj,jk) / ( 1._wp + rn_alp * zwx(ji,jj) )           &
+                  &                            * (  avmu(ji,jj,jk) + avmu(ji-1,jj,jk)      &
+                  &                               + avmv(ji,jj,jk) + avmv(ji,jj-1,jk)  )   &
                   &          + avtb(jk) * tmask(ji,jj,jk)
                !                                            ! Add the background coefficient on eddy viscosity
@@ -134 +148 @@
       CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )
       !
+      IF( wrk_not_released(2, 1) )   CALL ctl_stop('zdf_ric: failed to release workspace array')
+      !
    END SUBROUTINE zdf_ric
 
@@ -150 +166 @@
       !! ** Action  :   increase by 1 the nstop flag is setting problem encounter
       !!----------------------------------------------------------------------
-      INTEGER :: ji, jj, jk        ! dummy loop indices
+      INTEGER :: ji, jj, jk   ! dummy loop indices
       !!
       NAMELIST/namzdf_ric/ rn_avmri, rn_alp, nn_ric
@@ -168 +184 @@
       ENDIF
       !
-      DO jk = 1, jpk                 ! weighting mean array tmric for 4 T-points which accounts for coastal boundary conditions.
-         DO jj = 2, jpj              
+      !                              ! allocate zdfric arrays
+      IF( zdf_ric_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_ric_init : unable to allocate arrays' )
+      !
+      DO jk = 1, jpk                 ! weighting mean array tmric for 4 T-points
+         DO jj = 2, jpj              ! which accounts for coastal boundary conditions            
             DO ji = 2, jpi
                tmric(ji,jj,jk) =  tmask(ji,jj,jk)                                  &
@@ -177 +196 @@
          END DO
       END DO
-      tmric(:,1,:) = 0.e0
+      tmric(:,1,:) = 0._wp
       !
       DO jk = 1, jpk                 ! Initialization of vertical eddy coef. to the background value