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, version 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_2d
    USE dimens_m, ONLY: iim, jjm, llm
    USE disvert_m, ONLY: ap, bp
    use flumass_m, only: flumass
    use massbarxy_m, only: massbarxy
    use massdair_m, only: massdair
    USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1
    use sortvarc_m, only: sortvarc
    use tourpot_m, only: tourpot

    ! Arguments:
    INTEGER, INTENT(IN):: itau
    REAL, INTENT(IN):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm) vent covariant
    REAL, INTENT(IN):: vcov(:, :, :) ! (iim + 1, jjm, llm) ! vent covariant
    REAL, INTENT(IN):: teta(ip1jmp1, llm)
    REAL, INTENT (IN):: ps(ip1jmp1)
    real, intent(out):: masse(ip1jmp1, llm)
    REAL, INTENT(IN):: pk(iip1, jjp1, llm)
    REAL pkf(ip1jmp1, llm)
    REAL, INTENT(IN):: phis(ip1jmp1)
    REAL, INTENT(IN):: phi(ip1jmp1, llm)
    REAL dudyn(ip1jmp1, llm), dv((iim + 1) * jjm, llm)
    REAL dteta(ip1jmp1, llm)
    real, INTENT(out):: dp(ip1jmp1)
    REAL, INTENT(out):: w(ip1jmp1, llm)
    REAL, intent(out):: pbaru(ip1jmp1, llm), pbarv((iim + 1) * jjm, llm)
    REAL, intent(in):: time_0
    LOGICAL, INTENT(IN):: conser

    ! Local:

    REAL vcont((iim + 1) * jjm, llm), ucont(ip1jmp1, llm)
    REAL ang(iim + 1, jjm + 1, llm), p(ip1jmp1, llmp1)
    REAL massebx(ip1jmp1, llm), masseby((iim + 1) * jjm, llm)
    REAL vorpot(iim + 1, jjm, llm)
    real ecin(ip1jmp1, llm), convm(ip1jmp1, llm)
    REAL bern(ip1jmp1, llm)
    REAL massebxy(iim + 1, jjm, 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)

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