-
Notifications
You must be signed in to change notification settings - Fork 0
/
FortranInputParser.f90
131 lines (112 loc) · 5.09 KB
/
FortranInputParser.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
!------------------------------------------------------------------------------
PROGRAM FortranInputParser
!------------------------------------------------------------------------------
!
!++m* FortranInputParser.f90/FortranInputParser
!
! NAME
! PROGRAM FortranInputParser
!
! PURPOSE
! Program to test the Fortran Input Parser.
!
! FILENAME
! FortranInputParser.f90
!
!##
!
!-----------------------------------------------------------------------------
USE My_Input_and_Output_Units,ONLY:my_output_unit
USE EnvironmentAndSystem ,ONLY:AssignDefaultOperatingSystem
USE input_driver_module ,ONLY:input_driver
USE mod_collect_database ,ONLY:Write_Database_Entries
USE mod_collect_inputfile ,ONLY:Write_Inputfile_Entries
USE system_specific_parser ,ONLY:OperatingSystemC , &
ParseInputFileOnlyL, &
WriteCompactFileL , &
OutputDirC
USE parser_parameters ,ONLY:DATA_FileC
USE mod_CallSystem ,ONLY:Execute_Command_in_Directory
USE variables_inputfile ,ONLY:CommandLineBatchL
IMPLICIT NONE
CHARACTER(len=:),ALLOCATABLE :: InputFilenameC
CHARACTER(len=:),ALLOCATABLE :: DatabaseFilenameC
CHARACTER(len=:),ALLOCATABLE :: commandC
CHARACTER(len=:),ALLOCATABLE :: Directory_for_execute_commandC
WRITE(*,'(A)') "============================================================"
WRITE(*,'(A)') " Fortran Input Parser"
WRITE(*,'(A)') "============================================================"
WRITE(*,'(A)') ""
WRITE(*,'(A)') "------------------------------------------------------------"
WRITE(*,'(A)') " (c) nextnano GmbH (BSD license)"
WRITE(*,'(A)') "------------------------------------------------------------"
WRITE(*,'(A)') ""
WRITE(*,'(A)') " This example programs reads in the following two files:"
WRITE(*,'(A)') " - database.in"
WRITE(*,'(A)') " - inputfile.in"
WRITE(*,'(A)') " It parses the data and stores it in variables."
WRITE(*,'(A)') " It demonstrates the features of this Fortran Input Parser."
WRITE(*,'(A)') ""
WRITE(*,'(A)') "------------------------------------------------------------"
WRITE(*,'(A)') ""
!OperatingSystemC = 'windows' ! defines backslash or slash ==> backslash "/" for directories
OperatingSystemC = 'linux' ! defines backslash or slash ==> slash "\" for directories
OutputDirC = 'output/' ! Define name of output directory
InputFilenameC = 'input/inputfile.in'
DatabaseFilenameC = 'input/database.in'
ParseInputFileOnlyL = .TRUE. ! If .TRUE., an .xml file is written out.
WriteCompactFileL = .TRUE. ! If .TRUE., a .compact file is written out.
!--------------------------
! Update operating system.
!--------------------------
CALL AssignDefaultOperatingSystem(OperatingSystemC)
!--------------------------------
! Call input driver and read in:
! - database
! - inputfile
!--------------------------------
CALL input_driver(InputFilenameC,DatabaseFilenameC)
!--------------------------------
! Print variables of database.
!--------------------------------
CALL Write_Database_Entries
!--------------------------------
! Print variables of inputfile.
!--------------------------------
CALL Write_Inputfile_Entries
WRITE(*,'(A)') ""
WRITE(*,'(A)') "------------------------------------------------------------"
WRITE(*,'(A)') " Input files have been parsed successfully."
WRITE(*,'(A)') "------------------------------------------------------------"
WRITE(*,'(A)') ""
!------------------------------------
! Execute command line (==> '!DATA')
!------------------------------------
IF ( CommandLineBatchL ) THEN
!------------------------------------------------
! Always execute command in local output folder.
!------------------------------------------------
IF ( DATA_FILEC /= '') THEN ! If file is not present, it has not been written. Then there is no need for post-processing.
Directory_for_execute_commandC = ''
IF ( TRIM(OperatingSystemC) /= 'windows' ) THEN
!-----------------------------------------------
! Make sure that script has execute permission.
!-----------------------------------------------
commandC = 'chmod a+x '//'"'//TRIM(DATA_FileC)//'"'
CALL Execute_Command_in_Directory(Directory_for_execute_commandC,commandC, &
my_output_unit,OperatingSystemC)
END IF
commandC = '"'//TRIM(DATA_FileC)//'"'
CALL Execute_Command_in_Directory(Directory_for_execute_commandC,commandC, &
my_output_unit,OperatingSystemC)
END IF
ELSE
WRITE(*,'(A)') ""
WRITE(*,'(A)') "------------------------------------------------------------"
WRITE(*,'(A)') " Batch file has not been executed."
WRITE(*,'(A)') "------------------------------------------------------------"
WRITE(*,'(A)') ""
END IF
!------------------------------------------------------------------------------
END PROGRAM FortranInputParser
!------------------------------------------------------------------------------