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

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

@@ -18 +18 @@
    USE zdf_oce         ! ocean vertical physics
    USE trdmod_oce      ! ocean active tracer trends
-   USE trdtra      ! ocean active tracer trends
+   USE trdtra          ! ocean active tracer trends
    USE eosbn2          ! equation of state (eos routine) 
    USE lbclnk          ! lateral boundary conditions (or mpp link)
    USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   tra_npc    ! routine called by step.F90
+   PUBLIC   tra_npc       ! routine called by step.F90
 
    !! * Substitutions
@@ -55 +56 @@
       !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371.
       !!----------------------------------------------------------------------
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released, wrk_in_use_xz, wrk_not_released_xz
+      USE wrk_nemo, ONLY:   ztrdt => wrk_3d_1 , ztrds => wrk_3d_2 , zrhop => wrk_3d_3
+      USE wrk_nemo, ONLY:   zwx   => wrk_xz_1 , zwy   => wrk_xz_2 , zwz   => wrk_xz_3
+      !
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !!
+      !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       INTEGER  ::   inpcc        ! number of statically instable water column
@@ -63 +68 @@
       INTEGER  ::   ikbot, ik, ikup, ikdown   ! ???
       REAL(wp) ::   ze3tot, zta, zsa, zraua, ze3dwn
-      REAL(wp), DIMENSION(jpi,jpk)     ::   zwx, zwy, zwz   ! 2D arrays
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zrhop           ! 3D arrays
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
+
+      ! Strictly 1 and 2 3D workspaces only needed if(l_trdtra) but it doesn't 
+      ! cost us anything and makes code simpler.
+      IF( wrk_in_use(3, 1,2,3) .OR. wrk_in_use_xz(1,2,3) ) THEN
+         CALL ctl_stop('tra_npc: requested workspace arrays unavailable')   ;   RETURN
+      ENDIF
 
       IF( MOD( kt, nn_npc ) == 0 ) THEN
@@ -76 +84 @@
 
          IF( l_trdtra )   THEN                    !* Save ta and sa trends
-            ALLOCATE( ztrdt(jpi,jpj,jpk) )  ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
-            ALLOCATE( ztrds(jpi,jpj,jpk) )  ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+            ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
+            ztrds(:,:,:) = tsa(:,:,:,jp_sal)
          ENDIF
 
@@ -192 +200 @@
             CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_npc, ztrdt )
             CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_npc, ztrds )
-            DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
          ENDIF
       
          ! Lateral boundary conditions on ( ta, sa )   ( Unchanged sign)
          ! ------------------------------============
-         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )
-         CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
+         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )   ;   CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
       
 
@@ -210 +216 @@
       ENDIF
       !
+      IF( wrk_not_released(3, 1,2,3) .OR.   &
+          wrk_not_released_xz(1,2,3) )   CALL ctl_stop('tra_npc: failed to release workspace arrays')
+      !
    END SUBROUTINE tra_npc