GCC Code Coverage Report

Directory: ./
File: dyn3d_common/sortvarc.f
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 58 74 78.4%
Branches: 30 38 78.9%
Line Branch Exec Source
1 !
2 ! $Id: sortvarc.F 2622 2016-09-04 06:12:02Z emillour $
3 !
4 243 SUBROUTINE sortvarc
5 $(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time ,
6 $ vcov )
7
8 USE control_mod, ONLY: resetvarc
9 USE comconst_mod, ONLY: dtvr, daysec, g, rad, omeg
10 USE logic_mod, ONLY: read_start
11 USE ener_mod, ONLY: etot,ptot,ztot,stot,ang,
12 & etot0,ptot0,ztot0,stot0,ang0,
13 & rmsdpdt,rmsv
14 IMPLICIT NONE
15
16
17 c=======================================================================
18 c
19 c Auteur: P. Le Van
20 c -------
21 c
22 c Objet:
23 c ------
24 c
25 c sortie des variables de controle
26 c
27 c=======================================================================
28 c-----------------------------------------------------------------------
29 c Declarations:
30 c -------------
31
32 INCLUDE "dimensions.h"
33 INCLUDE "paramet.h"
34 INCLUDE "comgeom.h"
35 INCLUDE "iniprint.h"
36
37 c Arguments:
38 c ----------
39
40 INTEGER,INTENT(IN) :: itau
41 REAL,INTENT(IN) :: ucov(ip1jmp1,llm)
42 REAL,INTENT(IN) :: teta(ip1jmp1,llm)
43 REAL,INTENT(IN) :: masse(ip1jmp1,llm)
44 REAL,INTENT(IN) :: vcov(ip1jm,llm)
45 REAL,INTENT(IN) :: ps(ip1jmp1)
46 REAL,INTENT(IN) :: phis(ip1jmp1)
47 REAL,INTENT(IN) :: vorpot(ip1jm,llm)
48 REAL,INTENT(IN) :: phi(ip1jmp1,llm)
49 REAL,INTENT(IN) :: bern(ip1jmp1,llm)
50 REAL,INTENT(IN) :: dp(ip1jmp1)
51 REAL,INTENT(IN) :: time
52 REAL,INTENT(IN) :: pk(ip1jmp1,llm)
53
54 c Local:
55 c ------
56
57 REAL vor(ip1jm),bernf(ip1jmp1,llm),ztotl(llm)
58 REAL etotl(llm),stotl(llm),rmsvl(llm),angl(llm),ge(ip1jmp1)
59 REAL cosphi(ip1jm),omegcosp(ip1jm)
60 REAL dtvrs1j,rjour,heure,radsg,radomeg
61 REAL massebxy(ip1jm,llm)
62 INTEGER l, ij, imjmp1
63
64 REAL SSUM
65 LOGICAL,SAVE :: firstcal=.true.
66 CHARACTER(LEN=*),PARAMETER :: modname="sortvarc"
67
68 c-----------------------------------------------------------------------
69 ! Ehouarn: when no initialization fields from file, resetvarc should be
70 ! set to false
71
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 80 times.
 81 if (firstcal) then
72
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 if (.not.read_start) then
73 ✗ resetvarc=.true.
74 endif
75 endif
76
77 81 dtvrs1j = dtvr/daysec
78 81 rjour = REAL( INT( itau * dtvrs1j ))
79 81 heure = ( itau*dtvrs1j-rjour ) * 24.
80 imjmp1 = iim * jjp1
81
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 81 times.
 81 IF(ABS(heure - 24.).LE.0.0001 ) heure = 0.
82 c
83 81 CALL massbarxy ( masse, massebxy )
84
85 c ..... Calcul de rmsdpdt .....
86
87
2/2
✓ Branch 0 taken 88209 times.
✓ Branch 1 taken 81 times.
 88290 ge(:)=dp(:)*dp(:)
88
89 81 rmsdpdt = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
90 c
91 81 rmsdpdt = daysec* 1.e-2 * SQRT(rmsdpdt/imjmp1)
92
93 81 CALL SCOPY( ijp1llm,bern,1,bernf,1 )
94 81 CALL filtreg(bernf,jjp1,llm,-2,2,.TRUE.,1)
95
96 c ..... Calcul du moment angulaire .....
97
98 81 radsg = rad /g
99 81 radomeg = rad * omeg
100 c
101
2/2
✓ Branch 0 taken 82863 times.
✓ Branch 1 taken 81 times.
 82944 DO ij=iip2,ip1jm
102 82863 cosphi( ij ) = COS(rlatu((ij-1)/iip1+1))
103 82944 omegcosp(ij) = radomeg * cosphi(ij)
104 ENDDO
105
106 c ... Calcul de l'energie,de l'enstrophie,de l'entropie et de rmsv .
107
108
2/2
✓ Branch 0 taken 3159 times.
✓ Branch 1 taken 81 times.
 3240 DO l=1,llm
109
2/2
✓ Branch 0 taken 3335904 times.
✓ Branch 1 taken 3159 times.
 3339063 DO ij = 1,ip1jm
