subroutine writedynav( histid, nq, time, vcov, , ucov,teta,ppk,phi,q,masse,ps,phis) USE ioipsl implicit none C C Ecriture du fichier histoire au format IOIPSL C C Appels succesifs des routines: histwrite C C Entree: C histid: ID du fichier histoire C nqmx: nombre maxi de traceurs C time: temps de l'ecriture C vcov: vents v covariants C ucov: vents u covariants C teta: temperature potentielle C phi : geopotentiel instantane C q : traceurs C masse: masse C ps :pression au sol C phis : geopotentiel au sol C C C Sortie: C fileid: ID du fichier netcdf cree 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 C Arguments C INTEGER histid, nq REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm) REAL ps(ip1jmp1),masse(ip1jmp1,llm) REAL phis(ip1jmp1) REAL q(ip1jmp1,llm,nq) integer time C Variables locales C integer ndex2d(iip1*jjp1),ndex3d(iip1*jjp1*llm),iq, ii, ll character*3 str real us(ip1jmp1*llm), vs(ip1jmp1*llm) real tm(ip1jmp1*llm) REAL vnat(ip1jm,llm),unat(ip1jmp1,llm) logical ok_sync integer itau_w C C Initialisations C str='q ' ndex3d = 0 ndex2d = 0 ok_sync = .TRUE. us = 999.999 vs = 999.999 tm = 999.999 vnat = 999.999 unat = 999.999 itau_w = itau_dyn + time C Passage aux composantes naturelles du vent call covnat(llm, ucov, vcov, unat, vnat) C C Appels a histwrite pour l'ecriture des variables a sauvegarder C C Vents U scalaire C call gr_u_scal(llm, unat, us) call histwrite(histid, 'u', itau_w, us, . iip1*jjp1*llm, ndex3d) C C Vents V scalaire C call gr_v_scal(llm, vnat, vs) call histwrite(histid, 'v', itau_w, vs, . iip1*jjp1*llm, ndex3d) C C Temperature potentielle moyennee C call histwrite(histid, 'theta', itau_w, teta, . iip1*jjp1*llm, ndex3d) C C Temperature moyennee C do ii = 1, ijp1llm tm(ii) = teta(ii) * ppk(ii)/cpp enddo call histwrite(histid, 'temp', itau_w, tm, . iip1*jjp1*llm, ndex3d) C C Geopotentiel C call histwrite(histid, 'phi', itau_w, phi, . iip1*jjp1*llm, ndex3d) 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 ELSE WRITE(str(2:3),'(i2.2)') iq ENDIF call histwrite(histid, str, itau_w, q(:,:,iq), . iip1*jjp1*llm, ndex3d) enddo endif C C Masse C call histwrite(histid, 'masse', itau_w, masse, iip1*jjp1, ndex2d) C C Pression au sol C call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d) C C Geopotentiel au sol C call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d) C C Fin C if (ok_sync) call histsync(histid) return end