source: trunk/NEMO/TOP_SRC/trcwri.F @ 247

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 trcwri(kt)
CCC---------------------------------------------------------------------
CCC
CCC                       ROUTINE trcwri
CCC                     ******************
CCC
CCC  PURPOSE :
CCC  ---------
CCC     WRITE restart fields in nutwrs
CCC
CC   METHOD :
CC   -------
CC
CC nutwrs FILE:
CC each nstock time step , SAVE fields which are necessary for
CC passive tracer restart
CC
CC
CC   INPUT :
CC   -----
CC      argument
CC              kt              : time step
CC      COMMON
CC            /cottrc/          : passive tracers fields (before,now
CC                                  ,after)
CC
CC   OUTPUT :
CC   ------
CC      FILE
CC    nutwrs      : standard restart fields OUTPUT
CC
CC
CC   WORKSPACE :
CC   ---------
CC      ji,jj,jk,jl,ino0,it0,iarak0
CC
CC   MODIFICATIONS:
CC   --------------
CC      original : 96-12
CC      addition : 99-12 (M.-A. Foujols) NetCDF FORMAT with ioipsl
CC      additions : 00-05 (A. Estublier) 
CC                  TVD Limiter Scheme : key_trc_tvd
CC      additions : 01-01 (M.A Foujols, E. Kestenare) bug fix: restclo
CC      additions : 01-01 (O. Aumont, E. Kestenare) 
CC                  write restart file for sediments
CC      additions : 01-05 (O. Aumont, E. Kestenare) 
CC                  write restart file for calcite and silicate sediments
CC----------------------------------------------------------------------
CC parameters and commons
CC ======================
#if defined key_mpp
c no ioipsl
#include "trcwri.mpp.h"
#    else
CDIR$ NOLIST
      USE ioipsl 
      USE oce_trc
      USE trc
      USE sms
      IMPLICIT NONE
CDIR$ LIST
CC----------------------------------------------------------------------
CC local declarations
CC ==================
      INTEGER kt

#if defined key_passivetrc

      INTEGER jn
      INTEGER ino0,it0,iarak0
      INTEGER ic,jc,ji,jj,jk
      INTEGER iyear, imonth, iday, iy, itime
      REAL zsec, zdate0, zdt, zinfo(3),zdiag_var,zdiag_varmin,
     $     zdiag_varmax
      CHARACTER*50 clname,clname1,clname2,cln,clnet
      LOGICAL clbon

C
C
C 1. OUTPUT of restart fields (nutwrs)
C ---------------------------
C
      IF( (mod(kt,nstock).eq.0) .OR. (kt.eq.nitend) ) THEN
C
C 0. initialisations
C ------------------
C
          IF(lwp) THEN
              WRITE(numout,*) ' '
              WRITE(numout,*)
     $            ' trcwri: restart OUTPUT done in nutwrs = ',nutwrs
     $            ,' at it= ',kt,' date= ',ndastp
              WRITE(numout,*) ' -------'
          ENDIF
C
          ino0 =no
          it0  =kt

#if defined key_trc_cen2 || defined key_trc_tvd
          iarak0=1
#else
          iarak0=0
#endif
C
C 1. WRITE in nutwrs
C
C ... first information
C
          INQUIRE (FILE=trestart,EXIST=clbon)
          IF(clbon) THEN
              OPEN(UNIT=numwrs,FILE=trestart,STATUS='old')
              CLOSE(numwrs,STATUS='delete')
          ENDIF

          iyear = ndastp/10000
          imonth = ndastp/100 - iyear*100
          iday = ndastp - imonth*100 - iyear*10000
          iyear = ndastp/10000
          zsec=0.
          iy=iyear-(iyear/100)*100
          ic=1
          DO jc=1,16
            IF(cexper(jc:jc).ne.' ') ic=jc
          END DO
          WRITE(cln,'("_",i2.2,i2.2,i2.2,"_restart.trc")') iy,imonth
     $        ,iday 
          clname=cexper(1:ic)//cln
          ic=1
          DO jc=1,48
            IF(clname(jc:jc).ne.' ') ic=jc
          END DO
          trestart=clname(1:ic)//".nc"
          itime=0
          CALL ymds2ju(iyear,imonth,iday,zsec,zdate0)
          CALL restini('NONE',jpi,jpj,glamt,gphit,jpk,gdept,clname
     $        ,itime,zdate0,rdt,nutwrs)
          zinfo(1)=FLOAT(ino0)
          zinfo(2)=FLOAT(it0)
          zinfo(3)=FLOAT(iarak0)
          CALL restput(nutwrs,'info',1,1,3,0,zinfo)
C
C prognostic variables
C

         DO jn=1,jptra
            clname='TRN'//ctrcnm(jn)
            CALL restput(nutwrs,clname,jpi,jpj,jpk,0,trn(:,:,:,jn))

         zdiag_var=0.
         zdiag_varmin=0.
         zdiag_varmax=0.
         WRITE(numout,*) '----TRACER STAT----'

         DO ji=1,jpi
            DO jj=1,jpj
              DO jk=1,jpk

              zdiag_var=zdiag_var+tmask(ji,jj,jk)*trn(ji,jj,jk,jn)
              
              IF (tmask(ji,jj,jk).EQ.1.) THEN

                  IF (zdiag_varmin.GT.trn(ji,jj,jk,jn)) 
     $                zdiag_varmin =  trn(ji,jj,jk,jn)
                  IF (zdiag_varmax.LT.trn(ji,jj,jk,jn))
     $                zdiag_varmax =  trn(ji,jj,jk,jn)
            
              ENDIF

              END DO
            END DO
         END DO
      
         zdiag_var=zdiag_var/(jpi*jpj*jpk)
         
         WRITE(numout,*) 'MEAN NO ',jn,' =',zdiag_var,'MIN= '
     $       ,zdiag_varmin,'MAX= ',zdiag_varmax

         END DO



          DO jn=1,jptra
            clname='TRB'//ctrcnm(jn)
            CALL restput(nutwrs,clname,jpi,jpj,jpk,0,trb(:,:,:,jn))
          END DO

#         if defined key_trc_hamocc3
             clname='SED'//ctrcnm(jppoc)
             clname1='SED'//ctrcnm(jpcal)
             clname2='SED'//ctrcnm(jpsil)
             CALL restput(nutwrs,clname1,jpi,jpj,1,0,sedcal(:,:))
             CALL restput(nutwrs,clname2,jpi,jpj,1,0,sedsil(:,:))
             CALL restput(nutwrs,clname,jpi,jpj,1,0,sedpoc(:,:))
#         elif defined key_trc_npzd || defined key_trc_lobster1
             clname='SED'//ctrcnm(jpdet)
             CALL restput(nutwrs,clname,jpi,jpj,1,0,sedpoc(:,:))
#         elif defined key_trc_pisces
             clname='SED'//ctrcnm(jppoc)
             clname1='SED'//ctrcnm(jpcal)
             clname2='SED'//ctrcnm(jpsil)
             CALL restput(nutwrs,clname1,jpi,jpj,1,0,sedcal(:,:))
             CALL restput(nutwrs,clname2,jpi,jpj,1,0,sedsil(:,:))
             CALL restput(nutwrs,clname,jpi,jpj,1,0,sedpoc(:,:))
#         endif

          CALL restclo(nutwrs)

      ENDIF
C
#else
C
C no passive tracers
C
#endif
C
#endif
      RETURN
      END