source: tags/nemo_v1_04/NEMO/TOP_SRC/SMS/trcdib.F @ 280

CCC $Header$ 
CCC  TOP 1.0 , LOCEAN-IPSL (2005) 
C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
C ---------------------------------------------------------------------------
CDIR$ LIST
      SUBROUTINE trcdib(kt,kindic)
CCC---------------------------------------------------------------------
CCC
CCC                       ROUTINE trcdib
CCC                     ******************
CCC
CCC  Purpose :
CCC  ---------
CCC     Specific output of opa: biological fields
CCC
CCC     If "key_mpp" or "key_fdir, direct access FORMAT
CCC
CCC
CC   Method :
CC   -------
CC
CC At the beginning of the first time step (nit000), define all
CC the NETCDF files and fields for passive tracer
CC
CC      At each time step call histdef to compute the mean if necessary
CC Each nwrite time step, output the instantaneous or mean fields
CC
CC IF kindic <0, output of fields before the model interruption.
CC      IF kindic =0, time step loop
CC      IF kindic >0, output of fields before the time step loop
CC
CC
CC
CC   Input :
CC   -----
CC      argument
CC              kt              : time step
CC    kindic      : indicator of abnormal termination
CC      COMMON
CC            /comcoh/          : orthogonal curvilinear coordinates
CC                                and scale factors
CC            /comask/          : masks, bathymetry
CC            /cottrc/          : passive tracers fields (before,now
CC                                  ,after)
CC            /cimcdf/     : NETCDF variables
CC
CC   Output :
CC   ------
CC      file
CC              "histname" files: at least one file for each grid
CC
CC
CC   Workspace :
CC   ---------
CC      local
CC              zphy ()         : 3D aray for printing
CC              ztra            : total nitrogen
CC              zder            : derive in nitrogen
CC
CC
CC   EXTERNAL :
CC   --------
CC prihre, hist..., dianam
CC
CC   MODIFICATIONS:
CC   --------------
CC      original  : 95-01  passive tracers  (M. Levy)
CC      additions : 98-01 (C. Levy) NETCDF format using ioipsl interface
CC      additions : 99-01 (M.A. Foujols) adapted for passive tracer
CC      additions : 00-12 (E Kestenare) assign a parameter to name
CC                                      individual tracers
CC----------------------------------------------------------------------
CC parameters and commons
CC ======================
      USE ioipsl
      USE oce_trc
      USE trp_trc
      USE in_out_manager
      USE trc
      USE sms
      USE dianam
      IMPLICIT NONE
CC----------------------------------------------------------------------
CC local declarations
CC ==================
      INTEGER kt, kindic

#    if defined key_passivetrc && key_trc_diabio

      INTEGER ji, jj, jk, jn, jl
      LOGICAL clp
C
      CHARACTER*40 clhstnam
      CHARACTER*40 clop
      CHARACTER*20 cltra, cltrau
      CHARACTER*80 cltral

      REAL zsto,zout
      INTEGER iimi, iima, ijmi, ijma, ipk
      REAL zsec

      REAL ztra,zder,zphy(jpi,jpj,jpk)
C
CC----------------------------------------------------------------------
CC statement functions
CC ===================
CDIR$ NOLIST
#include "domzgr_substitute.h90"
CDIR$ LIST
CCC---------------------------------------------------------------------
CCC  OPA8, LODYC (15/11/96)
CCC---------------------------------------------------------------------
C
C 0. Initialisation
C -----------------
C
C local variable for debugging
      clp=.false.
      clp=clp.and.lwp
C
C Define frequency of output and means
C
#        if defined key_diainstant
      zsto=nwritebio*rdt
      clop='inst(only(x))'
#        else
      zsto=rdt
      clop='ave(only(x))'
#        endif
      zout=nwritebio*rdt
C
C Define indexes of the horizontal output zoom
      iimi=1
      iima=jpi
      ijmi=1
      ijma=jpj
c ipk limit storage in depth
      ipk = jpk
C
C
C 1. Define NETCDF files and fields at beginning of first time step
C -----------------------------------------------------------------
C
      IF(clp)WRITE(numout,*)'trcdib kt=',kt,' kindic ',kindic
      IF (kt.eq.nit000.and.kindic.eq.1) THEN
C
C Define the NETCDF files for biological trends
C
          CALL dia_nam(clhstnam,nwrite,'biolog')
          IF(lwp)WRITE(numout,*)
     $        " Name of NETCDF file for biological trends ",clhstnam
C Horizontal grid : glamt and gphit
          WRITE(numout,*)" indexes of zoom = ", 
     $      iimi, iima, ijmi, ijma
          WRITE(numout,*)" limit storage in depth = ", ipk
