trunk/dyn3d/advect.f

module advect_m

  IMPLICIT NONE

contains

  SUBROUTINE advect(ucov, vcov, teta, w, massebx, masseby, du, dv, dteta)

    ! From dyn3d/advect.F, version 1.1.1.1, 2004/05/19 12:53:06
    ! Authors: P. Le Van , F. Hourdin
    ! Objet : calcul des termes d'advection verticale pour u, v, teta.
    ! Ces termes sont ajoutés à du, dv, dteta.

    USE dimens_m, ONLY : iim, llm
    USE paramet_m, ONLY : iip1, iip2, ip1jm, ip1jmp1
    USE comconst, ONLY : daysec
    USE comgeom, ONLY : unsaire

    REAL, intent(in):: ucov(ip1jmp1, llm), vcov(ip1jm, llm)
    real, intent(in):: teta(ip1jmp1, llm)
    real, INTENT (IN):: w(ip1jmp1, llm)
    REAL, intent(in):: massebx(ip1jmp1, llm), masseby(ip1jm, llm)
    REAL, intent(inout):: du(ip1jmp1, llm), dv(ip1jm, llm), dteta(ip1jmp1, llm)

    ! Local:
    REAL uav(ip1jmp1, llm), vav(ip1jm, llm), wsur2(ip1jmp1)
    REAL ww, uu, vv
    INTEGER ij, l

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

    ! 2. Calculs preliminaires :

    ! Calcul de \bar{u}^{yy}
    DO l = 1, llm
       DO ij = iip2, ip1jmp1
          uav(ij, l) = 0.25*(ucov(ij, l)+ucov(ij-iip1, l))
       END DO
       DO ij = iip2, ip1jm
          uav(ij, l) = uav(ij, l) + uav(ij+iip1, l)
       END DO
       DO ij = 1, iip1
          uav(ij, l) = 0.
          uav(ip1jm+ij, l) = 0.
       END DO
    END DO

    ! Calcul de \bar{v}^{xx}
    DO l = 1, llm
       DO ij = 2, ip1jm
          vav(ij, l) = 0.25*(vcov(ij, l)+vcov(ij-1, l))
       END DO
       DO ij = 1, ip1jm, iip1
          vav(ij, l) = vav(ij+iim, l)
       END DO
       DO ij = 1, ip1jm - 1
          vav(ij, l) = vav(ij, l) + vav(ij+1, l)
       END DO
       DO ij = 1, ip1jm, iip1
          vav(ij+iim, l) = vav(ij, l)
       END DO
    END DO

    DO l = 1, llm - 1
       ! calcul de - w/2 au niveau l+1
       DO ij = 1, ip1jmp1
          wsur2(ij) = -0.5 * w(ij, l+1)
       END DO

       ! calcul pour "du"
       DO ij = iip2, ip1jm - 1
          ww = wsur2(ij) + wsur2(ij+1)
          uu = 0.5*(ucov(ij, l)+ucov(ij, l+1))
          du(ij, l) = du(ij, l) - ww*(uu-uav(ij, l))/massebx(ij, l)
          du(ij, l+1) = du(ij, l+1) + ww*(uu-uav(ij, l+1))/massebx(ij, l+1)
       END DO

       ! correction pour du(iip1, j, l)
       ! du(iip1, j, l)= du(1, j, l)
       DO ij = iip1 + iip1, ip1jm, iip1
          du(ij, l) = du(ij-iim, l)
          du(ij, l+1) = du(ij-iim, l+1)
       END DO

       ! calcul pour dv
       DO ij = 1, ip1jm
          ww = wsur2(ij+iip1) + wsur2(ij)
          vv = 0.5*(vcov(ij, l)+vcov(ij, l+1))
          dv(ij, l) = dv(ij, l) - ww*(vv-vav(ij, l))/masseby(ij, l)
          dv(ij, l+1) = dv(ij, l+1) + ww*(vv-vav(ij, l+1))/masseby(ij, l+1)
       END DO

       ! calcul pour dh
       ! calcul de - d(\bar{teta}^z * w) qu'on ajoute à dh
       DO ij = 1, ip1jmp1
          ww = wsur2(ij) * (teta(ij, l) + teta(ij, l + 1))
          dteta(ij, l) = dteta(ij, l) - ww
          dteta(ij, l + 1) = dteta(ij, l + 1) + ww
       end DO
    END DO

  END SUBROUTINE advect

