Changeset 2590 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

Timestamp:

2011-02-18T13:49:27+01:00 (13 years ago)

Author:

trackstand2

Message:

Merge branch 'dynamic_memory' into master-svn-dyn

File:

• branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90 (modified) (12 diffs)

branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

@@ -42 +42 @@
    PUBLIC   tra_bbl_adv   !  -          -          -              -
    PUBLIC   bbl           !  routine called by trcbbl.F90 and dtadyn.F90
+   PUBLIC   tra_bbl_alloc !  routine called by nemogcm.F90
 
    LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .TRUE.    !: bottom boundary layer flag
@@ -53 +54 @@
    REAL(wp), PUBLIC ::   rn_gambbl  = 10.0_wp   !: lateral coeff. for bottom boundary layer scheme [s]
 
-   REAL(wp), DIMENSION(jpi,jpj), PUBLIC ::   utr_bbl  , vtr_bbl   ! u- (v-) transport in the bottom boundary layer
-   REAL(wp), DIMENSION(jpi,jpj), PUBLIC ::   ahu_bbl  , ahv_bbl   ! masked diffusive bbl coefficients at u and v-points
-
-   INTEGER , DIMENSION(jpi,jpj) ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level
-   INTEGER , DIMENSION(jpi,jpj) ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction
-   REAL(wp), DIMENSION(jpi,jpj) ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points
-   REAL(wp), DIMENSION(jpi,jpj) ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points
-   REAL(wp), DIMENSION(jpi,jpj) ::   e1e2t_r   ! thichness of the bbl (e3) at u and v-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   utr_bbl  , vtr_bbl   ! u- (v-) transport in the bottom boundary layer
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   ahu_bbl  , ahv_bbl   ! masked diffusive bbl coefficients at u and v-points
+
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2t_r   ! thichness of the bbl (e3) at u and v-points
    LOGICAL, PUBLIC              ::   l_bbl                    !: flag to compute bbl diffu. flux coef and transport
 
@@ -72 +73 @@
    !!----------------------------------------------------------------------
 CONTAINS
+
+   FUNCTION tra_bbl_alloc()
+      IMPLICIT none
+      INTEGER :: tra_bbl_alloc
+
+      ALLOCATE(utr_bbl(jpi,jpj),   vtr_bbl(jpi,jpj),   &
+               ahu_bbl(jpi,jpj),   ahv_bbl(jpi,jpj),   &
+               mbku_d(jpi,jpj),    mbkv_d(jpi,jpj),    &
+               mgrhu(jpi,jpj),     mgrhv(jpi,jpj),     &
+               ahu_bbl_0(jpi,jpj), ahv_bbl_0(jpi,jpj), &
+               e3u_bbl_0(jpi,jpj), e3v_bbl_0(jpi,jpj), &
+               e1e2t_r(jpi,jpj),                       &
+               Stat=tra_bbl_alloc)
+
+      IF(tra_bbl_alloc > 0)THEN
+         CALL ctl_warn('tra_bbl_alloc: allocation of arrays failed.')
+      END IF
+
+   END FUNCTION tra_bbl_alloc
 
    SUBROUTINE tra_bbl( kt )
@@ -153 +173 @@
       !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
       !!----------------------------------------------------------------------  
+      USE wrk_nemo, ONLY: wrk_use, wrk_release
+      USE wrk_nemo, ONLY: zptb => wrk_2d_1
+      !!
       INTEGER                              , INTENT(in   ) ::   kjpt    ! number of tracers
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb   ! before and now tracer fields
@@ -160 +183 @@
       INTEGER  ::   ik           ! local integers
       REAL(wp) ::   zbtr         ! local scalars
-      REAL(wp), DIMENSION(jpi,jpj) ::   zptb   ! tracer trend 
-      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      !
+      IF(.not. wrk_use(2,1))THEN
+         CALL ctl_stop('tra_bbl_dif: ERROR: requested workspace array unavailable')
+         RETURN
+      END IF
       !
       DO jn = 1, kjpt                                     ! tracer loop
@@ -196 +223 @@
       END DO                                                ! end tracer
       !                                                     ! ===========
+      IF(.not. wrk_release(2,1))THEN
+         CALL ctl_stop('tra_bbl_dif: ERROR: failed to release workspace array')
+      END IF
+      !
    END SUBROUTINE tra_bbl_dif
    
@@ -314 +345 @@
       !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
       !!----------------------------------------------------------------------  
+      USE wrk_nemo, ONLY: wrk_use, wrk_release
+      USE wrk_nemo, ONLY: zub => wrk_2d_1, zvb => wrk_2d_2, ztb => wrk_2d_3, &
+                          zsb => wrk_2d_4, zdep => wrk_2d_5
       INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index
       CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
@@ -323 +357 @@
       REAL(wp) ::   zsign, zsigna, zgbbl      ! local scalars
       REAL(wp) ::   zgdrho, zt, zs, zh        !   -      -
-      REAL(wp), DIMENSION(jpi,jpj) ::   zub, zvb, ztb, zsb, zdep  !  2D workspace
       !!
       REAL(wp) ::   fsalbt, fsbeta, pft, pfs, pfh   ! statement function
@@ -357 +390 @@
                                           - 0.121555e-07 ) * pfh
       !!----------------------------------------------------------------------
-      
+
+      IF(.not. wrk_use(2, 1,2,3,4,5))THEN
+         CALL ctl_stop('bbl: ERROR: requested workspace arrays unavailable')
+         RETURN
+      END IF
+     
       IF( kt == nit000 )  THEN
          IF(lwp)  WRITE(numout,*)
@@ -494 +532 @@
       ENDIF
       !
+      IF(.not. wrk_release(2, 1,2,3,4,5))THEN
+         CALL ctl_stop('bbl: ERROR: failed to release workspace arrays')
+      END IF
+      !
    END SUBROUTINE bbl
 
@@ -506 +548 @@
       !!              called by tra_bbl at the first timestep (nit000)
       !!----------------------------------------------------------------------
+      USE wrk_nemo, ONLY: wrk_use, wrk_release
+      USE wrk_nemo, ONLY: zmbk => wrk_2d_1
       INTEGER ::   ji, jj               ! dummy loop indices
       INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integer
-      REAL(wp), DIMENSION(jpi,jpj) ::   zmbk   ! 2D workspace 
       !!
       NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl
       !!----------------------------------------------------------------------
+
+      IF(.not. wrk_use(2,1))THEN
+         CALL ctl_stop('tra_bbl_init: ERROR: requested workspace array unavailable')
+         RETURN
+      END IF
 
       REWIND ( numnam )              !* Read Namelist nambbl : bottom boundary layer scheme
@@ -594 +642 @@
       ENDIF
       !
+      IF(.not. wrk_release(2,1))THEN
+         CALL ctl_stop('tra_bbl_init: ERROR: failed to release workspace array')
+      END IF
+      !
    END SUBROUTINE tra_bbl_init