trunk/dyn3d/caldyn.f

SUBROUTINE caldyn(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &
     conser, du, dv, dteta, dp, w, pbaru, pbarv, time_0)

  ! From dyn3d/caldyn.F, v 1.1.1.1 2004/05/19 12:53:06
  !  Auteur :  P. Le Van
  !   Objet:
  !   Calcul des tendances dynamiques.

  USE dimens_m, ONLY : iim, llm
  USE paramet_m, ONLY : iip1, ip1jm, ip1jmp1, jjp1, llmp1
  USE comvert, ONLY : ap, bp
  USE comgeom, ONLY : airesurg, constang
  use sortvarc_m, only: sortvarc

  IMPLICIT NONE

  !   Arguments:

  LOGICAL, INTENT (IN):: conser
  INTEGER, INTENT (IN):: itau
  REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)
  REAL ps(ip1jmp1), phis(ip1jmp1)
  REAL, INTENT (IN) :: pk(iip1, jjp1, llm)
  REAL pkf(ip1jmp1, llm)
  REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)
  REAL phi(ip1jmp1, llm), masse(ip1jmp1, llm)
  REAL dv(ip1jm, llm), du(ip1jmp1, llm)
  REAL dteta(ip1jmp1, llm), dp(ip1jmp1)
  REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
  REAL, intent(in):: time_0

  !   Local:

  REAL ang(ip1jmp1, llm), p(ip1jmp1, llmp1)
  REAL massebx(ip1jmp1, llm), masseby(ip1jm, llm), psexbarxy(ip1jm)
  REAL vorpot(ip1jm, llm)
  REAL w(ip1jmp1, llm), ecin(ip1jmp1, llm), convm(ip1jmp1, llm)
  REAL bern(ip1jmp1, llm)
  REAL massebxy(ip1jm, llm)

  INTEGER ij, l

  !-----------------------------------------------------------------------
  !   Calcul des tendances dynamiques:

  CALL covcont(llm, ucov, vcov, ucont, vcont)
  forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
  CALL psextbar(ps, psexbarxy)
  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)

  DO ij = 1, ip1jmp1
     dp(ij) = convm(ij, 1)/airesurg(ij)
  END DO

  CALL vitvert(convm, w)
  CALL tourpot(vcov, ucov, massebxy, vorpot)
  CALL dudv1(vorpot, pbaru, pbarv, du, dv)
  CALL enercin(vcov, ucov, vcont, ucont, ecin)
  CALL bernoui(ip1jmp1, llm, phi, ecin, bern)
  CALL dudv2(teta, pkf, bern, du, dv)


  DO l = 1, llm
     DO ij = 1, ip1jmp1
        ang(ij, l) = ucov(ij, l) + constang(ij)
     END DO
  END DO


  CALL advect(ang, vcov, teta, w, massebx, masseby, du, dv, dteta, conser)

  !  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
  !          probablement. Observe sur le code compile avec pgf90 3.0-1
  DO l = 1, llm
     DO ij = 1, ip1jm, iip1
        IF (dv(ij, l)/=dv(ij+iim, l)) THEN
           dv(ij+iim, l) = dv(ij, l)
        END IF
     END DO
  END DO

  !   Sorties eventuelles des variables de controle:
  IF (conser) CALL sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, &
       phi, bern, dp, time_0)

