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

trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

@@ -25 +25 @@
    USE dom_oce         ! ocean space and time domain
    USE trdmod_oce      ! tracers trends
-   USE trdtra      ! tracers trends
+   USE trdtra          ! tracers trends
    USE in_out_manager  ! I/O manager
    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
-   USE lib_mpp
+   USE lib_mpp         ! MPP library
    USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    USE diaptr          ! poleward transport diagnostics
@@ -39 +39 @@
    PUBLIC   tra_adv_tvd    ! routine called by step.F90
 
-   LOGICAL  :: l_trd       ! flag to compute trends
+   LOGICAL ::   l_trd   ! flag to compute trends
 
    !! * Substitutions
@@ -66 +66 @@
       !!             - save the trends 
       !!----------------------------------------------------------------------
-      USE oce         , zwx => ua   ! use ua as workspace
-      USE oce         , zwy => va   ! use va as workspace
-      !!
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE oce     , ONLY:   zwx => ua        , zwy => va          ! (ua,va) used as workspace
+      USE wrk_nemo, ONLY:   zwi => wrk_3d_12 , zwz => wrk_3d_13   ! 3D workspace
+      !
       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
@@ -76 +77 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
-      !!
+      !
       INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices  
       REAL(wp) ::   z2dtt, zbtr, ztra        ! local scalar
       REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      -
       REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zwi, zwz   ! 3D workspace
       REAL(wp), DIMENSION (:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz
       !!----------------------------------------------------------------------
+
+      IF( wrk_in_use(3, 12,13) ) THEN
+         CALL ctl_stop('tra_adv_tvd: requested workspace arrays unavailable')   ;   RETURN
+      ENDIF
 
       IF( kt == nit000 )  THEN
@@ -235 +239 @@
          ENDIF
          !
-      ENDDO
+      END DO
       !
       IF( l_trd )  THEN
         DEALLOCATE( ztrdx )     ;     DEALLOCATE( ztrdy )     ;      DEALLOCATE( ztrdz )  
       END IF
+      !
+      IF( wrk_not_released(3, 12,13) )   CALL ctl_stop('tra_adv_tvd: failed to release workspace arrays')
       !
    END SUBROUTINE tra_adv_tvd
@@ -257 +263 @@
       !!       in-space based differencing for fluid
       !!----------------------------------------------------------------------
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY:   zbetup => wrk_3d_8  , zbetdo => wrk_3d_9    ! 3D workspace
+      USE wrk_nemo, ONLY:   zbup   => wrk_3d_10 , zbdo   => wrk_3d_11   !  -     -
+      !
       REAL(wp), DIMENSION(jpk)         , INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field
       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
-      !!
-      INTEGER ::   ji, jj, jk               ! dummy loop indices
-      INTEGER ::   ikm1
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbetup, zbetdo
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbup, zbdo
-      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt
-      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv
-      REAL(wp) ::   zup, zdo
-      !!----------------------------------------------------------------------
-
-      zbig = 1.e+40
-      zrtrn = 1.e-15
-      zbetup(:,:,jpk) = 0.e0   ;   zbetdo(:,:,jpk) = 0.e0
+      !
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ikm1         ! local integer
+      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! local scalars
+      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
+      !!----------------------------------------------------------------------
+
+      IF( wrk_in_use(3, 8,9,10,11) ) THEN
+         CALL ctl_stop('nonosc: requested workspace array unavailable')   ;   RETURN
+      ENDIF
+
+      zbig  = 1.e+40_wp
+      zrtrn = 1.e-15_wp
+      zbetup(:,:,jpk) = 0._wp   ;   zbetdo(:,:,jpk) = 0._wp
 
 
@@ -348 +359 @@
       CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
       !
+      IF( wrk_not_released(3, 8,9,10,11) )   CALL ctl_stop('nonosc: failed to release workspace arrays')
+      !
    END SUBROUTINE nonosc