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

trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

@@ -10 +10 @@
    !!----------------------------------------------------------------------
    !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   trc_adv      : compute ocean tracer advection trend
@@ -26 +25 @@
    USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine)
    USE ldftra_oce      ! lateral diffusion coefficient on tracers
-   USE in_out_manager  ! I/O manager
-   USE prtctl_trc          ! Print control
+   USE prtctl_trc      ! Print control
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   trc_adv    ! routine called by step module
+   PUBLIC   trc_adv          ! routine called by step module
+   PUBLIC   trc_adv_alloc    ! routine called by nemogcm module
 
    INTEGER ::   nadv   ! choice of the type of advection scheme
-   REAL(wp), DIMENSION(jpk) ::   r2dt  ! vertical profile time-step, = 2 rdttra
-      !                                ! except at nit000 (=rdttra) if neuler=0
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra
+   !                                                    ! except at nit000 (=rdttra) if neuler=0
 
    !! * Substitutions
@@ -46 +45 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
+
+   INTEGER FUNCTION trc_adv_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv_alloc  ***
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc )
+
+      IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.')
+
+   END FUNCTION trc_adv_alloc
+
 
    SUBROUTINE trc_adv( kt )
@@ -57 +67 @@
       !! ** Method  : - Update the tracer with the advection term following nadv
       !!----------------------------------------------------------------------
+      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY: zun => wrk_3d_4, zvn => wrk_3d_5, zwn => wrk_3d_6   ! effective velocity
       !!
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
-      !
-      INTEGER :: jk 
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn   ! effective velocity
-      CHARACTER (len=22) :: charout
-      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER ::   jk 
+      CHARACTER (len=22) ::   charout
+      !!----------------------------------------------------------------------
+      !
+      IF( wrk_in_use(3, 4,5,6) ) THEN
+         CALL ctl_stop('trc_adv : requested workspace arrays unavailable')   ;   RETURN
+      ENDIF
 
       IF( kt == nit000 )   CALL trc_adv_ctl          ! initialisation & control of options
@@ -80 +95 @@
       DO jk = 1, jpkm1
          !                                                ! eulerian transport only
-         zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
-         zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
-         zwn(:,:,jk) = e1t(:,:) * e2t(:,:)      * wn(:,:,jk)
+         zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)
+         zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk)
          !
       END DO
@@ -125 +140 @@
                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
       END IF
+      !
+      IF( wrk_not_released(3, 4,5,6) ) CALL ctl_stop('trc_adv : failed to release workspace arrays.')
       !
    END SUBROUTINE trc_adv
@@ -171 +188 @@
       !
    END SUBROUTINE trc_adv_ctl
+   
 #else
    !!----------------------------------------------------------------------
@@ -181 +199 @@
    END SUBROUTINE trc_adv
 #endif
+
   !!======================================================================
 END MODULE trcadv