110 3339063 vor(ij)=vorpot(ij,l)*vorpot(ij,l)*massebxy(ij,l)
111 ENDDO
112 3159 ztotl(l)=(SSUM(ip1jm,vor,1)-SSUM(jjm,vor,iip1))
113
114
2/2
✓ Branch 0 taken 3440151 times.
✓ Branch 1 taken 3159 times.
 3443310 DO ij = 1,ip1jmp1
115 ge(ij)= masse(ij,l)*(phis(ij)+teta(ij,l)*pk(ij,l) +
116 3443310 s bernf(ij,l)-phi(ij,l))
117 ENDDO
118 3159 etotl(l) = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
119
120
2/2
✓ Branch 0 taken 3440151 times.
✓ Branch 1 taken 3159 times.
 3443310 DO ij = 1, ip1jmp1
121 3443310 ge(ij) = masse(ij,l)*teta(ij,l)
122 ENDDO
123 3159 stotl(l)= SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
124
125
2/2
✓ Branch 0 taken 3440151 times.
✓ Branch 1 taken 3159 times.
 3443310 DO ij=1,ip1jmp1
126 3443310 ge(ij)=masse(ij,l)*AMAX1(bernf(ij,l)-phi(ij,l),0.)
127 ENDDO
128 3159 rmsvl(l)=2.*(SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1))
129
130
2/2
✓ Branch 0 taken 3231657 times.
✓ Branch 1 taken 3159 times.
 3234816 DO ij =iip2,ip1jm
131 ge(ij)=(ucov(ij,l)/cu(ij)+omegcosp(ij))*masse(ij,l) *
132 3234816 * cosphi(ij)
133 ENDDO
134 angl(l) = rad *
135 3240 s (SSUM(ip1jm-iip1,ge(iip2),1)-SSUM(jjm-1,ge(iip2),iip1))
136 ENDDO
137
138
2/2
✓ Branch 0 taken 88209 times.
✓ Branch 1 taken 81 times.
 88290 DO ij=1,ip1jmp1
139 88290 ge(ij)= ps(ij)*aire(ij)
140 ENDDO
141 81 ptot = SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1)
142 81 etot = SSUM( llm, etotl, 1 )
143 81 ztot = SSUM( llm, ztotl, 1 )
144 81 stot = SSUM( llm, stotl, 1 )
145 81 rmsv = SSUM( llm, rmsvl, 1 )
146 81 ang = SSUM( llm, angl, 1 )
147
148
3/4
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 80 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
 81 IF (firstcal.and.resetvarc) then
149 ✗ WRITE(lunout,3500) itau, rjour, heure, time
150 ✗ WRITE(lunout,*) trim(modname),
151 ✗ & ' WARNING!!! Recomputing initial values of : '
152 ✗ WRITE(lunout,*) 'ptot,rmsdpdt,etot,ztot,stot,rmsv,ang'
153 ✗ WRITE(lunout,*) ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
154 ✗ etot0 = etot
155 ✗ ptot0 = ptot
156 ✗ ztot0 = ztot
157 ✗ stot0 = stot
158 ✗ ang0 = ang
159 END IF
160
161 ! compute relative changes in etot,... (except if 'reference' values
162 ! are zero, which can happen when using iniacademic)
163
1/2
✓ Branch 0 taken 81 times.
✗ Branch 1 not taken.
 81 if (etot0.ne.0) then
164 81 etot= etot/etot0
165 else
166 ✗ etot=1.
167 endif
168 81 rmsv= SQRT(rmsv/ptot)
169
1/2
✓ Branch 0 taken 81 times.
✗ Branch 1 not taken.
 81 if (ptot0.ne.0) then
170 81 ptot= ptot/ptot0
171 else
172 ✗ ptot=1.
173 endif
174
1/2
✓ Branch 0 taken 81 times.
✗ Branch 1 not taken.
 81 if (ztot0.ne.0) then
175 81 ztot= ztot/ztot0
176 else
177 ✗ ztot=1.
178 endif
179
1/2
✓ Branch 0 taken 81 times.
✗ Branch 1 not taken.
 81 if (stot0.ne.0) then
180 81 stot= stot/stot0
181 else
182 ✗ stot=1.
183 endif
184
1/2
✓ Branch 0 taken 81 times.
✗ Branch 1 not taken.
 81 if (ang0.ne.0) then
185 81 ang = ang /ang0
186 else
187 ✗ ang=1.
188 endif
189
190 81 firstcal = .false.
191
192 81 WRITE(lunout,3500) itau, rjour, heure, time
193 81 WRITE(lunout,4000) ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
194
195 3500 FORMAT(10("*"),4x,'pas',i7,5x,'jour',f9.0,'heure',f5.1,4x
196 * ,'date',f14.4,4x,10("*"))
197 4000 FORMAT(10x,'masse',4x,'rmsdpdt',7x,'energie',2x,'enstrophie'
198 * ,2x,'entropie',3x,'rmsv',4x,'mt.ang',/,'GLOB '
199 . ,f10.6,e13.6,5f10.3/
200 * )
201 81 END
202
203