trunk/dyn3d/caldyn.f

module caldyn_m

  IMPLICIT NONE

contains

  SUBROUTINE caldyn(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &
       du, 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 dimensions, 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, ang0, etot0, ptot0, stot0, ztot0
    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
    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 du(:, :, :) ! (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
    real ang, etot, ptot, ztot, stot, rmsdpdt, rmsv

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

    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, du(:, 2: jjm, :), dv)
    CALL enercin(vcov, ucov, vcont, ucont, ecin)
    bern = bernoui(phi, ecin)
    CALL dudv2(teta, pkf, bern, du, dv)

    forall (l = 1: llm) ang_3d(:, :, l) = ucov(:, :, l) + constang_2d
    CALL advect(ang_3d, vcov, teta, w, massebx, masseby, du, 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, &
            ang, etot, ptot, ztot, stot, rmsdpdt, rmsv)

       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 / ptot0, rmsdpdt, etot / etot0, ztot / ztot0, &
            stot / stot0, sqrt(rmsv / ptot), ang / ang0
    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	260	du, 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	265	USE dimensions, 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	259	USE dynetat0_m, ONLY: day_ini, ang0, etot0, ptot0, stot0, ztot0
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	259	use sortvarc_m, only: sortvarc
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	260	REAL du(:, :, :) ! (iim + 1, jjm + 1, llm)
48	guez	88	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	259	real ang, etot, ptot, ztot, stot, rmsdpdt, rmsv
67	guez	3
68	guez	43	!-----------------------------------------------------------------------
69	guez	3
70	guez	43	CALL covcont(llm, ucov, vcov, ucont, vcont)
71			forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
72			CALL massdair(p, masse)
73			CALL massbar(masse, massebx, masseby)
74			CALL massbarxy(masse, massebxy)
75			CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)
76			CALL dteta1(teta, pbaru, pbarv, dteta)
77			CALL convmas(pbaru, pbarv, convm)
78	guez	252	dp = convm(:, :, 1) / airesurg_2d
79			w = vitvert(convm)
80	guez	43	CALL tourpot(vcov, ucov, massebxy, vorpot)
81	guez	260	CALL dudv1(vorpot, pbaru, pbarv, du(:, 2: jjm, :), dv)
82	guez	43	CALL enercin(vcov, ucov, vcont, ucont, ecin)
83	guez	133	bern = bernoui(phi, ecin)
84	guez	260	CALL dudv2(teta, pkf, bern, du, dv)
85	guez	3
86	guez	104	forall (l = 1: llm) ang_3d(:, :, l) = ucov(:, :, l) + constang_2d
87	guez	260	CALL advect(ang_3d, vcov, teta, w, massebx, masseby, du, dv, dteta)
88	guez	3
89	guez	91	! Warning problème de périodicité de dv sur les PC Linux. Problème
90			! d'arrondi probablement. Observé sur le code compilé avec pgf90
91			! 3.0-1.
92	guez	43	DO l = 1, llm
93	guez	79	DO ij = 1, (iim + 1) * jjm, iip1
94	guez	43	IF (dv(ij, l)/=dv(ij+iim, l)) THEN
95			dv(ij+iim, l) = dv(ij, l)
96			END IF
97			END DO
98			END DO
99
100	guez	88	! Sorties éventuelles des variables de contrôle :
101	guez	104	IF (conser) then
102			CALL sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, &
103	guez	259	ang, etot, ptot, ztot, stot, rmsdpdt, rmsv)
104
105	guez	128	time = real(itau) / day_step
106	guez	104	heure = mod(itau * dtvr / daysec, 1.) * 24.
107			IF (abs(heure-24.) <= 1e-4) heure = 0.
108	guez	43
109	guez	104	PRINT 3500, itau, int(day_ini + time), heure, time
110	guez	259	PRINT 4000, ptot / ptot0, rmsdpdt, etot / etot0, ztot / ztot0, &
111			stot / stot0, sqrt(rmsv / ptot), ang / ang0
112	guez	104	end IF
113
114			3500 FORMAT (4X, 'pas', I7, 5X, 'jour', i5, 1X, 'heure', F5.1, 4X, 'date', &
115			F10.5)
116			4000 FORMAT (10X, 'masse', 4X, 'rmsdpdt', 7X, 'energie', 2X, 'enstrophie', &
117			2X, 'entropie', 3X, 'rmsv', 4X, 'mt.ang', /, 'GLOB ', F10.6, &
118			E13.6, 5F10.3/)
119
120	guez	43	END SUBROUTINE caldyn
121
122			end module caldyn_m