source: LMDZ.3.3/tags/IPSL-CM4_CMIP/libf/bibio/writedynav.F @ 575

      subroutine writedynav( histid, nq, time, vcov, 
     ,                          ucov,teta,ppk,phi,q,masse,ps,phis)

      USE ioipsl
      implicit none

C
C   Ecriture du fichier histoire au format IOIPSL
C
C   Appels succesifs des routines: histwrite
C
C   Entree:
C      histid: ID du fichier histoire
C      nqmx: nombre maxi de traceurs
C      time: temps de l'ecriture
C      vcov: vents v covariants
C      ucov: vents u covariants
C      teta: temperature potentielle
C      phi : geopotentiel instantane
C      q   : traceurs
C      masse: masse
C      ps   :pression au sol
C      phis : geopotentiel au sol
C      
C
C   Sortie:
C      fileid: ID du fichier netcdf cree
C
C   L. Fairhead, LMD, 03/99
C
C =====================================================================
C
C   Declarations
#include "dimensions.h"
#include "paramet.h"
#include "comconst.h"
#include "comvert.h"
#include "comgeom.h"
#include "temps.h"
#include "ener.h"
#include "logic.h"
#include "description.h"
#include "serre.h"

C
C   Arguments
C

      INTEGER histid, nq
      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) 
      REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm)                  
      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
      REAL phis(ip1jmp1)                  
      REAL q(ip1jmp1,llm,nq)
      integer time


C   Variables locales
C
      integer ndex2d(iip1*jjp1),ndex3d(iip1*jjp1*llm),iq, ii, ll
      character*3 str
      real us(ip1jmp1*llm), vs(ip1jmp1*llm)
      real tm(ip1jmp1*llm)
      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm) 
      logical ok_sync
      integer itau_w
C
C  Initialisations
C
      str='q  '
      ndex3d = 0
      ndex2d = 0
      ok_sync = .TRUE.
      us = 999.999
      vs = 999.999
      tm = 999.999
      vnat = 999.999
      unat = 999.999
      itau_w = itau_dyn + time

C Passage aux composantes naturelles du vent
      call covnat(llm, ucov, vcov, unat, vnat)

C
C  Appels a histwrite pour l'ecriture des variables a sauvegarder
C
C  Vents U scalaire
C
      call gr_u_scal(llm, unat, us)
      call histwrite(histid, 'u', itau_w, us, 
     .               iip1*jjp1*llm, ndex3d)
C
C  Vents V scalaire
C
      call gr_v_scal(llm, vnat, vs)
      call histwrite(histid, 'v', itau_w, vs, 
     .               iip1*jjp1*llm, ndex3d)
C
C  Temperature potentielle moyennee
C
      call histwrite(histid, 'theta', itau_w, teta, 
     .                iip1*jjp1*llm, ndex3d)
C
C  Temperature moyennee
C
      do ii = 1, ijp1llm
        tm(ii) = teta(ii) * ppk(ii)/cpp
      enddo
      call histwrite(histid, 'temp', itau_w, tm, 
     .                iip1*jjp1*llm, ndex3d)
C
C  Geopotentiel
C
      call histwrite(histid, 'phi', itau_w, phi, 
     .                iip1*jjp1*llm, ndex3d)
C
C  Traceurs
C
      IF(nq.GE.1) THEN
        DO iq=1,nq
          IF ( iq.LE.9 ) THEN
            WRITE(str(2:2),'(i1.1)') iq
          ELSE
            WRITE(str(2:3),'(i2.2)') iq
          ENDIF
          call histwrite(histid, str, itau_w, q(:,:,iq), 
     .                   iip1*jjp1*llm, ndex3d)
        enddo
      endif
C
C  Masse
C
       call histwrite(histid, 'masse', itau_w, masse, iip1*jjp1, ndex2d)
C
C  Pression au sol
C
       call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
C
C  Geopotentiel au sol
C
       call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
C
C  Fin
C
      if (ok_sync) call histsync(histid)
      return
      end