File: N:\mfix\model\cartesian_grid\write_progress_bar.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: WRITE_PROGRESS_BAR                                     C
4     !  Purpose: Displays a progress bar on the screen                      C
5     !                                                                      C
6     !  Author: Jeff Dietiker                              Date: 30-JAN-09  C
7     !  Reviewer:                                          Date: **-***-**  C
8     !                                                                      C
9     !  Revision Number:                                                    C
10     !  Purpose:                                                            C
11     !  Author:                                            Date: dd-mmm-yy  C
12     !  Reviewer:                                          Date: dd-mmm-yy  C
13     !                                                                      C
14     !  Literature/Document References:                                     C
15     !                                                                      C
16     !  Variables referenced:                                               C
17     !                                                                      C
18     !  Variables modified:                                                 C
19     !                                                                      C
20     !  Local variables:                                                    C
21     !                                                                      C
22     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
23     !
24           SUBROUTINE WRITE_PROGRESS_BAR(I,I_MAX,JUSTIFICATION)
25     
26     !-----------------------------------------------
27     !   M o d u l e s
28     !-----------------------------------------------
29     
30           USE compar
31           USE exit, only: mfix_exit
32           USE fldvar
33           USE funits
34           USE mpi_utility
35           USE param
36           USE param1
37           USE physprop
38           USE progress_bar
39           USE run
40           USE rxns
41           USE scalars
42           IMPLICIT NONE
43     
44           INTEGER :: I,I_MAX,ISKIP,PROGRESS
45           INTEGER :: P,P1,P2
46           CHARACTER (LEN=9) :: TEXT
47           CHARACTER (LEN=4) :: BAR_STATUS
48           CHARACTER (LEN=BAR_WIDTH) :: PROGRESSBAR
49           CHARACTER (LEN=1) :: JUSTIFICATION
50           DOUBLE PRECISION :: PERCENT
51     
52           IF(.NOT.PRINT_PROGRESS_BAR)  RETURN
53     
54           IF(myPE /= PE_IO) RETURN
55     
56           ISKIP = INT(BAR_RESOLUTION * 0.01 *FLOAT(I_MAX))
57     
58           IF((MOD(I,ISKIP)/=0).AND.(I/=I_MAX)) RETURN
59     
60           CALL ERASE_PROGRESS_BAR(BAR_WIDTH,BAR_STATUS,JUSTIFICATION)
61     
62           BAR_STATUS =''
63           IF((BAR_WIDTH<10).OR.(BAR_WIDTH>80)) RETURN
64     
65           PERCENT  = FLOAT(I)/FLOAT(I_MAX) * 100.0
66           PROGRESS = INT(0.01*PERCENT * BAR_WIDTH)  + 1
67     
68           WRITE(TEXT,10) PERCENT
69     10    FORMAT(' ',F5.1,' % ')
70     
71           DO P = 1, PROGRESS
72              PROGRESSBAR(P:P)= BAR_CHAR
73           ENDDO
74     
75           DO P = PROGRESS+1,BAR_WIDTH
76              PROGRESSBAR(P:P)= ' '
77           ENDDO
78     
79           SELECT CASE(JUSTIFICATION)
80              CASE('L')
81     
82                 WRITE(*,15,ADVANCE='NO')TEXT,'|',PROGRESSBAR,'|'
83     
84              CASE('C')
85     
86                 P1 = BAR_WIDTH / 2 - 3
87                 P2 = BAR_WIDTH / 2 + 5
88     
89                 PROGRESSBAR(P1:P2)= TEXT
90     
91                 WRITE(*,20,ADVANCE='NO')'|',PROGRESSBAR,'|'
92     
93              CASE('R')
94     
95                 WRITE(*,15,ADVANCE='NO')'|',PROGRESSBAR,'|',TEXT
96     
97              CASE('N')
98     
99                 WRITE(*,20,ADVANCE='NO')'|',PROGRESSBAR,'|'
100     
101              CASE DEFAULT
102                 WRITE(*,*)'SUBROUTINE: WRITE_PROGRESS_BAR.'
103                 WRITE(*,*)'INCORRECT JUSTIFICATION DESCRIPTOR:',JUSTIFICATION
104                 WRITE(*,*)'ACCEPTABLE VALUES ARE:'
105                 WRITE(*,*)'L : LEFT JUSTIFICATION'
106                 WRITE(*,*)'C : CENTER JUSTIFICATION'
107                 WRITE(*,*)'R : RIGHT JUSTIFICATION'
108                 WRITE(*,*)'N : NO TEXT'
109                 call mfix_exit(myPE)
110           END SELECT
111     
112           IF(PERCENT>=100.0) THEN
113              BAR_STATUS ='DONE'
114              WRITE(*,*)
115           ENDIF
116     
117     15    FORMAT(A,A,A,A)
118     20    FORMAT(A,A,A)
119     
120     
121           RETURN
122           END SUBROUTINE WRITE_PROGRESS_BAR
123     
124     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
125     !                                                                      C
126     !  Module name: ERASE_PROGRESS_BAR                                     C
127     !  Purpose: Erases a progress bar on the screen                        C
128     !                                                                      C
129     !  Author: Jeff Dietiker                              Date: 30-JAN-09  C
130     !  Reviewer:                                          Date: **-***-**  C
131     !                                                                      C
132     !  Revision Number:                                                    C
133     !  Purpose:                                                            C
134     !  Author:                                            Date: dd-mmm-yy  C
135     !  Reviewer:                                          Date: dd-mmm-yy  C
136     !                                                                      C
137     !  Literature/Document References:                                     C
138     !                                                                      C
139     !  Variables referenced:                                               C
140     !                                                                      C
141     !  Variables modified:                                                 C
142     !                                                                      C
143     !  Local variables:                                                    C
144     !                                                                      C
145     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
146     
147           SUBROUTINE ERASE_PROGRESS_BAR(BAR_WIDTH,BAR_STATUS,JUSTIFICATION)
148     
149     !-----------------------------------------------
150     !   M o d u l e s
151     !-----------------------------------------------
152           USE compar
153           USE exit, only: mfix_exit
154           USE fldvar
155           USE funits
156           USE mpi_utility
157           USE parallel
158           USE param
159           USE param1
160           USE physprop
161           USE run
162           USE rxns
163           USE scalars
164           USE sendrecv
165           IMPLICIT NONE
166     
167           INTEGER :: I,BAR_WIDTH,NERASE
168           CHARACTER (LEN=4) :: BAR_STATUS
169           CHARACTER (LEN=1) :: JUSTIFICATION
170     
171           IF(myPE /= PE_IO) RETURN
172     
173           IF(BAR_STATUS=='DONE') THEN
174              BAR_STATUS = ''
175              RETURN
176           ENDIF
177     
178           IF((BAR_WIDTH<10).OR.(BAR_WIDTH>80)) RETURN
179     
180     
181           SELECT CASE(JUSTIFICATION)
182              CASE('L')
183                 NERASE = BAR_WIDTH + 11
184              CASE('C')
185                 NERASE = BAR_WIDTH + 2
186              CASE('R')
187                 NERASE = BAR_WIDTH + 11
188              CASE('N')
189                 NERASE = BAR_WIDTH + 2
190              CASE DEFAULT
191                 WRITE(*,*)'SUBROUTINE: WRITE_PROGRESS_BAR.'
192                 WRITE(*,*)'INCORRECT JUSTIFICATION DESCRIPTOR:',JUSTIFICATION
193                 WRITE(*,*)'ACCEPTABLE VALUES ARE:'
194                 WRITE(*,*)'L : LEFT JUSTIFICATION'
195                 WRITE(*,*)'C : CENTER JUSTIFICATION'
196                 WRITE(*,*)'R : RIGHT JUSTIFICATION'
197                 WRITE(*,*)'N : NO TEXT'
198                 call mfix_exit(myPE)
199           END SELECT
200     
201           DO I = 1,NERASE
202              WRITE(*,10,ADVANCE='NO')CHAR(8)
203           ENDDO
204     10    FORMAT(A)
205     
206           RETURN
207           END SUBROUTINE ERASE_PROGRESS_BAR
208     
209     
210