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

trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

@@ -7 +7 @@
    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
    !!----------------------------------------------------------------------
-#if defined key_diaar5
+#if defined key_diaar5   || defined key_esopa
    !!----------------------------------------------------------------------
    !!   'key_diaar5'  :                           activate ar5 diagnotics
@@ -25 +25 @@
    PUBLIC   dia_ar5        ! routine called in step.F90 module
    PUBLIC   dia_ar5_init   ! routine called in opa.F90 module
+   PUBLIC   dia_ar5_alloc  ! routine called in nemogcm.F90 module
 
    LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .TRUE.   ! coupled flag
@@ -30 +31 @@
    REAL(wp)                         ::   vol0         ! ocean volume (interior domain)
    REAL(wp)                         ::   area_tot     ! total ocean surface (interior domain)
-   REAL(wp), DIMENSION(jpi,jpj    ) ::   area         ! cell surface (interior domain)
-   REAL(wp), DIMENSION(jpi,jpj    ) ::   thick0       ! ocean thickness (interior domain)
-   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   sn0          ! initial salinity
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   area         ! cell surface (interior domain)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   thick0       ! ocean thickness (interior domain)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity
       
    !! * Substitutions
@@ -43 +44 @@
 CONTAINS
 
+   FUNCTION dia_ar5_alloc()
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_ar5_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: dia_ar5_alloc
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( dia_ar5_alloc )
+      IF( dia_ar5_alloc /= 0 )   CALL ctl_warn('dia_ar5_alloc: failed to allocate arrays')
+      !
+   END FUNCTION dia_ar5_alloc
+
+
    SUBROUTINE dia_ar5( kt )
       !!----------------------------------------------------------------------
@@ -48 +64 @@
       !!
       !! ** Purpose :   compute and output some AR5 diagnostics
-      !!
-      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY:   zarea_ssh => wrk_2d_1 , zbotpres => wrk_2d_2   ! 2D workspace
+      USE wrk_nemo, ONLY:   zrhd      => wrk_3d_1 , zrhop    => wrk_3d_2   ! 3D      -
+      USE wrk_nemo, ONLY:   ztsn      => wrk_4d_1                          ! 4D      -
+      !
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
-      !!
+      !
       INTEGER  ::   ji, jj, jk                      ! dummy loop arguments
       REAL(wp) ::   zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass
-      REAL(wp), DIMENSION(jpi,jpj    ) ::   zarea_ssh, zbotpres
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zrhd, zrhop
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::   ztsn
       !!--------------------------------------------------------------------
+
+      IF( wrk_in_use(2, 1,2) .OR.   &
+          wrk_in_use(3, 1,2) .OR.   &
+          wrk_in_use(4, 1)   ) THEN
+         CALL ctl_stop('dia_ar5: requested workspace arrays unavailable')   ;   RETURN
+      ENDIF
 
       CALL iom_put( 'cellthc', fse3t(:,:,:) )
@@ -137 +160 @@
       CALL iom_put( 'saltot' , zsal  )
       !
+      IF( wrk_not_released(2, 1,2) .OR.   &
+          wrk_not_released(3, 1,2) .OR.   &
+          wrk_not_released(4, 1)   )   CALL ctl_stop('dia_ar5: failed to release workspace arrays')
+      !
    END SUBROUTINE dia_ar5
 
@@ -146 +173 @@
       !! ** Purpose :   initialization for AR5 diagnostic computation
       !!----------------------------------------------------------------------
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY:   wrk_4d_1      ! 4D workspace
+      !
       INTEGER  ::   inum
       INTEGER  ::   ik
       INTEGER  ::   ji, jj, jk  ! dummy loop indices
       REAL(wp) ::   zztmp  
-      REAL(wp), DIMENSION(jpi,jpj,jpk, 2) ::   zsaldta   ! Jan/Dec levitus salinity
-      !!----------------------------------------------------------------------
-      !
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity
+      !!----------------------------------------------------------------------
+      !
+      IF(wrk_in_use(4, 1) ) THEN
+         CALL ctl_stop('dia_ar5_init: requested workspace array unavailable.')   ;   RETURN
+      ENDIF
+      zsaldta => wrk_4d_1(:,:,:,1:2)
+
+      !                                      ! allocate dia_ar5 arrays
+      IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' )
+
       area(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)
 
@@ -183 +221 @@
       ENDIF
       !
+      IF( wrk_not_released(4, 1) )   CALL ctl_stop('dia_ar5_init: failed to release workspace array')
+      !
    END SUBROUTINE dia_ar5_init