trunk/dyn3d/caldyn0.f90

module caldyn0_m

  IMPLICIT NONE

contains

  SUBROUTINE caldyn0(ucov, vcov, teta, ps, pk, phis, phi)

    ! From dyn3d/caldyn0.F, version 1.1.1.1, 2004/05/19 12:53:07
    ! Authors:  P. Le Van, F. Forget
    ! Objet : calcul des tendances dynamiques

    use bernoui_m, only: bernoui
    USE comgeom, ONLY: airesurg_2d
    use convmas_m, only: convmas
    use covcont_m, only: covcont
    USE dimensions, ONLY: iim, jjm, llm
    USE disvert_m, ONLY: ap, bp
    use dynetat0_m, only: 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

    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 (IN):: pk(iip1, jjp1, llm)
    REAL, INTENT (IN):: phis(ip1jmp1)
    REAL, INTENT (IN):: phi(iim + 1, jjm + 1, llm)

    ! Local:
    real masse(ip1jmp1, llm)
    REAL w(iim + 1, jjm + 1, llm)
    REAL pbaru(ip1jmp1, llm), pbarv((iim + 1) * jjm, llm)
    REAL vcont((iim + 1) * jjm, llm), ucont(ip1jmp1, llm)
    REAL 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 massebxy(iim + 1, jjm, llm), dp(iim + 1, jjm + 1)
    INTEGER l
    real ang, etot, ptot, ztot, stot, rmsdpdt, rmsv

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

    PRINT *, 'Call sequence information: caldyn0'

    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 convmas(pbaru, pbarv, convm)
    dp = convm(:, :, 1) / airesurg_2d
    w = vitvert(convm)
    CALL tourpot(vcov, ucov, massebxy, vorpot)
    CALL enercin(vcov, ucov, vcont, ucont, ecin)
    CALL sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, &
         bernoui(phi, ecin), dp, ang, etot, ptot, ztot, stot, rmsdpdt, rmsv)
    PRINT *, 'ptot = ', ptot
    PRINT *, 'etot = ', etot
    PRINT *, 'ztot = ', ztot
    PRINT *, 'stot = ', stot
    PRINT *, 'ang = ', ang
    etot0 = etot
    ptot0 = ptot
    ztot0 = ztot
    stot0 = stot
    ang0  = ang

  END SUBROUTINE caldyn0

end module caldyn0_m
1	guez	23	module caldyn0_m
2	guez	3
3	guez	23	IMPLICIT NONE
4	guez	4
5	guez	23	contains
6	guez	3
7	guez	163	SUBROUTINE caldyn0(ucov, vcov, teta, ps, pk, phis, phi)
8	guez	3
9	guez	91	! From dyn3d/caldyn0.F, version 1.1.1.1, 2004/05/19 12:53:07
10	guez	79	! Authors: P. Le Van, F. Forget
11	guez	78	! Objet : calcul des tendances dynamiques
12	guez	3
13	guez	104	use bernoui_m, only: bernoui
14	guez	252	USE comgeom, ONLY: airesurg_2d
15	guez	91	use convmas_m, only: convmas
16	guez	161	use covcont_m, only: covcont
17	guez	265	USE dimensions, ONLY: iim, jjm, llm
18	guez	78	USE disvert_m, ONLY: ap, bp
19	guez	259	use dynetat0_m, only: ang0, etot0, ptot0, stot0, ztot0
20	guez	207	use enercin_m, only: enercin
21	guez	78	use flumass_m, only: flumass
22	guez	91	use massbar_m, only: massbar
23	guez	78	use massbarxy_m, only: massbarxy
24	guez	67	use massdair_m, only: massdair
25	guez	79	USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1
26	guez	104	use sortvarc_m, only: sortvarc
27	guez	78	use tourpot_m, only: tourpot
28	guez	91	use vitvert_m, only: vitvert
29	guez	3
30	guez	79	REAL, INTENT(IN):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm) vent covariant
31			REAL, INTENT(IN):: vcov(:, :, :) ! (iim + 1, jjm, llm) ! vent covariant
32	guez	73	REAL, INTENT(IN):: teta(ip1jmp1, llm)
33	guez	78	REAL, INTENT (IN):: ps(ip1jmp1)
34			REAL, INTENT (IN):: pk(iip1, jjp1, llm)
35			REAL, INTENT (IN):: phis(ip1jmp1)
36	guez	104	REAL, INTENT (IN):: phi(iim + 1, jjm + 1, llm)
37	guez	3
38	guez	78	! Local:
39	guez	163	real masse(ip1jmp1, llm)
40			REAL w(iim + 1, jjm + 1, llm)
41			REAL pbaru(ip1jmp1, llm), pbarv((iim + 1) * jjm, llm)
42	guez	79	REAL vcont((iim + 1) * jjm, llm), ucont(ip1jmp1, llm)
43	guez	78	REAL p(ip1jmp1, llmp1)
44	guez	79	REAL massebx(ip1jmp1, llm), masseby((iim + 1) * jjm, llm)
45			REAL vorpot(iim + 1, jjm, llm)
46	guez	252	real ecin(iim + 1, jjm + 1, llm), convm(iim + 1, jjm + 1, llm)
47			REAL massebxy(iim + 1, jjm, llm), dp(iim + 1, jjm + 1)
48	guez	79	INTEGER l
49	guez	259	real ang, etot, ptot, ztot, stot, rmsdpdt, rmsv
50	guez	3
51	guez	23	!-----------------------------------------------------------------------
52	guez	3
53	guez	23	PRINT *, 'Call sequence information: caldyn0'
54	guez	3
55	guez	23	CALL covcont(llm, ucov, vcov, ucont, vcont)
56	guez	37	forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
57	guez	23	CALL massdair(p, masse)
58			CALL massbar(masse, massebx, masseby)
59			CALL massbarxy(masse, massebxy)
60			CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)
61			CALL convmas(pbaru, pbarv, convm)
62	guez	252	dp = convm(:, :, 1) / airesurg_2d
63			w = vitvert(convm)
64	guez	23	CALL tourpot(vcov, ucov, massebxy, vorpot)
65			CALL enercin(vcov, ucov, vcont, ucont, ecin)
66	guez	133	CALL sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, &
67	guez	259	bernoui(phi, ecin), dp, ang, etot, ptot, ztot, stot, rmsdpdt, rmsv)
68			PRINT *, 'ptot = ', ptot
69			PRINT *, 'etot = ', etot
70			PRINT *, 'ztot = ', ztot
71			PRINT *, 'stot = ', stot
72			PRINT *, 'ang = ', ang
73			etot0 = etot
74			ptot0 = ptot
75			ztot0 = ztot
76			stot0 = stot
77			ang0 = ang
78	guez	23
79			END SUBROUTINE caldyn0
80
81			end module caldyn0_m