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, conser)

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

    use advect_m, only: advect
    use bernoui_m, only: bernoui
    USE comconst, ONLY: daysec, dtvr
    USE comgeom, ONLY: airesurg_2d, constang_2d
    USE conf_gcm_m, ONLY: day_step
    use convmas_m, only: convmas
    use covcont_m, only: covcont
    USE dimens_m, ONLY: iim, jjm, llm
    USE disvert_m, ONLY: ap, bp
    use dteta1_m, only: dteta1
    use dudv1_m, only: dudv1
    use dudv2_m, only: dudv2
    USE dynetat0_m, ONLY: day_ini
    use enercin_m, only: enercin
    use flumass_m, only: flumass
    use massbar_m, only: massbar
    use massbarxy_m, only: massbarxy
    use massdair_m, only: massdair
    USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1
    use sortvarc_m, only: sortvarc, ang, etot, ptot, rmsdpdt, rmsv, stot, ztot
    use tourpot_m, only: tourpot
    use vitvert_m, only: vitvert

    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(:, :, :) ! (iim + 1, jjm + 1, llm)
    REAL, INTENT (IN):: ps(ip1jmp1)
    real, intent(out):: masse(ip1jmp1, llm)
    REAL, INTENT(IN):: pk(iip1, jjp1, llm)
    REAL, INTENT(IN):: pkf(ip1jmp1, llm)
    REAL, INTENT(IN):: phis(ip1jmp1)
    REAL, INTENT(IN):: phi(iim + 1, jjm + 1, llm)
    REAL dudyn(:, :, :) ! (iim + 1, jjm + 1, llm)
    real dv((iim + 1) * jjm, llm)
    REAL, INTENT(out):: dteta(:, :, :) ! (iim + 1, jjm + 1, llm)
    real, INTENT(out):: dp(:, :) ! (iim + 1, jjm + 1)
    REAL, INTENT(out):: w(:, :, :) ! (iim + 1, jjm + 1, llm)
    REAL, intent(out):: pbaru(:, :, :) ! (iim + 1, jjm + 1, llm)
    REAL, intent(out):: pbarv(:, :, :) ! (iim + 1, jjm, llm)
    LOGICAL, INTENT(IN):: conser

    ! Local:
    REAL vcont((iim + 1) * jjm, llm), ucont(ip1jmp1, llm)
    REAL ang_3d(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(iim + 1, jjm + 1, llm), convm(iim + 1, jjm + 1, llm)
    REAL bern(iim + 1, jjm + 1, llm)
    REAL massebxy(iim + 1, jjm, llm)
    INTEGER ij, l
    real heure, time

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

    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_2d
    w = vitvert(convm)
    CALL tourpot(vcov, ucov, massebxy, vorpot)
    CALL dudv1(vorpot, pbaru, pbarv, dudyn(:, 2: jjm, :), dv)
    CALL enercin(vcov, ucov, vcont, ucont, ecin)
    bern = bernoui(phi, ecin)
    CALL dudv2(teta, pkf, bern, dudyn, dv)

    forall (l = 1: llm) ang_3d(:, :, l) = ucov(:, :, l) + constang_2d
    CALL advect(ang_3d, vcov, teta, w, massebx, masseby, dudyn, dv, dteta)

    ! Warning problème de périodicité de dv sur les PC Linux. Problème
    ! d'arrondi probablement. Observé sur le code compilé 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 éventuelles des variables de contrôle :
    IF (conser) then
       CALL sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, &
            resetvarc = .false.)
       time = real(itau) / day_step
       heure = mod(itau * dtvr / daysec, 1.) * 24.
       IF (abs(heure-24.) <= 1e-4) heure = 0.

       PRINT 3500, itau, int(day_ini + time), heure, time
       PRINT 4000, ptot, rmsdpdt, etot, ztot, stot, rmsv, ang
    end IF

3500 FORMAT (4X, 'pas', I7, 5X, 'jour', i5, 1X, 'heure', F5.1, 4X, 'date', &
         F10.5)
4000 FORMAT (10X, 'masse', 4X, 'rmsdpdt', 7X, 'energie', 2X, 'enstrophie', &
         2X, 'entropie', 3X, 'rmsv', 4X, 'mt.ang', /, 'GLOB  ', F10.6, &
         E13.6, 5F10.3/)

  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	128	dudyn, dv, dteta, dp, w, pbaru, pbarv, conser)
