Changeset 3161 for branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90

Timestamp:

2011-11-20T16:02:18+01:00 (12 years ago)

Author:

cetlod

Message:

New dynamical allocation & timing in OPA_SRC/DYN routines

File:

• branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90 (modified) (11 diffs)

branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90

@@ -30 +30 @@
    USE phycst
    USE lbclnk
-
+   USE wrk_nemo_2      ! Memory Allocation
 
    IMPLICIT NONE
@@ -102 +102 @@
       USE iom
       !!
-!!    Local dynamic allocation
       INTEGER  ::   ji, jj, jk    ! dummy loop indices
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   ht       ! temporary 2D workspace
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   htn      ! temporary 2D workspace
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   tscale   ! temporary 2D workspace
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   tsp      ! temporary 2D workspace
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   hur_n    ! temporary 2D workspace
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   hvr_n    ! temporary 2D workspace
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   hu_n     ! temporary 2D workspace
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   hv_n     ! temporary 2D workspace
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   znmask   ! temporary 3D array for nmask
       REAL(wp) :: unemin,unemax,vnemin,vnemax   ! extrema of (u*, v*) fields
       REAL(wp) :: zhdivmin,zhdivmax             ! extrema of horizontal divergence of (u*, v*) fields
@@ -118 +108 @@
       REAL(wp) :: ustar,vstar                   ! (u*, v*) before tapering in shallow water
       REAL(wp) :: hramp                         ! depth over which Neptune vel. is ramped down
-      !!
-      NAMELIST/namdyn_nept/ ln_neptsimp,      &
-                            ln_smooth_neptvel,&
-             rn_tslse,        &
-             rn_tslsp,        &
-                            ln_neptramp,      &
-                            rn_htrmin,        &
-             rn_htrmax
-      !!----------------------------------------------------------------------
-
+      !
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: ht, htn, tscale, tsp, hur_n, hvr_n, hu_n, hv_n      
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: znmask
+      !!
+      NAMELIST/namdyn_nept/ ln_neptsimp, ln_smooth_neptvel, rn_tslse, rn_tslsp,      &
+                            ln_neptramp, rn_htrmin, rn_htrmax
+      !!----------------------------------------------------------------------
+      !                                                           ! Dynamically allocate local work arrays
+      CALL wrk_alloc( jpi, jpj     , ht, htn, tscale, tsp, hur_n, hvr_n, hu_n, hv_n  ) 
+      CALL wrk_alloc( jpi, jpj, jpk, znmask                                          ) 
+      !
       ! Define the (simplified) Neptune parameters
       ! ==========================================
@@ -179 +170 @@
 !!    Perform dynamic allocation of shared module variables
       IF( dynnept_alloc() /= 0 )   CALL ctl_warn('dynnept_alloc: array allocate failed.')
-
-!!    Dynamically allocate local work arrays
-      ALLOCATE( ht(jpi,jpj), htn(jpi,jpj), tscale(jpi,jpj), tsp(jpi,jpj),      &
-         &      hur_n(jpi,jpj), hvr_n(jpi,jpj), hu_n(jpi,jpj), hv_n(jpi,jpj),  &
-         &      znmask(jpi,jpj,jpk) )
 
       IF( .not. ln_rstart ) THEN      ! If restarting, these arrays are read from the restart file
@@ -350 +336 @@
 !!    Deallocate temporary workspace arrays, which are all local to
 !!    this routine, except where passed as arguments to other routines
-      DEALLOCATE( ht, htn, tscale, tsp, hur_n, hvr_n, hu_n, hv_n, znmask )
-
+      CALL wrk_dealloc( jpi, jpj     , ht, htn, tscale, tsp, hur_n, hvr_n, hu_n, hv_n  ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, znmask                                          ) 
+      !
    END SUBROUTINE dyn_nept_init
 
@@ -393 +380 @@
       INTEGER  ::   ji, jj, jk          ! dummy loop indices
       !!----------------------------------------------------------------------
-
-
+      !    
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'dyn_nept_div_cur_init :'
@@ -501 +487 @@
          ENDIF
          !
-    lastkt = kt        ! Store kt
-    !
+         lastkt = kt     ! Store kt
+         !
       ENDIF
       !
@@ -530 +516 @@
 
 
-   SUBROUTINE dyn_nept_smooth_vel( htold, htnew, option )
+   SUBROUTINE dyn_nept_smooth_vel( htold, htnew, ld_option )
 
       !!----------------------------------------------------------------------
@@ -539 +525 @@
       !! ** Action : - Updates the array htnew (output) with a smoothed
       !!               version of the (input) array htold. Form of smoothing
-      !!               algorithm is controlled by the (logical) argument option.
-      !!----------------------------------------------------------------------
-
-      INTEGER                                   ::   ji, jj  ! dummy loop indices
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN)  ::   htold   ! temporary 2D workspace
-      LOGICAL, INTENT(IN)                       ::   option  ! temporary 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj)              ::   htnew   ! temporary 2D workspace
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     ::   work    ! temporary 2D workspace
-      INTEGER,  ALLOCATABLE, DIMENSION(:,:)     ::   nb      ! temporary 2D workspace
-      INTEGER,  ALLOCATABLE, DIMENSION(:,:)     ::   iwork   ! temporary 2D workspace
-
-!!    Dynamically allocate local work arrays
-      ALLOCATE( work(jpi,jpj), nb(jpi,jpj), iwork(jpi,jpj) )
-
+      !!               algorithm is controlled by the (logical) argument ld_option.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )  ::  htold      ! temporary 2D workspace
+      LOGICAL                     , INTENT(in   )  ::  ld_option  ! temporary 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)  ::  htnew      ! temporary 2D workspace
+      !
+      INTEGER                           ::  ji, jj  ! dummy loop indices
+      INTEGER , POINTER, DIMENSION(:,:) ::  nb, iwork
+      REAL(wp), POINTER, DIMENSION(:,:) ::  work    ! temporary 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi, jpj, nb, iwork ) 
+      CALL wrk_alloc( jpi, jpj, work      ) 
+      !
       iwork(:,:) = 0
 
@@ -565 +551 @@
       !! htnew contains valid ocean depths from htold, or zero
 
-      !! set work to a smoothed/averaged version of htnew; choice controlled by option
+      !! set work to a smoothed/averaged version of htnew; choice controlled by ld_option
       !! nb is set to the sum of the weights of the valid values used in work
-      IF( option ) THEN
+      IF( ld_option ) THEN
 
          !! Apply scale-selective smoothing in determining work from htnew
@@ -615 +601 @@
       END WHERE
 
-!!    Deallocate temporary workspace arrays, all local to this routine
-      DEALLOCATE( work, nb, iwork )
-
+      !!    Deallocate temporary workspace arrays, all local to this routine
+      CALL wrk_dealloc( jpi, jpj, nb, iwork ) 
+      CALL wrk_dealloc( jpi, jpj, work      ) 
+      !
    END SUBROUTINE dyn_nept_smooth_vel