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

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