Changeset 2715 for trunk/NEMOGCM/NEMO/TOP_SRC/trcdia.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/TOP_SRC/trcdia.F90 (modified) (20 diffs)

trunk/NEMOGCM/NEMO/TOP_SRC/trcdia.F90

@@ -25 +25 @@
    USE par_trc
    USE dianam    ! build name of file (routine)
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp
    USE ioipsl
 
@@ -32 +30 @@
    PRIVATE
 
-   PUBLIC   trc_dia   ! called by XXX module 
+   PUBLIC   trc_dia        ! called by XXX module 
+   PUBLIC   trc_dia_alloc  ! called by nemogcm.F90
 
    INTEGER  ::   nit5      !: id for tracer output file
@@ -40 +39 @@
    INTEGER  ::   ndimt51   !: number of ocean points in index array
    REAL(wp) ::   zjulian   !: ????   not DOCTOR !
-   INTEGER , DIMENSION (jpij*jpk) ::   ndext50   !: integer arrays for ocean 3D index
-   INTEGER , DIMENSION (jpij)     ::   ndext51   !: integer arrays for ocean surface index
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION (:) ::   ndext50   !: integer arrays for ocean 3D index
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION (:) ::   ndext51   !: integer arrays for ocean surface index
 # if defined key_diatrc
    INTEGER  ::   nitd      !: id for additional array output file
@@ -58 +57 @@
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
@@ -68 +67 @@
       !! ** Purpose :   output passive tracers fields 
       !!---------------------------------------------------------------------
-      INTEGER, INTENT( in ) :: kt
-      INTEGER               :: kindic
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step
+      !
+      INTEGER ::   kindic   ! local integer
       !!---------------------------------------------------------------------
       !
@@ -95 +95 @@
       !!        IF kindic >0, output of fields before the time step loop
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt          ! ocean time-step
-      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination
-      !!
+      INTEGER, INTENT(in) ::   kt       ! ocean time-step
+      INTEGER, INTENT(in) ::   kindic   ! indicator of abnormal termination
+      !
       INTEGER ::   jn
       LOGICAL ::   ll_print = .FALSE.
@@ -183 +183 @@
          DO jn = 1, jptra
             IF( lutsav(jn) ) THEN
-               cltra  = ctrcnm(jn)   ! short title for tracer
-               cltral = ctrcnl(jn)   ! long title for tracer
-               cltrau = ctrcun(jn)   ! UNIT for tracer
+               cltra  = TRIM( ctrcnm(jn) )   ! short title for tracer
+               cltral = TRIM( ctrcnl(jn) )   ! long title for tracer
+               cltrau = TRIM( ctrcun(jn) )   ! UNIT for tracer
                CALL histdef( nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5,  &
                   &          ipk, 1, ipk,  ndepit5, 32, clop, zsto, zout ) 
@@ -208 +208 @@
 
       DO jn = 1, jptra
-         cltra = ctrcnm(jn)      ! short title for tracer
+         cltra  = TRIM( ctrcnm(jn) )   ! short title for tracer
          IF( lutsav(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 )
       END DO
@@ -216 +216 @@
       IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nit5 )
       !
-
    END SUBROUTINE trcdit_wr
 
@@ -237 +236 @@
       !!        IF kindic >0, output of fields before the time step loop
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt          ! ocean time-step
-      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination
+      INTEGER, INTENT(in) ::   kt       ! ocean time-step
+      INTEGER, INTENT(in) ::   kindic   ! indicator of abnormal termination
       !!
       LOGICAL ::   ll_print = .FALSE.
@@ -308 +307 @@
          ! more 3D horizontal arrays
          DO jl = 1, jpdia3d
-            cltra  = ctrc3d(jl)   ! short title for 3D diagnostic
-            cltral = ctrc3l(jl)   ! long title for 3D diagnostic
-            cltrau = ctrc3u(jl)   ! UNIT for 3D diagnostic
+            cltra  = TRIM( ctrc3d(jl) )   ! short title for 3D diagnostic
+            cltral = TRIM( ctrc3l(jl) )  ! long title for 3D diagnostic
+            cltrau = TRIM( ctrc3u(jl) )  ! UNIT for 3D diagnostic
             CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,   &
                &          ipk, 1, ipk,  ndepitd, 32, clop, zsto, zout )
