source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedyn_xios.F90 @ 5133

! $Id$

SUBROUTINE writedyn_xios(vcov, ucov, teta, ppk, phi, q, &
        masse, ps, phis)

  USE lmdz_xios
  USE parallel_lmdz
  USE misc_mod
  USE infotrac, ONLY: nqtot
  USE com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
  USE comconst_mod, ONLY: cpp
  USE temps_mod, ONLY: itau_dyn
  USE mod_xios_dyn3dmem, ONLY: writefield_dyn_u, writefield_dyn_v
  USE lmdz_description, ONLY: descript
  USE lmdz_iniprint, ONLY: lunout, prt_level

  IMPLICIT NONE

  !   Ecriture du fichier histoire au format xios


  !   Entree:
  !      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/21

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

  !   Declarations
  include "dimensions.h"
  include "paramet.h"
  include "comgeom.h"

  !   Arguments

  REAL vcov(ijb_v:ije_v, llm), ucov(ijb_u:ije_u, llm)
  REAL teta(ijb_u:ije_u, llm), phi(ijb_u:ije_u, llm)
  REAL ppk(ijb_u:ije_u, llm)
  REAL ps(ijb_u:ije_u), masse(ijb_u:ije_u, llm)
  REAL phis(ijb_u:ije_u)
  REAL q(ijb_u:ije_u, llm, nqtot)
  INTEGER time


  !   Variables locales

  INTEGER, SAVE, ALLOCATABLE :: ndex2d(:), ndexu(:), ndexv(:)
  INTEGER :: iq, ii, ll
  REAL, SAVE, ALLOCATABLE :: tm(:, :)
  REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
  REAL, SAVE, ALLOCATABLE :: vbuffer(:, :)
  LOGICAL ok_sync
  INTEGER itau_w
  INTEGER :: ijb, ije, jjn
  LOGICAL, SAVE :: first = .TRUE.
  LOGICAL, SAVE :: debuglf = .TRUE.
  !$OMP THREADPRIVATE(debuglf)
  !$OMP THREADPRIVATE(first)

  !  Initialisations

  !      WRITE(*,*)'IN WRITEDYN_XIOS'
  IF (first) THEN
    !$OMP BARRIER
    !$OMP MASTER
    ALLOCATE(unat(ijb_u:ije_u, llm))
    ALLOCATE(vnat(ijb_v:ije_v, llm))
    IF (pole_sud) THEN
      ALLOCATE(vbuffer(ijb_v:ije_v + iip1, llm))
    ELSE
      ALLOCATE(vbuffer(ijb_v:ije_v + iip1, llm))
    ENDIF
    ALLOCATE(tm(ijb_u:ije_u, llm))
    ALLOCATE(ndex2d(ijnb_u * llm))
    ALLOCATE(ndexu(ijnb_u * llm))
    ALLOCATE(ndexv(ijnb_v * llm))
    unat = 0.; vnat = 0.; tm = 0. ;
    ndex2d = 0
    ndexu = 0
    ndexv = 0
    vbuffer = 0.
    !$OMP END MASTER
    !$OMP BARRIER
    first = .FALSE.
  ENDIF

  ok_sync = .TRUE.
  itau_w = itau_dyn + time

  ! Passage aux composantes naturelles du vent
  CALL covnat_loc(llm, ucov, vcov, unat, vnat)

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

  !  Vents U

  ijb = ij_begin
  ije = ij_end
  jjn = jj_nb

  CALL writefield_dyn_u('U', unat(ijb:ije, :))

  !  Vents V

  ije = ij_end
  IF (pole_sud) THEN
    jjn = jj_nb - 1
    ije = ij_end - iip1
  ENDIF
  vbuffer(ijb:ije, :) = vnat(ijb:ije, :)

  IF (pole_sud) THEN
    CALL writefield_dyn_v('V', vbuffer(ijb:ije + iip1, :))
  ELSE
    CALL writefield_dyn_v('V', vbuffer(ijb:ije, :))
  ENDIF

  !  Temperature potentielle moyennee

  ijb = ij_begin
  ije = ij_end
  jjn = jj_nb
  CALL writefield_dyn_u('THETA', teta(ijb:ije, :))

  !  Temperature moyennee

  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
  do ll = 1, llm
    do ii = ijb, ije
      tm(ii, ll) = teta(ii, ll) * ppk(ii, ll) / cpp
    enddo
  enddo
  !$OMP ENDDO
  CALL writefield_dyn_u('TEMP', tm(ijb:ije, :))

  !  Geopotentiel

  CALL writefield_dyn_u('PHI', phi(ijb:ije, :))

  ! Tracers?

  !        DO iq=1,nqtot
  !        ENDDO

  !  Masse

  CALL writefield_dyn_u('MASSE', masse(ijb:ije, :))

  !  Pression au sol

  CALL writefield_dyn_u('PS', ps(ijb:ije))

END