V3FIT
prior_gaussian.f
Go to the documentation of this file.
1 !*******************************************************************************
4 !
5 ! Note separating the Doxygen comment block here so detailed decription is
6 ! found in the Module not the file.
7 !
15 !*******************************************************************************
16 
17  MODULE prior_gaussian
18 
19  USE data_parameters
20  USE model
21  USE stel_kinds, only : rprec, dp
22  USE signal
23 
24  IMPLICIT NONE
25 
26 !*******************************************************************************
27 ! DERIVED-TYPE DECLARATIONS
28 ! 1) prior_gaussian base class
29 !
30 !*******************************************************************************
31 !-------------------------------------------------------------------------------
37 !-------------------------------------------------------------------------------
38  TYPE, EXTENDS(signal_class) :: prior_gaussian_class
40  INTEGER :: param_id = data_no_id
42  INTEGER, DIMENSION(2) :: indices = 0
43  CONTAINS
44  PROCEDURE :: &
45  & get_modeled_signal_last => prior_gaussian_get_modeled_signal
46  PROCEDURE :: &
47  & get_type => prior_gaussian_get_type
48  PROCEDURE :: get_gp_i => prior_gaussian_get_gp_i
49  PROCEDURE :: get_gp_s => prior_gaussian_get_gp_s
50  PROCEDURE :: get_gp_x => prior_gaussian_get_gp_x
51  PROCEDURE :: &
52  & write_auxiliary => prior_gaussian_write_auxiliary
53  final :: prior_gaussian_destruct
54  END TYPE prior_gaussian_class
55 
56 !*******************************************************************************
57 ! INTERFACE BLOCKS
58 !*******************************************************************************
59 !-------------------------------------------------------------------------------
61 !-------------------------------------------------------------------------------
62  INTERFACE prior_gaussian_class
63  MODULE PROCEDURE prior_gaussian_construct
64  END INTERFACE
65 
66  CONTAINS
67 !*******************************************************************************
68 ! CONSTRUCTION SUBROUTINES
69 !*******************************************************************************
70 !-------------------------------------------------------------------------------
79 !-------------------------------------------------------------------------------
80  FUNCTION prior_gaussian_construct(a_model, param_name, indices)
81 
82  IMPLICIT NONE
83 
84 ! Declare Arguments
85  class(prior_gaussian_class), POINTER :: &
86  & prior_gaussian_construct
87  TYPE (model_class), INTENT(in) :: a_model
88  CHARACTER (len=*), INTENT(in) :: param_name
89  INTEGER, DIMENSION(2), INTENT(in) :: indices
90 
91 ! local variables
92  REAL (rprec) :: start_time
93 
94 ! Start of executable code
95  start_time = profiler_get_start_time()
96 
97  ALLOCATE(prior_gaussian_construct)
98 
99  prior_gaussian_construct%param_id = &
100  & model_get_param_id(a_model, trim(param_name))
101  prior_gaussian_construct%indices = indices
102 
103  CALL profiler_set_stop_time('prior_gaussian_construct', &
104  & start_time)
105 
106  END FUNCTION
107 
108 !*******************************************************************************
109 ! DESTRUCTION SUBROUTINES
110 !*******************************************************************************
111 !-------------------------------------------------------------------------------
117 !-------------------------------------------------------------------------------
118  SUBROUTINE prior_gaussian_destruct(this)
119 
120  IMPLICIT NONE
121 
122 ! Declare Arguments
123  TYPE (prior_gaussian_class), INTENT(inout) :: this
124 
125 ! Start of executable code
126  this%param_id = data_no_id
127  this%indices = 0
128 
129  END SUBROUTINE
130 
131 !*******************************************************************************
132 ! GETTERS SUBROUTINES
133 !*******************************************************************************
134 !-------------------------------------------------------------------------------
144 !-------------------------------------------------------------------------------
145  FUNCTION prior_gaussian_get_modeled_signal(this, a_model, sigma, &
146  & last_value)
147 
148  IMPLICIT NONE
149 
150 ! Declare Arguments
151  REAL (rprec), DIMENSION(4) :: prior_gaussian_get_modeled_signal
152  class(prior_gaussian_class), INTENT(inout) :: this
153  TYPE (model_class), POINTER :: a_model
154  REAL (rprec), DIMENSION(4), INTENT(out) :: sigma
155  REAL (rprec), DIMENSION(4), INTENT(in) :: last_value
156 
157 ! local variables
158  REAL (rprec) :: start_time
159 
160 ! Start of executable code
161  start_time = profiler_get_start_time()
162 
163  prior_gaussian_get_modeled_signal = 0.0
164  prior_gaussian_get_modeled_signal(1) = &
165  & model_get_param_value(a_model, this%param_id, &
166  & this%indices(1), this%indices(2)) &
167  sigma = 0.0
168 
169  CALL this%scale_and_offset(a_model, &
170  & prior_gaussian_get_modeled_signal(1))
171 
172  CALL profiler_set_stop_time('prior_gaussian_get_modeled_signal', &
173  & start_time)
174 
175  END FUNCTION
176 
177 !-------------------------------------------------------------------------------
182 !-------------------------------------------------------------------------------
183  FUNCTION prior_gaussian_get_type(this)
184 
185  IMPLICIT NONE
186 
187 ! Declare Arguments
188  CHARACTER (len=data_name_length) :: prior_gaussian_get_type
189  class(prior_gaussian_class), INTENT(in) :: this
190 
191 ! local variables
192  REAL (rprec) :: start_time
193 
194 ! Start of executable code
195  start_time = profiler_get_start_time()
196 
197  prior_gaussian_get_type = 'guassian'
198 
199  CALL profiler_set_stop_time('prior_gaussian_get_type', &
200  & start_time)
201 
202  END FUNCTION
203 
204 !-------------------------------------------------------------------------------
217 !-------------------------------------------------------------------------------
218  FUNCTION prior_gaussian_get_gp_i(this, a_model, i, flags)
219 
220  IMPLICIT NONE
221 
222 ! Declare Arguments
223  REAL (rprec) :: prior_gaussian_get_gp_i
224  class(prior_gaussian_class), INTENT(in) :: this
225  TYPE (model_class), POINTER :: a_model
226  INTEGER, INTENT(in) :: i
227  INTEGER, INTENT(in) :: flags
228 
229 ! local variables
230  REAL (rprec) :: start_time
231 
232 ! Start of executable code
233  start_time = profiler_get_start_time()
234 
235  IF (btest(flags, model_state_ne_flag)) THEN
236  prior_gaussian_get_gp_i = &
237  & model_get_gp_ne(a_model, this%indices(1), i)
238  ELSE IF (btest(flags, model_state_te_flag)) THEN
239  prior_gaussian_get_gp_i = &
240  & model_get_gp_te(a_model, this%indices(1), i)
241  ELSE IF (btest(flags, model_state_ti_flag)) THEN
242  prior_gaussian_get_gp_i = &
243  & model_get_gp_ti(a_model, this%indices(1), i)
244  ELSE IF (btest(flags, model_state_sxrem_flag + &
245  & (this%indices(1) - 1))) THEN
246  prior_gaussian_get_gp_i = &
247  & model_get_gp_sxrem(a_model, this%indices(2), i, &
248  & this%indices(1))
249  ELSE
250  prior_gaussian_get_gp_i = 0.0
251  END IF
252 
253  CALL this%scale_and_offset(a_model, prior_gaussian_get_gp_i)
254 
255  CALL profiler_set_stop_time('prior_gaussian_get_gp_i', start_time)
256 
257  END FUNCTION
258 
259 !-------------------------------------------------------------------------------
271 !-------------------------------------------------------------------------------
272  FUNCTION prior_gaussian_get_gp_s(this, a_model, signal, flags)
273 
274  IMPLICIT NONE
275 
276 ! Declare Arguments
277  REAL (rprec) :: prior_gaussian_get_gp_s
278  class(prior_gaussian_class), INTENT(in) :: this
279  TYPE (model_class), POINTER :: a_model
280  class(signal_class), POINTER :: signal
281  INTEGER, INTENT(in) :: flags
282 
283 ! local variables
284  REAL (rprec) :: start_time
285 
286 ! Start of executable code
287  start_time = profiler_get_start_time()
288 
289  IF (btest(flags, model_state_ne_flag) .or. &
290  & btest(flags, model_state_te_flag) .or. &
291  & btest(flags, model_state_ti_flag)) THEN
292  prior_gaussian_get_gp_s = &
293  & signal%get_gp(a_model, this%indices(1), flags)
294  ELSE IF (btest(flags, model_state_sxrem_flag + &
295  & (this%indices(1) - 1))) THEN
296  prior_gaussian_get_gp_s = &
297  & signal%get_gp(a_model, this%indices(2), flags)
298  ELSE
299  prior_gaussian_get_gp_s = 0.0
300  END IF
301 
302  CALL this%scale_and_offset(a_model, prior_gaussian_get_gp_s)
303 
304  CALL profiler_set_stop_time('prior_gaussian_get_gp_s', start_time)
305 
306  END FUNCTION
307 
308 !-------------------------------------------------------------------------------
323 !-------------------------------------------------------------------------------
324  FUNCTION prior_gaussian_get_gp_x(this, a_model, x_cart, flags)
325 
326  IMPLICIT NONE
327 
328 ! Declare Arguments
329  REAL (rprec) :: prior_gaussian_get_gp_x
330  class(prior_gaussian_class), INTENT(in) :: this
331  TYPE (model_class), POINTER :: a_model
332  REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
333  INTEGER, INTENT(in) :: flags
334 
335 ! local variables
336  REAL (rprec) :: start_time
337 
338 ! Start of executable code
339  start_time = profiler_get_start_time()
340 
341  IF (btest(flags, model_state_ne_flag)) THEN
342  prior_gaussian_get_gp_x = model_get_gp_ne(a_model, x_cart, &
343  & this%indices(1))
344  ELSE IF (btest(flags, model_state_te_flag)) THEN
345  prior_gaussian_get_gp_x = model_get_gp_te(a_model, x_cart, &
346  & this%indices(1))
347  ELSE IF (btest(flags, model_state_ti_flag)) THEN
348  prior_gaussian_get_gp_x = model_get_gp_ti(a_model, x_cart, &
349  & this%indices(1))
350  ELSE IF (btest(flags, model_state_sxrem_flag + &
351  & (this%indices(1) - 1))) THEN
352  prior_gaussian_get_gp_x = model_get_gp_sxrem(a_model, x_cart, &
353  & this%indices(2), &
354  & this%indices(1))
355  ELSE
356  prior_gaussian_get_gp_x = 0.0
357  END IF
358 
359  CALL this%scale_and_offset(a_model, prior_gaussian_get_gp_x)
360 
361  CALL profiler_set_stop_time('prior_gaussian_get_gp_x', start_time)
362 
363  END FUNCTION
364 
365 !*******************************************************************************
366 ! UTILITY SUBROUTINES
367 !*******************************************************************************
368 !-------------------------------------------------------------------------------
377 !-------------------------------------------------------------------------------
378  SUBROUTINE prior_gaussian_write_auxiliary(this, iou, index, &
379  & a_model)
380 
381  IMPLICIT NONE
382 
383 ! Declare Arguments
384  class(prior_gaussian_class), INTENT(in) :: this
385  INTEGER, INTENT(in) :: iou
386  INTEGER, INTENT(in) :: index
387  TYPE (model_class), INTENT(in) :: a_model
388 
389 ! local variables
390  REAL (rprec) :: start_time
391 
392 ! Start of executable code
393  start_time = profiler_get_start_time()
394 
395  WRITE (iou,*)
396  WRITE (iou,1000) index, this%get_type()
397  WRITE (iou,1001)
398  WRITE (iou,1002) model_get_param_name(a_model, this%param_id), &
399  & this%indices
400 
401  CALL profiler_set_stop_time('prior_gaussian_write_auxiliary', &
402  & start_time)
403 
404 1000 FORMAT('Signal',1x,i4,1x,'is a prior signal, type: ',a)
405 1001 FORMAT('parameter name',8x,'inx1',2x,'inx2')
406 1002 FORMAT(a20,2(2x,i4))
407 
408  END SUBROUTINE
409 
410  END MODULE
prior_gaussian::prior_gaussian_get_gp_s
real(rprec) function prior_gaussian_get_gp_s(this, a_model, signal, flags)
Gets the guassian process kernel for a prior signal and a signal.
Definition: prior_gaussian.f:273
model
Defines the base class of the type model_class. The model contains information not specific to the eq...
Definition: model.f:59
prior_gaussian::prior_gaussian_class
Base class representing a prior_guassian signal.
Definition: prior_gaussian.f:38
prior_gaussian::prior_gaussian_destruct
subroutine prior_gaussian_destruct(this)
Deconstruct a prior_gaussian_class object.
Definition: prior_gaussian.f:119
prior_gaussian::prior_gaussian_get_modeled_signal
real(rprec) function, dimension(4) prior_gaussian_get_modeled_signal(this, a_model, sigma, last_value)
Calculates the modeled signal.
Definition: prior_gaussian.f:147
prior_gaussian::prior_gaussian_get_gp_x
real(rprec) function prior_gaussian_get_gp_x(this, a_model, x_cart, flags)
Gets the guassian process kernel for a prior signal and a cartesian position.
Definition: prior_gaussian.f:325
model::model_get_param_value
real(rprec) function model_get_param_value(this, id, i_index, j_index)
Gets the value of a model parameter.
Definition: model.f:970
model::model_get_gp_te
Interface for the model guassian process electron temperature profile values.
Definition: model.f:249
prior_gaussian::prior_gaussian_write_auxiliary
subroutine prior_gaussian_write_auxiliary(this, iou, index, a_model)
Write out auxiliary signal information to an output file.
Definition: prior_gaussian.f:380
model::model_get_param_id
integer function model_get_param_id(this, param_name)
Get the id for a parameter.
Definition: model.f:885
model::model_class
Base class representing a model.
Definition: model.f:141
data_parameters::data_no_id
integer, parameter data_no_id
Default parameter id specifiying no id.
Definition: data_parameters.f:26
model::model_get_gp_ti
Interface for the model guassian process ion temperature profile values.
Definition: model.f:266
prior_gaussian::prior_gaussian_get_type
character(len=data_name_length) function prior_gaussian_get_type(this)
Gets a discription of the prior type.
Definition: prior_gaussian.f:184
model::model_get_gp_ne
Interface for the model guassian process density profile values.
Definition: model.f:231
model::model_get_gp_sxrem
Interface for the mdoel guassian process soft x-ray emissivity profile values.
Definition: model.f:292
data_parameters
This modules contains parameters used by equilibrium models.
Definition: data_parameters.f:10
prior_gaussian::prior_gaussian_get_gp_i
real(rprec) function prior_gaussian_get_gp_i(this, a_model, i, flags)
Gets the guassian process kernel for a prior signal and a position.
Definition: prior_gaussian.f:219
model::model_get_param_name
character(len=data_name_length) function model_get_param_name(this, id)
Gets the name of a model parameter.
Definition: model.f:1081
signal::signal_class
Base class representing a signal.
Definition: signal.f:33
prior_gaussian
Defines the base class of the type prior_gaussian_class. This class implements priors of the type.
Definition: prior_gaussian.f:17
signal
Defines the base class of the type signal_class.
Definition: signal.f:14
prior_gaussian::prior_gaussian_construct
class(prior_gaussian_class) function, pointer prior_gaussian_construct(a_model, param_name, indices)
Construct a prior_gaussian_class object.
Definition: prior_gaussian.f:81
Generated on Thu Mar 5 2020 15:49:26 for V3FIT by   doxygen 1.8.17