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

    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	guez	3
18	guez	88	REAL, intent(in):: ucov(ip1jmp1, llm), vcov(ip1jm, llm)
19	guez	46	real, intent(in):: teta(ip1jmp1, llm)
20	guez	88	real, INTENT (IN):: w(ip1jmp1, llm)
21	guez	46	REAL, intent(in):: massebx(ip1jmp1, llm), masseby(ip1jm, llm)
22	guez	88	REAL, intent(inout):: du(ip1jmp1, llm), dv(ip1jm, llm), dteta(ip1jmp1, llm)
23	guez	3
24	guez	46	! Local:
25			REAL uav(ip1jmp1, llm), vav(ip1jm, llm), wsur2(ip1jmp1)
26	guez	47	REAL ww, uu, vv
27	guez	46	INTEGER ij, l
28	guez	3
29	guez	46	!-----------------------------------------------------------------------
30	guez	3
31	guez	46	! 2. Calculs preliminaires :
32	guez	3
33	guez	46	! Calcul de \bar{u}^{yy}
34			DO l = 1, llm
35			DO ij = iip2, ip1jmp1
36			uav(ij, l) = 0.25*(ucov(ij, l)+ucov(ij-iip1, l))
37			END DO
38			DO ij = iip2, ip1jm
39			uav(ij, l) = uav(ij, l) + uav(ij+iip1, l)
40			END DO
41			DO ij = 1, iip1
42			uav(ij, l) = 0.
43			uav(ip1jm+ij, l) = 0.
44			END DO
45			END DO
46	guez	3
47	guez	46	! Calcul de \bar{v}^{xx}
48			DO l = 1, llm
49			DO ij = 2, ip1jm
50			vav(ij, l) = 0.25*(vcov(ij, l)+vcov(ij-1, l))
51			END DO
52			DO ij = 1, ip1jm, iip1
53			vav(ij, l) = vav(ij+iim, l)
54			END DO
55			DO ij = 1, ip1jm - 1
56			vav(ij, l) = vav(ij, l) + vav(ij+1, l)
57			END DO
58			DO ij = 1, ip1jm, iip1
59			vav(ij+iim, l) = vav(ij, l)
60			END DO
61			END DO
62	guez	3
63	guez	46	DO l = 1, llm - 1
64			! calcul de - w/2 au niveau l+1
65			DO ij = 1, ip1jmp1
66			wsur2(ij) = -0.5 * w(ij, l+1)
67			END DO
68	guez	3
69	guez	46	! calcul pour "du"
70			DO ij = iip2, ip1jm - 1
71			ww = wsur2(ij) + wsur2(ij+1)
72			uu = 0.5*(ucov(ij, l)+ucov(ij, l+1))
73			du(ij, l) = du(ij, l) - ww*(uu-uav(ij, l))/massebx(ij, l)
74			du(ij, l+1) = du(ij, l+1) + ww*(uu-uav(ij, l+1))/massebx(ij, l+1)
75			END DO
76	guez	3
77	guez	46	! correction pour du(iip1, j, l)
78			! du(iip1, j, l)= du(1, j, l)
79			DO ij = iip1 + iip1, ip1jm, iip1
80			du(ij, l) = du(ij-iim, l)
81			du(ij, l+1) = du(ij-iim, l+1)
82			END DO
83	guez	3
84	guez	46	! calcul pour dv
85			DO ij = 1, ip1jm
86			ww = wsur2(ij+iip1) + wsur2(ij)
87			vv = 0.5*(vcov(ij, l)+vcov(ij, l+1))
88			dv(ij, l) = dv(ij, l) - ww*(vv-vav(ij, l))/masseby(ij, l)
89			dv(ij, l+1) = dv(ij, l+1) + ww*(vv-vav(ij, l+1))/masseby(ij, l+1)
90			END DO
91	guez	3
92	guez	46	! calcul pour dh
93			! calcul de - d(\bar{teta}^z * w) qu'on ajoute à dh
94			DO ij = 1, ip1jmp1
95			ww = wsur2(ij) * (teta(ij, l) + teta(ij, l + 1))
96			dteta(ij, l) = dteta(ij, l) - ww
97			dteta(ij, l + 1) = dteta(ij, l + 1) + ww
98			end DO
99			END DO
100	guez	3
101	guez	46	END SUBROUTINE advect
102	guez	3
103	guez	46	end module advect_m