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 |