GCC Code Coverage Report

Directory: ./
File: phys/tend_to_tke.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 37 37 100.0%
Branches: 56 56 100.0%
Line Branch Exec Source
1 !***************************************************************************************
2 ! tend_to_tke.F90
3 !*************
4 !
5 ! Subroutine that adds a tendency on the TKE created by the
6 ! fluxes of momentum retrieved from the wind speed tendencies
7 ! of the physics.
8 !
9 ! The basic concept is the following:
10 ! the TKE equation writes de/dt = -u'w' du/dz -v'w' dv/dz +g/theta dtheta/dz +......
11 !
12 !
13 ! We expect contributions to the term u'w' and v'w' that do not come from the Yamada
14 ! scheme, for instance: gravity waves, drag from high vegetation..... These contributions
15 ! need to be accounted for.
16 ! we explicitely calculate the fluxes, integrating the wind speed
17 ! tendency from the top of the atmospher
18 !
19 !
20 !
21 ! contacts: Frederic Hourdin, Etienne Vignon
22 !
23 ! History:
24 !---------
25 ! - 1st redaction, Etienne, 15/10/2016
26 ! Ajout des 4 sous surfaces pour la tke
27 ! on sort l'ajout des tendances du if sur les deux cas, pour ne pas
28 ! dupliuqer les lignes
29 ! on enleve le pas de temps qui disprait dans les calculs
30 !
31 !
32 !**************************************************************************************
33
34 480 SUBROUTINE tend_to_tke(dt,plev,exner,temp,windu,windv,dt_a,du_a,dv_a,pctsrf,tke)
35
36 USE dimphy, ONLY: klon, klev
37 USE indice_sol_mod, ONLY: nbsrf
38
39 IMPLICIT NONE
40 !
41 ! $Header$
42 !
43 ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
44 ! veillez � n'utiliser que des ! pour les commentaires
45 ! et � bien positionner les & des lignes de continuation
46 ! (les placer en colonne 6 et en colonne 73)
47 !
48 !
49 ! A1.0 Fundamental constants
50 REAL RPI,RCLUM,RHPLA,RKBOL,RNAVO
51 ! A1.1 Astronomical constants
52 REAL RDAY,REA,REPSM,RSIYEA,RSIDAY,ROMEGA
53 ! A1.1.bis Constantes concernant l'orbite de la Terre:
54 REAL R_ecc, R_peri, R_incl
55 ! A1.2 Geoide
56 REAL RA,RG,R1SA
57 ! A1.3 Radiation
58 ! REAL RSIGMA,RI0
59 REAL RSIGMA
60 ! A1.4 Thermodynamic gas phase
61 REAL RMO3,RMCO2,RMC,RMCH4,RMN2O,RMCFC11,RMCFC12
62 REAL R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV
63 REAL RKAPPA,RETV, eps_w
64 ! A1.5,6 Thermodynamic liquid,solid phases
65 REAL RCW,RCS
66 ! A1.7 Thermodynamic transition of phase
67 REAL RLVTT,RLSTT,RLMLT,RTT,RATM
68 ! A1.8 Curve of saturation
69 REAL RESTT,RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS
70 REAL RALPD,RBETD,RGAMD
71 !
72 COMMON/YOMCST/RPI ,RCLUM ,RHPLA ,RKBOL ,RNAVO &
73 & ,RDAY ,REA ,REPSM ,RSIYEA,RSIDAY,ROMEGA &
74 & ,R_ecc, R_peri, R_incl &
75 & ,RA ,RG ,R1SA &
76 & ,RSIGMA &
77 & ,R ,RMD ,RMV ,RD ,RV ,RCPD &
78 & ,RMO3 ,RMCO2 ,RMC ,RMCH4 ,RMN2O ,RMCFC11 ,RMCFC12 &
79 & ,RCPV ,RCVD ,RCVV ,RKAPPA,RETV, eps_w &
80 & ,RCW ,RCS &
81 & ,RLVTT ,RLSTT ,RLMLT ,RTT ,RATM &
82 & ,RESTT ,RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,RGAMS &
83 & ,RALPD ,RBETD ,RGAMD
84 ! ------------------------------------------------------------------
85 !$OMP THREADPRIVATE(/YOMCST/)
86
87 ! Declarations
88 !==============
89
90
91 ! Inputs
92 !-------
93 REAL dt ! Time step [s]
94 REAL plev(klon,klev+1) ! inter-layer pressure [Pa]
95 REAL temp(klon,klev) ! temperature [K], grid-cell average or for a one subsurface
96 REAL windu(klon,klev) ! zonal wind [m/s], grid-cell average or for a one subsurface
97 REAL windv(klon,klev) ! meridonal wind [m/s], grid-cell average or for a one subsurface
98 REAL exner(klon,klev) ! Fonction d'Exner = T/theta
99 REAL dt_a(klon,klev) ! Temperature tendency [K], grid-cell average or for a one subsurface
100 REAL du_a(klon,klev) ! Zonal wind speed tendency [m/s], grid-cell average or for a one subsurface
101 REAL dv_a(klon,klev) ! Meridional wind speed tendency [m/s], grid-cell average or for a one subsurface
102 REAL pctsrf(klon,nbsrf+1) ! Turbulent Kinetic energy [m2/s2], grid-cell average or for a subsurface
103
104 ! Inputs/Outputs
105 !---------------
106 REAL tke(klon,klev+1,nbsrf+1) ! Turbulent Kinetic energy [m2/s2], grid-cell average or for a subsurface
107
108
109 ! Local
110 !-------
111
112
113 INTEGER i,k,isrf ! indices
114 960 REAL masse(klon,klev) ! mass in the layers [kg/m2]
115 960 REAL unsmasse(klon,klev+1) ! linear mass in the layers [kg/m2]
116 960 REAL flux_rhotw(klon,klev+1) ! flux massique de tempe. pot. rho*u'*theta'
117 960 REAL flux_rhouw(klon,klev+1) ! flux massique de quantit?? de mouvement rho*u'*w' [kg/m/s2]
118 960 REAL flux_rhovw(klon,klev+1) ! flux massique de quantit?? de mouvement rho*v'*w' [kg/m/s2]
119 960 REAL tendt(klon,klev) ! new temperature tke tendency [m2/s2/s]
120 960 REAL tendu(klon,klev) ! new zonal tke tendency [m2/s2/s]
121 480 REAL tendv(klon,klev) ! new meridonal tke tendency [m2/s2/s]
122
123
124
125
126 ! First calculations:
127 !=====================
128
129
4/4
✓ Branch 0 taken 19200 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 19084800 times.
✓ Branch 3 taken 19200 times.
 19104480 unsmasse(:,:)=0.
