Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

Timestamp:

2012-01-28T17:44:18+01:00 (12 years ago)

Author:

rblod

Message:

Merge of 3.4beta into the trunk

File:

• trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90 (modified) (10 diffs)

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

@@ -29 +29 @@
    USE restart         ! ocean restart
    USE lib_mpp         ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
 
    IMPLICIT NONE
@@ -90 +93 @@
       !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
       !!----------------------------------------------------------------------
-      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
-      USE wrk_nemo, ONLY:   zekb => wrk_2d_1 , zekg => wrk_2d_2 , zekr => wrk_2d_3
-      USE wrk_nemo, ONLY:   ze0  => wrk_3d_1 , ze1  => wrk_3d_2 , ze2  => wrk_3d_3
-      USE wrk_nemo, ONLY:   ze3  => wrk_3d_4 , zea  => wrk_3d_5
       !
       INTEGER, INTENT(in) ::   kt     ! ocean time-step
@@ -102 +101 @@
       REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         -
       REAL(wp) ::   zz0, zz1, z1_e3t     !    -         -
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zekb, zekg, zekr
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt
       !!----------------------------------------------------------------------
-
-      IF( wrk_in_use(3, 1,2,3,4,5) .OR. wrk_in_use(2, 1,2,3) )THEN
-         CALL ctl_stop('tra_qsr: requested workspace arrays unavailable')   ;   RETURN
-      ENDIF
-
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_qsr')
+      !
+      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        ) 
+      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
+      !
       IF( kt == nit000 ) THEN
          IF(lwp) WRITE(numout,*)
@@ -117 +118 @@
 
       IF( l_trdtra ) THEN      ! Save ta and sa trends
-         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdt ) 
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
       ENDIF
 
@@ -237 +239 @@
                zz1   = ( 1. - rn_abs ) * ro0cpr
                DO jk = 1, nksr                    ! solar heat absorbed at T-point in the top 400m 
-                  DO jj = 2, jpjm1
-                     DO ji = 2, jpim1
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
                         zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r )
                         zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )
@@ -283 +285 @@
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_qsr, ztrdt )
-         DEALLOCATE( ztrdt )
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt ) 
       ENDIF
       !                       ! print mean trends (used for debugging)
       IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
       !
-      IF( wrk_not_released(3, 1,2,3,4,5) .OR.   &
-          wrk_not_released(2, 1,2,3)     )   CALL ctl_stop('tra_qsr: failed to release workspace arrays')
+      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_qsr')
       !
    END SUBROUTINE tra_qsr
@@ -311 +315 @@
       !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
       !!----------------------------------------------------------------------
-      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
-      USE wrk_nemo, ONLY:   zekb => wrk_2d_1 , zekg => wrk_2d_2 , zekr => wrk_2d_3
-      USE wrk_nemo, ONLY:   ze0  => wrk_3d_1 , ze1  => wrk_3d_2 , ze2 => wrk_3d_3
-      USE wrk_nemo, ONLY:   ze3  => wrk_3d_4 , zea  => wrk_3d_5
       !
       INTEGER  ::   ji, jj, jk     ! dummy loop indices
@@ -320 +320 @@
       REAL(wp) ::   zz0, zc0  , zc1, zcoef       ! local scalars
       REAL(wp) ::   zz1, zc2  , zc3, zchl        !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zekb, zekg, zekr
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea
       !
       CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files
@@ -328 +330 @@
       !!----------------------------------------------------------------------
 
-      IF( wrk_in_use(2, 1,2,3) .OR. wrk_in_use(3, 1,2,3,4,5) )THEN
-         CALL ctl_stop('tra_qsr_init: requested workspace arrays unavailable')   ;   RETURN
-      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init')
+      !
+      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        ) 
+      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
+      !
 
       cn_dir = './'       ! directory in which the model is executed
@@ -504 +509 @@
       ENDIF
       !
-      IF( wrk_not_released(2, 1,2,3)     .OR.   &
-          wrk_not_released(3, 1,2,3,4,5) )   CALL ctl_stop('tra_qsr_init: failed to release workspace arrays')
+      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_qsr_init')
       !
    END SUBROUTINE tra_qsr_init