! $Id: initdynav_p.F 1279 2009-12-10 09:02:56Z fairhead $ SUBROUTINE inithist_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 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 USE lmdz_description, ONLY: descript 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: ! 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 ! Arguments INTEGER :: 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 :: dynhist_domain_id INTEGER :: dynhistv_domain_id INTEGER :: dynhistu_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', dynhist_domain_id) CALL histbeg(dynhist_file, iip1, rlong(:, 1), jjn, & rlat(1, jjb:jje), 1, iip1, 1, jjn, tau0, & zjulian, tstep, thoriid, & histid, dynhist_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', dynhistv_domain_id) CALL histbeg(dynhistv_file, iip1, rlong(:, 1), jjn, & rlat(1, jjb:jje), 1, iip1, 1, jjn, tau0, & zjulian, tstep, vhoriid, & histvid, dynhistv_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', dynhistu_domain_id) CALL histbeg(dynhistu_file, iip1, rlong(:, 1), jjn, & rlat(1, jjb:jje), 1, iip1, 1, jjn, tau0, & zjulian, tstep, uhoriid, & histuid, dynhistu_domain_id) ! ------------------------------------------------------------- ! 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., zvertiidv, 'down') CALL histvert(histuid, 'presnivs', 'Niveaux pression', 'mb', & llm, presnivs / 100., zvertiidu, 'down') ! ------------------------------------------------------------- ! Appels a histdef pour la definition des variables a sauvegarder ! ------------------------------------------------------------- ! Vents U jjn = jj_nb CALL histdef(histuid, 'u', 'vent u', & 'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu, & 32, 'inst(X)', t_ops, t_wrt) ! Vents V IF (pole_sud) jjn = jj_nb - 1 CALL histdef(histvid, 'v', 'vent v', & 'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv, & 32, 'inst(X)', t_ops, t_wrt) ! Temperature jjn = jj_nb CALL histdef(histid, 'temp', 'temperature', 'K', & iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 32, 'inst(X)', t_ops, t_wrt) ! Temperature potentielle CALL histdef(histid, 'theta', 'temperature potentielle', 'K', & iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 32, 'inst(X)', t_ops, t_wrt) ! Geopotentiel CALL histdef(histid, 'phi', 'geopotentiel', '-', & iip1, jjn, 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, jjn, thoriid, llm, 1, llm, zvertiid, ! . 32, 'inst(X)', t_ops, t_wrt) ! enddo ! Masse CALL histdef(histid, 'masse', 'masse', 'kg', & iip1, jjn, 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, jjn, thoriid, 1, 1, 1, -99, & 32, 'inst(X)', t_ops, t_wrt) ! Geopotentiel au sol ! CALL histdef(histid, 'phis', 'geopotentiel au sol', '-', ! . iip1, jjn, thoriid, 1, 1, 1, -99, ! . 32, 'inst(X)', t_ops, t_wrt) ! Fin CALL histend(histid) CALL histend(histuid) CALL histend(histvid) END SUBROUTINE inithist_loc