@@ -317 +316 @@
          ! more 2D horizontal arrays
          DO jl = 1, jpdia2d
-            cltra  = ctrc2d(jl)    ! short title for 2D diagnostic
-            cltral = ctrc2l(jl)   ! long title for 2D diagnostic
-            cltrau = ctrc2u(jl)   ! UNIT for 2D diagnostic
+            cltra  = TRIM( ctrc2d(jl) )   ! short title for 2D diagnostic
+            cltral = TRIM( ctrc2l(jl) )  ! long title for 2D diagnostic
+            cltrau = TRIM( ctrc2u(jl) )  ! UNIT for 2D diagnostic
             CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,  &
                &          1, 1, 1,  -99, 32, clop, zsto, zout )
@@ -345 +344 @@
       ! more 3D horizontal arrays
       DO jl = 1, jpdia3d
-         cltra = ctrc3d(jl)   ! short title for 3D diagnostic
+         cltra  = TRIM( ctrc3d(jl) )   ! short title for 3D diagnostic
          CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jl), ndimt50 ,ndext50)
       END DO
@@ -351 +350 @@
       ! more 2D horizontal arrays
       DO jl = 1, jpdia2d
-         cltra = ctrc2d(jl)   ! short title for 2D diagnostic
+         cltra  = TRIM( ctrc2d(jl) )   ! short title for 2D diagnostic
          CALL histwrite(nitd, cltra, it, trc2d(:,:,jl), ndimt51  ,ndext51)
       END DO
@@ -364 +363 @@
 # else
    SUBROUTINE trcdii_wr( kt, kindic )                      ! Dummy routine
-      INTEGER, INTENT ( in ) :: kt, kindic
+      INTEGER, INTENT (in) :: kt, kindic
    END SUBROUTINE trcdii_wr
 # endif
@@ -400 +399 @@
       ! Initialisation
       ! --------------
-
       
       ! local variable for debugging
@@ -451 +449 @@
          ! biological trends
          DO jl = 1, jpdiabio
-            cltra  = ctrbio(jl)   ! short title for biological diagnostic
-            cltral = ctrbil(jl)   ! long title for biological diagnostic
-            cltrau = ctrbiu(jl)   ! UNIT for biological diagnostic
+            cltra  = TRIM( ctrbio(jl) )   ! short title for biological diagnostic
+            cltral = TRIM( ctrbil(jl) )  ! long title for biological diagnostic
+            cltrau = TRIM( ctrbiu(jl) )  ! UNIT for biological diagnostic
             CALL histdef( nitb, cltra, cltral, cltrau, jpi, jpj, nhoritb,  &
                &         ipk, 1, ipk,  ndepitb, 32, clop, zsto, zout)
@@ -477 +475 @@
 
       DO jl = 1, jpdiabio
-         cltra = ctrbio(jl)  ! short title for biological diagnostic
+         cltra  = TRIM( ctrbio(jl) )   ! short title for biological diagnostic
          CALL histwrite(nitb, cltra, it, trbio(:,:,:,jl), ndimt50,ndext50)
       END DO
@@ -485 +483 @@
       IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nitb )
       !
-
    END SUBROUTINE trcdib_wr
 
@@ -496 +493 @@
 # endif 
 
+   INTEGER FUNCTION trc_dia_alloc()
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_dia_alloc  ***
+      !!---------------------------------------------------------------------
+      ALLOCATE( ndext50(jpij*jpk), ndext51(jpij), STAT=trc_dia_alloc )
+      !
+      IF( trc_dia_alloc /= 0 )   CALL ctl_warn('trc_dia_alloc : failed to allocate arrays')
+      !
+   END FUNCTION trc_dia_alloc
 #else
    !!----------------------------------------------------------------------