File: /nfs/home/0/users/jenkins/mfix.git/model/chem/stiff_chem_stats_mod.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Module name: STIFF_CHEM_DEBUG                                       !
4     !                                                                      !
5     !  Purpose:                                                            !
6     !                                                                      !
7     !  Author: J.Musser                                   Date:            !
8     !                                                                      !
9     !  Comments:                                                           !
10     !                                                                      !
11     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
12           MODULE STIFF_CHEM_STATS
13     
14           PRIVATE
15     
16     ! Variable Access:
17     !---------------------------------------------------------------------//
18           PUBLIC :: failedCount
19     
20     
21     ! Subroutine Access:
22     !---------------------------------------------------------------------//
23           PUBLIC :: ALLOCATE_STIFF_CHEM_STATS
24     
25           PUBLIC :: INIT_STIFF_CHEM_STATS
26           PUBLIC :: UPDATE_STIFF_CHEM_STATS
27           PUBLIC :: WRITE_STIFF_CHEM_STATS
28     
29     
30     ! Routine used to compare to values.
31           LOGICAL, external :: COMPARE
32     
33     
34     ! Static variables/parameters.
35     !---------------------------------------------------------------------//
36     ! Frequency to report the number of steps distribution.
37           INTEGER, parameter :: reportNST_Freq = 10
38     
39     ! Variables updated once each call to the stiff solver.
40     !---------------------------------------------------------------------//
41     ! Frequency to report the number of steps distribution.
42           INTEGER :: reportNST
43     
44           INTEGER :: failedCount_total
45           INTEGER :: countINCPT_total
46     
47     
48     ! Variables updated every IJK loop cycle.
49     !---------------------------------------------------------------------//
50     
51     ! The minimum number of integrations needed (over all IJK)
52           INTEGER, allocatable :: minNST(:)                     ! local
53           INTEGER, allocatable :: minNST_all(:)                 ! global
54     
55     ! The maximum number of integrations needed (over all IJK)
56           INTEGER, allocatable :: maxNST(:)                     ! local
57           INTEGER, allocatable :: maxNST_all(:)                 ! global
58     
59     ! An array that stores the distrubtion of the number of steps needed
60     ! to integrate ODES.
61           INTEGER, allocatable :: countNST(:)                   ! local
62           INTEGER, allocatable :: countNST_all(:)               ! global
63     
64     ! Number of cells that only have homogeneous chemical reactions.
65           INTEGER, allocatable :: Homogns(:)                    ! local
66           INTEGER, allocatable :: Homogns_all(:)                ! global
67     
68     ! Number of cells that only have homogeneous and/or heterogeneous
69     ! chemical reactions.
70           INTEGER, allocatable :: Hetrgns(:)                    ! local
71           INTEGER, allocatable :: Hetrgns_all(:)                ! global
72     
73     ! Number of cells that failed to successfully integration ODEs.
74           INTEGER, allocatable :: failedCount(:)                ! local
75           INTEGER, allocatable :: failedCount_all(:)            ! global
76     
77     ! Maximum number of attempts to integrate.
78           INTEGER, allocatable :: maxAttempts(:)                ! local
79           INTEGER, allocatable :: maxAttempts_all(:)            ! global
80     
81     ! Maximum number of incomplete integrations.
82           INTEGER, allocatable :: countINCPT(:)                 ! local
83           INTEGER, allocatable :: countINCPT_all(:)             ! global
84     
85           DOUBLE PRECISION :: ODE_StartTime
86     
87           contains
88     
89     
90     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
91     !                                                                      !
92     !  Module name: ALLOCATE_STIFF_CHEM_STATS                              !
93     !                                                                      !
94     !  Purpose:                                                            !
95     !                                                                      !
96     !  Author: J.Musser                                   Date:            !
97     !                                                                      !
98     !  Comments:                                                           !
99     !                                                                      !
100     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
101           SUBROUTINE ALLOCATE_STIFF_CHEM_STATS
102     
103           use compar, only: myPE
104           use compar, only: numPEs
105           use output, only: FULL_LOG
106     
107           implicit none
108     
109           reportNST = 1
110           failedCount_total = 0
111           countINCPT_total = 0
112     
113     ! Number of cells that failed to successfully integration ODEs.
114           allocate( failedCount(0:numPEs-1) ); failedCount = 0    ! local
115           allocate( failedCount_all(0:numPEs-1) )                 ! global
116     
117           if(.NOT.FULL_LOG) return
118     
119     ! The minimum number of integrations needed (over all IJK)
120           allocate( minNST(0:numPEs-1)); minNST = 0               ! local
121           allocate( minNST_all(0:numPEs-1) )                      ! global
122           minNST(myPE) = 5000
123     
124     ! The maximum number of integrations needed (over all IJK)
125           allocate( maxNST(0:numPEs-1) ); maxNST = 0              ! local
126           allocate( maxNST_all(0:numPEs-1) )                      ! global
127     
128     ! An array that stores the distrubtion of the number of steps needed
129     ! to integrate ODES.
130           allocate( countNST(5) ); IF(reportNST==1) countNST = 0  ! local
131           allocate( countNST_all(5) )                             ! global
132     
133     ! Number of cells that only have homogeneous chemical reactions.
134           allocate( Homogns(0:numPEs-1) ); Homogns = 0            ! local
135           allocate( Homogns_all(0:numPEs-1) )                     ! global
136     
137     ! Number of cells that only have homogeneous and/or heterogeneous
138     ! chemical reactions.
139           allocate( Hetrgns(0:numPEs-1) ); Hetrgns = 0;           ! local
140           allocate( Hetrgns_all(0:numPEs-1) )                     ! global
141     
142     ! Maximum number of attempts to integrate.
143           allocate( maxAttempts(0:numPEs-1) ); maxAttempts = 0    ! local
144           allocate( maxAttempts_all(0:numPEs-1) )                 ! global
145     
146     ! Number of cells that fail to completely integrate the time step
147     ! given the maximum number of steps.
148           allocate( countINCPT(0:numPEs-1) ); countINCPT = 0      ! local
149           allocate( countINCPT_all(0:numPEs-1) )                  ! global
150     
151     
152           RETURN
153           END SUBROUTINE ALLOCATE_STIFF_CHEM_STATS
154     
155     
156     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
157     !                                                                      !
158     !  Module name: INIT_ODE_STATS0                                        !
159     !                                                                      !
160     !  Purpose:                                                            !
161     !                                                                      !
162     !  Author: J.Musser                                   Date:            !
163     !                                                                      !
164     !  Comments:                                                           !
165     !                                                                      !
166     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
167           SUBROUTINE INIT_STIFF_CHEM_STATS
168     
169           use compar, only: myPE
170           use compar, only: PE_IO
171           use output, only: FULL_LOG
172     
173           implicit none
174     
175           if(.NOT.FULL_LOG) return
176     
177           CALL CPU_TIME(ODE_StartTime)
178     
179           Hetrgns = 0
180           Homogns = 0
181           failedCount = 0
182           countINCPT = 0
183     
184           if(myPE == PE_IO) &
185              write(*,"(/3x,'Integrating stiff chemistry...')",ADVANCE="NO")
186     
187           RETURN
188           END SUBROUTINE INIT_STIFF_CHEM_STATS
189     
190     
191     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
192     !                                                                      !
193     !  Module name: UPDATE_STIFF_CHEM_STATS                                !
194     !                                                                      !
195     !  Purpose:                                                            !
196     !                                                                      !
197     !  Author: J.Musser                                   Date:            !
198     !                                                                      !
199     !  Comments:                                                           !
200     !                                                                      !
201     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
202           SUBROUTINE UPDATE_STIFF_CHEM_STATS(lNEQ, lNEQ_DIMN, lNST, &
203              lODE_DIMN, lAtps, lIncpt)
204     
205           use compar, only: myPE
206           use compar, only: PE_IO
207     
208           implicit none
209     
210     ! The number of steps needed to integrate.
211           INTEGER, intent(in) :: lNEQ_DIMN
212     
213     ! (1) :: Number of ODEs
214     ! (2) :: Fluid cell index (IJK) passed into ODEPACK
215           INTEGER, dimension(lNEQ_DIMN), intent(in) :: lNEQ
216     ! The number of steps needed to integrate.
217           INTEGER, intent(in) :: lNST
218     ! The number ODEs (maximum).
219           INTEGER, intent(in) :: lODE_DIMN
220     
221     ! The number of attempts.
222           INTEGER, intent(in) :: lAtps
223     
224     ! Flag that the integration is incomplete
225           LOGICAL, intent(in) :: lIncpt
226     
227     
228           IF(lNEQ(1) == lODE_DIMN) THEN
229              Hetrgns(myPE) = Hetrgns(myPE) + 1
230           ELSE
231              Homogns(myPE) = Homogns(myPE) + 1
232           ENDIF
233     
234           maxAttempts(myPE) = max(lAtps, maxAttempts(myPE))
235     
236           minNST(myPE) = min(minNST(myPE), lNST)
237           maxNST(myPE) = max(maxNST(myPE), lNST)
238     
239           IF (lNST <           10) THEN
240              countNST(1) = countNST(1) + 1
241           ELSE IF (lNST <     100) THEN
242              countNST(2) = countNST(2) + 1
243           ELSE IF (lNST <    1000) THEN
244              countNST(3) = countNST(3) + 1
245           ELSE IF (lNST <   10000) THEN
246              countNST(4) = countNST(4) + 1
247           ELSE
248              countNST(5) = countNST(5) + 1
249           ENDIF
250     
251           IF(lIncpt) countINCPT(myPE) = countINCPT(myPE) + 1
252     
253           RETURN
254           END SUBROUTINE UPDATE_STIFF_CHEM_STATS
255     
256     
257     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
258     !  Module name: WRITE_ODE_STATS                                        !
259     !                                                                      !
260     !  Purpose:                                                            !
261     !                                                                      !
262     !  Author: J.Musser                                   Date:            !
263     !                                                                      !
264     !  Comments:                                                           !
265     !                                                                      !
266     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
267           SUBROUTINE WRITE_STIFF_CHEM_STATS
268     
269           use compar, only: myPE
270           use compar, only: PE_IO
271           use output, only: FULL_LOG
272     
273           use mpi_utility
274     
275           implicit none
276     
277     ! Message buffer.
278           CHARACTER(LEN=64) :: lMsg0, lMsg1
279     
280           DOUBLE PRECISION :: lODE_EndTime, lODE_RunTime
281     
282           IF(.NOT.FULL_LOG) return
283     
284     
285     ! Update screen message.
286           IF(myPE == PE_IO) WRITE(*,"(2x,'DONE.',/)")
287     
288     
289           CALL CPU_TIME(lODE_EndTime)
290           lODE_RunTime = lODE_EndTime - ODE_StartTime
291     
292     
293     ! Collect stats on min/max number of steps.
294           minNST_all = 0; CALL global_sum(minNST, minNST_all)
295           maxNST_all = 0; CALL global_sum(maxNST, maxNST_all)
296     
297     ! Collect stats on the number of cells with pure homogeneous reactions.
298           Homogns_all = 0;
299           CALL global_sum(Homogns, Homogns_all)
300     
301     ! Collect stats on the number of cells with heterogeneous and
302     ! homogeneous reactions.
303           Hetrgns_all = 0
304           CALL global_sum(Hetrgns, Hetrgns_all)
305     
306     ! Collect stats on the maximum number of integration attempts.
307           maxAttempts_all = 0
308           CALL global_sum(maxAttempts, maxAttempts_all)
309     
310     ! Collect stats on the maximum number of incomplete integrations.
311           countINCPT_all = 0
312           CALL global_sum(countINCPT, countINCPT_all)
313     
314     ! Collect stats on the number of failed integrations.
315           failedCount_all = 0
316           CALL global_sum(failedCount, failedCount_all)
317     
318     
319     ! Display stiff solver summary.
320           IF(myPE == PE_IO) THEN
321     
322     ! Report Min/Max steps:
323              lMsg0=''; write(lMsg0,*) minval(minNST_all)
324              lMsg1=''; write(lMsg1,*) maxval(maxNST_all)
325              write(*,1000)  trim(adjustl(lMsg0)), trim(adjustl(lMsg1))
326     
327     ! Report Homogeneous/Heterogeneous reactions:
328              lMsg0=''; write(lMsg0,*) sum(Homogns_all)
329              lMsg1=''; write(lMsg1,*) sum(Hetrgns_all)
330              write(*,1001) trim(adjustl(lMsg0)), trim(adjustl(lMsg1))
331     
332     ! Report Max attempts:
333              lMsg0=''; write(lMsg0,*) maxval(maxAttempts_all)
334              write(*,1004)  trim(adjustl(lMsg0))
335     
336     ! Report incomplete integrations:
337              countINCPT_total = countINCPT_total + sum(countINCPT_all)
338     
339              IF(countINCPT_total > 0) THEN
340                 lMsg0=''; write(lMsg0,*) sum(countINCPT_all)
341                 lMsg1=''; write(lMsg1,*) countINCPT_total
342                 write(*,1002) 'incomplete', trim(adjustl(lMsg0)), trim(adjustl(lMsg1))
343              ENDIF
344     
345     ! Report failed integrations:
346              failedCount_total = failedCount_total + sum(failedCount_all)
347     
348              IF(failedCount_total > 0) THEN
349                 lMsg0=''; write(lMsg0,*) sum(failedCount_all)
350                 lMsg1=''; write(lMsg1,*) failedCount_total
351                 write(*,1002) 'failed', trim(adjustl(lMsg0)), trim(adjustl(lMsg1))
352              ENDIF
353     
354              IF(lODE_RunTime > 3.6d3) THEN
355                 lMsg0=''; write(lMsg0,"(f8.4)") lODE_RunTime/3.6d3
356                 lMsg1='hrs'
357              ELSEIF(lODE_RunTime > 6.0d1) THEN
358                 lMsg0=''; write(lMsg0,"(f8.4)") lODE_RunTime/6.0d1
359                 lMsg1='min'
360              ELSE
361                 lMsg0=''; write(lMsg0,"(f8.4)") lODE_RunTime
362                 lMsg1='sec'
363              ENDIF
364              write(*,1003) trim(adjustl(lMsg0)), trim(adjustl(lMsg1))
365     
366           ENDIF
367     
368     
369           if(reportNST == reportNST_Freq) then
370     ! Collect the number of steps distributions.
371              countNST_all = 0;
372              CALL global_sum(countNST, countNST_all)
373     
374              countNST_all = int(countNST_all/reportNST_Freq)
375     
376              if(myPE == PE_IO) then
377                 write(*,"(/5x,'Average Integration Distribution:')")
378                 write(*,"(7x,'NST < 10^1: ', I6)")countNST_all(1)
379                 write(*,"(7x,'NST < 10^2: ', I6)")countNST_all(2)
380                 write(*,"(7x,'NST < 10^3: ', I6)")countNST_all(3)
381                 write(*,"(7x,'NST < 10^4: ', I6)")countNST_all(4)
382                 write(*,"(7x,'NST > 10^5: ', I6)")countNST_all(5)
383              endif
384     ! Reset the reporting counter.
385              reportNST = 1
386     ! Clear out old data.
387              countNST = 0
388              countNST_all = 0
389           else
390     ! Increment the reporting counter.
391              reportNST = reportNST + 1
392           endif
393     
394           if(myPE == PE_IO)write(*,"(/' ')")
395     
396           RETURN
397     
398      1000 Format(5x,'Minimum/Maximum number of steps over all cells: ',A,'/',A)
399      1001 Format(5x,'Number of cells with Homogeneous/Heterogeneous reactions: ',A,'/',A)
400      1002 Format(5x,'Number of Current/Cumulative ',A,' integrations: ',A,'/',A)
401      1003 Format(5x,'CPU Time Used: ',A,' ',A)
402      1004 Format(5x,'Maximum number of integration attempts: ',A)
403     
404           END SUBROUTINE WRITE_STIFF_CHEM_STATS
405     
406           END MODULE STIFF_CHEM_STATS
407