! $Id: writedynav.f90 5272 2024-10-24 15:53:15Z abarral $ subroutine writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis) USE ioipsl USE infotrac, ONLY : nqtot use com_io_dyn_mod, only : histaveid, histvaveid, histuaveid USE comconst_mod, ONLY: cpp USE temps_mod, ONLY: itau_dyn USE dimensions_mod, ONLY: iim, jjm, llm, ndm USE paramet_mod_h, ONLY: iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1, kftd, ip1jm, ip1jmp1, & ip1jmi1, ijp1llm, ijmllm, mvar, jcfil, jcfllm 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 "comgeom.h" include "description.h" include "iniprint.h" ! Arguments 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, nqtot) integer time ! This routine needs IOIPSL to work ! Variables locales integer ndex2d(ip1jmp1), ndexu(ip1jmp1*llm), ndexv(ip1jm*llm) INTEGER iq, ii, ll real tm(ip1jmp1*llm) REAL vnat(ip1jm, llm), unat(ip1jmp1, llm) logical ok_sync integer itau_w !----------------------------------------------------------------- ! Initialisations ndexu = 0 ndexv = 0 ndex2d = 0 ok_sync = .TRUE. tm = 999.999 vnat = 999.999 unat = 999.999 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(histuaveid, 'u', itau_w, unat, & iip1*jjp1*llm, ndexu) ! Vents V call histwrite(histvaveid, 'v', itau_w, vnat, & iip1*jjm*llm, ndexv) ! Temperature potentielle moyennee call histwrite(histaveid, 'theta', itau_w, teta, & iip1*jjp1*llm, ndexu) ! Temperature moyennee do ii = 1, ijp1llm tm(ii) = teta(ii) * ppk(ii)/cpp enddo call histwrite(histaveid, 'temp', itau_w, tm, & iip1*jjp1*llm, ndexu) ! Geopotentiel call histwrite(histaveid, 'phi', itau_w, phi, & iip1*jjp1*llm, ndexu) ! Traceurs ! DO iq=1, nqtot ! call histwrite(histaveid, tracers(iq)%longName, itau_w, & ! q(:, :, iq), iip1*jjp1*llm, ndexu) ! enddo ! Masse call histwrite(histaveid, 'masse', itau_w, masse, & iip1*jjp1*llm, ndexu) ! Pression au sol call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d) ! Geopotentiel au sol ! call histwrite(histaveid, 'phis', itau_w, phis, iip1*jjp1, ndex2d) if (ok_sync) then call histsync(histaveid) call histsync(histvaveid) call histsync(histuaveid) ENDIF end subroutine writedynav