130
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 18720 times.
 19200 DO k=1,klev
131
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 18607680 times.
 18626400 masse(:,k)=(plev(:,k)-plev(:,k+1))/RG
132
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 18607680 times.
 18626400 unsmasse(:,k)=unsmasse(:,k)+0.5/masse(:,k)
133
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 18607680 times.
 18626880 unsmasse(:,k+1)=unsmasse(:,k+1)+0.5/masse(:,k)
134 END DO
135
136
4/4
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 18720 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
 18626880 tendu(:,:)=0.0
137
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
 18626880 tendv(:,:)=0.0
138
139 ! Method 1: Calculation of fluxes using a downward integration
140 !============================================================
141
142
143
144 ! Flux calculation
145
146
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
 477600 flux_rhotw(:,klev+1)=0.
147
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
 477600 flux_rhouw(:,klev+1)=0.
148
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
 477600 flux_rhovw(:,klev+1)=0.
149
150
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 18720 times.
 19200 DO k=klev,1,-1
151
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 18607680 times.
 18626400 flux_rhotw(:,k)=flux_rhotw(:,k+1)+masse(:,k)*dt_a(:,k)/exner(:,k)
152
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 18607680 times.
 18626400 flux_rhouw(:,k)=flux_rhouw(:,k+1)+masse(:,k)*du_a(:,k)
153
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
 18626880 flux_rhovw(:,k)=flux_rhovw(:,k+1)+masse(:,k)*dv_a(:,k)
154 ENDDO
155
156
157 ! TKE update:
158
159
2/2
✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 480 times.
 18720 DO k=2,klev
160
2/2
✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 18130560 times.
 18148800 tendt(:,k)=-flux_rhotw(:,k)*(exner(:,k)-exner(:,k-1))*unsmasse(:,k)*RCPD
161
2/2
✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 18130560 times.
 18148800 tendu(:,k)=-flux_rhouw(:,k)*(windu(:,k)-windu(:,k-1))*unsmasse(:,k)
162
2/2
✓ Branch 0 taken 18130560 times.
✓ Branch 1 taken 18240 times.
 18149280 tendv(:,k)=-flux_rhovw(:,k)*(windv(:,k)-windv(:,k-1))*unsmasse(:,k)
163 ENDDO
164
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
 477600 tendt(:,1)=-flux_rhotw(:,1)*(exner(:,1)-1.)*unsmasse(:,1)*RCPD
165
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
 477600 tendu(:,1)=-1.*flux_rhouw(:,1)*windu(:,1)*unsmasse(:,1)
166
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
 477600 tendv(:,1)=-1.*flux_rhovw(:,1)*windv(:,1)*unsmasse(:,1)
167
168
169
2/2
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
 2400 DO isrf=1,nbsrf
170
2/2
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
 77280 DO k=1,klev
171
2/2
✓ Branch 0 taken 74430720 times.
✓ Branch 1 taken 74880 times.
 74507520 DO i=1,klon
172
2/2
✓ Branch 0 taken 30749628 times.
✓ Branch 1 taken 43681092 times.
 74505600 IF (pctsrf(i,isrf)>0.) THEN
173 30749628 tke(i,k,isrf)= tke(i,k,isrf)+tendu(i,k)+tendv(i,k)+tendt(i,k)
174 30749628 tke(i,k,isrf)= max(tke(i,k,isrf),1.e-10)
175 ENDIF
176 ENDDO
177 ENDDO
178 ENDDO
179
180
181 ! IF (klon==1) THEN
182 ! CALL iophys_ecrit('u',klev,'u','',windu)
183 ! CALL iophys_ecrit('v',klev,'v','',windu)
184 ! CALL iophys_ecrit('t',klev,'t','',temp)
185 ! CALL iophys_ecrit('tke1',klev,'tke1','',tke(:,1:klev,1))
186 ! CALL iophys_ecrit('tke2',klev,'tke2','',tke(:,1:klev,2))
187 ! CALL iophys_ecrit('tke3',klev,'tke3','',tke(:,1:klev,3))
188 ! CALL iophys_ecrit('tke4',klev,'tke4','',tke(:,1:klev,4))
189 ! CALL iophys_ecrit('theta',klev,'theta','',temp/exner)
190 ! CALL iophys_ecrit('Duv',klev,'Duv','',tendu(:,1:klev)+tendv(:,1:klev))
191 ! CALL iophys_ecrit('Dt',klev,'Dt','',tendt(:,1:klev))
192 ! ENDIF
193
194 480 END SUBROUTINE tend_to_tke
195