Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.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/DYN/dynldf_iso.F90 (modified) (11 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90

@@ -4 +4 @@
    !! Ocean dynamics:  lateral viscosity trend
    !!======================================================================
+   !! History :  OPA  !  97-07  (G. Madec)  Original code
+   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!             -   !  2004-08  (C. Talandier) New trends organization
+   !!            2.0  !  2005-11  (G. Madec)  s-coordinate: horizontal diffusion
+   !!----------------------------------------------------------------------
 #if defined key_ldfslp   ||   defined key_esopa
    !!----------------------------------------------------------------------
@@ -12 +17 @@
    !!                  tal s-coordinate laplacian operator.
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
@@ -23 +27 @@
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
    USE prtctl          ! Print control
 
@@ -28 +33 @@
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC dyn_ldf_iso           ! called by step.F90
+   PUBLIC   dyn_ldf_iso           ! called by step.F90
+   PUBLIC   dyn_ldf_iso_alloc     ! called by nemogcm.F90
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfuw, zdiu, zdju, zdj1u   ! 2D workspace (dyn_ldf_iso) 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfvw, zdiv, zdjv, zdj1v   !  -      -
 
    !! * Substitutions
@@ -36 +44 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.3 , 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 dyn_ldf_iso_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_ldf_iso_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( zfuw(jpi,jpk) , zdiu(jpi,jpk) , zdju(jpi,jpk) , zdj1u(jpi,jpk) ,     & 
+         &      zfvw(jpi,jpk) , zdiv(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_iso_alloc )
+         !
+      IF( dyn_ldf_iso_alloc /= 0 )   CALL ctl_warn('dyn_ldf_iso_alloc: array allocate failed.')
+   END FUNCTION dyn_ldf_iso_alloc
+
 
    SUBROUTINE dyn_ldf_iso( kt )
@@ -86 +104 @@
       !!        Update (avmu,avmv) to accompt for the diagonal vertical component
       !!      of the rotated operator in dynzdf module
-      !!
-      !! History :
-      !!   8.0  !  97-07  (G. Madec)  Original code
-      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
-      !!   9.0  !  04-08  (C. Talandier) New trends organization
-      !!        !  05-11  (G. Madec)  s-coordinate: horizontal diffusion
       !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
-
-      !! * Local declarations
-      INTEGER  ::   ji, jj, jk            ! dummy loop indices
-      REAL(wp) ::   &
-         zabe1, zabe2, zcof1, zcof2,   &  ! temporary scalars
-         zmskt, zmskf, zbu, zbv,       &
-         zuah, zvah
-      REAL(wp), DIMENSION(jpi,jpj) ::   &
-         ziut, zjuf, zjvt, zivf,        & ! temporary workspace
-         zdku, zdk1u, zdkv, zdk1v
-
-      REAL(wp) ::   &
-         zcoef0, zcoef3, zcoef4, zmkt, zmkf,   &
-         zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj
-      REAL(wp), DIMENSION(jpi,jpk) ::        &
-         zfuw, zdiu, zdju, zdj1u,            & !    "        "
-         zfvw, zdiv, zdjv, zdj1v
-
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY:   ziut  => wrk_2d_1 , zjuf  => wrk_2d_2 , zjvt => wrk_2d_3    ! 2D workspace
+      USE wrk_nemo, ONLY:   zivf  => wrk_2d_4 , zdku  => wrk_2d_5 , zdkv => wrk_2d_6    ! 2D workspace
+      USE wrk_nemo, ONLY:   zdk1u => wrk_2d_7 , zdk1v => wrk_2d_8
+      !
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zabe1, zabe2, zcof1, zcof2                       ! local scalars
+      REAL(wp) ::   zmskt, zmskf, zbu, zbv, zuah, zvah               !   -      -
+      REAL(wp) ::   zcoef0, zcoef3, zcoef4, zmkt, zmkf               !   -      -
+      REAL(wp) ::   zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj   !   -      -
       !!----------------------------------------------------------------------
+
+      IF( wrk_in_use(2, 1,2,3,4,5,6,7,8) ) THEN
+         CALL ctl_stop('dyn_ldf_iso: requested workspace arrays unavailable')   ;   RETURN
+      END IF
 
       IF( kt == nit000 ) THEN
@@ -119 +127 @@
          IF(lwp) WRITE(numout,*) 'dyn_ldf_iso : iso-neutral laplacian diffusive operator or '
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate horizontal diffusive operator'
+         !                                      ! allocate dyn_ldf_bilap arrays
+         IF( dyn_ldf_iso_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_iso: failed to allocate arrays')
       ENDIF
 
-!     ! s-coordinate: Iso-level diffusion on momentum but not on tracer
+      ! s-coordinate: Iso-level diffusion on momentum but not on tracer
       IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN
- 
-         ! set the slopes of iso-level
-         DO jk = 1, jpk
+         !
+         DO jk = 1, jpk         ! set the slopes of iso-level
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -135 +144 @@
             END DO
          END DO
- 
          ! Lateral boundary conditions on the slopes
          CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. )
@@ -141 +149 @@
  
 !!bug
-         if( kt == nit000 ) then
-            IF(lwp) WRITE(numout,*) ' max slop: u',SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)),  &
-               &                             ' wi', sqrt(MAXVAL(wslpi)), ' wj', sqrt(MAXVAL(wslpj))
+         IF( kt == nit000 ) then
+            IF(lwp) WRITE(numout,*) ' max slop: u', SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)),  &
+               &                             ' wi', sqrt(MAXVAL(wslpi))     , ' wj', sqrt(MAXVAL(wslpj))
          endif
 !!end
@@ -420 +428 @@
       !                                                ! ===============
 
+      IF( wrk_not_released(2, 1,2,3,4,5,6,7,8) )   CALL ctl_stop('dyn_ldf_iso: failed to release workspace arrays')
+      !
    END SUBROUTINE dyn_ldf_iso
 
@@ -428 +438 @@
 CONTAINS
    SUBROUTINE dyn_ldf_iso( kt )               ! Empty routine
+      INTEGER, INTENT(in) :: kt
       WRITE(*,*) 'dyn_ldf_iso: You should not have seen this print! error?', kt
    END SUBROUTINE dyn_ldf_iso