trunk/dyn3d/caldyn.f

module caldyn_m

  IMPLICIT NONE

contains

  SUBROUTINE caldyn(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &
       dudyn, dv, dteta, dp, w, pbaru, pbarv, time_0, conser)

    ! From dyn3d/caldyn.F, v 1.1.1.1 2004/05/19 12:53:06
    ! Auteur : P. Le Van
    ! Objet : calcul des tendances dynamiques

    use advect_m, only: advect
    USE comgeom, ONLY : airesurg, constang
    USE dimens_m, ONLY : iim, llm
    USE disvert_m, ONLY : ap, bp
    use massdair_m, only: massdair
    USE paramet_m, ONLY : iip1, ip1jm, ip1jmp1, jjp1, llmp1
    use sortvarc_m, only: sortvarc

    ! Arguments:

    LOGICAL, INTENT(IN):: conser
    INTEGER, INTENT(IN):: itau
    REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm)
    real, intent(in):: teta(ip1jmp1, llm)
    REAL, INTENT(IN):: ps(ip1jmp1), phis(ip1jmp1)
    REAL, INTENT(IN):: pk(iip1, jjp1, llm)
    REAL pkf(ip1jmp1, llm)
    REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)
    REAL, INTENT(IN):: phi(ip1jmp1, llm)
    real masse(ip1jmp1, llm)
    REAL dv(ip1jm, llm), dudyn(ip1jmp1, llm)
    REAL dteta(ip1jmp1, llm)
    real, INTENT(out):: dp(ip1jmp1)
    REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
    REAL, intent(in):: time_0
    REAL, INTENT(out):: w(ip1jmp1, llm)

    ! Local:

    REAL ang(ip1jmp1, llm), p(ip1jmp1, llmp1)
    REAL massebx(ip1jmp1, llm), masseby(ip1jm, llm)
    REAL vorpot(ip1jm, llm)
    real ecin(ip1jmp1, llm), convm(ip1jmp1, llm)
    REAL bern(ip1jmp1, llm)
    REAL massebxy(ip1jm, llm)

    INTEGER ij, l

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

    CALL covcont(llm, ucov, vcov, ucont, vcont)
    forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
    CALL massdair(p, masse)
    CALL massbar(masse, massebx, masseby)
    CALL massbarxy(masse, massebxy)
    CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)
    CALL dteta1(teta, pbaru, pbarv, dteta)
    CALL convmas(pbaru, pbarv, convm)
    dp = convm(:, 1) / airesurg
    CALL vitvert(convm, w)
    CALL tourpot(vcov, ucov, massebxy, vorpot)
    CALL dudv1(vorpot, pbaru, pbarv, dudyn, dv)
    CALL enercin(vcov, ucov, vcont, ucont, ecin)
    CALL bernoui(ip1jmp1, llm, phi, ecin, bern)
    CALL dudv2(teta, pkf, bern, dudyn, dv)

    DO l = 1, llm
       DO ij = 1, ip1jmp1
          ang(ij, l) = ucov(ij, l) + constang(ij)
       END DO
    END DO

    CALL advect(ang, vcov, teta, w, massebx, masseby, dudyn, dv, dteta)

    ! WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
    ! probablement. Observe sur le code compile avec pgf90 3.0-1
    DO l = 1, llm
       DO ij = 1, ip1jm, iip1
          IF (dv(ij, l)/=dv(ij+iim, l)) THEN
             dv(ij+iim, l) = dv(ij, l)
          END IF
       END DO
    END DO

    ! Sorties eventuelles des variables de controle :
    IF (conser) CALL sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, &
         phi, bern, dp, time_0)

  END SUBROUTINE caldyn

