source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writehist_loc.f90 @ 5225

! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $

SUBROUTINE writehist_loc(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
  USE ioipsl
  USE parallel_lmdz
  USE misc_mod
  USE lmdz_infotrac, ONLY: nqtot
  USE com_io_dyn_mod, ONLY: histid, histvid, histuid
  USE comconst_mod, ONLY: cpp
  USE temps_mod, ONLY: itau_dyn
  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:
  !  histid: ID du fichier histoire
  !  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


  !   Sortie:
  !  fileid: ID du fichier netcdf cree

  !   L. Fairhead, LMD, 03/99

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

  !   Declarations




  !   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


  ! This routine needs IOIPSL
  !   Variables locales

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


  !  Initialisations

  IF (adjust) return

  IF (first) THEN
    !$OMP BARRIER
    !$OMP MASTER
    ALLOCATE(unat(ijb_u:ije_u, llm))
    ALLOCATE(vnat(ijb_v:ije_v, llm))
    ALLOCATE(tm(ijb_u:ije_u, llm))
    ALLOCATE(ndex2d(ijnb_u * llm))
    ALLOCATE(ndexu(ijnb_u * llm))
    ALLOCATE(ndexv(ijnb_v * llm))
    ndex2d = 0
    ndexu = 0
    ndexv = 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
  !

  !$OMP BARRIER
  !$OMP MASTER
  ijb = ij_begin
  ije = ij_end
  jjn = jj_nb

  CALL histwrite(histuid, 'u', itau_w, unat(ijb:ije, :), &
          iip1 * jjn * llm, ndexu)
  !$OMP END MASTER


  !  Vents V

  ije = ij_end
  IF (pole_sud) jjn = jj_nb - 1
  IF (pole_sud) ije = ij_end - iip1
  !$OMP BARRIER
  !$OMP MASTER
  CALL histwrite(histvid, 'v', itau_w, vnat(ijb:ije, :), &
          iip1 * jjn * llm, ndexv)
  !$OMP END MASTER



  !  Temperature potentielle

  ijb = ij_begin
  ije = ij_end
  jjn = jj_nb
  !$OMP MASTER
  CALL histwrite(histid, 'theta', itau_w, teta(ijb:ije, :), &
          iip1 * jjn * llm, ndexu)
  !$OMP END MASTER


  !  Temperature
  !

  !$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

  !$OMP MASTER
  CALL histwrite(histid, 'temp', itau_w, tm(ijb:ije, :), &
          iip1 * jjn * llm, ndexu)
  !$OMP END MASTER



  !  Geopotentiel

  !$OMP MASTER
  CALL histwrite(histid, 'phi', itau_w, phi(ijb:ije, :), &
          iip1 * jjn * llm, ndexu)
  !$OMP END MASTER



  !  Traceurs

  !!$OMP MASTER
  !    DO iq=1,nqtot
  !      CALL histwrite(histid, tracers(iq)%longName, itau_w,
  ! .                   q(ijb:ije,:,iq), iip1*jjn*llm, ndexu)
  !    enddo
  !!$OMP END MASTER



  !  Masse

  !$OMP MASTER
  CALL histwrite(histid, 'masse', itau_w, masse(ijb:ije, :), &
          iip1 * jjn * llm, ndexu)
  !$OMP END MASTER



  !  Pression au sol

  !$OMP MASTER
  CALL histwrite(histid, 'ps', itau_w, ps(ijb:ije), &
          iip1 * jjn, ndex2d)
  !$OMP END MASTER


  !  Geopotentiel au sol

  !$OMP MASTER
  ! CALL histwrite(histid, 'phis', itau_w, phis(ijb:ije),
  ! .                 iip1*jjn, ndex2d)
  !$OMP END MASTER


  !  Fin

  !$OMP MASTER
  IF (ok_sync) THEN
    CALL histsync(histid)
    CALL histsync(histvid)
    CALL histsync(histuid)
  ENDIF
  !$OMP END MASTER
END SUBROUTINE writehist_loc