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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !     Module name: READ_NAMELIST(POST)                                 !
4     !     Author: P. Nicoletti                            Date: 25-NOV-91  !
5     !                                                                      !
6     !     Purpose: Read in the NAMELIST variables                          !
7     !                                                                      !
8     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
9           SUBROUTINE READ_NAMELIST(POST)
10     
11           USE param
12           USE param1
13           USE run
14           USE output
15           USE physprop
16           USE geometry
17           USE ic
18           USE is
19           USE bc
20           USE ps
21           USE fldvar
22           USE constant
23           USE indices
24           USE toleranc
25           USE funits
26           USE scales
27           USE ur_facs
28           USE leqsol
29           USE residual
30           USE rxns
31           USE scalars
32           USE compar
33           USE parallel
34           USE discretelement
35           USE mfix_pic
36           USE usr
37           USE des_bc
38           USE pic_bc
39           USE des_thermo
40           USE des_rxns
41           USE stiff_chem
42           USE cdist
43           USE quadric
44           USE cutcell
45           USE vtk
46           USE polygon
47           USE dashboard
48           Use stl
49           USE qmom_kinetic_equation
50           use particle_filter
51     
52           use error_manager
53     
54           IMPLICIT NONE
55     
56     ! Dummy Arguments:
57     !------------------------------------------------------------------------//
58     !  This routine is called from: 0 -  mfix; 1 - post_mfix
59           INTEGER :: POST
60     
61     
62     ! Local Variables:
63     !------------------------------------------------------------------------//
64     ! LINE_STRING(1:MAXCOL) has valid input data
65           INTEGER, PARAMETER :: MAXCOL = 80
66     ! Holds one line in the input file
67           CHARACTER(LEN=512) :: LINE_STRING
68     ! Length of noncomment string
69           INTEGER :: LINE_LEN
70     ! Line number
71           INTEGER :: LINE_NO
72     ! Coefficient of restitution (old symbol)
73           DOUBLE PRECISION e
74     ! Indicates whether currently reading rxns or rate
75           LOGICAL :: RXN_FLAG
76     ! Indicate whether to do a namelist read on the line
77           LOGICAL :: READ_FLAG
78     ! Logical to check if file exits.
79           LOGICAL :: lEXISTS
80     ! Error flag
81           LOGICAL :: ERROR
82     
83           CHARACTER(len=256) :: STRING
84           INTEGER :: IOS, II
85     
86     ! External Functions
87     !---------------------------------------------------------------------//
88     ! Returns integer if data past column MAXCOL.
89           INTEGER, EXTERNAL :: LINE_TOO_BIG
90     ! Integer function which returns COMMENT_INDEX
91           INTEGER, EXTERNAL :: SEEK_COMMENT
92     ! Blank line function
93           LOGICAL, EXTERNAL :: BLANK_LINE
94     
95     ! External namelist files:
96     !---------------------------------------------------------------------//
97           INCLUDE 'usrnlst.inc'
98           INCLUDE 'namelist.inc'
99           INCLUDE 'des/desnamelist.inc'
100           INCLUDE 'cartesian_grid/cartesian_grid_namelist.inc'
101           INCLUDE 'qmomk/qmomknamelist.inc'
102     
103     
104     
105           E = UNDEFINED
106           RXN_FLAG = .FALSE.
107           READ_FLAG = .TRUE.
108           NO_OF_RXNS = 0
109           LINE_NO = 0
110     
111     
112     ! Open the mfix.dat file. Report errors if the file is not located or
113     ! there is difficulties opening it.
114           inquire(file='mfix.dat',exist=lEXISTS)
115           IF(.NOT.lEXISTS) THEN
116              IF(myPE == PE_IO) WRITE(*,1000)
117              CALL MFIX_EXIT(myPE)
118     
119      1000 FORMAT(2/,1X,70('*')/' From: READ_NAMELIST',/' Error 1000: ',    &
120              'The input data file, mfix.dat, is missing. Aborting.',/1x,   &
121              70('*'),2/)
122     
123           ELSE
124              OPEN(UNIT=UNIT_DAT, FILE='mfix.dat', STATUS='OLD', IOSTAT=IOS)
125              IF(IOS /= 0) THEN
126                 IF(myPE == PE_IO) WRITE (*,1100)
127                 CALL MFIX_EXIT(myPE)
128              ENDIF
129     
130      1001 FORMAT(2/,1X,70('*')/' From: READ_NAMELIST',/' Error 1001: ',    &
131              'Unable to open the mfix.dat file. Aborting.',/1x,70('*'),2/)
132           ENDIF
133     
134     
135     ! Loop through the mfix.dat file and process the input data.
136           READ_LP: DO
137              READ (UNIT_DAT,"(A)",IOSTAT=IOS) LINE_STRING
138              IF(IOS < 0) EXIT READ_LP
139              IF(IOS > 0) THEN
140              ENDIF
141     
142              LINE_NO = LINE_NO + 1
143     
144              LINE_LEN = SEEK_COMMENT(LINE_STRING,LEN(LINE_STRING)) - 1
145              CALL REMOVE_COMMENT(LINE_STRING, LINE_LEN+1, LEN(LINE_STRING))
146     
147              IF(LINE_LEN <= 0) CYCLE READ_LP           ! comment line
148              IF(BLANK_LINE(LINE_STRING)) CYCLE READ_LP ! blank line
149     
150              IF(LINE_TOO_BIG(LINE_STRING,LINE_LEN,MAXCOL) > 0) THEN
151                 WRITE (*, 1100) trim(iVAL(LINE_NO)), trim(ival(MAXCOL)), &
152                    LINE_STRING(1:MAXCOL)
153                 CALL MFIX_EXIT(myPE)
154              ENDIF
155     
156      1100 FORMAT(//1X,70('*')/1x,'From: READ_NAMELIST',/1x,'Error 1100: ', &
157              'Line ',A,' in mfix.dat has is too long. Input lines should', &
158              /1x,'not pass column ',A,'.',2/3x,A,2/1x,'Please correct ',   &
159              'the mfix.dat file.',/1X,70('*'),2/)
160     
161     ! All subsequent lines are thermochemical data
162              IF(LINE_STRING(1:11) == 'THERMO DATA') EXIT READ_LP
163     
164              CALL SET_KEYWORD(ERROR)
165              IF (ERROR) THEN
166     ! At this point, the keyword was not identified therefore it is
167     ! either deprecated or unknown.
168                 CALL DEPRECATED_OR_UNKNOWN(LINE_NO, LINE_STRING(1:LINE_LEN))
169              ENDIF
170     
171           ENDDO READ_LP
172     
173           DO II=1, COMMAND_ARGUMENT_COUNT()
174              CALL GET_COMMAND_ARGUMENT(ii,LINE_STRING)
175              LINE_LEN = len(line_string)
176              CALL SET_KEYWORD(ERROR)
177              IF (ERROR) THEN
178                 CALL DEPRECATED_OR_UNKNOWN(LINE_NO, LINE_STRING(1:LINE_LEN))
179              ENDIF
180           ENDDO
181     
182           CLOSE(UNIT=UNIT_DAT)
183           IF (E /= UNDEFINED) C_E = E
184     
185           RETURN
186     
187     CONTAINS
188     
189     
190     ! returns true if there is an error
191       SUBROUTINE SET_KEYWORD(ERROR)
192     
193         IMPLICIT NONE
194     
195         LOGICAL, INTENT(OUT) ::ERROR
196     
197         ERROR = .FALSE.
198     
199     ! Make upper case all except species names
200         if(index(LINE_STRING,'SPECIES_NAME') == 0 .AND. &
201              index(LINE_STRING,'species_name') == 0 .AND. &
202              index(LINE_STRING,'Species_Name') == 0 .AND. &
203              index(LINE_STRING,'SPECIES_g') == 0 .AND.    &
204              index(LINE_STRING,'Species_g') == 0 .AND.    &
205              index(LINE_STRING,'species_g') == 0 .AND.    &
206              index(LINE_STRING,'SPECIES_s') == 0 .AND.    &
207              index(LINE_STRING,'Species_s') == 0 .AND.    &
208              index(LINE_STRING,'species_s') == 0)         &
209              CALL MAKE_UPPER_CASE (LINE_STRING, LINE_LEN)
210     
211         CALL REPLACE_TAB (LINE_STRING, LINE_LEN)
212         CALL REMOVE_PAR_BLANKS(LINE_STRING)
213     
214     ! Complete arithmetic operations and expand line
215         CALL PARSE_LINE (LINE_STRING, LINE_LEN, RXN_FLAG, READ_FLAG)
216     
217     ! Write the current line to a scratch file
218     ! and read the scratch file in NAMELIST format
219         IF(.NOT.READ_FLAG) RETURN
220     
221     ! Standard model input parameters.
222         STRING=''; STRING = '&INPUT_DATA '//&
223              trim(adjustl(LINE_STRING(1:LINE_LEN)))//'/'
224         READ(STRING, NML=INPUT_DATA, IOSTAT=IOS)
225         IF(IOS == 0)  RETURN
226     
227     ! Stop processing keyword inputs if runing POST_MFIX
228         IF(POST == 1) RETURN
229     
230     ! Discrete Element model input parameters.
231         STRING=''; STRING = '&DES_INPUT_DATA '//&
232              trim(adjustl(LINE_STRING(1:LINE_LEN)))//'/'
233         READ(STRING, NML=DES_INPUT_DATA, IOSTAT=IOS)
234         IF(IOS == 0)  RETURN
235     
236     ! User defined input parameters.
237         STRING=''; STRING = '&USR_INPUT_DATA '//&
238              trim(adjustl(LINE_STRING(1:LINE_LEN)))//'/'
239         READ(STRING, NML=USR_INPUT_DATA, IOSTAT=IOS)
240         IF(IOS == 0)  RETURN
241     
242     ! Cartesian grid cut-cell input parameters.
243         STRING=''; STRING = '&CARTESIAN_GRID_INPUT_DATA '//&
244              trim(adjustl(LINE_STRING(1:LINE_LEN)))//'/'
245         READ(STRING, NML=CARTESIAN_GRID_INPUT_DATA, IOSTAT=IOS)
246         IF(IOS == 0)  RETURN
247     
248     ! QMOMK input parameters.
249         STRING=''; STRING = '&QMOMK_INPUT_DATA '//&
250              trim(adjustl(LINE_STRING(1:LINE_LEN)))//'/'
251         READ(STRING, NML=QMOMK_INPUT_DATA, IOSTAT=IOS)
252         IF(IOS == 0)  RETURN
253     
254         ERROR = .TRUE.
255     
256         RETURN
257     
258       END SUBROUTINE SET_KEYWORD
259     
260     END SUBROUTINE READ_NAMELIST
261     
262     
263     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
264     !                                                                      !
265     ! Funcation: BLANK_LINE                                                !
266     ! Author: P. Nicoletti                                Date: 25-NOV-91  !
267     !                                                                      !
268     ! Purpose: Return .TRUE. if a line contains no input or only spaces.   !
269     !                                                                      !
270     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
271           LOGICAL FUNCTION BLANK_LINE (line)
272     
273           IMPLICIT NONE
274     
275           CHARACTER :: LINE*(*)
276     
277           INTEGER :: L
278     
279           BLANK_LINE = .FALSE.
280           DO L=1, len(line)
281              IF(line(L:L)/=' ' .and. line(L:L)/='    ')RETURN
282           ENDDO
283     
284           BLANK_LINE = .TRUE.
285           RETURN
286           END FUNCTION BLANK_LINE
287