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 dimens_m, 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	module vlsplt_m
2
3	IMPLICIT NONE
4
5	contains
6
7	SUBROUTINE vlsplt(q, pente_max, masse, w, pbaru, pbarv, pdt)
8
9	! From LMDZ4/libf/dyn3d/vlsplt.F, version 1.2 2005/02/24 12:16:57 fairhead
10
11	! Authors: P. Le Van, F. Hourdin, F. Forget
12
13	! Sch\'ema d'advection "pseudo-amont".
14
15	USE dimens_m, ONLY: iim, llm
16	USE paramet_m, ONLY: iip1, iip2, ip1jm, ip1jmp1
17	use vlx_m, only: vlx
18
19	REAL, intent(inout):: q(ip1jmp1, llm)
20
21	REAL, intent(in):: pente_max
22	! facteur de limitation des pentes, 2 en general
23
24	real, intent(in):: masse(ip1jmp1, llm)
25	REAL, intent(in):: w(ip1jmp1, llm) ! flux de masse
26
27	REAL, intent(in):: pbaru( ip1jmp1, llm ), pbarv( ip1jm, llm)
28	! flux de masse en u, v
29
30	real, intent(in):: pdt ! pas de temps
31
32	! Local:
33
34	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
41	!---------------------------------------------------------------
42
43	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
57	DO ij = 1, ip1jmp1
58	mw(ij, llm+1) = 0.
59	ENDDO
60
61	zm = masse
62
63	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
69	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