! $Id: writehist.f90 5118 2024-07-24 14:39:59Z abarral $ SUBROUTINE writehist(time, vcov, ucov, teta, phi, q, masse, ps, phis) USE ioipsl USE infotrac, ONLY: nqtot USE com_io_dyn_mod, ONLY: histid, histvid, histuid USE temps_mod, ONLY: itau_dyn USE lmdz_description, ONLY: descript USE lmdz_iniprint, ONLY: lunout, prt_level IMPLICIT NONE ! ! Ecriture du fichier histoire au format IOIPSL ! ! Appels succesifs des routines: histwrite ! ! Entree: ! time: temps de l'ecriture ! vcov: vents v covariants ! ucov: vents u covariants ! teta: temperature potentielle ! phi : geopotentiel instantane ! q : traceurs ! masse: masse ! ps :pression au sol ! phis : geopotentiel au sol ! ! ! L. Fairhead, LMD, 03/99 ! ! ===================================================================== ! ! Declarations include "dimensions.h" include "paramet.h" include "comgeom.h" ! ! Arguments ! 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 ! This routine needs IOIPSL to work ! Variables locales ! 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) ! ! Initialisations ! 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) ! ! Appels a histwrite pour l'ecriture des variables a sauvegarder ! ! Vents U ! CALL histwrite(histuid, 'u', itau_w, unat, & iip1 * jjp1 * llm, ndexu) ! ! Vents V ! CALL histwrite(histvid, 'v', itau_w, vnat, & iip1 * jjm * llm, ndexv) ! ! Temperature potentielle ! CALL histwrite(histid, 'teta', itau_w, teta, & iip1 * jjp1 * llm, ndexu) ! ! Geopotentiel ! CALL histwrite(histid, 'phi', itau_w, phi, & iip1 * jjp1 * llm, ndexu) ! ! Traceurs ! ! DO iq=1,nqtot ! CALL histwrite(histid, tracers(iq)%longName, itau_w, ! . q(:,:,iq), iip1*jjp1*llm, ndexu) ! enddo !C ! Masse ! CALL histwrite(histid, 'masse', itau_w, masse, iip1 * jjp1 * llm, ndexu) ! ! Pression au sol ! CALL histwrite(histid, 'ps', itau_w, ps, iip1 * jjp1, ndex2d) ! ! Geopotentiel au sol ! ! CALL histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d) ! ! Fin ! IF (ok_sync) THEN CALL histsync(histid) CALL histsync(histvid) CALL histsync(histuid) ENDIF RETURN END SUBROUTINE writehist