GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/homogene.F90 Lines: 0 5 0.0 %
Date: 2023-06-30 12:51:15 Branches: 0 4 0.0 %

Line Branch Exec Source
1
2
! $Header$
3
4
SUBROUTINE homogene(paprs, q, dq, u, v, du, dv)
5
  USE dimphy
6
  IMPLICIT NONE
7
  ! ==============================================================
8
  ! Schema ad hoc du melange vertical pour les vitesses u et v,
9
  ! a appliquer apres le schema de convection (fiajc et fiajh).
10
11
  ! paprs:input, pression demi-couche (inter-couche)
12
  ! q:    input, vapeur d'eau (kg/kg)
13
  ! dq:   input, incrementation de vapeur d'eau (de la convection)
14
  ! u:    input, vitesse u
15
  ! v:    input, vitesse v
16
17
  ! du:   output, incrementation pour u
18
  ! dv:   output, incrementation pour v
19
  ! ==============================================================
20
21
  REAL paprs(klon, klev+1)
22
  REAL q(klon, klev), dq(klon, klev)
23
  REAL u(klon, klev), du(klon, klev)
24
  REAL v(klon, klev), dv(klon, klev)
25
26
  REAL zm_dq(klon) ! quantite totale de l'eau deplacee
27
  REAL zm_q(klon) ! quantite totale de la vapeur d'eau
28
  REAL zm_u(klon) ! moyenne de u (brassage parfait et total)
29
  REAL zm_v(klon) ! moyenne de v (brassage parfait et total)
30
  REAL z_frac(klon) ! fraction du brassage parfait et total
31
  REAL zm_dp(klon)
32
33
  REAL zx
34
  INTEGER i, k
35
  REAL frac_max
36
  PARAMETER (frac_max=0.1)
37
  REAL seuil
38
  PARAMETER (seuil=1.0E-10)
39
  LOGICAL faisrien
40
  PARAMETER (faisrien=.TRUE.)
41
42
  DO k = 1, klev
43
    DO i = 1, klon
44
      du(i, k) = 0.0
45
      dv(i, k) = 0.0
46
    END DO
47
  END DO
48
49
  IF (faisrien) RETURN
50
51
  DO i = 1, klon
52
    zm_dq(i) = 0.
53
    zm_q(i) = 0.
54
    zm_u(i) = 0.
55
    zm_v(i) = 0.
56
    zm_dp(i) = 0.
57
  END DO
58
  DO k = 1, klev
59
    DO i = 1, klon
60
      IF (abs(dq(i,k))>seuil) THEN
61
        zx = paprs(i, k) - paprs(i, k+1)
62
        zm_dq(i) = zm_dq(i) + abs(dq(i,k))*zx
63
        zm_q(i) = zm_q(i) + q(i, k)*zx
64
        zm_dp(i) = zm_dp(i) + zx
65
        zm_u(i) = zm_u(i) + u(i, k)*zx
66
        zm_v(i) = zm_v(i) + v(i, k)*zx
67
      END IF
68
    END DO
69
  END DO
70
71
  ! Hypothese principale: apres la convection, la vitesse de chaque
72
  ! couche est composee de deux parties: celle (1-z_frac) de la vitesse
73
  ! original et celle (z_frac) de la vitesse moyenne qui serait la
74
  ! vitesse de chaque couche si le brassage etait parfait et total.
75
  ! La fraction du brassage est calculee par le rapport entre la quantite
76
  ! totale de la vapeur d'eau deplacee (ou condensee) et la quantite
77
  ! totale de la vapeur d'eau. Et cette fraction est limitee a frac_max
78
  ! (Est-ce vraiment raisonnable ? Z.X. Li, le 07-09-1995).
79
80
  DO i = 1, klon
81
    IF (zm_dp(i)>=1.0E-15 .AND. zm_q(i)>=1.0E-15) THEN
82
      z_frac(i) = min(frac_max, zm_dq(i)/zm_q(i))
83
      zm_u(i) = zm_u(i)/zm_dp(i)
84
      zm_v(i) = zm_v(i)/zm_dp(i)
85
    END IF
86
  END DO
87
  DO k = 1, klev
88
    DO i = 1, klon
89
      IF (zm_dp(i)>=1.E-15 .AND. zm_q(i)>=1.E-15 .AND. abs(dq(i, &
90
          k))>seuil) THEN
91
        du(i, k) = u(i, k)*(1.-z_frac(i)) + zm_u(i)*z_frac(i) - u(i, k)
92
        dv(i, k) = v(i, k)*(1.-z_frac(i)) + zm_v(i)*z_frac(i) - v(i, k)
93
      END IF
94
    END DO
95
  END DO
96
97
  RETURN
98
END SUBROUTINE homogene