! ! $Id: writehist.F 1357 2010-04-14 14:03:19Z jbmadeleine $ ! subroutine writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis) #ifdef CPP_IOIPSL USE ioipsl #endif USE infotrac, ONLY : nqtot, ttext use com_io_dyn_mod, only : histid,histvid,histuid implicit none C C Ecriture du fichier histoire au format IOIPSL C C Appels succesifs des routines: histwrite C C Entree: 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 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" #include "iniprint.h" C C Arguments C REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm) REAL ps(ip1jmp1),masse(ip1jmp1,llm) REAL phis(ip1jmp1) REAL q(ip1jmp1,llm,nqtot) integer time #ifdef CPP_IOIPSL ! This routine needs IOIPSL to work C Variables locales C integer iq, ii, ll integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1) logical ok_sync integer itau_w REAL vnat(ip1jm,llm),unat(ip1jmp1,llm) C C Initialisations C ndexu = 0 ndexv = 0 ndex2d = 0 ok_sync =.TRUE. itau_w = itau_dyn + time ! 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 C call histwrite(histuid, 'u', itau_w, unat, . iip1*jjp1*llm, ndexu) C C Vents V C call histwrite(histvid, 'v', itau_w, vnat, . iip1*jjm*llm, ndexv) C C Temperature potentielle C call histwrite(histid, 'teta', itau_w, teta, . iip1*jjp1*llm, ndexu) C C Geopotentiel C call histwrite(histid, 'phi', itau_w, phi, . iip1*jjp1*llm, ndexu) C C Traceurs C ! DO iq=1,nqtot ! call histwrite(histid, ttext(iq), itau_w, q(:,:,iq), ! . iip1*jjp1*llm, ndexu) ! enddo !C C Masse C call histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu) 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) then call histsync(histid) call histsync(histvid) call histsync(histuid) endif #else ! tell the user this routine should be run with ioipsl write(lunout,*)"writehist: Warning this routine should not be", & " used without ioipsl" #endif ! of #ifdef CPP_IOIPSL return end