9	guez	3
10	guez	88	! From dyn3d/caldyn.F, version 1.1.1.1, 2004/05/19 12:53:06
11			! Author: P. Le Van
12	guez	43	! Objet : calcul des tendances dynamiques
13	guez	3
14	guez	46	use advect_m, only: advect
15	guez	104	use bernoui_m, only: bernoui
16			USE comconst, ONLY: daysec, dtvr
17	guez	252	USE comgeom, ONLY: airesurg_2d, constang_2d
18	guez	104	USE conf_gcm_m, ONLY: day_step
19	guez	91	use convmas_m, only: convmas
20	guez	161	use covcont_m, only: covcont
21	guez	78	USE dimens_m, ONLY: iim, jjm, llm
22	guez	70	USE disvert_m, ONLY: ap, bp
23	guez	88	use dteta1_m, only: dteta1
24			use dudv1_m, only: dudv1
25			use dudv2_m, only: dudv2
26	guez	104	USE dynetat0_m, ONLY: day_ini
27	guez	207	use enercin_m, only: enercin
28	guez	78	use flumass_m, only: flumass
29	guez	91	use massbar_m, only: massbar
30	guez	78	use massbarxy_m, only: massbarxy
31	guez	67	use massdair_m, only: massdair
32	guez	79	USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1
33	guez	104	use sortvarc_m, only: sortvarc, ang, etot, ptot, rmsdpdt, rmsv, stot, ztot
34	guez	78	use tourpot_m, only: tourpot
35	guez	91	use vitvert_m, only: vitvert
36	guez	3
37	guez	46	INTEGER, INTENT(IN):: itau
38	guez	78	REAL, INTENT(IN):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm) vent covariant
39	guez	138	REAL, INTENT(IN):: vcov(:, :, :) ! (iim + 1, jjm, llm) vent covariant
40			REAL, INTENT(IN):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
41	guez	79	REAL, INTENT (IN):: ps(ip1jmp1)
42	guez	70	real, intent(out):: masse(ip1jmp1, llm)
43	guez	46	REAL, INTENT(IN):: pk(iip1, jjp1, llm)
44	guez	88	REAL, INTENT(IN):: pkf(ip1jmp1, llm)
45	guez	70	REAL, INTENT(IN):: phis(ip1jmp1)
46	guez	104	REAL, INTENT(IN):: phi(iim + 1, jjm + 1, llm)
47	guez	88	REAL dudyn(:, :, :) ! (iim + 1, jjm + 1, llm)
48			real dv((iim + 1) * jjm, llm)
49	guez	138	REAL, INTENT(out):: dteta(:, :, :) ! (iim + 1, jjm + 1, llm)
50	guez	252	real, INTENT(out):: dp(:, :) ! (iim + 1, jjm + 1)
51	guez	91	REAL, INTENT(out):: w(:, :, :) ! (iim + 1, jjm + 1, llm)
52	guez	252	REAL, intent(out):: pbaru(:, :, :) ! (iim + 1, jjm + 1, llm)
53			REAL, intent(out):: pbarv(:, :, :) ! (iim + 1, jjm, llm)
54	guez	70	LOGICAL, INTENT(IN):: conser
55	guez	3
56	guez	43	! Local:
57	guez	79	REAL vcont((iim + 1) * jjm, llm), ucont(ip1jmp1, llm)
58	guez	104	REAL ang_3d(iim + 1, jjm + 1, llm), p(ip1jmp1, llmp1)
59	guez	79	REAL massebx(ip1jmp1, llm), masseby((iim + 1) * jjm, llm)
60			REAL vorpot(iim + 1, jjm, llm)
61	guez	252	real ecin(iim + 1, jjm + 1, llm), convm(iim + 1, jjm + 1, llm)
62	guez	104	REAL bern(iim + 1, jjm + 1, llm)
63	guez	79	REAL massebxy(iim + 1, jjm, llm)
64	guez	43	INTEGER ij, l
65	guez	104	real heure, time
66	guez	3
67	guez	43	!-----------------------------------------------------------------------
68	guez	3
69	guez	43	CALL covcont(llm, ucov, vcov, ucont, vcont)
70			forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
71			CALL massdair(p, masse)
72			CALL massbar(masse, massebx, masseby)
73			CALL massbarxy(masse, massebxy)
74			CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)
75			CALL dteta1(teta, pbaru, pbarv, dteta)
76			CALL convmas(pbaru, pbarv, convm)
77	guez	252	dp = convm(:, :, 1) / airesurg_2d
78			w = vitvert(convm)
79	guez	43	CALL tourpot(vcov, ucov, massebxy, vorpot)
80	guez	91	CALL dudv1(vorpot, pbaru, pbarv, dudyn(:, 2: jjm, :), dv)
81	guez	43	CALL enercin(vcov, ucov, vcont, ucont, ecin)
82	guez	133	bern = bernoui(phi, ecin)
83	guez	47	CALL dudv2(teta, pkf, bern, dudyn, dv)
84	guez	3
85	guez	104	forall (l = 1: llm) ang_3d(:, :, l) = ucov(:, :, l) + constang_2d
86			CALL advect(ang_3d, vcov, teta, w, massebx, masseby, dudyn, dv, dteta)
87	guez	3
88	guez	91	! Warning problème de périodicité de dv sur les PC Linux. Problème
89			! d'arrondi probablement. Observé sur le code compilé avec pgf90
90			! 3.0-1.
91	guez	43	DO l = 1, llm
92	guez	79	DO ij = 1, (iim + 1) * jjm, iip1
93	guez	43	IF (dv(ij, l)/=dv(ij+iim, l)) THEN
94			dv(ij+iim, l) = dv(ij, l)
95			END IF
96			END DO
97			END DO
98
99	guez	88	! Sorties éventuelles des variables de contrôle :
100	guez	104	IF (conser) then
101			CALL sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, &
102			resetvarc = .false.)
103	guez	128	time = real(itau) / day_step
104	guez	104	heure = mod(itau * dtvr / daysec, 1.) * 24.
105			IF (abs(heure-24.) <= 1e-4) heure = 0.
106	guez	43
107	guez	104	PRINT 3500, itau, int(day_ini + time), heure, time
108			PRINT 4000, ptot, rmsdpdt, etot, ztot, stot, rmsv, ang
109			end IF
110
111			3500 FORMAT (4X, 'pas', I7, 5X, 'jour', i5, 1X, 'heure', F5.1, 4X, 'date', &
112			F10.5)
113			4000 FORMAT (10X, 'masse', 4X, 'rmsdpdt', 7X, 'energie', 2X, 'enstrophie', &
114			2X, 'entropie', 3X, 'rmsv', 4X, 'mt.ang', /, 'GLOB ', F10.6, &
115			E13.6, 5F10.3/)
116
117	guez	43	END SUBROUTINE caldyn
118
119			end module caldyn_m