dyn3d/Vlsplt/vlsplt.f

module vlsplt_m

  IMPLICIT NONE

contains

  SUBROUTINE vlsplt(q, pente_max, masse, w, pbaru, pbarv, pdt)

    ! From LMDZ4/libf/dyn3d/vlsplt.F, version 1.2 2005/02/24 12:16:57 fairhead

    ! Authors: P. Le Van, F. Hourdin, F. Forget

    ! Sch\'ema d'advection "pseudo-amont".

    USE dimensions, ONLY: iim, llm
    USE paramet_m, ONLY: iip1, iip2, ip1jm, ip1jmp1
    use vlx_m, only: vlx

    REAL, intent(inout):: q(ip1jmp1, llm)

    REAL, intent(in):: pente_max
    ! facteur de limitation des pentes, 2 en general

    real, intent(in):: masse(ip1jmp1, llm)
    REAL, intent(in):: w(ip1jmp1, llm) ! flux de masse

    REAL, intent(in):: pbaru( ip1jmp1, llm ), pbarv( ip1jm, llm)
    ! flux de masse en u, v

    real, intent(in):: pdt ! pas de temps

    ! Local:

    INTEGER ij, l
    REAL zm(ip1jmp1, llm)
    REAL mu(ip1jmp1, llm)
    REAL mv(ip1jm, llm)
    REAL mw(ip1jmp1, llm+1)
    REAL zzpbar, zzw

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

    zzpbar = 0.5 * pdt
    zzw = pdt
    DO l = 1, llm
       DO ij = iip2, ip1jm
          mu(ij, l) = pbaru(ij, l) * zzpbar
       ENDDO
       DO ij = 1, ip1jm
          mv(ij, l) = pbarv(ij, l) * zzpbar
       ENDDO
       DO ij = 1, ip1jmp1
          mw(ij, l) = w(ij, l) * zzw
       ENDDO
    ENDDO

    DO ij = 1, ip1jmp1
       mw(ij, llm+1) = 0.
    ENDDO

    zm = masse

    call vlx(q, pente_max, zm, mu)
    call vly(q, pente_max, zm, mv)
    call vlz(q, pente_max, zm, mw)
    call vly(q, pente_max, zm, mv)
    call vlx(q, pente_max, zm, mu)

    DO ij = 1, ip1jm + 1, iip1
       q(ij + iim, :) = q(ij, :)
    ENDDO

  END SUBROUTINE vlsplt

end module vlsplt_m
1	guez	157	module vlsplt_m
2	guez	3
3	guez	157	IMPLICIT NONE
4	guez	3
5	guez	157	contains
6	guez	3
7	guez	157	SUBROUTINE vlsplt(q, pente_max, masse, w, pbaru, pbarv, pdt)
8	guez	3
9	guez	157	! From LMDZ4/libf/dyn3d/vlsplt.F, version 1.2 2005/02/24 12:16:57 fairhead
10	guez	3
11	guez	157	! Authors: P. Le Van, F. Hourdin, F. Forget
12	guez	3
13	guez	157	! Sch\'ema d'advection "pseudo-amont".
14	guez	31
15	guez	265	USE dimensions, ONLY: iim, llm
16	guez	178	USE paramet_m, ONLY: iip1, iip2, ip1jm, ip1jmp1
17	guez	157	use vlx_m, only: vlx
18	guez	3
19	guez	157	REAL, intent(inout):: q(ip1jmp1, llm)
20	guez	3
21	guez	157	REAL, intent(in):: pente_max
22			! facteur de limitation des pentes, 2 en general
23	guez	3
24	guez	157	real, intent(in):: masse(ip1jmp1, llm)
25			REAL, intent(in):: w(ip1jmp1, llm) ! flux de masse
26	guez	3
27	guez	157	REAL, intent(in):: pbaru( ip1jmp1, llm ), pbarv( ip1jm, llm)
28			! flux de masse en u, v
29	guez	3
30	guez	157	real, intent(in):: pdt ! pas de temps
31	guez	3
32	guez	157	! Local:
33	guez	3
34	guez	157	INTEGER ij, l
35			REAL zm(ip1jmp1, llm)
36			REAL mu(ip1jmp1, llm)
37			REAL mv(ip1jm, llm)
38			REAL mw(ip1jmp1, llm+1)
39			REAL zzpbar, zzw
40	guez	31
41	guez	157	!---------------------------------------------------------------
42	guez	3
43	guez	157	zzpbar = 0.5 * pdt
44			zzw = pdt
45			DO l = 1, llm
46			DO ij = iip2, ip1jm
47			mu(ij, l) = pbaru(ij, l) * zzpbar
48			ENDDO
49			DO ij = 1, ip1jm
50			mv(ij, l) = pbarv(ij, l) * zzpbar
51			ENDDO
52			DO ij = 1, ip1jmp1
53			mw(ij, l) = w(ij, l) * zzw
54			ENDDO
55			ENDDO
56	guez	40
57	guez	157	DO ij = 1, ip1jmp1
58			mw(ij, llm+1) = 0.
59			ENDDO
60	guez	40
61	guez	157	zm = masse
62	guez	40
63	guez	157	call vlx(q, pente_max, zm, mu)
64			call vly(q, pente_max, zm, mv)
65			call vlz(q, pente_max, zm, mw)
66			call vly(q, pente_max, zm, mv)
67			call vlx(q, pente_max, zm, mu)
68	guez	40
69	guez	157	DO ij = 1, ip1jm + 1, iip1
70			q(ij + iim, :) = q(ij, :)
71			ENDDO
72
73			END SUBROUTINE vlsplt
74
75			end module vlsplt_m