END SUBROUTINE caldyn
1	guez	25	SUBROUTINE caldyn(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &
2	guez	33	conser, du, dv, dteta, dp, w, pbaru, pbarv, time_0)
3	guez	3
4	guez	25	! From dyn3d/caldyn.F, v 1.1.1.1 2004/05/19 12:53:06
5			! Auteur : P. Le Van
6			! Objet:
7			! Calcul des tendances dynamiques.
8	guez	3
9	guez	33	USE dimens_m, ONLY : iim, llm
10			USE paramet_m, ONLY : iip1, ip1jm, ip1jmp1, jjp1, llmp1
11			USE comvert, ONLY : ap, bp
12			USE comgeom, ONLY : airesurg, constang
13			use sortvarc_m, only: sortvarc
14	guez	3
15	guez	25	IMPLICIT NONE
16	guez	3
17	guez	25	! Arguments:
18	guez	3
19	guez	25	LOGICAL, INTENT (IN):: conser
20			INTEGER, INTENT (IN):: itau
21			REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)
22			REAL ps(ip1jmp1), phis(ip1jmp1)
23			REAL, INTENT (IN) :: pk(iip1, jjp1, llm)
24			REAL pkf(ip1jmp1, llm)
25			REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)
26			REAL phi(ip1jmp1, llm), masse(ip1jmp1, llm)
27			REAL dv(ip1jm, llm), du(ip1jmp1, llm)
28			REAL dteta(ip1jmp1, llm), dp(ip1jmp1)
29			REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
30	guez	33	REAL, intent(in):: time_0
31	guez	3
32	guez	25	! Local:
33	guez	3
34	guez	25	REAL ang(ip1jmp1, llm), p(ip1jmp1, llmp1)
35			REAL massebx(ip1jmp1, llm), masseby(ip1jm, llm), psexbarxy(ip1jm)
36			REAL vorpot(ip1jm, llm)
37			REAL w(ip1jmp1, llm), ecin(ip1jmp1, llm), convm(ip1jmp1, llm)
38			REAL bern(ip1jmp1, llm)
39			REAL massebxy(ip1jm, llm)
40	guez	3
41	guez	25	INTEGER ij, l
42	guez	3
43	guez	25	!-----------------------------------------------------------------------
44			! Calcul des tendances dynamiques:
45	guez	3
46	guez	25	CALL covcont(llm, ucov, vcov, ucont, vcont)
47	guez	37	forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
48	guez	25	CALL psextbar(ps, psexbarxy)
49			CALL massdair(p, masse)
50			CALL massbar(masse, massebx, masseby)
51			CALL massbarxy(masse, massebxy)
52			CALL flumass(massebx, masseby, vcont, ucont, pbaru, pbarv)
53			CALL dteta1(teta, pbaru, pbarv, dteta)
54			CALL convmas(pbaru, pbarv, convm)
55	guez	3
56	guez	25	DO ij = 1, ip1jmp1
57			dp(ij) = convm(ij, 1)/airesurg(ij)
58			END DO
59	guez	3
60	guez	25	CALL vitvert(convm, w)
61			CALL tourpot(vcov, ucov, massebxy, vorpot)
62			CALL dudv1(vorpot, pbaru, pbarv, du, dv)
63			CALL enercin(vcov, ucov, vcont, ucont, ecin)
64			CALL bernoui(ip1jmp1, llm, phi, ecin, bern)
65			CALL dudv2(teta, pkf, bern, du, dv)
66	guez	3
67
68	guez	25	DO l = 1, llm
69			DO ij = 1, ip1jmp1
70			ang(ij, l) = ucov(ij, l) + constang(ij)
71			END DO
72			END DO
73	guez	3
74
75	guez	25	CALL advect(ang, vcov, teta, w, massebx, masseby, du, dv, dteta, conser)
76	guez	3
77	guez	25	! WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
78			! probablement. Observe sur le code compile avec pgf90 3.0-1
79			DO l = 1, llm
80			DO ij = 1, ip1jm, iip1
81			IF (dv(ij, l)/=dv(ij+iim, l)) THEN
82			dv(ij+iim, l) = dv(ij, l)
83			END IF
84			END DO
85			END DO
86	guez	3
87	guez	25	! Sorties eventuelles des variables de controle:
88	guez	32	IF (conser) CALL sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, &
89	guez	33	phi, bern, dp, time_0)
90	guez	3
91	guez	25	END SUBROUTINE caldyn