libf/bibio/writedynav.f90

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):: phi(:, :, :) ! (iim + 1, jjm + 1, llm)
    ! geopotentiel instantane

    real, intent(in):: pk(:, :, :) ! (iim + 1, jjm + 1, llm)
    REAL, intent(in):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol
    real, intent(in):: masse(:, :, :) ! (iim + 1, jjm + 1, llm)
    REAL, intent(in):: phis(:, :) ! (iim + 1, jjm + 1) geopotentiel au sol
    REAL, intent(in):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx) traceurs
    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
1	guez	56	module writedynav_m
2	guez	3
3	guez	56	implicit none
4	guez	3
5	guez	56	contains
6	guez	3
7	guez	67	subroutine writedynav(vcov, ucov, teta, pk, phi, q, masse, ps, phis, time)
8	guez	3
9	guez	56	! From LMDZ4/libf/bibio/writedynav.F, version 1.1.1.1 2004/05/19 12:53:05
10	guez	62	! Écriture du fichier histoire au format IOIPSL
11			! L. Fairhead, LMD, 03/99
12	guez	3
13	guez	56	! Appels successifs des routines histwrite
14	guez	3
15	guez	67	USE comconst, ONLY: cpp
16	guez	61	use covnat_m, only: covnat
17	guez	67	USE dimens_m, ONLY: iim, jjm, llm, nqmx
18			USE histsync_m, ONLY: histsync
19	guez	56	USE histwrite_m, ONLY: histwrite
20			USE iniadvtrac_m, ONLY: ttext
21			use initdynav_m, only: histaveid
22	guez	67	use nr_util, only: assert
23			USE paramet_m, ONLY: iip1, ip1jm, ip1jmp1, jjp1
24			USE temps, ONLY: itau_dyn
25	guez	45
26	guez	67	! Vents covariants :
27			REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm)
28			REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
29
30			REAL, intent(in):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
31			! temperature potentielle
32
33			real, intent(in):: phi(:, :, :) ! (iim + 1, jjm + 1, llm)
34			! geopotentiel instantane
35
36			real, intent(in):: pk(:, :, :) ! (iim + 1, jjm + 1, llm)
37			REAL, intent(in):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol
38			real, intent(in):: masse(:, :, :) ! (iim + 1, jjm + 1, llm)
39			REAL, intent(in):: phis(:, :) ! (iim + 1, jjm + 1) geopotentiel au sol
40	guez	62	REAL, intent(in):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx) traceurs
41	guez	61	integer, intent(in):: time ! temps de l'ecriture
42	guez	45
43	guez	56	! Variables locales
44	guez	67	integer iq
45	guez	56	real us(ip1jmp1llm), vs(ip1jmp1llm)
46			REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
47			integer itau_w
48	guez	45
49	guez	56	!---------------------------------------------------------------
50	guez	45
51	guez	67	call assert((/size(vcov, 1), size(ucov, 1), size(teta, 1), size(phi, 1), &
52			size(pk, 1), size(ps, 1), size(masse, 1), size(phis, 1), &
53			size(q, 1)/) == iim + 1, "writedynav iim")
54			call assert((/size(vcov, 2) + 1, size(ucov, 2), size(teta, 2), &
55			size(phi, 2), size(pk, 2), size(ps, 2), size(masse, 2), &
56			size(phis, 2), size(q, 2)/) == jjm + 1, "writedynav jjm")
57			call assert((/size(vcov, 3), size(ucov, 3), size(teta, 3), size(phi, 3), &
58			size(pk, 3), size(masse, 3), size(q, 3)/) == llm, "writedynav llm")
59			call assert(size(q, 4) == nqmx, "writedynav nqmx")
60
61	guez	56	! Initialisations
62			us = 999.999
63			vs = 999.999
64			vnat = 999.999
65			unat = 999.999
66			itau_w = itau_dyn + time
67	guez	45
68	guez	56	! Passage aux composantes naturelles du vent
69			call covnat(llm, ucov, vcov, unat, vnat)
70	guez	45
71	guez	56	! Appels a histwrite pour l'ecriture des variables a sauvegarder
72	guez	45
73	guez	56	! Vents U scalaire
74			call gr_u_scal(llm, unat, us)
75			call histwrite(histaveid, 'u', itau_w, us)
76	guez	45
77	guez	56	! Vents V scalaire
78			call gr_v_scal(llm, vnat, vs)
79			call histwrite(histaveid, 'v', itau_w, vs)
80	guez	45
81	guez	56	! Temperature potentielle moyennee
82			call histwrite(histaveid, 'theta', itau_w, teta)
83	guez	45
84	guez	56	! Temperature moyennee
85	guez	67	call histwrite(histaveid, 'temp', itau_w, teta * pk / cpp)
86	guez	45
87	guez	56	call histwrite(histaveid, 'phi', itau_w, phi)
88	guez	45
89	guez	56	! Traceurs
90	guez	61	DO iq = 1, size(q, 4)
91			call histwrite(histaveid, ttext(iq), itau_w, q(:, :, :, iq))
92	guez	56	enddo
93	guez	45
94	guez	56	call histwrite(histaveid, 'masse', itau_w, masse)
95			call histwrite(histaveid, 'ps', itau_w, ps)
96			call histwrite(histaveid, 'phis', itau_w, phis)
97
98	guez	67	call histsync(histaveid)
99	guez	56
100			end subroutine writedynav
101
102			end module writedynav_m