-
Notifications
You must be signed in to change notification settings - Fork 0
/
parser_read_in_keywords_database.f90
160 lines (127 loc) · 6.34 KB
/
parser_read_in_keywords_database.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
!------------------------------------------------------------------------------
MODULE variables_database
!------------------------------------------------------------------------------
!
! Module to store values read in from inputfile.
!
!------------------------------------------------------------------------------
IMPLICIT NONE
!-------------------------------------------------
! These variables are read in from the inputfile.
!-------------------------------------------------
TYPE :: type_PhysicsConstants
REAL(8) :: electron_charge
REAL(8) :: Planck_constant
END TYPE type_PhysicsConstants
TYPE(type_PhysicsConstants) :: PhysicsConstants
!------------------------------------------------------------------------------
END MODULE variables_database
!------------------------------------------------------------------------------
!
!
!
!
!------------------------------------------------------------------------------
MODULE mod_collect_database
!------------------------------------------------------------------------------
IMPLICIT NONE
CONTAINS
!------------------------------------------------------------------------------
SUBROUTINE Collect_Database_Entries
!------------------------------------------------------------------------------
!
! To read entries from inputfile.
!
!------------------------------------------------------------------------------
USE generic_database ,ONLY:get_from_database
USE mod_input_data ,ONLY:type_data
!-------------------------------------------------
! These variables are read in from the inputfile.
!-------------------------------------------------
USE variables_database,ONLY:PhysicsConstants
IMPLICIT NONE
INTEGER,PARAMETER :: String_Length = 300
LOGICAL :: newL,continueL,presentL,lastL ! control variables
CHARACTER(len=String_Length) :: keywordC,specifierC ! string variables for keyword and specifier (input of SUBROUTINE get_from_inputfile)
INTEGER :: line
INTEGER :: counter
TYPE(type_data) :: value
!-----------------------------------------------------------------------------
keywordC = '$physical-constants'
!-----------------------------------------------------------------------------
newL = .TRUE. ; continueL = .FALSE. ; lastL = .FALSE. ! new search for keyword
!----------------------------------------------------------------------------
specifierC = 'electron-charge'
!----------------------------------------------------------------------------
counter = 0 ! set counter to zero
DO
IF (lastL) EXIT ! Exit if last record was read
CALL get_from_database(keywordC,newL,specifierC,continueL,value%double,presentL,line,lastL) ! get data
IF (presentL) THEN
PhysicsConstants%electron_charge = value%double
counter = counter + 1 ! count entries to check for unique database
ELSE
PhysicsConstants%electron_charge = 0d0
END IF
newL = .FALSE. ; continueL = .TRUE. ! stay at records for actual keyword, scan for next specifier entry
END DO
IF (counter /= 1) CALL ERROR(1)
!----------------------------------------------------------------------------
specifierC = 'Planck-constant'
!----------------------------------------------------------------------------
newL= .FALSE. ; continueL = .FALSE. ! stay at records for actual keyword, scan for next specifier entry
CALL get_from_database(keywordC,newL,specifierC,continueL,value%double,presentL,line,lastL) ! get data
! IF (.NOT. presentL) CALL ERROR
PhysicsConstants%Planck_constant = value%double
!----------------------------------------------------------------------------
CONTAINS
!------------------------------------------------------------------------------
SUBROUTINE ERROR(error_number)
!------------------------------------------------------------------------------
USE Parser_Errors,ONLY:Print_Keyword_Specifier_Line
IMPLICIT NONE
INTEGER,INTENT(in) :: error_number
WRITE(*,*) "ERROR detected in SUBROUTINE Collect_Database_Entries."
SELECT CASE(error_number)
CASE(1)
WRITE(*,*) "Specifier occurs more than 1 time."
WRITE(*,*) " value%double = ",value%double
CALL Print_Keyword_Specifier_Line(keywordC,specifierC,line,STOP_L=.TRUE.)
CASE DEFAULT
WRITE(*,*) "Unknown error number = ",error_number
STOP
END SELECT
!------------------------------------------------------------------------------
END SUBROUTINE ERROR
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
END SUBROUTINE Collect_Database_Entries
!------------------------------------------------------------------------------
!
!
!
!------------------------------------------------------------------------------
SUBROUTINE Write_Database_Entries
!------------------------------------------------------------------------------
!
! Write out entries found in inputfile.
!
!------------------------------------------------------------------------------
USE variables_database,ONLY:PhysicsConstants
IMPLICIT NONE
WRITE(*,'(A)') ""
WRITE(*,'(A)') "==============================================================================="
WRITE(*,'(A)') " Content of database:"
WRITE(*,'(A)') "-------------------------------------------------------------------------------"
WRITE(*,'(A)') ""
WRITE(*,*) " The electron charge is ",PhysicsConstants%electron_charge," [As]."
WRITE(*,*) " Planck's constant is ",PhysicsConstants%Planck_constant," [Js]."
WRITE(*,'(A)') ""
WRITE(*,'(A)') "==============================================================================="
WRITE(*,'(A)') ""
!------------------------------------------------------------------------------
END SUBROUTINE Write_Database_Entries
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
END MODULE mod_collect_database
!------------------------------------------------------------------------------