GCC Code Coverage Report

Directory: ./
File: dyn3d_common/inidissip.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 77 91 84.6%
Branches: 62 84 73.8%
Line Branch Exec Source
1 !
2 ! $Id: inidissip.F90 2603 2016-07-25 09:31:56Z emillour $
3 !
4 53 SUBROUTINE inidissip ( lstardis,nitergdiv,nitergrot,niterh , &
5 tetagdiv,tetagrot,tetatemp, vert_prof_dissip)
6 !=======================================================================
7 ! initialisation de la dissipation horizontale
8 !=======================================================================
9 !-----------------------------------------------------------------------
10 ! declarations:
11 ! -------------
12
13 USE control_mod, only : dissip_period,iperiod
14 USE comconst_mod, ONLY: dissip_deltaz, dissip_factz, dissip_zref, &
15 dtdiss, dtvr, rad
16 USE comvert_mod, ONLY: preff, presnivs
17
18 IMPLICIT NONE
19 include "dimensions.h"
20 include "paramet.h"
21 include "comdissipn.h"
22 include "iniprint.h"
23
24 LOGICAL,INTENT(in) :: lstardis
25 INTEGER,INTENT(in) :: nitergdiv,nitergrot,niterh
26 REAL,INTENT(in) :: tetagdiv,tetagrot,tetatemp
27
28 integer, INTENT(in):: vert_prof_dissip
29 ! Vertical profile of horizontal dissipation
30 ! Allowed values:
31 ! 0: rational fraction, function of pressure
32 ! 1: tanh of altitude
33
34 ! Local variables:
35 REAL fact,zvert(llm),zz
36 REAL zh(ip1jmp1),zu(ip1jmp1), gx(ip1jmp1), divgra(ip1jmp1)
37 real zv(ip1jm), gy(ip1jm), deltap(ip1jmp1,llm)
38 REAL ullm,vllm,umin,vmin,zhmin,zhmax
39 REAL zllm
40
41 INTEGER l,ij,idum,ii
42 REAL tetamin
43 REAL pseudoz
44 character (len=80) :: abort_message
45
46 REAL ran1
47
48
49 !-----------------------------------------------------------------------
50 !
51 ! calcul des valeurs propres des operateurs par methode iterrative:
52 ! -----------------------------------------------------------------
53
54 1 crot = -1.
55 1 cdivu = -1.
56 1 cdivh = -1.
57
58 ! calcul de la valeur propre de divgrad:
59 ! --------------------------------------
60 idum = 0
61
2/2
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
 40 DO l = 1, llm
62
2/2
✓ Branch 0 taken 42471 times.
✓ Branch 1 taken 39 times.
 42511 DO ij = 1, ip1jmp1
63 42510 deltap(ij,l) = 1.
64 ENDDO
65 ENDDO
66
67 1 idum = -1
68 1 zh(1) = RAN1(idum)-.5
69 1 idum = 0
70
2/2
✓ Branch 0 taken 1088 times.
✓ Branch 1 taken 1 times.
 1089 DO ij = 2, ip1jmp1
71 1089 zh(ij) = RAN1(idum) -.5
72 ENDDO
73
74 1 CALL filtreg (zh,jjp1,1,2,1,.TRUE.,1)
75
76 1 CALL minmax(iip1*jjp1,zh,zhmin,zhmax )
77
78
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF ( zhmin .GE. zhmax ) THEN
79 ✗ write(lunout,*)' Inidissip zh min max ',zhmin,zhmax
80 ✗ abort_message='probleme generateur alleatoire dans inidissip'
81 ✗ call abort_gcm('inidissip',abort_message,1)
82 ENDIF
83
84 1 zllm = ABS( zhmax )
85
2/2
✓ Branch 0 taken 50 times.
✓ Branch 1 taken 1 times.
 51 DO l = 1,50
86
1/2
✓ Branch 0 taken 50 times.
✗ Branch 1 not taken.
 50 IF(lstardis) THEN