end module caldyn_m
1	guez	43	module caldyn_m
2	guez	3
3	guez	43	IMPLICIT NONE
4	guez	3
5	guez	43	contains
6	guez	3
7	guez	43	SUBROUTINE caldyn(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &
8	guez	47	dudyn, dv, dteta, dp, w, pbaru, pbarv, time_0, conser)
9	guez	3
10	guez	43	! From dyn3d/caldyn.F, v 1.1.1.1 2004/05/19 12:53:06
11			! Auteur : P. Le Van
12			! Objet : calcul des tendances dynamiques
13	guez	3
14	guez	46	use advect_m, only: advect
15	guez	67	USE comgeom, ONLY : airesurg, constang
16	guez	43	USE dimens_m, ONLY : iim, llm
17	guez	67	USE disvert_m, ONLY : ap, bp
18			use massdair_m, only: massdair
19	guez	43	USE paramet_m, ONLY : iip1, ip1jm, ip1jmp1, jjp1, llmp1
20			use sortvarc_m, only: sortvarc
21	guez	3
22	guez	43	! Arguments:
23	guez	3
24	guez	46	LOGICAL, INTENT(IN):: conser
25			INTEGER, INTENT(IN):: itau
26	guez	43	REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm)
27			real, intent(in):: teta(ip1jmp1, llm)
28	guez	46	REAL, INTENT(IN):: ps(ip1jmp1), phis(ip1jmp1)
29			REAL, INTENT(IN):: pk(iip1, jjp1, llm)
30	guez	43	REAL pkf(ip1jmp1, llm)
31			REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)
32	guez	68	REAL, INTENT(IN):: phi(ip1jmp1, llm)
33			real masse(ip1jmp1, llm)
34	guez	47	REAL dv(ip1jm, llm), dudyn(ip1jmp1, llm)
35	guez	46	REAL dteta(ip1jmp1, llm)
36			real, INTENT(out):: dp(ip1jmp1)
37	guez	43	REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
38			REAL, intent(in):: time_0
39	guez	46	REAL, INTENT(out):: w(ip1jmp1, llm)
40	guez	3
41	guez	43	! Local:
42	guez	3
43	guez	43	REAL ang(ip1jmp1, llm), p(ip1jmp1, llmp1)
44	guez	46	REAL massebx(ip1jmp1, llm), masseby(ip1jm, llm)
45	guez	43	REAL vorpot(ip1jm, llm)
46			real ecin(ip1jmp1, llm), convm(ip1jmp1, llm)
47			REAL bern(ip1jmp1, llm)
48			REAL massebxy(ip1jm, llm)
49	guez	3
50	guez	43	INTEGER ij, l
51	guez	3
52	guez	43	!-----------------------------------------------------------------------
53	guez	3
54	guez	43	CALL covcont(llm, ucov, vcov, ucont, vcont)
55			forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
56			CALL massdair(p, masse)
57			CALL massbar(masse, massebx, masseby)
58			CALL massbarxy(masse, massebxy)
59			CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)
60			CALL dteta1(teta, pbaru, pbarv, dteta)
61			CALL convmas(pbaru, pbarv, convm)
62	guez	46	dp = convm(:, 1) / airesurg
63	guez	43	CALL vitvert(convm, w)
64			CALL tourpot(vcov, ucov, massebxy, vorpot)
65	guez	47	CALL dudv1(vorpot, pbaru, pbarv, dudyn, dv)
66	guez	43	CALL enercin(vcov, ucov, vcont, ucont, ecin)
67			CALL bernoui(ip1jmp1, llm, phi, ecin, bern)
68	guez	47	CALL dudv2(teta, pkf, bern, dudyn, dv)
69	guez	3
70	guez	43	DO l = 1, llm
71			DO ij = 1, ip1jmp1
72			ang(ij, l) = ucov(ij, l) + constang(ij)
73			END DO
74			END DO
75	guez	3
76	guez	47	CALL advect(ang, vcov, teta, w, massebx, masseby, dudyn, dv, dteta)
77	guez	3
78	guez	43	! WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
79			! probablement. Observe sur le code compile avec pgf90 3.0-1
80			DO l = 1, llm
81			DO ij = 1, ip1jm, iip1
82			IF (dv(ij, l)/=dv(ij+iim, l)) THEN
83			dv(ij+iim, l) = dv(ij, l)
84			END IF
85			END DO
86			END DO
87
88			! Sorties eventuelles des variables de controle :
89			IF (conser) CALL sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, &
90			phi, bern, dp, time_0)
91
92			END SUBROUTINE caldyn
93
94			end module caldyn_m