Sources/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, 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(ip1jmp1)
    REAL, INTENT(out):: w(:, :, :) ! (iim + 1, jjm + 1, llm)
    REAL, intent(out):: pbaru(ip1jmp1, llm), 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(ip1jmp1, 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
    CALL vitvert(convm, w)
    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	78	USE comgeom, ONLY: airesurg, 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	46	real, INTENT(out):: dp(ip1jmp1)
51	guez	91	REAL, INTENT(out):: w(:, :, :) ! (iim + 1, jjm + 1, llm)
52	guez	79	REAL, intent(out):: pbaru(ip1jmp1, llm), pbarv((iim + 1) * jjm, llm)
53	guez	70	LOGICAL, INTENT(IN):: conser
54	guez	3
55	guez	43	! Local:
56	guez	79	REAL vcont((iim + 1) * jjm, llm), ucont(ip1jmp1, llm)
57	guez	104	REAL ang_3d(iim + 1, jjm + 1, llm), p(ip1jmp1, llmp1)
58	guez	79	REAL massebx(ip1jmp1, llm), masseby((iim + 1) * jjm, llm)
59			REAL vorpot(iim + 1, jjm, llm)
60	guez	104	real ecin(iim + 1, jjm + 1, llm), convm(ip1jmp1, llm)
61			REAL bern(iim + 1, jjm + 1, llm)
62	guez	79	REAL massebxy(iim + 1, jjm, llm)
63	guez	43	INTEGER ij, l
64	guez	104	real heure, time
65	guez	3
66	guez	43	!-----------------------------------------------------------------------
67	guez	3
68	guez	43	CALL covcont(llm, ucov, vcov, ucont, vcont)
69			forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
70			CALL massdair(p, masse)
71			CALL massbar(masse, massebx, masseby)
72			CALL massbarxy(masse, massebxy)
73			CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)
74			CALL dteta1(teta, pbaru, pbarv, dteta)
75			CALL convmas(pbaru, pbarv, convm)
76	guez	46	dp = convm(:, 1) / airesurg
77	guez	43	CALL vitvert(convm, w)
78			CALL tourpot(vcov, ucov, massebxy, vorpot)
79	guez	91	CALL dudv1(vorpot, pbaru, pbarv, dudyn(:, 2: jjm, :), dv)
80	guez	43	CALL enercin(vcov, ucov, vcont, ucont, ecin)
81	guez	133	bern = bernoui(phi, ecin)
82	guez	47	CALL dudv2(teta, pkf, bern, dudyn, dv)
83	guez	3
84	guez	104	forall (l = 1: llm) ang_3d(:, :, l) = ucov(:, :, l) + constang_2d
85			CALL advect(ang_3d, vcov, teta, w, massebx, masseby, dudyn, dv, dteta)
86	guez	3
87	guez	91	! Warning problème de périodicité de dv sur les PC Linux. Problème
88			! d'arrondi probablement. Observé sur le code compilé avec pgf90
89			! 3.0-1.
90	guez	43	DO l = 1, llm
91	guez	79	DO ij = 1, (iim + 1) * jjm, iip1
92	guez	43	IF (dv(ij, l)/=dv(ij+iim, l)) THEN
93			dv(ij+iim, l) = dv(ij, l)
94			END IF
95			END DO
96			END DO
97
98	guez	88	! Sorties éventuelles des variables de contrôle :
99	guez	104	IF (conser) then
100			CALL sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, &
101			resetvarc = .false.)
102	guez	128	time = real(itau) / day_step
103	guez	104	heure = mod(itau * dtvr / daysec, 1.) * 24.
104			IF (abs(heure-24.) <= 1e-4) heure = 0.
105	guez	43
106	guez	104	PRINT 3500, itau, int(day_ini + time), heure, time
107			PRINT 4000, ptot, rmsdpdt, etot, ztot, stot, rmsv, ang
108			end IF
109
110			3500 FORMAT (4X, 'pas', I7, 5X, 'jour', i5, 1X, 'heure', F5.1, 4X, 'date', &
111			F10.5)
112			4000 FORMAT (10X, 'masse', 4X, 'rmsdpdt', 7X, 'energie', 2X, 'enstrophie', &
113			2X, 'entropie', 3X, 'rmsv', 4X, 'mt.ang', /, 'GLOB ', F10.6, &
114			E13.6, 5F10.3/)
115
116	guez	43	END SUBROUTINE caldyn
117
118			end module caldyn_m