87 50 CALL divgrad2(1,zh,deltap,niterh,divgra)
88 ELSE
89 ✗ CALL divgrad (1,zh,niterh,divgra)
90 ENDIF
91
92
6/8
✗ Branch 0 not taken.
✓ Branch 1 taken 50 times.
✓ Branch 2 taken 50 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 54450 times.
✓ Branch 5 taken 50 times.
✓ Branch 6 taken 868 times.
✓ Branch 7 taken 53582 times.
 54550 zllm = ABS(maxval(divgra))
93
2/2
✓ Branch 0 taken 54450 times.
✓ Branch 1 taken 50 times.
 54501 zh = divgra / zllm
94 ENDDO
95
96
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF(lstardis) THEN
97 1 cdivh = 1./ zllm
98 ELSE
99 ✗ cdivh = zllm ** ( -1./niterh )
100 ENDIF
101
102 ! calcul des valeurs propres de gradiv (ii =1) et nxgrarot(ii=2)
103 ! -----------------------------------------------------------------
104 1 write(lunout,*)'inidissip: calcul des valeurs propres'
105
106
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
 3 DO ii = 1, 2
107 !
108
2/2
✓ Branch 0 taken 2178 times.
✓ Branch 1 taken 2 times.
 2180 DO ij = 1, ip1jmp1
109 2180 zu(ij) = RAN1(idum) -.5
110 ENDDO
111 2 CALL filtreg (zu,jjp1,1,2,1,.TRUE.,1)
112
2/2
✓ Branch 0 taken 2112 times.
✓ Branch 1 taken 2 times.
 2114 DO ij = 1, ip1jm
113 2114 zv(ij) = RAN1(idum) -.5
114 ENDDO
115 2 CALL filtreg (zv,jjm,1,2,1,.FALSE.,1)
116
117 2 CALL minmax(iip1*jjp1,zu,umin,ullm )
118 2 CALL minmax(iip1*jjm, zv,vmin,vllm )
119
120 2 ullm = ABS ( ullm )
121 2 vllm = ABS ( vllm )
122
123
2/2
✓ Branch 0 taken 100 times.
✓ Branch 1 taken 2 times.
 102 DO l = 1, 50
124
2/2
✓ Branch 0 taken 50 times.
✓ Branch 1 taken 50 times.
 100 IF(ii.EQ.1) THEN
125 !cccc CALL covcont( 1,zu,zv,zu,zv )
126
1/2
✓ Branch 0 taken 50 times.
✗ Branch 1 not taken.
 50 IF(lstardis) THEN
127 50 CALL gradiv2( 1,zu,zv,nitergdiv,gx,gy )
128 ELSE
129 ✗ CALL gradiv ( 1,zu,zv,nitergdiv,gx,gy )
130 ENDIF
131 ELSE
132
1/2
✓ Branch 0 taken 50 times.
✗ Branch 1 not taken.
 50 IF(lstardis) THEN
133 50 CALL nxgraro2( 1,zu,zv,nitergrot,gx,gy )
134 ELSE
135 ✗ CALL nxgrarot( 1,zu,zv,nitergrot,gx,gy )
136 ENDIF
137 ENDIF
138
139
12/16
✗ Branch 0 not taken.
✓ Branch 1 taken 100 times.
✓ Branch 2 taken 100 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 100 times.
✓ Branch 5 taken 108900 times.
✓ Branch 6 taken 1586 times.
✓ Branch 7 taken 107314 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 100 times.
✓ Branch 10 taken 100 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 105600 times.
✓ Branch 13 taken 100 times.
✓ Branch 14 taken 1617 times.
✓ Branch 15 taken 103983 times.
 214900 zllm = max(abs(maxval(gx)), abs(maxval(gy)))
140
2/2
✓ Branch 0 taken 108900 times.
✓ Branch 1 taken 100 times.
 109000 zu = gx / zllm
