GCC Code Coverage Report


Directory: ./
File: phys/phystokenc_mod.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 4 170 2.4%
Branches: 0 294 0.0%

Line Branch Exec Source
1 !
2 ! $Id: phystokenc_mod.F90 2343 2015-08-20 10:02:53Z emillour $
3 !
4 MODULE phystokenc_mod
5
6 IMPLICIT NONE
7
8 LOGICAL,SAVE :: offline
9 !$OMP THREADPRIVATE(offline)
10 INTEGER,SAVE :: istphy
11 !$OMP THREADPRIVATE(istphy)
12
13
14 CONTAINS
15
16 1 SUBROUTINE init_phystokenc(offline_dyn,istphy_dyn)
17 IMPLICIT NONE
18 LOGICAL,INTENT(IN) :: offline_dyn
19 INTEGER,INTENT(IN) :: istphy_dyn
20
21 1 offline=offline_dyn
22 1 istphy=istphy_dyn
23
24 1 END SUBROUTINE init_phystokenc
25
26 ✗ SUBROUTINE phystokenc (nlon,nlev,pdtphys,rlon,rlat, &
27 pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
28 pfm_therm,pentr_therm, &
29 ✗ cdragh, pcoefh,yu1,yv1,ftsol,pctsrf, &
30 frac_impa,frac_nucl, &
31 pphis,paire,dtime,itap, &
32 ✗ psh, pda, pphi, pmp, pupwd, pdnwd)
33
34 USE ioipsl
35 USE dimphy
36 USE infotrac_phy, ONLY : nqtot
37 USE iophy
38 USE indice_sol_mod
39 USE print_control_mod, ONLY: lunout
40 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
41
42 IMPLICIT NONE
43
44 !======================================================================
45 ! Auteur(s) FH
46 ! Objet: Ecriture des variables pour transport offline
47 !
48 !======================================================================
49
50 ! Arguments:
51 !
52 REAL,DIMENSION(klon,klev), INTENT(IN) :: psh ! humidite specifique
53 REAL,DIMENSION(klon,klev), INTENT(IN) :: pda
54 REAL,DIMENSION(klon,klev,klev), INTENT(IN):: pphi
55 REAL,DIMENSION(klon,klev), INTENT(IN) :: pmp
56 REAL,DIMENSION(klon,klev), INTENT(IN) :: pupwd ! saturated updraft mass flux
57 REAL,DIMENSION(klon,klev), INTENT(IN) :: pdnwd ! saturated downdraft mass flux
58
59 ! EN ENTREE:
60 ! ==========
61 !
62 ! divers:
63 ! -------
64 !
65 INTEGER nlon ! nombre de points horizontaux
66 INTEGER nlev ! nombre de couches verticales
67 REAL pdtphys ! pas d'integration pour la physique (seconde)
68 INTEGER itap
69 INTEGER, SAVE :: physid
70 !$OMP THREADPRIVATE(physid)
71
72 ! convection:
73 ! -----------
74 !
75 REAL pmfu(klon,klev) ! flux de masse dans le panache montant
76 REAL pmfd(klon,klev) ! flux de masse dans le panache descendant
77 REAL pen_u(klon,klev) ! flux entraine dans le panache montant
78 REAL pde_u(klon,klev) ! flux detraine dans le panache montant
79 REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
80 REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
81 REAL pt(klon,klev)
82 REAL,ALLOCATABLE,SAVE :: t(:,:)
83 !$OMP THREADPRIVATE(t)
84 !
85 REAL rlon(klon), rlat(klon), dtime
86 REAL zx_tmp_3d(nbp_lon,nbp_lat,klev),zx_tmp_2d(nbp_lon,nbp_lat)
87
88 ! Couche limite:
89 ! --------------
90 !
91 REAL cdragh(klon) ! cdrag
92 REAL pcoefh(klon,klev) ! coeff melange CL
93 ✗ REAL pcoefh_buf(klon,klev) ! coeff melange CL + cdrag
94 REAL yv1(klon)
95 REAL yu1(klon),pphis(klon),paire(klon)
96
97 ! Les Thermiques : (Abderr 25 11 02)
98 ! ---------------
99 REAL, INTENT(IN) :: pfm_therm(klon,klev+1)
100 REAL pentr_therm(klon,klev)
101
102 REAL,ALLOCATABLE,SAVE :: entr_therm(:,:)
103 REAL,ALLOCATABLE,SAVE :: fm_therm(:,:)
104 !$OMP THREADPRIVATE(entr_therm)
105 !$OMP THREADPRIVATE(fm_therm)
106 !
107 ! Lessivage:
108 ! ----------
109 !
110 REAL frac_impa(klon,klev)
111 REAL frac_nucl(klon,klev)
112 !
113 ! Arguments necessaires pour les sources et puits de traceur
114 !
115 REAL ftsol(klon,nbsrf) ! Temperature du sol (surf)(Kelvin)
116 REAL pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol)
117 !======================================================================
118 !
119 INTEGER i, k, kk
120 REAL,ALLOCATABLE,SAVE :: mfu(:,:) ! flux de masse dans le panache montant
121 REAL,ALLOCATABLE,SAVE :: mfd(:,:) ! flux de masse dans le panache descendant
122 REAL,ALLOCATABLE,SAVE :: en_u(:,:) ! flux entraine dans le panache montant
123 REAL,ALLOCATABLE,SAVE :: de_u(:,:) ! flux detraine dans le panache montant
124 REAL,ALLOCATABLE,SAVE :: en_d(:,:) ! flux entraine dans le panache descendant
125 REAL,ALLOCATABLE,SAVE :: de_d(:,:) ! flux detraine dans le panache descendant
126 REAL,ALLOCATABLE,SAVE :: coefh(:,:) ! flux detraine dans le panache descendant
127
128 REAL,ALLOCATABLE,SAVE :: pyu1(:)
129 REAL,ALLOCATABLE,SAVE :: pyv1(:)
130 REAL,ALLOCATABLE,SAVE :: pftsol(:,:)
131 REAL,ALLOCATABLE,SAVE :: ppsrf(:,:)
132 !$OMP THREADPRIVATE(mfu,mfd,en_u,de_u,en_d,de_d,coefh)
133 !$OMP THREADPRIVATE(pyu1,pyv1,pftsol,ppsrf)
134
135
136 REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: sh
137 REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: da
138 REAL,DIMENSION(:,:,:), ALLOCATABLE,SAVE :: phi
139 REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: mp
140 REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: upwd
141 REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: dnwd
142
143 REAL, SAVE :: dtcum
144 INTEGER, SAVE:: iadvtr=0
145 !$OMP THREADPRIVATE(dtcum,iadvtr)
146 REAL zmin,zmax
147 LOGICAL ok_sync
148 CHARACTER(len=12) :: nvar
149 logical, parameter :: lstokenc=.FALSE.
150 !
151 !======================================================================
152
153 ✗ iadvtr=iadvtr+1
154
155 ! Dans le meme vecteur on recombine le drag et les coeff d'echange
156 ✗ pcoefh_buf(:,1) = cdragh(:)
157 ✗ pcoefh_buf(:,2:klev) = pcoefh(:,2:klev)
158
159 ok_sync = .TRUE.
160
161 ! Initialization done only once
162 !======================================================================
163 ✗ IF (iadvtr==1) THEN
164 ✗ ALLOCATE( t(klon,klev))
165 ✗ ALLOCATE( mfu(klon,klev))
166 ✗ ALLOCATE( mfd(klon,klev))
167 ✗ ALLOCATE( en_u(klon,klev))
168 ✗ ALLOCATE( de_u(klon,klev))
169 ✗ ALLOCATE( en_d(klon,klev))
170 ✗ ALLOCATE( de_d(klon,klev))
171 ✗ ALLOCATE( coefh(klon,klev))
172 ✗ ALLOCATE( entr_therm(klon,klev))
173 ✗ ALLOCATE( fm_therm(klon,klev))
174 ✗ ALLOCATE( pyu1(klon))
175 ✗ ALLOCATE( pyv1(klon))
176 ✗ ALLOCATE( pftsol(klon,nbsrf))
177 ✗ ALLOCATE( ppsrf(klon,nbsrf))
178
179 ✗ ALLOCATE(sh(klon,klev))
180 ✗ ALLOCATE(da(klon,klev))
181 ✗ ALLOCATE(phi(klon,klev,klev))
182 ✗ ALLOCATE(mp(klon,klev))
183 ✗ ALLOCATE(upwd(klon,klev))
184 ✗ ALLOCATE(dnwd(klon,klev))
185
186 ✗ CALL initphysto('phystoke', dtime, dtime*istphy,dtime*istphy,physid)
187
188 ! Write field phis and aire only once
189 ✗ CALL histwrite_phy(physid,lstokenc,"phis",itap,pphis)
190 ✗ CALL histwrite_phy(physid,lstokenc,"aire",itap,paire)
191 ✗ CALL histwrite_phy(physid,lstokenc,"longitudes",itap,rlon)
192 ✗ CALL histwrite_phy(physid,lstokenc,"latitudes",itap,rlat)
193
194 END IF
195
196
197 ! Set to zero cumulating fields
198 !======================================================================
199 ✗ IF (MOD(iadvtr,istphy)==1.OR.istphy==1) THEN
200 ✗ WRITE(lunout,*)'reinitialisation des champs cumules a iadvtr=',iadvtr
201 ✗ mfu(:,:)=0.
202 ✗ mfd(:,:)=0.
203 ✗ en_u(:,:)=0.
204 ✗ de_u(:,:)=0.
205 ✗ en_d(:,:)=0.
206 ✗ de_d(:,:)=0.
207 ✗ coefh(:,:)=0.
208 ✗ t(:,:)=0.
209 ✗ fm_therm(:,:)=0.
210 ✗ entr_therm(:,:)=0.
211 ✗ pyv1(:)=0.
212 ✗ pyu1(:)=0.
213 ✗ pftsol(:,:)=0.
214 ✗ ppsrf(:,:)=0.
215 ✗ sh(:,:)=0.
216 ✗ da(:,:)=0.
217 ✗ phi(:,:,:)=0.
218 ✗ mp(:,:)=0.
219 ✗ upwd(:,:)=0.
220 ✗ dnwd(:,:)=0.
221 ✗ dtcum=0.
222 ENDIF
223
224
225 ! Cumulate fields at each time step
226 !======================================================================
227 ✗ DO k=1,klev
228 ✗ DO i=1,klon
229 ✗ mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
230 ✗ mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
231 ✗ en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys
232 ✗ de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys
233 ✗ en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
234 ✗ de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
235 ✗ coefh(i,k)=coefh(i,k)+pcoefh_buf(i,k)*pdtphys
236 ✗ t(i,k)=t(i,k)+pt(i,k)*pdtphys
237 ✗ fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys
238 ✗ entr_therm(i,k)=entr_therm(i,k)+pentr_therm(i,k)*pdtphys
239 ✗ sh(i,k) = sh(i,k) + psh(i,k)*pdtphys
240 ✗ da(i,k) = da(i,k) + pda(i,k)*pdtphys
241 ✗ mp(i,k) = mp(i,k) + pmp(i,k)*pdtphys
242 ✗ upwd(i,k) = upwd(i,k) + pupwd(i,k)*pdtphys
243 ✗ dnwd(i,k) = dnwd(i,k) + pdnwd(i,k)*pdtphys
244 ENDDO
245 ENDDO
246
247 ✗ DO kk=1,klev
248 ✗ DO k=1,klev
249 ✗ DO i=1,klon
250 ✗ phi(i,k,kk) = phi(i,k,kk) + pphi(i,k,kk)*pdtphys
251 END DO
252 END DO
253 END DO
254
255 ✗ DO i=1,klon
256 ✗ pyv1(i)=pyv1(i)+yv1(i)*pdtphys
257 ✗ pyu1(i)=pyu1(i)+yu1(i)*pdtphys
258 END DO
259 ✗ DO k=1,nbsrf
260 ✗ DO i=1,klon
261 ✗ pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys
262 ✗ ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys
263 ENDDO
264 ENDDO
265
266 ! Add time step to cumulated time
267 ✗ dtcum=dtcum+pdtphys
268
269
270 ! Write fields to file, if it is time to do so
271 !======================================================================
272 ✗ IF(MOD(iadvtr,istphy)==0) THEN
273
274 ! normalize with time period
275 ✗ DO k=1,klev
276 ✗ DO i=1,klon
277 ✗ mfu(i,k)=mfu(i,k)/dtcum
278 ✗ mfd(i,k)=mfd(i,k)/dtcum
279 ✗ en_u(i,k)=en_u(i,k)/dtcum
280 ✗ de_u(i,k)=de_u(i,k)/dtcum
281 ✗ en_d(i,k)=en_d(i,k)/dtcum
282 ✗ de_d(i,k)=de_d(i,k)/dtcum
283 ✗ coefh(i,k)=coefh(i,k)/dtcum
284 ✗ t(i,k)=t(i,k)/dtcum
285 ✗ fm_therm(i,k)=fm_therm(i,k)/dtcum
286 ✗ entr_therm(i,k)=entr_therm(i,k)/dtcum
287 ✗ sh(i,k)=sh(i,k)/dtcum
288 ✗ da(i,k)=da(i,k)/dtcum
289 ✗ mp(i,k)=mp(i,k)/dtcum
290 ✗ upwd(i,k)=upwd(i,k)/dtcum
291 ✗ dnwd(i,k)=dnwd(i,k)/dtcum
292 ENDDO
293 ENDDO
294 ✗ DO kk=1,klev
295 ✗ DO k=1,klev
296 ✗ DO i=1,klon
297 ✗ phi(i,k,kk) = phi(i,k,kk)/dtcum
298 END DO
299 END DO
300 END DO
301 ✗ DO i=1,klon
302 ✗ pyv1(i)=pyv1(i)/dtcum
303 ✗ pyu1(i)=pyu1(i)/dtcum
304 END DO
305 ✗ DO k=1,nbsrf
306 ✗ DO i=1,klon
307 ✗ pftsol(i,k)=pftsol(i,k)/dtcum
308 ✗ ppsrf(i,k)=ppsrf(i,k)/dtcum
309 ENDDO
310 ENDDO
311
312 ! write fields
313 ✗ CALL histwrite_phy(physid,lstokenc,"t",itap,t)
314 ✗ CALL histwrite_phy(physid,lstokenc,"mfu",itap,mfu)
315 ✗ CALL histwrite_phy(physid,lstokenc,"mfd",itap,mfd)
316 ✗ CALL histwrite_phy(physid,lstokenc,"en_u",itap,en_u)
317 ✗ CALL histwrite_phy(physid,lstokenc,"de_u",itap,de_u)
318 ✗ CALL histwrite_phy(physid,lstokenc,"en_d",itap,en_d)
319 ✗ CALL histwrite_phy(physid,lstokenc,"de_d",itap,de_d)
320 ✗ CALL histwrite_phy(physid,lstokenc,"coefh",itap,coefh)
321 ✗ CALL histwrite_phy(physid,lstokenc,"fm_th",itap,fm_therm)
322 ✗ CALL histwrite_phy(physid,lstokenc,"en_th",itap,entr_therm)
323 ✗ CALL histwrite_phy(physid,lstokenc,"frac_impa",itap,frac_impa)
324 ✗ CALL histwrite_phy(physid,lstokenc,"frac_nucl",itap,frac_nucl)
325 ✗ CALL histwrite_phy(physid,lstokenc,"pyu1",itap,pyu1)
326 ✗ CALL histwrite_phy(physid,lstokenc,"pyv1",itap,pyv1)
327 ✗ CALL histwrite_phy(physid,lstokenc,"ftsol1",itap,pftsol(:,1))
328 ✗ CALL histwrite_phy(physid,lstokenc,"ftsol2",itap,pftsol(:,2))
329 ✗ CALL histwrite_phy(physid,lstokenc,"ftsol3",itap,pftsol(:,3))
330 ✗ CALL histwrite_phy(physid,lstokenc,"ftsol4",itap,pftsol(:,4))
331 ✗ CALL histwrite_phy(physid,lstokenc,"psrf1",itap,ppsrf(:,1))
332 ✗ CALL histwrite_phy(physid,lstokenc,"psrf2",itap,ppsrf(:,2))
333 ✗ CALL histwrite_phy(physid,lstokenc,"psrf3",itap,ppsrf(:,3))
334 ✗ CALL histwrite_phy(physid,lstokenc,"psrf4",itap,ppsrf(:,4))
335 ✗ CALL histwrite_phy(physid,lstokenc,"sh",itap,sh)
336 ✗ CALL histwrite_phy(physid,lstokenc,"da",itap,da)
337 ✗ CALL histwrite_phy(physid,lstokenc,"mp",itap,mp)
338 ✗ CALL histwrite_phy(physid,lstokenc,"upwd",itap,upwd)
339 ✗ CALL histwrite_phy(physid,lstokenc,"dnwd",itap,dnwd)
340
341
342 ! phi
343 ✗ DO k=1,klev
344 ✗ IF (k<10) THEN
345 ✗ WRITE(nvar,'(i1)') k
346 ✗ ELSE IF (k<100) THEN
347 ✗ WRITE(nvar,'(i2)') k
348 ELSE
349 ✗ WRITE(nvar,'(i3)') k
350 END IF
351 ✗ nvar='phi_lev'//trim(nvar)
352
353 ✗ CALL histwrite_phy(physid,lstokenc,nvar,itap,phi(:,:,k))
354 END DO
355
356 ! Syncronize file
357 !$OMP MASTER
358 ✗ IF (ok_sync) CALL histsync(physid)
359 !$OMP END MASTER
360
361
362 ! Calculate min and max values for some fields (coefficients de lessivage)
363 ✗ zmin=1e33
364 ✗ zmax=-1e33
365 ✗ DO k=1,klev
366 ✗ DO i=1,klon
367 ✗ zmax=MAX(zmax,frac_nucl(i,k))
368 ✗ zmin=MIN(zmin,frac_nucl(i,k))
369 ENDDO
370 ENDDO
371 ✗ WRITE(lunout,*)'------ coefs de lessivage (min et max) --------'
372 ✗ WRITE(lunout,*)'facteur de nucleation ',zmin,zmax
373 ✗ zmin=1e33
374 ✗ zmax=-1e33
375 ✗ DO k=1,klev
376 ✗ DO i=1,klon
377 ✗ zmax=MAX(zmax,frac_impa(i,k))
378 ✗ zmin=MIN(zmin,frac_impa(i,k))
379 ENDDO
380 ENDDO
381 ✗ WRITE(lunout,*)'facteur d impaction ',zmin,zmax
382
383 ENDIF ! IF(MOD(iadvtr,istphy)==0)
384
385 ✗ END SUBROUTINE phystokenc
386
387 END MODULE phystokenc_mod
388