--- trunk/libf/bibio/writedynav.f90 2011/04/27 13:00:12 45 +++ trunk/Sources/dyn3d/writedynav.f 2016/03/11 18:47:26 178 @@ -1,103 +1,103 @@ -subroutine writedynav(histid, nq, time, vcov, ucov, teta, ppk, phi, q, masse, & - ps, phis) +module writedynav_m - ! From LMDZ4/libf/bibio/writedynav.F, version 1.1.1.1 2004/05/19 12:53:05 - ! Ecriture du fichier histoire au format IOIPSL + implicit none - ! Appels successifs des routines histwrite +contains - ! Entree: - ! histid: ID du fichier histoire - ! time: temps de l'ecriture - ! 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 histwrite_m, ONLY : histwrite - USE histcom, 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 + subroutine writedynav(vcov, ucov, teta, pk, phi, q, masse, ps, phis, time) - implicit none + ! 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: ip1jm, ip1jmp1 + 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 - INTEGER histid, nq - 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 q(ip1jmp1, llm, nq) - integer, intent(in):: time - - ! 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(histid, 'u', itau_w, us) - - ! Vents V scalaire - call gr_v_scal(llm, vnat, vs) - call histwrite(histid, 'v', itau_w, vs) - - ! Temperature potentielle moyennee - call histwrite(histid, 'theta', itau_w, teta) - - ! Temperature moyennee - do ii = 1, ijp1llm - tm(ii) = teta(ii) * ppk(ii)/cpp - enddo - call histwrite(histid, 'temp', itau_w, tm) - - ! Geopotentiel - call histwrite(histid, 'phi', itau_w, phi) - - ! Traceurs - DO iq=1, nq - call histwrite(histid, ttext(iq), itau_w, q(:, :, iq)) - enddo - - ! Masse - call histwrite(histid, 'masse', itau_w, masse) - - ! Pression au sol - call histwrite(histid, 'ps', itau_w, ps) + call histwrite(histaveid, 'masse', itau_w, masse) + call histwrite(histaveid, 'ps', itau_w, ps) + call histwrite(histaveid, 'phis', itau_w, phis) - ! Geopotentiel au sol - call histwrite(histid, 'phis', itau_w, phis) + call histsync(histaveid) - if (ok_sync) call histsync(histid) + end subroutine writedynav -end subroutine writedynav +end module writedynav_m