GCC Code Coverage Report


Directory: ./
File: phys/cvltrorig.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 57 0.0%
Branches: 0 64 0.0%

Line Branch Exec Source
1 !
2 ! $Id $
3 !
4 SUBROUTINE cvltrorig(it,pdtime,da, phi, mp,paprs,pplay,x,upd,dnd,dx)
5 USE dimphy
6 USE infotrac_phy, ONLY : nbtr
7 IMPLICIT NONE
8 !=====================================================================
9 ! Objet : convection des traceurs / KE
10 ! Auteurs: M-A Filiberti and J-Y Grandpeix
11 !=====================================================================
12 include "YOMCST.h"
13 include "YOECUMF.h"
14
15 ! Entree
16 REAL,INTENT(IN) :: pdtime
17 INTEGER, INTENT(IN) :: it
18 REAL,DIMENSION(klon,klev),INTENT(IN) :: da
19 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi
20 REAL,DIMENSION(klon,klev),INTENT(IN) :: mp
21 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression aux 1/2 couches (bas en haut)
22 REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le milieu de chaque couche
23 REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: x ! q de traceur (bas en haut)
24 REAL,DIMENSION(klon,klev),INTENT(IN) :: upd ! saturated updraft mass flux
25 REAL,DIMENSION(klon,klev),INTENT(IN) :: dnd ! saturated downdraft mass flux
26
27 ! Sortie
28 REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: dx ! tendance de traceur (bas en haut)
29
30 ! Variables locales
31 ! REAL,DIMENSION(klon,klev) :: zed
32 REAL,DIMENSION(klon,klev,klev) :: zmd
33 REAL,DIMENSION(klon,klev,klev) :: za
34 REAL,DIMENSION(klon,klev) :: zmfd,zmfa
35 REAL,DIMENSION(klon,klev) :: zmfp,zmfu
36 REAL,DIMENSION(klon,klev) :: deltap
37 INTEGER :: i,k,j
38 REAL :: pdtimeRG
39 !! real conserv
40
41 ! =========================================
42 ! calcul des tendances liees au downdraft
43 ! =========================================
44 !cdir collapse
45 DO j=1,klev
46 DO i=1,klon
47 ! zed(i,j)=0.
48 zmfd(i,j)=0.
49 zmfa(i,j)=0.
50 zmfu(i,j)=0.
51 zmfp(i,j)=0.
52 END DO
53 END DO
54 !cdir collapse
55 DO k=1,klev
56 DO j=1,klev
57 DO i=1,klon
58 zmd(i,j,k)=0.
59 za (i,j,k)=0.
60 END DO
61 END DO
62 END DO
63 ! entrainement
64 ! DO k=1,klev-1
65 ! DO i=1,klon
66 ! zed(i,k)=max(0.,mp(i,k)-mp(i,k+1))
67 ! END DO
68 ! END DO
69
70 ! calcul de la matrice d echange
71 ! matrice de distribution de la masse entrainee en k
72
73 DO k=1,klev-1
74 DO i=1,klon
75 zmd(i,k,k)=max(0.,mp(i,k)-mp(i,k+1))
76 END DO
77 END DO
78 DO k=2,klev
79 DO j=k-1,1,-1
80 DO i=1,klon
81 if(mp(i,j+1).ne.0) then
82 zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1))
83 ENDif
84 END DO
85 END DO
86 END DO
87 DO k=1,klev
88 DO j=1,klev-1
89 DO i=1,klon
90 za(i,j,k)=max(0.,zmd(i,j+1,k)-zmd(i,j,k))
91 END DO
92 END DO
93 END DO
94 !
95 ! rajout du terme lie a l ascendance induite
96 !
97 DO j=2,klev
98 DO i=1,klon
99 za(i,j,j-1)=za(i,j,j-1)+mp(i,j)
100 END DO
101 END DO
102 !
103 ! tendances
104 !
105 DO k=1,klev
106 DO j=1,klev
107 DO i=1,klon
108 zmfd(i,j)=zmfd(i,j)+za(i,j,k)*(x(i,k,it)-x(i,j,it))
109 END DO
110 END DO
111 END DO
112 !
113 ! =========================================
114 ! calcul des tendances liees aux flux satures
115 ! =========================================
116 DO j=1,klev
117 DO i=1,klon
118 zmfa(i,j)=da(i,j)*(x(i,1,it)-x(i,j,it))
119 END DO
120 END DO
121 DO k=1,klev
122 DO j=1,klev
123 DO i=1,klon
124 zmfp(i,j)=zmfp(i,j)+phi(i,j,k)*(x(i,k,it)-x(i,j,it))
125 END DO
126 END DO
127 END DO
128 DO j=1,klev-1
129 DO i=1,klon
130 zmfu(i,j)=max(0.,upd(i,j+1)+dnd(i,j+1))*(x(i,j+1,it)-x(i,j,it))
131 END DO
132 END DO
133 DO j=2,klev
134 DO i=1,klon
135 zmfu(i,j)=zmfu(i,j)+min(0.,upd(i,j)+dnd(i,j))*(x(i,j,it)-x(i,j-1,it))
136 END DO
137 END DO
138
139 ! =========================================
140 ! calcul final des tendances
141 ! =========================================
142 DO k=1, klev
143 DO i=1, klon
144 deltap(i,k)=paprs(i,k)-paprs(i,k+1)
145 ENDDO
146 ENDDO
147 pdtimeRG=pdtime*RG
148 !cdir collapse
149 DO k=1, klev
150 DO i=1, klon
151 dx(i,k,it)=(zmfd(i,k)+zmfu(i,k) &
152 +zmfa(i,k)+zmfp(i,k))*pdtimeRG/deltap(i,k)
153 ENDDO
154 ENDDO
155
156 ! test de conservation du traceur
157 ! conserv=0.
158 ! DO k=1, klev
159 ! DO i=1, klon
160 ! conserv=conserv+dx(i,k,it)* &
161 ! deltap(i,k)/RG
162 ! ENDDO
163 ! ENDDO
164 ! print *,'it',it,'cvltrorig conserv',conserv
165
166 END SUBROUTINE cvltrorig
167