source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inithist.F90 @ 5101

! $Id: inithist.F90 5101 2024-07-23 06:22:55Z abarral $

subroutine inithist(day0, anne0, tstep, t_ops, t_wrt)

#ifdef CPP_IOIPSL
   USE IOIPSL
#endif
  USE infotrac, ONLY: nqtot
  use com_io_dyn_mod, ONLY: histid, histvid, histuid, &
          dynhist_file, dynhistv_file, dynhistu_file
  USE comconst_mod, ONLY: pi
  USE comvert_mod, ONLY: presnivs
  USE temps_mod, ONLY: itau_dyn

  implicit none

  !
  !   Routine d'initialisation des ecritures des fichiers histoires LMDZ
  !   au format IOIPSL
  !
  !   Appels succesifs des routines: histbeg
  !                              histhori
  !                              histver
  !                              histdef
  !                              histend
  !
  !   Entree:
  !
  !  infile: nom du fichier histoire a creer
  !  day0,anne0: date de reference
  !  tstep: duree du pas de temps en seconde
  !  t_ops: frequence de l'operation pour IOIPSL
  !  t_wrt: frequence d'ecriture sur le fichier
  !  nq: nombre de traceurs
  !
  !
  !   L. Fairhead, LMD, 03/99
  !
  ! =====================================================================
  !
  !   Declarations
  include "dimensions.h"
  include "paramet.h"
  include "comgeom.h"
  include "description.h"
  include "iniprint.h"

  !   Arguments
  !
  integer :: day0, anne0
  real :: tstep, t_ops, t_wrt

#ifdef CPP_IOIPSL
  ! This routine needs IOIPSL to work
  !   Variables locales
  !
  integer :: tau0
  real :: zjulian
  integer :: iq
  real :: rlong(iip1,jjp1), rlat(iip1,jjp1)
  integer :: uhoriid, vhoriid, thoriid, zvertiid
  integer :: ii,jj
  integer :: zan, dayref
  !
  !  Initialisations
  !
  pi = 4. * atan (1.)
  !
  !  Appel a histbeg: creation du fichier netcdf et initialisations diverses
  !

  zan = anne0
  dayref = day0
  CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
  tau0 = itau_dyn

  ! -------------------------------------------------------------
  ! Creation des 3 fichiers pour les grilles horizontales U,V,Scal
  ! -------------------------------------------------------------
  !Grille U
  do jj = 1, jjp1
    do ii = 1, iip1
      rlong(ii,jj) = rlonu(ii) * 180. / pi
      rlat(ii,jj) = rlatu(jj) * 180. / pi
    enddo
  enddo

  CALL histbeg(dynhistu_file, iip1, rlong(:,1), jjp1, rlat(1,:), &
        1, iip1, 1, jjp1, &
        tau0, zjulian, tstep, uhoriid, histuid)

  ! Grille V
  do jj = 1, jjm
    do ii = 1, iip1
      rlong(ii,jj) = rlonv(ii) * 180. / pi
      rlat(ii,jj) = rlatv(jj) * 180. / pi
    enddo
  enddo

  CALL histbeg(dynhistv_file, iip1, rlong(:,1), jjm, rlat(1,:), &
        1, iip1, 1, jjm, &
        tau0, zjulian, tstep, vhoriid, histvid)

  !Grille Scalaire
  do jj = 1, jjp1
    do ii = 1, iip1
      rlong(ii,jj) = rlonv(ii) * 180. / pi
      rlat(ii,jj) = rlatu(jj) * 180. / pi
    enddo
  enddo

  CALL histbeg(dynhist_file, iip1, rlong(:,1), jjp1, rlat(1,:), &
        1, iip1, 1, jjp1, &
        tau0, zjulian, tstep, thoriid, histid)
  ! -------------------------------------------------------------
  !  Appel a histvert pour la grille verticale
  ! -------------------------------------------------------------
  CALL histvert(histid, 'presnivs', 'Niveaux pression','mb', &
        llm, presnivs/100., zvertiid,'down')
  CALL histvert(histvid, 'presnivs', 'Niveaux pression','mb', &
        llm, presnivs/100., zvertiid,'down')
  CALL histvert(histuid, 'presnivs', 'Niveaux pression','mb', &
        llm, presnivs/100., zvertiid,'down')
  !
  ! -------------------------------------------------------------
  !  Appels a histdef pour la definition des variables a sauvegarder
  ! -------------------------------------------------------------
  !
  !  Vents U
  !
  CALL histdef(histuid, 'u', 'vent u', 'm/s', &
        iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &
        32, 'inst(X)', t_ops, t_wrt)
  !
  !  Vents V
  !
  CALL histdef(histvid, 'v', 'vent v', 'm/s', &
        iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &
        32, 'inst(X)', t_ops, t_wrt)

  !
  !  Temperature potentielle
  !
  CALL histdef(histid, 'teta', 'temperature potentielle', '-', &
        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
        32, 'inst(X)', t_ops, t_wrt)
  !
  !  Geopotentiel
  !
  CALL histdef(histid, 'phi', 'geopotentiel', '-', &
        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
        32, 'inst(X)', t_ops, t_wrt)
  !
  !  Traceurs
  !

  !    DO iq=1,nqtot
  !      CALL histdef(histid, tracers(iq)%name,
  !                           tracers(iq)%longName, '-',
  ! .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
  ! .             32, 'inst(X)', t_ops, t_wrt)
  !    enddo
  !C
  !  Masse
  !
  CALL histdef(histid, 'masse', 'masse', 'kg', &
        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
        32, 'inst(X)', t_ops, t_wrt)
  !
  !  Pression au sol
  !
  CALL histdef(histid, 'ps', 'pression naturelle au sol', 'Pa', &
        iip1, jjp1, thoriid, 1, 1, 1, -99, &
        32, 'inst(X)', t_ops, t_wrt)
  !
  !  Geopotentiel au sol
  !C
  !  CALL histdef(histid, 'phis', 'geopotentiel au sol', '-',
  ! .             iip1, jjp1, thoriid, 1, 1, 1, -99,
  ! .             32, 'inst(X)', t_ops, t_wrt)
  !C
  !  Fin
  !
  CALL histend(histid)
  CALL histend(histuid)
  CALL histend(histvid)
#else
  ! tell the user this routine should be run with ioipsl
  write(lunout, *)"inithist: Warning this routine should not be", &
          " used without ioipsl"
#endif
  ! of #ifdef CPP_IOIPSL
  return
end subroutine inithist