! $Id: initfluxsto.f90 5195 2024-09-16 13:18:00Z abarral $

SUBROUTINE initfluxsto &
        (infile, tstep, t_ops, t_wrt, &
        fileid, filevid, filedid)

  USE IOIPSL
  USE comconst_mod, ONLY: pi
  USE comvert_mod, ONLY: nivsigs
  USE temps_mod, ONLY: annee_ref, day_ref, 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


  !   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

  !   Sortie:
  !  fileid: ID du fichier netcdf cree
  !  filevid:ID du fichier netcdf pour la grille v

  !   L. Fairhead, LMD, 03/99

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

  !   Declarations



  !   Arguments

  CHARACTER(LEN = *) :: infile
  REAL :: tstep, t_ops, t_wrt
  INTEGER :: fileid, filevid, filedid

  ! This routine needs IOIPSL to work
  !   Variables locales

  REAL :: nivd(1)
  INTEGER :: tau0
  REAL :: zjulian
  CHARACTER(LEN = 3) :: str
  CHARACTER(LEN = 10) :: ctrac
  INTEGER :: iq
  REAL :: rlong(iip1, jjp1), rlat(iip1, jjp1), rl(1, 1)
  INTEGER :: uhoriid, vhoriid, thoriid, zvertiid, dhoriid, dvertiid
  INTEGER :: ii, jj
  INTEGER :: zan, idayref
  LOGICAL :: ok_sync

  !  Initialisations

  pi = 4. * atan (1.)
  str = 'q  '
  ctrac = 'traceur   '
  ok_sync = .TRUE.

  !  Appel a histbeg: creation du fichier netcdf et initialisations diverses
  !

  zan = annee_ref
  idayref = day_ref
  CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
  tau0 = itau_dyn

  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(infile, iip1, rlong(:, 1), jjp1, rlat(1, :), &
          1, iip1, 1, jjp1, &
          tau0, zjulian, tstep, uhoriid, fileid)

  !  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
  !  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
  !  un meme fichier)

  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('fluxstokev.nc', iip1, rlong(:, 1), jjm, rlat(1, :), &
          1, iip1, 1, jjm, &
          tau0, zjulian, tstep, vhoriid, filevid)

  rl(1, 1) = 1.
  CALL histbeg('defstoke.nc', 1, rl, 1, rl, &
          1, 1, 1, 1, &
          tau0, zjulian, tstep, dhoriid, filedid)


  !  Appel a histhori pour rajouter les autres grilles horizontales

  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 histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar', &
          'Grille points scalaires', thoriid)


  !  Appel a histvert pour la grille verticale

  CALL histvert(fileid, 'sig_s', 'Niveaux sigma', &
          'sigma_level', &
          llm, nivsigs, zvertiid)
  ! Pour le fichier V
  CALL histvert(filevid, 'sig_s', 'Niveaux sigma', &
          'sigma_level', &
          llm, nivsigs, zvertiid)
  ! pour le fichier def
  nivd(1) = 1
  CALL histvert(filedid, 'sig_s', 'Niveaux sigma', &
          'sigma_level', &
          1, nivd, dvertiid)


  !  Appels a histdef pour la definition des variables a sauvegarder

  CALL histdef(fileid, "phis", "Surface geop. height", "-", &
          iip1, jjp1, thoriid, 1, 1, 1, -99, 32, &
          "once", t_ops, t_wrt)

  CALL histdef(fileid, "aire", "Grid area", "-", &
          iip1, jjp1, thoriid, 1, 1, 1, -99, 32, &
          "once", t_ops, t_wrt)

  CALL histdef(filedid, "dtvr", "tps dyn", "s", &
          1, 1, dhoriid, 1, 1, 1, -99, 32, &
          "once", t_ops, t_wrt)

  CALL histdef(filedid, "istdyn", "tps stock", "s", &
          1, 1, dhoriid, 1, 1, 1, -99, 32, &
          "once", t_ops, t_wrt)

  CALL histdef(filedid, "istphy", "tps stock phy", "s", &
          1, 1, dhoriid, 1, 1, 1, -99, 32, &
          "once", t_ops, t_wrt)



  ! Masse

  CALL histdef(fileid, 'masse', 'Masse', 'kg', &
          iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
          32, 'inst(X)', t_ops, t_wrt)

  !  Pbaru

  CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', &
          iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &
          32, 'inst(X)', t_ops, t_wrt)


  !  Pbarv

  CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', &
          iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &
          32, 'inst(X)', t_ops, t_wrt)

  !  w

  CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', &
          iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
          32, 'inst(X)', t_ops, t_wrt)


  !  Temperature potentielle

  CALL histdef(fileid, 'teta', 'temperature potentielle', '-', &
          iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
          32, 'inst(X)', t_ops, t_wrt)
  !


  ! Geopotentiel

  CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', &
          iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
          32, 'inst(X)', t_ops, t_wrt)

  !  Fin

  CALL histend(fileid)
  CALL histend(filevid)
  CALL histend(filedid)
  IF (ok_sync) THEN
    CALL histsync(fileid)
    CALL histsync(filevid)
    CALL histsync(filedid)
  ENDIF

  RETURN
END SUBROUTINE initfluxsto