--- trunk/libf/bibio/writedynav.f 2008/02/27 13:16:39 3 +++ trunk/libf/bibio/writedynav.f90 2012/04/20 14:58:43 61 @@ -1,140 +1,107 @@ -! -! $Header: /home/cvsroot/LMDZ4/libf/bibio/writedynav.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $ -! - subroutine writedynav( histid, nq, time, vcov, - , ucov,teta,ppk,phi,q,masse,ps,phis) - - USE ioipsl -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 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 - use dimens_m - use paramet_m - use comconst - use comvert - use logic - use comgeom - use serre - use temps - use ener - use advtrac_m - implicit none - - -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, intent(in):: time - - -C Variables locales -C - integer ndex2d(iip1*jjp1),ndex3d(iip1*jjp1*llm),iq, ii, ll - 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 - 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 - DO iq=1,nq - call histwrite(histid, ttext(iq), itau_w, q(:,:,iq), - . iip1*jjp1*llm, ndex3d) - enddo -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 +module writedynav_m + + implicit none + +contains + + subroutine writedynav(vcov, ucov, teta, ppk, phi, q, masse, ps, phis, time) + + ! From LMDZ4/libf/bibio/writedynav.F, version 1.1.1.1 2004/05/19 12:53:05 + ! Ecriture du fichier histoire au format IOIPSL + + ! Appels successifs des routines histwrite + + ! Entree: + ! vcov: vents v covariants + ! ucov: vents u covariants + ! phi : geopotentiel instantane + ! q : traceurs + ! ps :pression au sol + ! phis : geopotentiel au sol + + ! L. Fairhead, LMD, 03/99 + + use covnat_m, only: covnat + USE histwrite_m, ONLY: histwrite + USE histsync_m, ONLY: histsync + USE dimens_m, ONLY: llm + USE paramet_m, ONLY: iip1, ijp1llm, ip1jm, ip1jmp1, jjp1 + USE comconst, ONLY: cpp + USE temps, ONLY: itau_dyn + USE iniadvtrac_m, ONLY: ttext + use initdynav_m, only: histaveid + + REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm) + REAL, intent(in):: teta(ip1jmp1*llm) ! temperature potentielle + real phi(ip1jmp1, llm), ppk(ip1jmp1*llm) + REAL ps(ip1jmp1) + real, intent(in):: masse(ip1jmp1, llm) + REAL phis(ip1jmp1) + REAL, intent(in):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx) + integer, intent(in):: time ! temps de l'ecriture + + ! Variables locales + integer ndex2d(iip1*jjp1), ndex3d(iip1*jjp1*llm), iq, ii, ll + real us(ip1jmp1*llm), vs(ip1jmp1*llm) + real tm(ip1jmp1*llm) + REAL vnat(ip1jm, llm), unat(ip1jmp1, llm) + logical ok_sync + integer itau_w + + !--------------------------------------------------------------- + + ! Initialisations + 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 + + ! 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 scalaire + call gr_u_scal(llm, unat, us) + call histwrite(histaveid, 'u', itau_w, us) + + ! Vents V scalaire + call gr_v_scal(llm, vnat, vs) + call histwrite(histaveid, 'v', itau_w, vs) + + ! Temperature potentielle moyennee + call histwrite(histaveid, 'theta', itau_w, teta) + + ! Temperature moyennee + do ii = 1, ijp1llm + tm(ii) = teta(ii) * ppk(ii)/cpp + enddo + call histwrite(histaveid, 'temp', itau_w, tm) + + ! Geopotentiel + call histwrite(histaveid, 'phi', itau_w, phi) + + ! Traceurs + DO iq = 1, size(q, 4) + call histwrite(histaveid, ttext(iq), itau_w, q(:, :, :, iq)) + enddo + + ! Masse + call histwrite(histaveid, 'masse', itau_w, masse) + + ! Pression au sol + call histwrite(histaveid, 'ps', itau_w, ps) + + ! Geopotentiel au sol + call histwrite(histaveid, 'phis', itau_w, phis) + + if (ok_sync) call histsync(histaveid) + + end subroutine writedynav + +end module writedynav_m