trunk/dyn3d/flumass.f

module flumass_m

  IMPLICIT NONE

contains

  SUBROUTINE flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)

    ! From LMDZ4/libf/dyn3d/flumass.F, version 1.1.1.1 2004/05/19 12:53:06

    ! Auteurs : P. Le Van, F. Hourdin
    ! Objet: calcul du flux de masse aux niveaux s 

    USE comgeom, ONLY: aire, aireu
    USE dimens_m, ONLY: iim, llm
    USE paramet_m, ONLY: iip1, iip2, ip1jm, ip1jmi1, ip1jmp1

    REAL, intent(in):: massebx(ip1jmp1, llm), masseby(ip1jm, llm)
    real, intent(in):: vcont(ip1jm, llm), ucont(ip1jmp1, llm)
    real, intent(out):: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)

    ! Local:
    REAL apbarun(iip1), apbarus(iip1)
    REAL sairen, saireun, saires, saireus, ctn, cts, ctn0, cts0
    INTEGER l, ij, i

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

    DO l = 1, llm
       DO ij = iip2, ip1jm
          pbaru(ij, l) = massebx(ij, l) * ucont(ij, l)
       end DO

       DO ij = 1, ip1jm
          pbarv(ij, l) = masseby(ij, l) * vcont(ij, l)
       end DO
    end DO

    ! Calcul de la composante du flux de masse en x aux pôles 
    ! par la résolution d'un système de deux équations

    ! la première équation décrivant le calcul de la divergence en un
    ! point i du pôle, ce calcul étant itéré de i = 1 à i = im.
    ! c'est-à-dire,

    ! ((0.5 * pbaru(i) - 0.5 * pbaru(i - 1) - pbarv(i)) / aire(i) =
    ! - somme de (pbarv(n)) / aire pôle

    ! l'autre équation spécifiant que la moyenne du flux de masse au
    ! pôle est nulle c'est-à-dire somme de pbaru(n) * aire locale(n) =
    ! 0.

    ! on en revient ainsi à déterminer la constante additive commune
    ! aux pbaru qui représentait pbaru(0, j, l) dans l'équation du
    ! calcul de la divergence au point i=1.

    ! i variant de 1 à im
    ! n variant de 1 à im

    sairen = SUM(aire(:iim))
    saireun= SUM(aireu(:iim))
    saires = SUM(aire(ip1jm + 1: ip1jm + iim))
    saireus= SUM(aireu(ip1jm + 1: ip1jm + iim))

    DO l = 1, llm
       ctn = SUM(pbarv(:iim, l))/ sairen
       cts = SUM(pbarv(ip1jmi1 + 1: ip1jmi1 + iim, l)) / saires

       pbaru(1, l)= pbarv(1, l) - ctn * aire(1)
       pbaru(ip1jm+1, l)= - pbarv(ip1jmi1+1, l) + cts * aire(ip1jm+1)

       DO i = 2, iim
          pbaru(i, l) = pbaru(i - 1, l) + &
               pbarv(i, l) - ctn * aire(i)

          pbaru(i+ ip1jm, l) = pbaru(i+ ip1jm-1, l) - &
               pbarv(i+ ip1jmi1, l) + cts * aire(i+ ip1jm)
       end DO
       DO i = 1, iim
          apbarun(i) = aireu(i) * pbaru(i, l)
          apbarus(i) = aireu(i +ip1jm) * pbaru(i +ip1jm, l)
       end DO
       ctn0 = - SUM(apbarun(:iim)) / saireun
       cts0 = - SUM(apbarus(:iim)) / saireus
       DO i = 1, iim
          pbaru(i, l) = 2. * (pbaru(i, l) + ctn0)
          pbaru(i+ ip1jm, l) = 2. * (pbaru(i +ip1jm, l) + cts0)
       end DO

       pbaru(iip1, l) = pbaru(1, l)
       pbaru(ip1jmp1, l) = pbaru(ip1jm +1, l)
    end DO

  END SUBROUTINE flumass

end module flumass_m
1	guez	78	module flumass_m
2	guez	3
3	guez	78	IMPLICIT NONE
4	guez	3
5	guez	78	contains
6	guez	3
7	guez	78	SUBROUTINE flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)
8	guez	3
9	guez	78	! From LMDZ4/libf/dyn3d/flumass.F, version 1.1.1.1 2004/05/19 12:53:06
10	guez	3
11	guez	78	! Auteurs : P. Le Van, F. Hourdin
12			! Objet: calcul du flux de masse aux niveaux s
13	guez	3
14	guez	164	USE comgeom, ONLY: aire, aireu
15	guez	78	USE dimens_m, ONLY: iim, llm
16			USE paramet_m, ONLY: iip1, iip2, ip1jm, ip1jmi1, ip1jmp1
17	guez	3
18	guez	78	REAL, intent(in):: massebx(ip1jmp1, llm), masseby(ip1jm, llm)
19			real, intent(in):: vcont(ip1jm, llm), ucont(ip1jmp1, llm)
20			real, intent(out):: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
21	guez	3
22	guez	78	! Local:
23			REAL apbarun(iip1), apbarus(iip1)
24			REAL sairen, saireun, saires, saireus, ctn, cts, ctn0, cts0
25			INTEGER l, ij, i
26	guez	3
27	guez	78	!----------------------------------------------------------------
28	guez	3
29	guez	78	DO l = 1, llm
30			DO ij = iip2, ip1jm
31			pbaru(ij, l) = massebx(ij, l) * ucont(ij, l)
32			end DO
33	guez	3
34	guez	78	DO ij = 1, ip1jm
35			pbarv(ij, l) = masseby(ij, l) * vcont(ij, l)
36			end DO
37			end DO
38	guez	3
39	guez	78	! Calcul de la composante du flux de masse en x aux pôles
40			! par la résolution d'un système de deux équations
41	guez	3
42	guez	78	! la première équation décrivant le calcul de la divergence en un
43			! point i du pôle, ce calcul étant itéré de i = 1 à i = im.
44			! c'est-à-dire,
45	guez	3
46	guez	78	! ((0.5 * pbaru(i) - 0.5 * pbaru(i - 1) - pbarv(i)) / aire(i) =
47			! - somme de (pbarv(n)) / aire pôle
48	guez	3
49	guez	78	! l'autre équation spécifiant que la moyenne du flux de masse au
50			! pôle est nulle c'est-à-dire somme de pbaru(n) * aire locale(n) =
51			! 0.
52	guez	3
53	guez	78	! on en revient ainsi à déterminer la constante additive commune
54			! aux pbaru qui représentait pbaru(0, j, l) dans l'équation du
55			! calcul de la divergence au point i=1.
56	guez	3
57	guez	78	! i variant de 1 à im
58			! n variant de 1 à im
59	guez	3
60	guez	78	sairen = SUM(aire(:iim))
61			saireun= SUM(aireu(:iim))
62			saires = SUM(aire(ip1jm + 1: ip1jm + iim))
63			saireus= SUM(aireu(ip1jm + 1: ip1jm + iim))
64	guez	3
65	guez	78	DO l = 1, llm
66			ctn = SUM(pbarv(:iim, l))/ sairen
67			cts = SUM(pbarv(ip1jmi1 + 1: ip1jmi1 + iim, l)) / saires
68	guez	3
69	guez	78	pbaru(1, l)= pbarv(1, l) - ctn * aire(1)
70			pbaru(ip1jm+1, l)= - pbarv(ip1jmi1+1, l) + cts * aire(ip1jm+1)
71	guez	3
72	guez	78	DO i = 2, iim
73			pbaru(i, l) = pbaru(i - 1, l) + &
74			pbarv(i, l) - ctn * aire(i)
75	guez	3
76	guez	78	pbaru(i+ ip1jm, l) = pbaru(i+ ip1jm-1, l) - &
77			pbarv(i+ ip1jmi1, l) + cts * aire(i+ ip1jm)
78			end DO
79			DO i = 1, iim
80			apbarun(i) = aireu(i) * pbaru(i, l)
81			apbarus(i) = aireu(i +ip1jm) * pbaru(i +ip1jm, l)
82			end DO
83			ctn0 = - SUM(apbarun(:iim)) / saireun
84			cts0 = - SUM(apbarus(:iim)) / saireus
85			DO i = 1, iim
86			pbaru(i, l) = 2. * (pbaru(i, l) + ctn0)
87			pbaru(i+ ip1jm, l) = 2. * (pbaru(i +ip1jm, l) + cts0)
88			end DO
89	guez	3
90	guez	78	pbaru(iip1, l) = pbaru(1, l)
91			pbaru(ip1jmp1, l) = pbaru(ip1jm +1, l)
92			end DO
93	guez	3
94	guez	78	END SUBROUTINE flumass
95	guez	3
96	guez	78	end module flumass_m