end module advect_m
1	guez	46	module advect_m
2	guez	3
3	guez	25	IMPLICIT NONE
4	guez	3
5	guez	46	contains
6	guez	3
7	guez	47	SUBROUTINE advect(ucov, vcov, teta, w, massebx, masseby, du, dv, dteta)
8	guez	3
9	guez	88	! From dyn3d/advect.F, version 1.1.1.1, 2004/05/19 12:53:06
10	guez	46	! Authors: P. Le Van , F. Hourdin
11			! Objet : calcul des termes d'advection verticale pour u, v, teta.
12			! Ces termes sont ajoutés à du, dv, dteta.
13	guez	3
14	guez	46	USE dimens_m, ONLY : iim, llm
15			USE paramet_m, ONLY : iip1, iip2, ip1jm, ip1jmp1
16			USE comconst, ONLY : daysec
17			USE comgeom, ONLY : unsaire
18	guez	3
19	guez	88	REAL, intent(in):: ucov(ip1jmp1, llm), vcov(ip1jm, llm)
20	guez	46	real, intent(in):: teta(ip1jmp1, llm)
21	guez	88	real, INTENT (IN):: w(ip1jmp1, llm)
22	guez	46	REAL, intent(in):: massebx(ip1jmp1, llm), masseby(ip1jm, llm)
23	guez	88	REAL, intent(inout):: du(ip1jmp1, llm), dv(ip1jm, llm), dteta(ip1jmp1, llm)
24	guez	3
25	guez	46	! Local:
26			REAL uav(ip1jmp1, llm), vav(ip1jm, llm), wsur2(ip1jmp1)
27	guez	47	REAL ww, uu, vv
28	guez	46	INTEGER ij, l
29	guez	3
30	guez	46	!-----------------------------------------------------------------------
31	guez	3
32	guez	46	! 2. Calculs preliminaires :
33	guez	3
34	guez	46	! Calcul de \bar{u}^{yy}
35			DO l = 1, llm
36			DO ij = iip2, ip1jmp1
37			uav(ij, l) = 0.25*(ucov(ij, l)+ucov(ij-iip1, l))
38			END DO
39			DO ij = iip2, ip1jm
40			uav(ij, l) = uav(ij, l) + uav(ij+iip1, l)
41			END DO
42			DO ij = 1, iip1
43			uav(ij, l) = 0.
44			uav(ip1jm+ij, l) = 0.
45			END DO
46			END DO
47	guez	3
48	guez	46	! Calcul de \bar{v}^{xx}
49			DO l = 1, llm
50			DO ij = 2, ip1jm
51			vav(ij, l) = 0.25*(vcov(ij, l)+vcov(ij-1, l))
52			END DO
53			DO ij = 1, ip1jm, iip1
54			vav(ij, l) = vav(ij+iim, l)
55			END DO
56			DO ij = 1, ip1jm - 1
57			vav(ij, l) = vav(ij, l) + vav(ij+1, l)
58			END DO
59			DO ij = 1, ip1jm, iip1
60			vav(ij+iim, l) = vav(ij, l)
61			END DO
62			END DO
63	guez	3
64	guez	46	DO l = 1, llm - 1
65			! calcul de - w/2 au niveau l+1
66			DO ij = 1, ip1jmp1
67			wsur2(ij) = -0.5 * w(ij, l+1)
68			END DO
69	guez	3
70	guez	46	! calcul pour "du"
71			DO ij = iip2, ip1jm - 1
72			ww = wsur2(ij) + wsur2(ij+1)
73			uu = 0.5*(ucov(ij, l)+ucov(ij, l+1))
74			du(ij, l) = du(ij, l) - ww*(uu-uav(ij, l))/massebx(ij, l)
75			du(ij, l+1) = du(ij, l+1) + ww*(uu-uav(ij, l+1))/massebx(ij, l+1)
76			END DO
77	guez	3
78	guez	46	! correction pour du(iip1, j, l)
79			! du(iip1, j, l)= du(1, j, l)
80			DO ij = iip1 + iip1, ip1jm, iip1
81			du(ij, l) = du(ij-iim, l)
82			du(ij, l+1) = du(ij-iim, l+1)
83			END DO
84	guez	3
85	guez	46	! calcul pour dv
86			DO ij = 1, ip1jm
87			ww = wsur2(ij+iip1) + wsur2(ij)
88			vv = 0.5*(vcov(ij, l)+vcov(ij, l+1))
89			dv(ij, l) = dv(ij, l) - ww*(vv-vav(ij, l))/masseby(ij, l)
90			dv(ij, l+1) = dv(ij, l+1) + ww*(vv-vav(ij, l+1))/masseby(ij, l+1)
91			END DO
92	guez	3
93	guez	46	! calcul pour dh
94			! calcul de - d(\bar{teta}^z * w) qu'on ajoute à dh
95			DO ij = 1, ip1jmp1
96			ww = wsur2(ij) * (teta(ij, l) + teta(ij, l + 1))
97			dteta(ij, l) = dteta(ij, l) - ww
98			dteta(ij, l + 1) = dteta(ij, l + 1) + ww
99			end DO
100			END DO
101	guez	3
102	guez	46	END SUBROUTINE advect
103	guez	3
104	guez	46	end module advect_m