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 dimensions, ONLY : iim, llm
    USE paramet_m, ONLY : iip1, iip2, ip1jm, ip1jmp1

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