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

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

@@ -16 +16 @@
    USE oce            ! ocean dynamics and tracers
    USE dom_oce        ! ocean space and time domain
-   USE in_out_manager ! I/O manager
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE trdmod         ! ocean dynamics trends
    USE trdmod_oce     ! ocean variables trends
+   USE in_out_manager ! I/O manager
    USE prtctl         ! Print control
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
 
    IMPLICIT NONE
@@ -34 +35 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
+   !! 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
 
@@ -68 +68 @@
       !! Reference : Shchepetkin & McWilliams, 2005, Ocean Modelling. 
       !!----------------------------------------------------------------------
-      USE oce, ONLY:   zfu => ta   ! use ta as 3D workspace
-      USE oce, ONLY:   zfv => sa   ! use sa as 3D workspace
-      !!
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE oce     , ONLY:   zfu    => ta       , zfv    => sa      ! (ta,sa) used as 3D workspace
+      USE wrk_nemo, ONLY:   zfu_t  => wrk_3d_1 , zfv_t  =>wrk_3d_4 , zfu_uw =>wrk_3d_6   ! 3D workspace
+      USE wrk_nemo, ONLY:   zfu_f  => wrk_3d_2 , zfv_f  =>wrk_3d_5 , zfv_vw =>wrk_3d_7
+      USE wrk_nemo, ONLY:   zfw    => wrk_3d_3
+      USE wrk_nemo, ONLY:   zlu_uu => wrk_4d_1 , zlv_vv=>wrk_4d_3   ! 4D workspace
+      USE wrk_nemo, ONLY:   zlu_uv => wrk_4d_2 , zlv_vu=>wrk_4d_4
+      !
       INTEGER, INTENT(in) ::   kt     ! ocean time-step index
-      !!
+      !
       INTEGER  ::   ji, jj, jk            ! dummy loop indices
       REAL(wp) ::   zbu, zbv    ! temporary scalars
       REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! temporary scalars
-      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfu_t, zfu_f     ! temporary workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfv_t, zfv_f     !    "           "
-      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfw, zfu_uw, zfv_vw
-      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlu_uu, zlu_uv   ! temporary workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlv_vv, zlv_vu   ! temporary workspace
       !!----------------------------------------------------------------------
 
@@ -88 +88 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
       ENDIF
-      zfu_t(:,:,:) = 0.e0
-      zfv_t(:,:,:) = 0.e0
-      zfu_f(:,:,:) = 0.e0
-      zfv_f(:,:,:) = 0.e0
-      !
-      zlu_uu(:,:,:,:) = 0.e0 
-      zlv_vv(:,:,:,:) = 0.e0 
-      zlu_uv(:,:,:,:) = 0.e0 
-      zlv_vu(:,:,:,:) = 0.e0 
+
+      ! Check that required workspace arrays are not already in use
+      IF( wrk_in_use(3, 1,2,3,4,5,6,7) .OR. wrk_in_use(4, 1,2,3,4) ) THEN
+         CALL ctl_stop('dyn_adv_ubs: requested workspace array unavailable')   ;   RETURN
+      ENDIF
+
+      zfu_t(:,:,:) = 0._wp
+      zfv_t(:,:,:) = 0._wp
+      zfu_f(:,:,:) = 0._wp
+      zfv_f(:,:,:) = 0._wp
+      !
+      zlu_uu(:,:,:,:) = 0._wp
+      zlv_vv(:,:,:,:) = 0._wp 
+      zlu_uv(:,:,:,:) = 0._wp 
+      zlv_vu(:,:,:,:) = 0._wp 
 
       IF( l_trddyn ) THEN           ! Save ua and va trends
@@ -116 +122 @@
                zlu_uv(ji,jj,jk,1) = ( ub (ji,jj+1,jk)-2.*ub (ji,jj,jk)+ub (ji,jj-1,jk) ) * umask(ji,jj,jk)
                zlv_vu(ji,jj,jk,1) = ( vb (ji+1,jj,jk)-2.*vb (ji,jj,jk)+vb (ji-1,jj,jk) ) * vmask(ji,jj,jk)
-               
+               !
                zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj,jk)-2.*zfu(ji,jj,jk)+zfu(ji-1,jj,jk) ) * umask(ji,jj,jk)
                zlv_vv(ji,jj,jk,2) = ( zfv(ji,jj+1,jk)-2.*zfv(ji,jj,jk)+zfv(ji,jj-1,jk) ) * vmask(ji,jj,jk)
@@ -125 +131 @@
       END DO
 !!gm BUG !!!  just below this should be +1 in all the communications
-      CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', -1.)   ;   CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', -1.)
-      CALL lbc_lnk( zlu_uu(:,:,:,2), 'U', -1.)   ;   CALL lbc_lnk( zlu_uv(:,:,:,2), 'U', -1.)
-      CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', -1.)   ;   CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', -1.)
-      CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', -1.)   ;   CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', -1.) 
-
+!      CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', -1.)   ;   CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', -1.)
+!      CALL lbc_lnk( zlu_uu(:,:,:,2), 'U', -1.)   ;   CALL lbc_lnk( zlu_uv(:,:,:,2), 'U', -1.)
+!      CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', -1.)   ;   CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', -1.)
+!      CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', -1.)   ;   CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', -1.)
+!
 !!gm corrected:
       CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', 1. )   ;   CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', 1. )
@@ -248 +254 @@
          &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
+      IF( wrk_not_released(3, 1,2,3,4,5,6,7) .OR.   &
+          wrk_not_released(4, 1,2,3,4)       )   CALL ctl_stop('dyn_adv_ubs: failed to release workspace array')
+      !
    END SUBROUTINE dyn_adv_ubs