Newer
Older
!< @brief initial conditions module
! --------------------------------------------------------------------------------
! modules used
! --------------------------------------------------------------------------------
#ifdef USE_CONFIG_PARSER
use iso_c_binding, only: C_NULL_CHAR
use config_parser
#endif
! directives list
! --------------------------------------------------------------------------------
private
! public interface
! --------------------------------------------------------------------------------
public :: set_const_profile, set_linear_profile, set_external_profile
! --------------------------------------------------------------------------------
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
! --------------------------------------------------------------------------------
subroutine set_const_profile(F, Fsurf, grid)
!< @brief set constant profile
! ----------------------------------------------------------------------------
type (gridDataType), intent(in) :: grid
real, dimension(grid%cz), intent(out) :: F
real, intent(in) :: Fsurf
! --------------------------------------------------------------------------------
F(1:grid%cz) = Fsurf
end subroutine
! --------------------------------------------------------------------------------
subroutine set_linear_profile(F, Fsurf, Fgrad, grid)
!< @brief set constant profile
! ----------------------------------------------------------------------------
type (gridDataType), intent(in) :: grid
real, dimension(grid%cz), intent(out) :: F
real, intent(in) :: Fsurf, Fgrad
integer :: k
! --------------------------------------------------------------------------------
do k = 1, grid%cz
F(k) = Fsurf + Fgrad * (grid%z(k) - (grid%zpos + grid%height))
end do
end subroutine
! --------------------------------------------------------------------------------
subroutine set_external_profile(F, filename, grid)
!< @brief set constant profile
! ----------------------------------------------------------------------------
type (gridDataType), intent(in) :: grid
real, dimension(grid%cz), intent(out) :: F
integer :: num
character(*), intent(in) :: filename
integer :: io, status
real :: val1, val2
real, allocatable :: depth(:), Fvalue(:)
real :: d
integer :: i, k
! --------------------------------------------------------------------------------
! --- define number of lines in file
open(newunit = io, file = filename, iostat = status, status ='old')
if (status /= 0) then
write(*, *) ' FAILURE! > unable to open file: ', trim(filename)
return
end if
num = 0
status = 0
do while (status.eq.0)
read (io, *, iostat = status) val1, val2
num = num + 1
enddo
num = num - 1
close(io)
if (num > 0) then
allocate(depth(num), Fvalue(num))
endif
! --- read input data
open(newunit = io, file = filename, iostat = status, status = 'old')
if (status /= 0) then
write(*, *) ' FAILURE! > unable to open file: ', trim(filename)
return
end if
do i = 1, num
read(io, *) depth(i), Fvalue(i)
enddo
close(io)
do k = 1, grid%cz
d = grid%zpos + grid%height - grid%z(k)
call c_interp_linear(F(k), d, Fvalue, depth, num)
end do
if (num > 0) then
deallocate(depth, Fvalue)
endif
end subroutine
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
! --------------------------------------------------------------------------------
subroutine set_config_profile(F, tag, grid, ierr)
!< @brief set constant profile
! ----------------------------------------------------------------------------
type (gridDataType), intent(in) :: grid
real, dimension(grid%cz), intent(out) :: F
integer, intent(out) :: ierr
character(len = *), intent(in) :: tag
character, allocatable :: config_field(:)
integer :: status
real :: Fsurf, Fgrad
! --------------------------------------------------------------------------------
ierr = 0 ! = OK
#ifdef USE_CONFIG_PARSER
call c_config_get_string(trim(tag)//".mode"//C_NULL_CHAR, config_field, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
if (trim(char_array2str(config_field)) == 'const') then
call c_config_get_float(trim(tag)//".surface_value"//C_NULL_CHAR, Fsurf, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
call set_const_profile(F, Fsurf, grid)
else if (trim(char_array2str(config_field)) == 'linear') then
call c_config_get_float(trim(tag)//".surface_value"//C_NULL_CHAR, Fsurf, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
call c_config_get_float(trim(tag)//".grad_z"//C_NULL_CHAR, Fgrad, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
call set_linear_profile(F, Fsurf, Fgrad, grid)
else if (trim(char_array2str(config_field)) == 'ascii') then
call c_config_get_string(trim(tag)//".filename"//C_NULL_CHAR, config_field, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
call set_external_profile(F, char_array2str(config_field), grid)
else
write(*, *) ' FAILURE! > unknown initial conditions mode: ', trim(char_array2str(config_field))
ierr = 1 ! signal ERROR
return
endif
#else
!> unable to define without config
ierr = 1
#endif
end subroutine