141
2/2
✓ Branch 0 taken 105600 times.
✓ Branch 1 taken 100 times.
 105702 zv = gy / zllm
142 end DO
143
144
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 1 times.
 3 IF ( ii.EQ.1 ) THEN
145
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF(lstardis) THEN
146 1 cdivu = 1./zllm
147 ELSE
148 ✗ cdivu = zllm **( -1./nitergdiv )
149 ENDIF
150 ELSE
151
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF(lstardis) THEN
152 1 crot = 1./ zllm
153 ELSE
154 ✗ crot = zllm **( -1./nitergrot )
155 ENDIF
156 ENDIF
157
158 end DO
159
160 ! petit test pour les operateurs non star:
161 ! ----------------------------------------
162
163 ! IF(.NOT.lstardis) THEN
164 1 fact = rad*24./REAL(jjm)
165 1 fact = fact*fact
166 1 write(lunout,*)'inidissip: coef u ', fact/cdivu, 1./cdivu
167 1 write(lunout,*)'inidissip: coef r ', fact/crot , 1./crot
168 1 write(lunout,*)'inidissip: coef h ', fact/cdivh, 1./cdivh
169 ! ENDIF
170
171 !-----------------------------------------------------------------------
172 ! variation verticale du coefficient de dissipation:
173 ! --------------------------------------------------
174
175
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 if (vert_prof_dissip == 1) then
176
2/2
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
 40 do l=1,llm
177 39 pseudoz=8.*log(preff/presnivs(l))
178 zvert(l)=1+ &
179 (tanh((pseudoz-dissip_zref)/dissip_deltaz)+1.)/2. &
180 40 *(dissip_factz-1.)
181 enddo
182 else
183 ✗ DO l=1,llm
184 ✗ zvert(l)=1.
185 ENDDO
186 fact=2.
187 ✗ DO l = 1, llm
188 ✗ zz = 1. - preff/presnivs(l)
189 ✗ zvert(l)= fact -( fact-1.)/( 1.+zz*zz )
190 ENDDO
191 endif
192
193
194 1 write(lunout,*)'inidissip: Constantes de temps de la diffusion horizontale'
195
196 1 tetamin = 1.e+6
197
198
2/2
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
 40 DO l=1,llm
199 39 tetaudiv(l) = zvert(l)/tetagdiv
200 39 tetaurot(l) = zvert(l)/tetagrot
201 39 tetah(l) = zvert(l)/tetatemp
202
203
1/2
✓ Branch 0 taken 39 times.
✗ Branch 1 not taken.
 39 IF( tetamin.GT. (1./tetaudiv(l)) ) tetamin = 1./ tetaudiv(l)
204
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 39 times.
 39 IF( tetamin.GT. (1./tetaurot(l)) ) tetamin = 1./ tetaurot(l)
205
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 39 times.
 40 IF( tetamin.GT. (1./ tetah(l)) ) tetamin = 1./ tetah(l)
206 ENDDO
207
208 ! If dissip_period=0 calculate value for dissipation period, else keep value read from gcm.def
209
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF (dissip_period == 0) THEN
210 1 dissip_period = INT( tetamin/( 2.*dtvr*iperiod) ) * iperiod
211 1 write(lunout,*)'inidissip: tetamin dtvr iperiod dissip_period(intermed) ',tetamin,dtvr,iperiod,dissip_period
212 1 dissip_period = MAX(iperiod,dissip_period)
213 END IF
214
215 1 dtdiss = dissip_period * dtvr
216 1 write(lunout,*)'inidissip: dissip_period=',dissip_period,' dtdiss=',dtdiss,' dtvr=',dtvr
217
218
2/2
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
 40 DO l = 1,llm
219 39 write(lunout,*)zvert(l),dtdiss*tetaudiv(l),dtdiss*tetaurot(l), &
220 79 dtdiss*tetah(l)
221 ENDDO
222
223 1 END SUBROUTINE inidissip
224