! $Id$ SUBROUTINE initfluxsto_p(infile, tstep, t_ops, t_wrt, fileid, filevid, filedid) USE IOIPSL USE parallel_lmdz USE lmdz_write_field USE misc_mod USE comconst_mod, ONLY: pi USE comvert_mod, ONLY: nivsigs USE temps_mod, ONLY: annee_ref, day_ref, 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 ! ! 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 include "dimensions.h" include "paramet.h" include "comgeom.h" ! Arguments ! CHARACTER(LEN = *) :: infile REAL :: tstep, t_ops, t_wrt INTEGER :: fileid, filevid, filedid ! This routine needs IOIPSL ! 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 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 :: dynu_domain_id INTEGER :: dynv_domain_id ! ! 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 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', dynu_domain_id) CALL histbeg(trim(infile), iip1, rlong(:, 1), jjn, rlat(1, jjb:jje), & 1, iip1, 1, jjn, tau0, zjulian, tstep, uhoriid, & fileid, dynu_domain_id) ! ! 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 jjb = jj_begin jje = jj_end jjn = jj_nb IF (pole_sud) jje = jj_end - 1 IF (pole_sud) jjn = jj_nb - 1 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', dynv_domain_id) CALL histbeg('fluxstokev', iip1, rlong(:, 1), jjn, rlat(1, jjb:jje), & 1, iip1, 1, jjn, tau0, zjulian, tstep, vhoriid, & filevid, dynv_domain_id) rl(1, 1) = 1. IF (mpi_rank==0) THEN CALL histbeg('defstoke.nc', 1, rl, 1, rl, & 1, 1, 1, 1, & tau0, zjulian, tstep, dhoriid, filedid) ENDIF ! ! 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 jjb = jj_begin jje = jj_end jjn = jj_nb CALL histhori(fileid, iip1, rlong(:, jjb:jje), jjn, rlat(:, jjb:jje), & '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 IF (mpi_rank==0) THEN nivd(1) = 1 CALL histvert(filedid, 'sig_s', 'Niveaux sigma', & 'sigma_level', & 1, nivd, dvertiid) ENDIF ! ! Appels a histdef pour la definition des variables a sauvegarder CALL histdef(fileid, "phis", "Surface geop. height", "-", & iip1, jjn, thoriid, 1, 1, 1, -99, 32, & "once", t_ops, t_wrt) CALL histdef(fileid, "aire", "Grid area", "-", & iip1, jjn, thoriid, 1, 1, 1, -99, 32, & "once", t_ops, t_wrt) IF (mpi_rank==0) THEN 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) ENDIF ! ! Masse ! CALL histdef(fileid, 'masse', 'Masse', 'kg', & iip1, jjn, 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, jjn, uhoriid, llm, 1, llm, zvertiid, & 32, 'inst(X)', t_ops, t_wrt) ! ! Pbarv ! IF (pole_sud) jjn = jj_nb - 1 CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', & iip1, jjn, vhoriid, llm, 1, llm, zvertiid, & 32, 'inst(X)', t_ops, t_wrt) ! ! w ! IF (pole_sud) jjn = jj_nb CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', & iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 32, 'inst(X)', t_ops, t_wrt) ! ! Temperature potentielle ! CALL histdef(fileid, 'teta', 'temperature potentielle', '-', & iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 32, 'inst(X)', t_ops, t_wrt) ! ! ! Geopotentiel ! CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', & iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 32, 'inst(X)', t_ops, t_wrt) ! ! Fin ! CALL histend(fileid) CALL histend(filevid) IF (mpi_rank==0) CALL histend(filedid) IF (ok_sync) THEN CALL histsync(fileid) CALL histsync(filevid) IF (mpi_rank==0) CALL histsync(filedid) ENDIF END SUBROUTINE initfluxsto_p