Sources/dyn3d/fluxstokenc.f

module fluxstokenc_m

  IMPLICIT NONE

contains

  SUBROUTINE fluxstokenc(pbaru, pbarv, masse, teta, phi, phis, time_step, itau)

    ! Author: F. Hourdin

    USE histwrite_m, ONLY: histwrite
    USE dimens_m, ONLY: jjm, llm, nqmx
    USE paramet_m, ONLY: iip1, ijmllm, ijp1llm, ip1jm, ip1jmp1, jjp1
    USE comgeom, ONLY: aire
    USE tracstoke, ONLY: istdyn, istphy

    REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
    REAL, intent(in):: masse(ip1jmp1, llm)
    real, intent(in):: phi(ip1jmp1, llm)
    real, intent(in):: teta(ip1jmp1, llm)
    REAL, intent(in):: phis(ip1jmp1)
    REAL, intent(in):: time_step
    INTEGER, INTENT (IN):: itau

    ! Variables local to the procedure:

    REAL, SAVE:: pbaruc(ip1jmp1, llm), pbarvc(ip1jm, llm)
    REAL, SAVE:: massem(ip1jmp1, llm)
    real, SAVE:: tetac(ip1jmp1, llm), phic(ip1jmp1, llm)

    REAL pbarug(ip1jmp1, llm), pbarvg(iip1, jjm, llm), wg(ip1jmp1, llm)
    REAL tst(1), ist(1), istp(1)
    INTEGER ij, l
    INTEGER, save:: fluxid, fluxvid
    integer fluxdid

    !-------------------------------------------------------------

    IF (itau == 0) THEN
       CALL initfluxsto(time_step, istdyn*time_step, istdyn*time_step, &
            fluxid, fluxvid, fluxdid)
       CALL histwrite(fluxid, 'phis', 1, phis)
       CALL histwrite(fluxid, 'aire', 1, aire)
       tst(1) = time_step
       CALL histwrite(fluxdid, 'dtvr', 1, tst)
       ist(1) = istdyn
       CALL histwrite(fluxdid, 'istdyn', 1, ist)
       istp(1) = istphy
       CALL histwrite(fluxdid, 'istphy', 1, istp)

       CALL initial0(ijp1llm, phic)
       CALL initial0(ijp1llm, tetac)
       CALL initial0(ijp1llm, pbaruc)
       CALL initial0(ijmllm, pbarvc)
    END IF

    !   accumulation des flux de masse horizontaux
    DO l = 1, llm
       DO ij = 1, ip1jmp1
          pbaruc(ij, l) = pbaruc(ij, l) + pbaru(ij, l)
          tetac(ij, l) = tetac(ij, l) + teta(ij, l)
          phic(ij, l) = phic(ij, l) + phi(ij, l)
       END DO
       DO ij = 1, ip1jm
          pbarvc(ij, l) = pbarvc(ij, l) + pbarv(ij, l)
       END DO
    END DO

    !   selection de la masse instantannee des mailles avant le transport.
    IF (itau == 0) massem = masse

    IF (mod(itau + 1, istdyn) == 0) THEN
       ! on advecte a ce pas de temps
       !    normalisation
       DO l = 1, llm
          DO ij = 1, ip1jmp1
             pbaruc(ij, l) = pbaruc(ij, l)/float(istdyn)
             tetac(ij, l) = tetac(ij, l)/float(istdyn)
             phic(ij, l) = phic(ij, l)/float(istdyn)
          END DO
          DO ij = 1, ip1jm
             pbarvc(ij, l) = pbarvc(ij, l)/float(istdyn)
          END DO
       END DO

       !   traitement des flux de masse avant advection.
       !     1. calcul de w
       !     2. groupement des mailles pres du pole.

       CALL groupe(pbaruc, pbarvc, pbarug, pbarvg, wg)

       CALL histwrite(fluxid, 'masse', itau, massem)
       CALL histwrite(fluxid, 'pbaru', itau, pbarug)
       CALL histwrite(fluxvid, 'pbarv', itau, pbarvg)
       CALL histwrite(fluxid, 'w', itau, wg)
       CALL histwrite(fluxid, 'teta', itau, tetac)
       CALL histwrite(fluxid, 'phi', itau, phic)
    END IF

  END SUBROUTINE fluxstokenc

