source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initdynav_loc.f90 @ 5134

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

SUBROUTINE initdynav_loc(day0, anne0, tstep, t_ops, t_wrt)

  ! This routine needs IOIPSL
  USE IOIPSL
  USE parallel_lmdz
  USE lmdz_write_field
  USE misc_mod
  ! USE infotrac
  USE com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid, &
          dynhistave_file, dynhistvave_file, dynhistuave_file
  USE comconst_mod, ONLY: pi
  USE comvert_mod, ONLY: presnivs
  USE temps_mod, ONLY: itau_dyn
  USE lmdz_description, ONLY: descript
  USE lmdz_iniprint, ONLY: lunout, prt_level

  IMPLICIT NONE

  !
  !   Routine d'initialisation des ecritures des fichiers histoires LMDZ
  !   au format IOIPSL. Initialisation du fichier histoire moyenne.
  !
  !   Appels succesifs des routines: histbeg
  !                              histhori
  !                              histver
  !                              histdef
  !                              histend
  !
  !   Entree:
  !
  !  day0,anne0: date de reference
  !  tstep : frequence d'ecriture
  !  t_ops: frequence de l'operation pour IOIPSL
  !  t_wrt: frequence d'ecriture sur le fichier
  !
  !   Sortie:
  !  fileid: ID du fichier netcdf cree
  !
  !   L. Fairhead, LMD, 03/99
  !
  ! =====================================================================
  !
  !   Declarations
  INCLUDE "dimensions.h"
  INCLUDE "paramet.h"
  INCLUDE "comgeom.h"

  !   Arguments
  !
  INTEGER(kind = 4) day0, anne0
  REAL :: tstep, t_ops, t_wrt

  ! This routine needs IOIPSL
  !   Variables locales
  !
  INTEGER :: tau0
  REAL :: zjulian
  INTEGER :: iq
  REAL :: rlong(iip1, jjp1), rlat(iip1, jjp1)
  INTEGER :: uhoriid, vhoriid, thoriid
  INTEGER :: zvertiid, zvertiidv, zvertiidu
  INTEGER :: ii, jj
  INTEGER :: zan, dayref
  INTEGER :: jjb, jje, jjn

  ! definition du domaine d'ecriture pour le rebuild

  INTEGER, DIMENSION(2) :: ddid
  INTEGER, DIMENSION(2) :: dsg
  INTEGER, DIMENSION(2) :: dsl
  INTEGER, DIMENSION(2) :: dpf
  INTEGER, DIMENSION(2) :: dpl
  INTEGER, DIMENSION(2) :: dhs
  INTEGER, DIMENSION(2) :: dhe

  INTEGER :: dynhistave_domain_id
  INTEGER :: dynhistvave_domain_id
  INTEGER :: dynhistuave_domain_id

  IF (adjust) return

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

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


  ! Creation de 3 fichiers pour les differentes grilles horizontales
  ! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier
  ! Grille Scalaire

  jjb = jj_begin
  jje = jj_end
  jjn = jj_nb

  ddid = (/ 1, 2 /)
  dsg = (/ iip1, jjp1 /)
  dsl = (/ iip1, jjn /)
  dpf = (/ 1, jjb /)
  dpl = (/ iip1, jje /)
  dhs = (/ 0, 0 /)
  dhe = (/ 0, 0 /)

  CALL flio_dom_set(mpi_size, mpi_rank, ddid, dsg, dsl, dpf, dpl, dhs, dhe, &
          'box', dynhistave_domain_id)

  CALL histbeg(dynhistave_file, iip1, rlong(:, 1), jjn, &
          rlat(1, jjb:jje), 1, iip1, 1, jjn, tau0, &
          zjulian, tstep, thoriid, &
          histaveid, dynhistave_domain_id)


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

  jjb = jj_begin
  jje = jj_end
  jjn = jj_nb
  IF (pole_sud) jjn = jjn - 1
  IF (pole_sud) jje = jje - 1

  do jj = jjb, jje
    do ii = 1, iip1
      rlong(ii, jj) = rlonv(ii) * 180. / pi
      rlat(ii, jj) = rlatv(jj) * 180. / pi
    enddo
  enddo

  ddid = (/ 1, 2 /)
  dsg = (/ iip1, jjm /)
  dsl = (/ iip1, jjn /)
  dpf = (/ 1, jjb /)
  dpl = (/ iip1, jje /)
  dhs = (/ 0, 0 /)
  dhe = (/ 0, 0 /)

  CALL flio_dom_set(mpi_size, mpi_rank, ddid, dsg, dsl, dpf, dpl, dhs, dhe, &
          'box', dynhistvave_domain_id)

  CALL histbeg(dynhistvave_file, iip1, rlong(:, 1), jjn, &
          rlat(1, jjb:jje), 1, iip1, 1, jjn, tau0, &
          zjulian, tstep, vhoriid, &
          histvaveid, dynhistvave_domain_id)

  ! 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

  jjb = jj_begin
  jje = jj_end
  jjn = jj_nb

  ddid = (/ 1, 2 /)
  dsg = (/ iip1, jjp1 /)
  dsl = (/ iip1, jjn /)
  dpf = (/ 1, jjb /)
  dpl = (/ iip1, jje /)
  dhs = (/ 0, 0 /)
  dhe = (/ 0, 0 /)

  CALL flio_dom_set(mpi_size, mpi_rank, ddid, dsg, dsl, dpf, dpl, dhs, dhe, &
          'box', dynhistuave_domain_id)

  CALL histbeg(dynhistuave_file, iip1, rlong(:, 1), jjn, &
          rlat(1, jjb:jje), 1, iip1, 1, jjn, tau0, &
          zjulian, tstep, uhoriid, &
          histuaveid, dynhistuave_domain_id)


  !
  !  Appel a histvert pour la grille verticale
  !
  CALL histvert(histaveid, 'presnivs', 'Niveaux Pression&
          &     approximatifs', 'mb', llm, presnivs / 100., zvertiid, 'down')
  CALL histvert(histuaveid, 'presnivs', 'Niveaux Pression&
          &     approximatifs', 'mb', llm, presnivs / 100., zvertiidv, 'down')
  CALL histvert(histvaveid, 'presnivs', 'Niveaux Pression&
          &     approximatifs', 'mb', llm, presnivs / 100., zvertiidu, 'down')

  !
  !  Appels a histdef pour la definition des variables a sauvegarder
  !
  !  Vents U
  !
  jjn = jj_nb
  CALL histdef(histuaveid, 'u', 'vent u moyen ', &
          'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu, &
          32, 'ave(X)', t_ops, t_wrt)

  !
  !  Vents V
  !
  IF (pole_sud) jjn = jj_nb - 1
  CALL histdef(histvaveid, 'v', 'vent v moyen', &
          'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv, &
          32, 'ave(X)', t_ops, t_wrt)

  !
  !  Temperature
  !
  jjn = jj_nb
  CALL histdef(histaveid, 'temp', 'temperature moyenne', 'K', &
          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
          32, 'ave(X)', t_ops, t_wrt)
  !
  !  Temperature potentielle
  !
  CALL histdef(histaveid, 'theta', 'temperature potentielle', 'K', &
          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
          32, 'ave(X)', t_ops, t_wrt)


  !
  !  Geopotentiel
  !
  CALL histdef(histaveid, 'phi', 'geopotentiel moyen', '-', &
          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
          32, 'ave(X)', t_ops, t_wrt)
  !
  !  Traceurs
  !
  !    DO iq=1,nqtot
  !      CALL histdef(histaveid, tracers(iq)%name,
  ! .                            tracers(iq)%longName, '-',
  ! .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
  ! .             32, 'ave(X)', t_ops, t_wrt)
  !    enddo
  !
  !  Masse
  !
  CALL histdef(histaveid, 'masse', 'masse moyenne', 'kg', &
          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
          32, 'ave(X)', t_ops, t_wrt)
  !
  !  Pression au sol
  !
  CALL histdef(histaveid, 'ps', 'pression naturelle au sol', 'Pa', &
          iip1, jjn, thoriid, 1, 1, 1, -99, &
          32, 'ave(X)', t_ops, t_wrt)
  !
  !  Geopotentiel au sol
  !
  !  CALL histdef(histaveid, 'phis', 'geopotentiel au sol', '-',
  ! .             iip1, jjn, thoriid, 1, 1, 1, -99,
  ! .             32, 'ave(X)', t_ops, t_wrt)
  !
  !  Fin
  !
  CALL histend(histaveid)
  CALL histend(histuaveid)
  CALL histend(histvaveid)
END SUBROUTINE initdynav_loc