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