File: N:\mfix\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     
207           implicit none
208     
209     ! The number of steps needed to integrate.
210           INTEGER, intent(in) :: lNEQ_DIMN
211     
212     ! (1) :: Number of ODEs
213     ! (2) :: Fluid cell index (IJK) passed into ODEPACK
214           INTEGER, dimension(lNEQ_DIMN), intent(in) :: lNEQ
215     ! The number of steps needed to integrate.
216           INTEGER, intent(in) :: lNST
217     ! The number ODEs (maximum).
218           INTEGER, intent(in) :: lODE_DIMN
219     
220     ! The number of attempts.
221           INTEGER, intent(in) :: lAtps
222     
223     ! Flag that the integration is incomplete
224           LOGICAL, intent(in) :: lIncpt
225     
226     
227           IF(lNEQ(1) == lODE_DIMN) THEN
228              Hetrgns(myPE) = Hetrgns(myPE) + 1
229           ELSE
230              Homogns(myPE) = Homogns(myPE) + 1
231           ENDIF
232     
233           maxAttempts(myPE) = max(lAtps, maxAttempts(myPE))
234     
235           minNST(myPE) = min(minNST(myPE), lNST)
236           maxNST(myPE) = max(maxNST(myPE), lNST)
237     
238           IF (lNST <           10) THEN
239              countNST(1) = countNST(1) + 1
240           ELSE IF (lNST <     100) THEN
241              countNST(2) = countNST(2) + 1
242           ELSE IF (lNST <    1000) THEN
243              countNST(3) = countNST(3) + 1
244           ELSE IF (lNST <   10000) THEN
245              countNST(4) = countNST(4) + 1
246           ELSE
247              countNST(5) = countNST(5) + 1
248           ENDIF
249     
250           IF(lIncpt) countINCPT(myPE) = countINCPT(myPE) + 1
251     
252           RETURN
253           END SUBROUTINE UPDATE_STIFF_CHEM_STATS
254     
255     
256     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
257     !  Module name: WRITE_ODE_STATS                                        !
258     !                                                                      !
259     !  Purpose:                                                            !
260     !                                                                      !
261     !  Author: J.Musser                                   Date:            !
262     !                                                                      !
263     !  Comments:                                                           !
264     !                                                                      !
265     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
266           SUBROUTINE WRITE_STIFF_CHEM_STATS
267     
268           use compar, only: myPE
269           use compar, only: PE_IO
270           use output, only: FULL_LOG
271     
272           use mpi_utility
273     
274           implicit none
275     
276     ! Message buffer.
277           CHARACTER(LEN=64) :: lMsg0, lMsg1
278     
279           DOUBLE PRECISION :: lODE_EndTime, lODE_RunTime
280     
281           IF(.NOT.FULL_LOG) return
282     
283     
284     ! Update screen message.
285           IF(myPE == PE_IO) WRITE(*,"(2x,'DONE.',/)")
286     
287     
288           CALL CPU_TIME(lODE_EndTime)
289           lODE_RunTime = lODE_EndTime - ODE_StartTime
290     
291     
292     ! Collect stats on min/max number of steps.
293           minNST_all = 0; CALL global_sum(minNST, minNST_all)
294           maxNST_all = 0; CALL global_sum(maxNST, maxNST_all)
295     
296     ! Collect stats on the number of cells with pure homogeneous reactions.
297           Homogns_all = 0;
298           CALL global_sum(Homogns, Homogns_all)
299     
300     ! Collect stats on the number of cells with heterogeneous and
301     ! homogeneous reactions.
302           Hetrgns_all = 0
303           CALL global_sum(Hetrgns, Hetrgns_all)
304     
305     ! Collect stats on the maximum number of integration attempts.
306           maxAttempts_all = 0
307           CALL global_sum(maxAttempts, maxAttempts_all)
308     
309     ! Collect stats on the maximum number of incomplete integrations.
310           countINCPT_all = 0
311           CALL global_sum(countINCPT, countINCPT_all)
312     
313     ! Collect stats on the number of failed integrations.
314           failedCount_all = 0
315           CALL global_sum(failedCount, failedCount_all)
316     
317     
318     ! Display stiff solver summary.
319           IF(myPE == PE_IO) THEN
320     
321     ! Report Min/Max steps:
322              lMsg0=''; write(lMsg0,*) minval(minNST_all)
323              lMsg1=''; write(lMsg1,*) maxval(maxNST_all)
324              write(*,1000)  trim(adjustl(lMsg0)), trim(adjustl(lMsg1))
325     
326     ! Report Homogeneous/Heterogeneous reactions:
327              lMsg0=''; write(lMsg0,*) sum(Homogns_all)
328              lMsg1=''; write(lMsg1,*) sum(Hetrgns_all)
329              write(*,1001) trim(adjustl(lMsg0)), trim(adjustl(lMsg1))
330     
331     ! Report Max attempts:
332              lMsg0=''; write(lMsg0,*) maxval(maxAttempts_all)
333              write(*,1004)  trim(adjustl(lMsg0))
334     
335     ! Report incomplete integrations:
336              countINCPT_total = countINCPT_total + sum(countINCPT_all)
337     
338              IF(countINCPT_total > 0) THEN
339                 lMsg0=''; write(lMsg0,*) sum(countINCPT_all)
340                 lMsg1=''; write(lMsg1,*) countINCPT_total
341                 write(*,1002) 'incomplete', trim(adjustl(lMsg0)), trim(adjustl(lMsg1))
342              ENDIF
343     
344     ! Report failed integrations:
345              failedCount_total = failedCount_total + sum(failedCount_all)
346     
347              IF(failedCount_total > 0) THEN
348                 lMsg0=''; write(lMsg0,*) sum(failedCount_all)
349                 lMsg1=''; write(lMsg1,*) failedCount_total
350                 write(*,1002) 'failed', trim(adjustl(lMsg0)), trim(adjustl(lMsg1))
351              ENDIF
352     
353              IF(lODE_RunTime > 3.6d3) THEN
354                 lMsg0=''; write(lMsg0,"(f8.4)") lODE_RunTime/3.6d3
355                 lMsg1='hrs'
356              ELSEIF(lODE_RunTime > 6.0d1) THEN
357                 lMsg0=''; write(lMsg0,"(f8.4)") lODE_RunTime/6.0d1
358                 lMsg1='min'
359              ELSE
360                 lMsg0=''; write(lMsg0,"(f8.4)") lODE_RunTime
361                 lMsg1='sec'
362              ENDIF
363              write(*,1003) trim(adjustl(lMsg0)), trim(adjustl(lMsg1))
364     
365           ENDIF
366     
367     
368           if(reportNST == reportNST_Freq) then
369     ! Collect the number of steps distributions.
370              countNST_all = 0;
371              CALL global_sum(countNST, countNST_all)
372     
373              countNST_all = int(countNST_all/reportNST_Freq)
374     
375              if(myPE == PE_IO) then
376                 write(*,"(/5x,'Average Integration Distribution:')")
377                 write(*,"(7x,'NST < 10^1: ', I6)")countNST_all(1)
378                 write(*,"(7x,'NST < 10^2: ', I6)")countNST_all(2)
379                 write(*,"(7x,'NST < 10^3: ', I6)")countNST_all(3)
380                 write(*,"(7x,'NST < 10^4: ', I6)")countNST_all(4)
381                 write(*,"(7x,'NST > 10^5: ', I6)")countNST_all(5)
382              endif
383     ! Reset the reporting counter.
384              reportNST = 1
385     ! Clear out old data.
386              countNST = 0
387              countNST_all = 0
388           else
389     ! Increment the reporting counter.
390              reportNST = reportNST + 1
391           endif
392     
393           if(myPE == PE_IO)write(*,"(/' ')")
394     
395           RETURN
396     
397      1000 Format(5x,'Minimum/Maximum number of steps over all cells: ',A,'/',A)
398      1001 Format(5x,'Number of cells with Homogeneous/Heterogeneous reactions: ',A,'/',A)
399      1002 Format(5x,'Number of Current/Cumulative ',A,' integrations: ',A,'/',A)
400      1003 Format(5x,'CPU Time Used: ',A,' ',A)
401      1004 Format(5x,'Maximum number of integration attempts: ',A)
402     
403           END SUBROUTINE WRITE_STIFF_CHEM_STATS
404     
405           END MODULE STIFF_CHEM_STATS
406