--- trunk/libf/bibio/writedynav.f 2011/04/13 12:29:18 44 +++ trunk/bibio/writedynav.f 2014/03/05 14:57:53 82 @@ -1,136 +1,103 @@ -! -! $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) - -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 histwrite_m - use histcom - use dimens_m - use paramet_m - use comconst - use comvert - use logic - use comgeom - use serre - use temps - use ener - use iniadvtrac_m - implicit none - - -C -C Arguments -C - - INTEGER histid, nq - REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) - REAL, intent(in):: teta(ip1jmp1*llm) - real 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) -C -C Vents V scalaire -C - call gr_v_scal(llm, vnat, vs) - call histwrite(histid, 'v', itau_w, vs) -C -C Temperature potentielle moyennee -C - call histwrite(histid, 'theta', itau_w, teta) -C -C Temperature moyennee -C - do ii = 1, ijp1llm - tm(ii) = teta(ii) * ppk(ii)/cpp - enddo - call histwrite(histid, 'temp', itau_w, tm) -C -C Geopotentiel -C - call histwrite(histid, 'phi', itau_w, phi) -C -C Traceurs -C - DO iq=1,nq - call histwrite(histid, ttext(iq), itau_w, q(:,:,iq)) - enddo -C -C Masse -C - call histwrite(histid, 'masse', itau_w, masse) -C -C Pression au sol -C - call histwrite(histid, 'ps', itau_w, ps) -C -C Geopotentiel au sol -C - call histwrite(histid, 'phis', itau_w, phis) -C -C Fin -C - if (ok_sync) call histsync(histid) - return - end +module writedynav_m + + implicit none + +contains + + subroutine writedynav(vcov, ucov, teta, pk, phi, q, masse, ps, phis, time) + + ! From LMDZ4/libf/bibio/writedynav.F, version 1.1.1.1 2004/05/19 12:53:05 + ! Écriture du fichier histoire au format IOIPSL + ! L. Fairhead, LMD, 03/99 + + ! Appels successifs des routines histwrite + + USE comconst, ONLY: cpp + use covnat_m, only: covnat + USE dimens_m, ONLY: iim, jjm, llm, nqmx + USE histsync_m, ONLY: histsync + USE histwrite_m, ONLY: histwrite + USE iniadvtrac_m, ONLY: ttext + use initdynav_m, only: histaveid + use nr_util, only: assert + USE paramet_m, ONLY: iip1, ip1jm, ip1jmp1, jjp1 + USE temps, ONLY: itau_dyn + + ! Vents covariants : + REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm) + REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm) + + REAL, intent(in):: teta(:, :, :) ! (iim + 1, jjm + 1, llm) + ! temperature potentielle + + real, intent(in):: pk(:, :, :) ! (iim + 1, jjm + 1, llm) + + real, intent(in):: phi(:, :, :) ! (iim + 1, jjm + 1, llm) + ! geopotentiel instantane + + REAL, intent(in):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx) traceurs + real, intent(in):: masse(:, :, :) ! (iim + 1, jjm + 1, llm) + REAL, intent(in):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol + REAL, intent(in):: phis(:, :) ! (iim + 1, jjm + 1) geopotentiel au sol + integer, intent(in):: time ! temps de l'ecriture + + ! Variables locales + integer iq + real us(ip1jmp1*llm), vs(ip1jmp1*llm) + REAL vnat(ip1jm, llm), unat(ip1jmp1, llm) + integer itau_w + + !--------------------------------------------------------------- + + call assert((/size(vcov, 1), size(ucov, 1), size(teta, 1), size(phi, 1), & + size(pk, 1), size(ps, 1), size(masse, 1), size(phis, 1), & + size(q, 1)/) == iim + 1, "writedynav iim") + call assert((/size(vcov, 2) + 1, size(ucov, 2), size(teta, 2), & + size(phi, 2), size(pk, 2), size(ps, 2), size(masse, 2), & + size(phis, 2), size(q, 2)/) == jjm + 1, "writedynav jjm") + call assert((/size(vcov, 3), size(ucov, 3), size(teta, 3), size(phi, 3), & + size(pk, 3), size(masse, 3), size(q, 3)/) == llm, "writedynav llm") + call assert(size(q, 4) == nqmx, "writedynav nqmx") + + ! Initialisations + us = 999.999 + vs = 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 + call histwrite(histaveid, 'temp', itau_w, teta * pk / cpp) + + call histwrite(histaveid, 'phi', itau_w, phi) + + ! Traceurs + DO iq = 1, size(q, 4) + call histwrite(histaveid, ttext(iq), itau_w, q(:, :, :, iq)) + enddo + + call histwrite(histaveid, 'masse', itau_w, masse) + call histwrite(histaveid, 'ps', itau_w, ps) + call histwrite(histaveid, 'phis', itau_w, phis) + + call histsync(histaveid) + + end subroutine writedynav + +end module writedynav_m