GCC Code Coverage Report


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

Line Branch Exec Source
1 !
2 ! $Header$
3 !
4 SUBROUTINE thermcell_init(ngrid,nlay,ztv,zlay,zlev, &
5 & lalim,lmin,alim_star,alim_star_tot,lev_out)
6
7 !----------------------------------------------------------------------
8 !thermcell_init: calcul du profil d alimentation du thermique
9 !----------------------------------------------------------------------
10 USE print_control_mod, ONLY: lunout
11 IMPLICIT NONE
12 integer :: iflag_thermals,nsplit_thermals
13
14 !!! nrlmd le 10/04/2012
15 integer :: iflag_trig_bl,iflag_clos_bl
16 integer :: tau_trig_shallow,tau_trig_deep
17 real :: s_trig
18 !!! fin nrlmd le 10/04/2012
19
20 real,parameter :: r_aspect_thermals=2.,l_mix_thermals=30.
21 real :: alp_bl_k
22 real :: tau_thermals,fact_thermals_ed_dz
23 integer,parameter :: w2di_thermals=0
24 integer :: isplit
25
26 integer :: iflag_coupl,iflag_clos,iflag_wake
27 integer :: iflag_thermals_ed,iflag_thermals_optflux,iflag_thermals_closure
28
29 common/ctherm1/iflag_thermals,nsplit_thermals,iflag_thermals_closure
30 common/ctherm2/tau_thermals,alp_bl_k,fact_thermals_ed_dz
31 common/ctherm4/iflag_coupl,iflag_clos,iflag_wake
32 common/ctherm5/iflag_thermals_ed,iflag_thermals_optflux
33
34 !!! nrlmd le 10/04/2012
35 common/ctherm6/iflag_trig_bl,iflag_clos_bl
36 common/ctherm7/tau_trig_shallow,tau_trig_deep
37 common/ctherm8/s_trig
38 !!! fin nrlmd le 10/04/2012
39
40 !$OMP THREADPRIVATE(/ctherm1/,/ctherm2/,/ctherm4/,/ctherm5/)
41 !$OMP THREADPRIVATE(/ctherm6/,/ctherm7/,/ctherm8/)
42
43 INTEGER l,ig
44 !arguments d entree
45 INTEGER ngrid,nlay
46 REAL ztv(ngrid,nlay)
47 REAL zlay(ngrid,nlay)
48 REAL zlev(ngrid,nlay+1)
49 !arguments de sortie
50 INTEGER lalim(ngrid)
51 INTEGER lmin(ngrid)
52 REAL alim_star(ngrid,nlay)
53 REAL alim_star_tot(ngrid)
54 integer lev_out ! niveau pour les print
55
56 REAL zzalim(ngrid)
57 !CR: ponderation entrainement des couches instables
58 !def des alim_star tels que alim=f*alim_star
59
60
61 write(lunout,*)'THERM INIT V20C '
62
63 alim_star_tot(:)=0.
64 alim_star(:,:)=0.
65 lmin(:)=1
66 lalim(:)=1
67
68 do l=1,nlay-1
69 do ig=1,ngrid
70 if (ztv(ig,l)> ztv(ig,l+1) .and. ztv(ig,1)>=ztv(ig,l) ) then
71 alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.) &
72 & *sqrt(zlev(ig,l+1))
73 lalim(:)=l+1
74 alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
75 endif
76 enddo
77 enddo
78 do l=1,nlay
79 do ig=1,ngrid
80 if (alim_star_tot(ig) > 1.e-10 ) then
81 alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
82 endif
83 enddo
84 enddo
85 alim_star_tot(:)=1.
86
87 return
88 end
89