C
          CALL histbeg(clhstnam, jpi, glamt, jpj, gphit,
     $        iimi, iima-iimi+1, ijmi, ijma-ijmi+1,
     $        nit000-1, djulian, rdt, nhoritb, nitb)
C Vertical grid for biological trends
          CALL histvert(nitb, 'deptht', 'Vertical T levels',
     $        'm', ipk, gdept, ndepitb)
C
C Declare all the output fields as NETCDF variables
C
C 
C biological trends
C
          DO jn=1,jpdiabio
            cltra=ctrbio(jn)    ! short title for biological diagnostic
            cltral=ctrbil(jn)   ! long title for biological diagnostic
            cltrau=ctrbiu(jn)   ! UNIT for biological diagnostic
            CALL histdef(nitb, cltra, cltral, cltrau, jpi, jpj, nhoritb,
     $          ipk, 1, ipk,  ndepitb, 32, clop, zsto, zout)
          END DO 
C
C CLOSE netcdf Files
C          
          CALL histend(nitb)
C
C SOME diagnostics to DO first time
C

#        if defined key_trc_npzd || defined key_trc_lobster1
C
C initial total nitrogen
C
          trai=0.
          DO jn=1,jptra
            DO jk=1,jpk
              DO jj=1,jpj
                DO ji=1,jpi
                  trai=trai+trn(ji,jj,jk,jn)*fse3t(ji,jj,jk)*tmask(ji,jj
     $                ,jk) 
                END DO
              END DO
            END DO
          END DO

          IF (lwp) then
              WRITE (numout,*) ' *** total nitrogen =  ',trai,
     $            ' at beginning of run it= ',kt
          ENDIF 
C
          DO jk=1,jpk
            DO jj=1,jpj
              DO ji=1,jpi
                zphy(ji,jj,jk)=trn(ji,jj,jk,jpphy)
              END DO
            END DO
          END DO
C
          IF (lwp) then
              WRITE (numout,*) ' -------'
              WRITE (numout,*) ' phyto'
              WRITE (numout,*) ' -------'
              CALL prizre(zphy,jpi,jpj,jpk,62,2,122,20,1,14,1,0.,numout)
          ENDIF 
#        endif

      ELSE
C
C
C 2. Start writing data
C ---------------------
C
C biological trends
C
          DO jn=1,jpdiabio
            cltra=ctrbio(jn)  ! short title for biological diagnostic
            CALL histwrite(nitb, cltra, kt, trbio(:,:,:,jn), ndimt50,
     $          ndext50) 
          END DO 
#        if defined key_trc_npzd || defined key_trc_lobster1

          IF(mod(kt-nit000+1,nwritebio).eq.0) THEN 
C
C total nitrogen every nwritebio time step
C
              ztra=0.
              DO jn=1,jptra
                DO jk=1,jpk
                  DO jj=1,jpj
                    DO ji=1,jpi
                      ztra=ztra+trn(ji,jj,jk,jn)*fse3t(ji,jj,jk)
     $                    *tmask(ji,jj,jk) 
                    END DO
                  END DO
                END DO
              END DO
C
              zder=(ztra-trai)/trai
              trai=ztra
              IF (lwp) THEN 
                  WRITE (numout,*)
                  WRITE (numout,*) ' *** derive in total nitrogen =  ',
     $                zder,' %',' at it= ',kt
                  WRITE (numout,*) ' *** total nitrogen =  ',trai,
     $                ' at it= ',kt
              ENDIF 
              
C
              DO jk=1,jpk
                DO jj=1,jpj
                  DO ji=1,jpi
                    zphy(ji,jj,jk)=trn(ji,jj,jk,jpphy)
                  END DO
                END DO
              END DO
C
              IF(lwp) THEN
                  WRITE (numout,*)
                  WRITE (numout,*) ' *** trcdib: at it= ',kt
                  WRITE (numout,*) ' -------'
                  WRITE (numout,*) ' phyto'
                  WRITE (numout,*) ' -------'
                  CALL prizre(zphy,jpi,jpj,jpk,jpj-1,2,jpj-1,20,1,14,1,
     $                0.,numout) 
              ENDIF 

          ENDIF 

#        endif
C
C synchronise FILE
C
          IF(lwp .and. mod( kt, nwritebio ).EQ.0) THEN 
             WRITE(numout,*) '**** trcdib : write NetCDF fields'
             CALL histsync(nitb)
         ENDIF 

      ENDIF
C
C 3. Closing all files
C --------------------
      IF (kt.EQ.nitend.OR.kindic.LT.0) THEN
          CALL histclo(nitb)
      ENDIF

#    else
C
C no passive tracers
C
#    endif

C
C 
      RETURN
      END