-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathsyntax_inputfile.f90
266 lines (235 loc) · 11 KB
/
syntax_inputfile.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
!------------------------------------------------------------------------------
MODULE mod_keywords_validator_inputfile
!------------------------------------------------------------------------------
!
!++m* syntax_inputfile.f90/mod_keywords_validator_inputfile
!
! NAME
! MODULE mod_keywords_validator_inputfile
!
! CONTAINS
! o SUBROUTINE InputSyntax_InputFile
!
! FILENAME
! syntax_input_inputfile.f90
!
! NOTES
! This module is similar to MODULE mod_keywords_validator_database.
!
!##
!
!------------------------------------------------------------------------------
IMPLICIT NONE
CONTAINS
!------------------------------------------------------------------------------
SUBROUTINE InputSyntax_InputFile(DebugL,optionC, stringC, filenameC)
!------------------------------------------------------------------------------
!
!++s* mod_keywords_validator_inputfile/InputSyntax_InputFile
!
! NAME
! SUBROUTINE InputSyntax_InputFile
!
! PURPOSE
! Defines input syntax of input file.
!
! USAGE
! CALL InputSyntax_InputFile(DebugL,optionC, stringC, filenameC)
!
! INPUT
! o DebugL: If .TRUE., print debug information to screen.
! o optionC: 'default-filename': Returns default filename of input file
! 'write-to-file': Write syntax definition to file.
! o filenameC: (optional) write syntax definition to file
!
! OUTPUT
! o stringC: string containing syntax definition or default filename
!
!##
!
!------------------------------------------------------------------------------
USE My_Input_and_Output_Units ,ONLY:my_output_unit
IMPLICIT NONE
LOGICAL ,INTENT(in) :: DebugL
CHARACTER(len=*) ,INTENT(in) :: optionC
CHARACTER(len=*) ,INTENT(in),OPTIONAL :: filenameC
CHARACTER(len=:),ALLOCATABLE,INTENT(out) :: stringC
INTEGER :: StringLength
CHARACTER(len=:),ALLOCATABLE :: DefaultFilenameC
LOGICAL :: ReturnDefaultFilenameL
LOGICAL :: WriteToFileL
CHARACTER(len=:),ALLOCATABLE :: nC ! new line character
CHARACTER(len=:),ALLOCATABLE :: sC ! string
!-------------------------------------------------------------------------
! Store the 'new line' character which is '\n' in C programming language.
!-------------------------------------------------------------------------
nC = NEW_LINE('n')
WriteToFileL = .FALSE.
ReturnDefaultFilenameL = .FALSE.
! DefaultFilenameC = "inputfile.in"
DefaultFilenameC = "input/inputfile.in"
SELECT CASE( TRIM(optionC) )
CASE('default-filename')
ReturnDefaultFilenameL = .TRUE.
CASE('write-to-file')
WriteToFileL = .TRUE.
CASE('syntax-definition')
!----------------------------
! Returns syntax definition.
!----------------------------
CASE DEFAULT
WRITE(my_output_unit,'(A)') " Error InputSyntax_InputFile: optionC ill-defined. optionC = "//TRIM(optionC)
STOP
END SELECT
IF ( ReturnDefaultFilenameL ) THEN
stringC = DefaultFilenameC
ELSE
sC=''
sC=sC// "!------------------------------------------------------------------------------!"//nC
sC=sC// "! This must be the first keyword. Do not change the order."//nC
sC=sC// "!------------------------------------------------------------------------------!"//nC
sC=sC// "$input_filename optional !"// &
" Do not change this. This must be the first keyword in this file. Do not change the order!"//nC
!sC=sC// " inputfile.in.in character optional !"// &
! " Do not change this. This must be the first specifier in case no input file is specified."//nC
sC=sC// " "//DefaultFilenameC// " character optional !"// &
" Do not change this. This must be the first specifier in case no input file is specified."//nC
sC=sC// "$end_input_filename optional !"//nC
sC=sC// "!------------------------------------------------------------------------------!"//nC
sC=sC// "! End of first keyword. Now the order does not matter."//nC
sC=sC// "!------------------------------------------------------------------------------!"//nC
sC=sC// ""//nC
sC=sC// "!------------------------------------------------------------------------------!"//nC
sC=sC// "$magnetic-field optional !"//nC
sC=sC// " magnetic-field-on character required CHOICE[yes,no]"//nC
sC=sC// " magnetic-field-strength double required !"//nC
sC=sC// " magnetic-field-direction integer_array required CHOICE[1 0 0,0 1 0,0 0 1]"//nC
sC=sC// "$end_magnetic-field optional !"//nC
sC=sC// "!------------------------------------------------------------------------------!"//nC
sC=sC// ""//nC
sC=sC// "!------------------------------------------------------------------------------!"//nC
sC=sC// "$material required !"//nC
sC=sC// " material-number integer required !"// &
" first entry is separator for new input sequence"//nC
sC=sC// " cluster-numbers integer_array required !"//nC
sC=sC// " material-name character required !"//nC
sC=sC// " alloy-function character optional CHOICE[constant,linear]"//nC
sC=sC// " alloy-concentration double optional !"//nC
sC=sC// " band-gaps double_array optional !"//nC
sC=sC// " crystal-type character optional CHOICE[zincblende,wurtzite]"//nC
sC=sC// " use-material-parameters-from-database logical optional CHOICE[.TRUE.,.FALSE.]"//nC
sC=sC// "$end_material required !"//nC
sC=sC// "!------------------------------------------------------------------------------!"//nC
sC=sC// ""//nC
sC=sC// "!------------------------------------------------------------------------------!"//nC
sC=sC// "$command-line optional !"//nC
sC=sC// " execute-command-line character required CHOICE[yes,no]"//nC
sC=sC// "$end_command-line optional !"//nC
sC=sC// "!------------------------------------------------------------------------------!"//nC
stringC = sC
StringLength = LEN_TRIM( stringC )
IF (DebugL) THEN
WRITE(my_output_unit,*) " length of string = ",StringLength
END IF
IF ( stringC(StringLength:StringLength) /= nC ) THEN
WRITE(my_output_unit,'(A)') " Error InputSyntax_InputFile: Line must end with a new line symbol."
STOP
END IF
!----------------------------------
! Write syntax definition to file.
!----------------------------------
IF (WriteToFileL) THEN
OPEN(10,file = filenameC)
WRITE(10,'(A)') stringC
CLOSE(10)
END IF
END IF ! If DefaultFilenameL.
!------------------------------------------------------------------------------
END SUBROUTINE InputSyntax_InputFile
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
END MODULE mod_keywords_validator_inputfile
!------------------------------------------------------------------------------
!
!
!
!------------------------------------------------------------------------------
MODULE mod_syntax_validator
!------------------------------------------------------------------------------
!
!++m* syntax_input_inputfile.f90/mod_syntax_validator
!
! NAME
! MODULE mod_syntax_validator
!
! CONTAINS
! o SUBROUTINE InputSyntax
!
! FILENAME
! input_parser/syntax_input_inputfile.f90
!
!##
!
!------------------------------------------------------------------------------
IMPLICIT NONE
CONTAINS
!------------------------------------------------------------------------------
SUBROUTINE InputSyntax(kind_of_fileC,DebugL,optionC, stringC, filenameC)
!------------------------------------------------------------------------------
!
!++s* mod_keywords_validator_inputfile/InputSyntax
!
! NAME
! SUBROUTINE InputSyntax
!
! PURPOSE
! Defines input syntax of input file.
!
! USAGE
! CALL InputSyntax(kind_of_fileC,DebugL,optionC, stringC, filenameC)
!
! INPUT
! o kind_of_fileC: 'inputfile', 'database'
! o DebugL: If .TRUE., print debug information to screen.
! o optionC: 'default-filename': Returns default filename of input file
! 'write-to-file': Write syntax definition to file.
! o filenameC: (optional) write syntax definition to file
!
! OUTPUT
! o stringC: string containing syntax definition or default filename
!
!##
!
!------------------------------------------------------------------------------
USE My_Input_and_Output_Units ,ONLY:my_output_unit
USE mod_keywords_validator_inputfile,ONLY:InputSyntax_InputFile
USE mod_keywords_validator_database ,ONLY:InputSyntax_Database
IMPLICIT NONE
CHARACTER(len=*) ,INTENT(in) :: kind_of_fileC
LOGICAL ,INTENT(in) :: DebugL
CHARACTER(len=*) ,INTENT(in) :: optionC
CHARACTER(len=*) ,INTENT(in),OPTIONAL :: filenameC
CHARACTER(len=:),ALLOCATABLE,INTENT(out) :: stringC
SELECT CASE( TRIM(kind_of_fileC) )
CASE('inputfile')
IF ( PRESENT(filenameC) ) THEN
CALL InputSyntax_InputFile(DebugL,optionC, stringC, filenameC)
ELSE
CALL InputSyntax_InputFile(DebugL,optionC, stringC)
END IF
CASE('database')
IF ( PRESENT(filenameC) ) THEN
CALL InputSyntax_Database( DebugL,optionC, stringC, filenameC)
ELSE
CALL InputSyntax_Database( DebugL,optionC, stringC)
END IF
CASE DEFAULT
WRITE(my_output_unit,'(A)') " Error InputSyntax: kind_of_fileC ill-defined. kind_of_fileC = ",TRIM(kind_of_fileC)
STOP
END SELECT
!------------------------------------------------------------------------------
END SUBROUTINE InputSyntax
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
END MODULE mod_syntax_validator
!------------------------------------------------------------------------------