GCC Code Coverage Report


Directory: ./
File: dyn/top_bound.f
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 53 60 88.3%
Branches: 53 60 88.3%

Line Branch Exec Source
1 !
2 ! $Id: top_bound.F 2600 2016-07-23 05:45:38Z emillour $
3 !
4 490 SUBROUTINE top_bound(vcov,ucov,teta,masse,dt)
5
6 USE comconst_mod, ONLY: iflag_top_bound, mode_top_bound,
7 & tau_top_bound
8 USE comvert_mod, ONLY: presnivs, preff, scaleheight
9
10 IMPLICIT NONE
11 c
12 include "dimensions.h"
13 include "paramet.h"
14 include "comgeom2.h"
15
16
17 c .. DISSIPATION LINEAIRE A HAUT NIVEAU, RUN MESO,
18 C F. LOTT DEC. 2006
19 c ( 10/12/06 )
20
21 c=======================================================================
22 c
23 c Auteur: F. LOTT
24 c -------
25 c
26 c Objet:
27 c ------
28 c
29 c Dissipation lin�aire (ex top_bound de la physique)
30 c
31 c=======================================================================
32
33 ! top_bound sponge layer model:
34 ! Quenching is modeled as: A(t)=Am+A0*exp(-lambda*t)
35 ! where Am is the zonal average of the field (or zero), and lambda the inverse
36 ! of the characteristic quenching/relaxation time scale
37 ! Thus, assuming Am to be time-independent, field at time t+dt is given by:
38 ! A(t+dt)=A(t)-(A(t)-Am)*(1-exp(-lambda*t))
39 ! Moreover lambda can be a function of model level (see below), and relaxation
40 ! can be toward the average zonal field or just zero (see below).
41
42 ! NB: top_bound sponge is only called from leapfrog if ok_strato=.true.
43
44 ! sponge parameters: (loaded/set in conf_gcm.F ; stored in comconst_mod)
45 ! iflag_top_bound=0 for no sponge
46 ! iflag_top_bound=1 for sponge over 4 topmost layers
47 ! iflag_top_bound=2 for sponge from top to ~1% of top layer pressure
48 ! mode_top_bound=0: no relaxation
49 ! mode_top_bound=1: u and v relax towards 0
50 ! mode_top_bound=2: u and v relax towards their zonal mean
51 ! mode_top_bound=3: u,v and pot. temp. relax towards their zonal mean
52 ! tau_top_bound : inverse of charactericstic relaxation time scale at
53 ! the topmost layer (Hz)
54
55
56 !
57 ! $Header$
58 !
59 ! Attention : ce fichier include est compatible format fixe/format libre
60 ! veillez à n'utiliser que des ! pour les commentaires
61 ! et à bien positionner les & des lignes de continuation
62 ! (les placer en colonne 6 et en colonne 73)
63 !-----------------------------------------------------------------------
64 ! INCLUDE comdissipn.h
65
66 REAL tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
67 !
68 COMMON/comdissipn/ tetaudiv(llm),tetaurot(llm),tetah(llm) , &
69 & cdivu, crot, cdivh
70
71 !
72 ! Les parametres de ce common proviennent des calculs effectues dans
73 ! Inidissip .
74 !
75 !-----------------------------------------------------------------------
76 !
77 ! $Header$
78 !
79 !
80 ! gestion des impressions de sorties et de d�bogage
81 ! lunout: unit� du fichier dans lequel se font les sorties
82 ! (par defaut 6, la sortie standard)
83 ! prt_level: niveau d'impression souhait� (0 = minimum)
84 !
85 INTEGER lunout, prt_level
86 COMMON /comprint/ lunout, prt_level
87
88 c Arguments:
89 c ----------
90
91 real,intent(inout) :: ucov(iip1,jjp1,llm) ! covariant zonal wind
92 real,intent(inout) :: vcov(iip1,jjm,llm) ! covariant meridional wind
93 real,intent(inout) :: teta(iip1,jjp1,llm) ! potential temperature
94 real,intent(in) :: masse(iip1,jjp1,llm) ! mass of atmosphere
95 real,intent(in) :: dt ! time step (s) of sponge model
96
97 c Local:
98 c ------
99
100 REAL massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm),zm
101 REAL uzon(jjp1,llm),vzon(jjm,llm),tzon(jjp1,llm)
102
103 integer i
104 REAL,SAVE :: rdamp(llm) ! quenching coefficient
105 real,save :: lambda(llm) ! inverse or quenching time scale (Hz)
106
107 LOGICAL,SAVE :: first=.true.
108
109 INTEGER j,l
110
111
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 if (iflag_top_bound.eq.0) return
112
113
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
480 if (first) then
114
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 if (iflag_top_bound.eq.1) then
115 ! sponge quenching over the topmost 4 atmospheric layers
116 lambda(:)=0.
117 lambda(llm)=tau_top_bound
118 lambda(llm-1)=tau_top_bound/2.
119 lambda(llm-2)=tau_top_bound/4.
120 lambda(llm-3)=tau_top_bound/8.
121
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 else if (iflag_top_bound.eq.2) then
122 ! sponge quenching over topmost layers down to pressures which are
123 ! higher than 100 times the topmost layer pressure
124 lambda(:)=tau_top_bound
125
2/2
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
40 s *max(presnivs(llm)/presnivs(:)-0.01,0.)
126 endif
127
128 ! quenching coefficient rdamp(:)
129 ! rdamp(:)=dt*lambda(:) ! Explicit Euler approx.
130
2/2
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
40 rdamp(:)=1.-exp(-lambda(:)*dt)
131
132 1 write(lunout,*)'TOP_BOUND mode',mode_top_bound
133 1 write(lunout,*)'Sponge layer coefficients'
134 1 write(lunout,*)'p (Pa) z(km) tau(s) 1./tau (Hz)'
135
2/2
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
40 do l=1,llm
136
2/2
✓ Branch 0 taken 7 times.
✓ Branch 1 taken 32 times.
40 if (rdamp(l).ne.0.) then
137 write(lunout,'(6(1pe12.4,1x))')
138 7 & presnivs(l),log(preff/presnivs(l))*scaleheight,
139 14 & 1./lambda(l),lambda(l)
140 endif
141 enddo
142 1 first=.false.
143 endif ! of if (first)
144
145 480 CALL massbar(masse,massebx,masseby)
146
147 ! compute zonal average of vcov and u
148
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 if (mode_top_bound.ge.2) then
149
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 do l=1,llm
150
2/2
✓ Branch 0 taken 599040 times.
✓ Branch 1 taken 18720 times.
618240 do j=1,jjm
151 599040 vzon(j,l)=0.
152 zm=0.
153
2/2
✓ Branch 0 taken 19169280 times.
✓ Branch 1 taken 599040 times.
19768320 do i=1,iim
154 ! NB: we can work using vcov zonal mean rather than v since the
155 ! cv coefficient (which relates the two) only varies with latitudes
156 19169280 vzon(j,l)=vzon(j,l)+vcov(i,j,l)*masseby(i,j,l)
157 19768320 zm=zm+masseby(i,j,l)
158 enddo
159 617760 vzon(j,l)=vzon(j,l)/zm
160 enddo
161 enddo
162
163
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 18720 times.
19200 do l=1,llm
164
2/2
✓ Branch 0 taken 580320 times.
✓ Branch 1 taken 18720 times.
599520 do j=2,jjm ! excluding poles
165 580320 uzon(j,l)=0.
166 zm=0.
167
2/2
✓ Branch 0 taken 18570240 times.
✓ Branch 1 taken 580320 times.
19150560 do i=1,iim
168 18570240 uzon(j,l)=uzon(j,l)+massebx(i,j,l)*ucov(i,j,l)/cu(i,j)
169 19150560 zm=zm+massebx(i,j,l)
170 enddo
171 599040 uzon(j,l)=uzon(j,l)/zm
172 enddo
173 enddo
174 else ! ucov and vcov will relax towards 0
175 vzon(:,:)=0.
176 uzon(:,:)=0.
177 endif ! of if (mode_top_bound.ge.2)
178
179 ! compute zonal average of potential temperature, if necessary
180
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 if (mode_top_bound.ge.3) then
181
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 do l=1,llm
182
2/2
✓ Branch 0 taken 580320 times.
✓ Branch 1 taken 18720 times.
599520 do j=2,jjm ! excluding poles
183 zm=0.
184 580320 tzon(j,l)=0.
185
2/2
✓ Branch 0 taken 18570240 times.
✓ Branch 1 taken 580320 times.
19150560 do i=1,iim
186 18570240 tzon(j,l)=tzon(j,l)+teta(i,j,l)*masse(i,j,l)
187 19150560 zm=zm+masse(i,j,l)
188 enddo
189 599040 tzon(j,l)=tzon(j,l)/zm
190 enddo
191 enddo
192 endif ! of if (mode_top_bound.ge.3)
193
194
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 if (mode_top_bound.ge.1) then
195 ! Apply sponge quenching on vcov:
196
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 do l=1,llm
197
2/2
✓ Branch 0 taken 617760 times.
✓ Branch 1 taken 18720 times.
636960 do i=1,iip1
198
2/2
✓ Branch 0 taken 19768320 times.
✓ Branch 1 taken 617760 times.
20404800 do j=1,jjm
199 vcov(i,j,l)=vcov(i,j,l)
200 20386080 & -rdamp(l)*(vcov(i,j,l)-vzon(j,l))
201 enddo
202 enddo
203 enddo
204
205 ! Apply sponge quenching on ucov:
206
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 do l=1,llm
207
2/2
✓ Branch 0 taken 617760 times.
✓ Branch 1 taken 18720 times.
636960 do i=1,iip1
208
2/2
✓ Branch 0 taken 19150560 times.
✓ Branch 1 taken 617760 times.
19787040 do j=2,jjm ! excluding poles
209 ucov(i,j,l)=ucov(i,j,l)
210 19768320 & -rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l))
211 enddo
212 enddo
213 enddo
214 endif ! of if (mode_top_bound.ge.1)
215
216
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 if (mode_top_bound.ge.3) then
217 ! Apply sponge quenching on teta:
218
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 do l=1,llm
219
2/2
✓ Branch 0 taken 617760 times.
✓ Branch 1 taken 18720 times.
636960 do i=1,iip1
220
2/2
✓ Branch 0 taken 19150560 times.
✓ Branch 1 taken 617760 times.
19787040 do j=2,jjm ! excluding poles
221 teta(i,j,l)=teta(i,j,l)
222 19768320 & -rdamp(l)*(teta(i,j,l)-tzon(j,l))
223 enddo
224 enddo
225 enddo
226 endif ! of if (mode_top_bound.ge.3)
227
228 END
229