end module fluxstokenc_m
1	guez	69	module fluxstokenc_m
2	guez	3
3	guez	69	IMPLICIT NONE
4	guez	3
5	guez	69	contains
6	guez	3
7	guez	69	SUBROUTINE fluxstokenc(pbaru, pbarv, masse, teta, phi, phis, time_step, itau)
8	guez	3
9	guez	69	! Author: F. Hourdin
10	guez	3
11	guez	69	USE histwrite_m, ONLY: histwrite
12			USE dimens_m, ONLY: jjm, llm, nqmx
13			USE paramet_m, ONLY: iip1, ijmllm, ijp1llm, ip1jm, ip1jmp1, jjp1
14			USE comgeom, ONLY: aire
15			USE tracstoke, ONLY: istdyn, istphy
16	guez	3
17	guez	69	REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
18	guez	102	REAL, intent(in):: masse(ip1jmp1, llm)
19	guez	69	real, intent(in):: phi(ip1jmp1, llm)
20			real, intent(in):: teta(ip1jmp1, llm)
21			REAL, intent(in):: phis(ip1jmp1)
22			REAL, intent(in):: time_step
23			INTEGER, INTENT (IN):: itau
24	guez	3
25	guez	69	! Variables local to the procedure:
26	guez	3
27	guez	69	REAL, SAVE:: pbaruc(ip1jmp1, llm), pbarvc(ip1jm, llm)
28			REAL, SAVE:: massem(ip1jmp1, llm)
29			real, SAVE:: tetac(ip1jmp1, llm), phic(ip1jmp1, llm)
30	guez	3
31	guez	69	REAL pbarug(ip1jmp1, llm), pbarvg(iip1, jjm, llm), wg(ip1jmp1, llm)
32			REAL tst(1), ist(1), istp(1)
33			INTEGER ij, l
34			INTEGER, save:: fluxid, fluxvid
35			integer fluxdid
36	guez	3
37	guez	69	!-------------------------------------------------------------
38	guez	3
39	guez	69	IF (itau == 0) THEN
40	guez	144	CALL initfluxsto(time_step, istdyntime_step, istdyntime_step, &
41	guez	69	fluxid, fluxvid, fluxdid)
42			CALL histwrite(fluxid, 'phis', 1, phis)
43			CALL histwrite(fluxid, 'aire', 1, aire)
44			tst(1) = time_step
45			CALL histwrite(fluxdid, 'dtvr', 1, tst)
46			ist(1) = istdyn
47			CALL histwrite(fluxdid, 'istdyn', 1, ist)
48			istp(1) = istphy
49			CALL histwrite(fluxdid, 'istphy', 1, istp)
50	guez	3
51	guez	69	CALL initial0(ijp1llm, phic)
52			CALL initial0(ijp1llm, tetac)
53			CALL initial0(ijp1llm, pbaruc)
54			CALL initial0(ijmllm, pbarvc)
55			END IF
56	guez	3
57	guez	69	! accumulation des flux de masse horizontaux
58			DO l = 1, llm
59			DO ij = 1, ip1jmp1
60			pbaruc(ij, l) = pbaruc(ij, l) + pbaru(ij, l)
61			tetac(ij, l) = tetac(ij, l) + teta(ij, l)
62			phic(ij, l) = phic(ij, l) + phi(ij, l)
63			END DO
64			DO ij = 1, ip1jm
65			pbarvc(ij, l) = pbarvc(ij, l) + pbarv(ij, l)
66			END DO
67			END DO
68	guez	3
69	guez	69	! selection de la masse instantannee des mailles avant le transport.
70	guez	102	IF (itau == 0) massem = masse
71	guez	28
72	guez	69	IF (mod(itau + 1, istdyn) == 0) THEN
73			! on advecte a ce pas de temps
74			! normalisation
75			DO l = 1, llm
76			DO ij = 1, ip1jmp1
77			pbaruc(ij, l) = pbaruc(ij, l)/float(istdyn)
78			tetac(ij, l) = tetac(ij, l)/float(istdyn)
79			phic(ij, l) = phic(ij, l)/float(istdyn)
80			END DO
81			DO ij = 1, ip1jm
82			pbarvc(ij, l) = pbarvc(ij, l)/float(istdyn)
83			END DO
84			END DO
85	guez	28
86	guez	69	! traitement des flux de masse avant advection.
87			! 1. calcul de w
88			! 2. groupement des mailles pres du pole.
89	guez	28
90	guez	150	CALL groupe(pbaruc, pbarvc, pbarug, pbarvg, wg)
91	guez	69
92			CALL histwrite(fluxid, 'masse', itau, massem)
93			CALL histwrite(fluxid, 'pbaru', itau, pbarug)
94			CALL histwrite(fluxvid, 'pbarv', itau, pbarvg)
95			CALL histwrite(fluxid, 'w', itau, wg)
96			CALL histwrite(fluxid, 'teta', itau, tetac)
97			CALL histwrite(fluxid, 'phi', itau, phic)
98			END IF
99
100			END SUBROUTINE fluxstokenc
101
102			end module fluxstokenc_m