subroutine inithist(infile,day0,anne0,tstep,t_ops,t_wrt,nq,fileid, . filevid) USE IOIPSL USE histcom implicit none C C Routine d'initialisation des ecritures des fichiers histoires LMDZ C au format IOIPSL C C Appels succesifs des routines: histbeg C histhori C histver C histdef C histend C C Entree: C C infile: nom du fichier histoire a creer C day0,anne0: date de reference C tstep: duree du pas de temps en seconde C t_ops: frequence de l'operation pour IOIPSL C t_wrt: frequence d'ecriture sur le fichier C nq: nombre de traceurs C C Sortie: C fileid: ID du fichier netcdf cree C filevid:ID du fichier netcdf pour la grille v C C L. Fairhead, LMD, 03/99 C C ===================================================================== C C Declarations #include "dimensions.h" #include "paramet.h" #include "comconst.h" #include "comvert.h" #include "comgeom.h" #include "temps.h" #include "ener.h" #include "logic.h" #include "description.h" #include "serre.h" C Arguments C character*(*) infile integer*4 day0, anne0 real tstep, t_ops, t_wrt integer fileid, filevid integer nq C Variables locales C integer tau0 real zjulian character*3 str character*10 ctrac integer iq real rlong(iip1,jjp1), rlat(iip1,jjp1) integer uhoriid, vhoriid, thoriid, zvertiid integer ii,jj integer zan, dayref C C Initialisations C pi = 4. * atan (1.) str='q ' ctrac = 'traceur ' C C Appel a histbeg: creation du fichier netcdf et initialisations diverses C 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) = 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) C C Creation du fichier histoire pour la grille en V (oblige pour l'instant, C IOIPSL ne permet pas de grilles avec des nombres de point differents dans C 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('dyn_histv.nc', iip1, rlong(:,1), jjm, rlat(1,:), . 1, iip1, 1, jjm, . tau0, zjulian, tstep, vhoriid, filevid) C C Appel a histhori pour rajouter les autres grilles horizontales C 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) C C Appel a histvert pour la grille verticale C call histvert(fileid, 'sig_s', 'Niveaux sigma','-', . llm, nivsigs, zvertiid) C Pour le fichier V call histvert(filevid, 'sig_s', 'Niveaux sigma','-', . llm, nivsigs, zvertiid) C C Appels a histdef pour la definition des variables a sauvegarder C C Vents U C call histdef(fileid, 'ucov', 'vents u covariants', 'm/s', . iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, . 32, 'inst(X)', t_ops, t_wrt) C C Vents V C call histdef(filevid, 'vcov', 'vents v covariants', 'm/s', . iip1, jjm, vhoriid, llm, 1, llm, zvertiid, . 32, 'inst(X)', t_ops, t_wrt) C C Temperature potentielle C call histdef(fileid, 'teta', 'temperature potentielle', '-', . iip1, jjp1, thoriid, llm, 1, llm, zvertiid, . 32, 'inst(X)', t_ops, t_wrt) C C Geopotentiel C call histdef(fileid, 'phi', 'geopotentiel instantane', '-', . iip1, jjp1, thoriid, llm, 1, llm, zvertiid, . 32, 'inst(X)', t_ops, t_wrt) C C Traceurs C IF(nq.GE.1) THEN DO iq=1,nq IF ( iq.LE.9 ) THEN WRITE(str(2:2),'(i1.1)') iq write(ctrac(9:9),'(i1.1)') iq ELSE WRITE(str(2:3),'(i2.2)') iq write(ctrac(9:10),'(i2.2)') iq ENDIF call histdef(fileid, str, ctrac, '-', . iip1, jjp1, thoriid, llm, 1, llm, zvertiid, . 32, 'inst(X)', t_ops, t_wrt) enddo endif C C Masse C call histdef(fileid, 'masse', 'masse', 'kg', . iip1, jjp1, thoriid, 1, 1, 1, -99, . 32, 'inst(X)', t_ops, t_wrt) C C Pression au sol C call histdef(fileid, 'ps', 'pression naturelle au sol', 'Pa', . iip1, jjp1, thoriid, 1, 1, 1, -99, . 32, 'inst(X)', t_ops, t_wrt) C C Pression au sol C call histdef(fileid, 'phis', 'geopotentiel au sol', '-', . iip1, jjp1, thoriid, 1, 1, 1, -99, . 32, 'inst(X)', t_ops, t_wrt) C C Fin C call histend(fileid) call histend(filevid) return end