source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writehist.f90 @ 5182

! $Id: writehist.f90 5182 2024-09-10 14:25:29Z abarral $

SUBROUTINE writehist(time, vcov, ucov, teta, phi, q, masse, ps, phis)

  USE ioipsl
  USE lmdz_infotrac, ONLY: nqtot
  USE com_io_dyn_mod, ONLY: histid, histvid, histuid
  USE temps_mod, ONLY: itau_dyn
  USE lmdz_description, ONLY: descript
  USE lmdz_iniprint, ONLY: lunout, prt_level
  USE lmdz_comgeom

  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
  USE lmdz_paramet
  IMPLICIT NONE


  !   Ecriture du fichier histoire au format IOIPSL

  !   Appels succesifs des routines: histwrite

  !   Entree:
  !  time: temps de l'ecriture
  !  vcov: vents v covariants
  !  ucov: vents u covariants
  !  teta: temperature potentielle
  !  phi : geopotentiel instantane
  !  q   : traceurs
  !  masse: masse
  !  ps   :pression au sol
  !  phis : geopotentiel au sol


  !   L. Fairhead, LMD, 03/99

  ! =====================================================================

  !   Declarations




  !   Arguments
  !

  REAL :: vcov(ip1jm, llm), ucov(ip1jmp1, llm)
  REAL :: teta(ip1jmp1, llm), phi(ip1jmp1, llm)
  REAL :: ps(ip1jmp1), masse(ip1jmp1, llm)
  REAL :: phis(ip1jmp1)
  REAL :: q(ip1jmp1, llm, nqtot)
  INTEGER :: time


  ! This routine needs IOIPSL to work
  !   Variables locales

  INTEGER :: iq, ii, ll
  INTEGER :: ndexu(ip1jmp1 * llm), ndexv(ip1jm * llm), ndex2d(ip1jmp1)
  LOGICAL :: ok_sync
  INTEGER :: itau_w
  REAL :: vnat(ip1jm, llm), unat(ip1jmp1, llm)


  !  Initialisations

  ndexu = 0
  ndexv = 0
  ndex2d = 0
  ok_sync = .TRUE.
  itau_w = itau_dyn + time
  !  Passage aux composantes naturelles du vent
  CALL covnat(llm, ucov, vcov, unat, vnat)

  !  Appels a histwrite pour l'ecriture des variables a sauvegarder

  !  Vents U

  CALL histwrite(histuid, 'u', itau_w, unat, &
          iip1 * jjp1 * llm, ndexu)

  !  Vents V

  CALL histwrite(histvid, 'v', itau_w, vnat, &
          iip1 * jjm * llm, ndexv)


  !  Temperature potentielle

  CALL histwrite(histid, 'teta', itau_w, teta, &
          iip1 * jjp1 * llm, ndexu)

  !  Geopotentiel

  CALL histwrite(histid, 'phi', itau_w, phi, &
          iip1 * jjp1 * llm, ndexu)

  !  Traceurs

  !    DO iq=1,nqtot
  !      CALL histwrite(histid, tracers(iq)%longName, itau_w,
  ! .                   q(:,:,iq), iip1*jjp1*llm, ndexu)
  !    enddo
  !C
  !  Masse

  CALL histwrite(histid, 'masse', itau_w, masse, iip1 * jjp1 * llm, ndexu)

  !  Pression au sol

  CALL histwrite(histid, 'ps', itau_w, ps, iip1 * jjp1, ndex2d)

  !  Geopotentiel au sol

  !  CALL histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)

  !  Fin

  IF (ok_sync) THEN
    CALL histsync(histid)
    CALL histsync(histvid)
    CALL histsync(histuid)
  ENDIF
  RETURN
END SUBROUTINE writehist