V3FIT
model.f
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
2 ! The @header, @table_section, @table_subsection, @item and @end_table commands
3 ! are custom defined commands in Doxygen.in. They are defined under ALIASES.
4 ! For the page created here, the 80 column limit is exceeded. Arguments of
5 ! aliases are separated by ','. If you intended ',' to be a string you must use
6 ! an escaped comma '\,'.
7 !
48 !*******************************************************************************
51 !
52 ! Note separating the Doxygen comment block here so detailed decription is
53 ! found in the Module not the file.
54 !
57 !*******************************************************************************
58 
59  MODULE model
60  USE equilibrium
61  USE emission
62  USE model_state
63  USE integration_path, ONLY: path_int_class
64 
65  IMPLICIT NONE
66 
67 !*******************************************************************************
68 ! model module parameters
69 !*******************************************************************************
71  INTEGER, PARAMETER, PRIVATE :: model_none_type = -1
72 
74  INTEGER, PARAMETER, PRIVATE :: model_ne_type = 0
76  INTEGER, PARAMETER, PRIVATE :: model_ne_te_p_type = 1
77 
79  INTEGER, PARAMETER, PRIVATE :: model_sxrem_type = 0
81  INTEGER, PARAMETER, PRIVATE :: model_sxrem_te_ne_type = 1
82 
84  INTEGER, PARAMETER, PRIVATE :: model_te_type = 0
86  INTEGER, PARAMETER, PRIVATE :: model_te_ne_p_type = 1
87 
89  INTEGER, PARAMETER, PRIVATE :: model_ti_type = 0
90 
92  INTEGER, PARAMETER, PRIVATE :: model_ze_type = 0
93 
94 ! Model parameter ids
96  INTEGER, PARAMETER :: model_ne_unit_id = 0
98  INTEGER, PARAMETER :: model_ne_min_id = 1
100  INTEGER, PARAMETER :: model_te_min_id = 2
102  INTEGER, PARAMETER :: model_ti_min_id = 3
104  INTEGER, PARAMETER :: model_pressure_fraction_id = 4
106  INTEGER, PARAMETER :: model_ze_min_id = 5
108  INTEGER, PARAMETER :: model_sxrem_min_id = 6
110  INTEGER, PARAMETER :: model_coosig_wgts_id = 7
112  INTEGER, PARAMETER :: model_signal_factor_id = 8
114  INTEGER, PARAMETER :: model_signal_offset_id = 9
115 
116 ! Derived Parameters
118  INTEGER, PARAMETER :: model_ne_grid_id = 10
120  INTEGER, PARAMETER :: model_te_grid_id = 11
122  INTEGER, PARAMETER :: model_ti_grid_id = 12
124  INTEGER, PARAMETER :: model_sxrem_grid_id = 13
126  INTEGER, PARAMETER :: model_ze_grid_id = 14
127 ! NOTE: When model parameters are added here, the equilibrium id's need to be
128 ! updated in additon.
129 
131  REAL(rprec), PARAMETER :: ev_per_joule = one/1.602e-19_rprec
132 
133 !*******************************************************************************
134 ! DERIVED-TYPE DECLARATIONS
135 ! 1) model class
136 !
137 !*******************************************************************************
138 !-------------------------------------------------------------------------------
140 !-------------------------------------------------------------------------------
141  TYPE model_class
143  INTEGER :: state_flags = model_state_all_off
144 
147  INTEGER :: ne_type = model_none_type
150  INTEGER, DIMENSION(:), POINTER :: sxrem_type => null()
153  INTEGER :: te_type = model_none_type
156  INTEGER :: ti_type = model_none_type
159  INTEGER :: ze_type = model_none_type
161  REAL (rprec) :: ne_unit = 1.0
163  REAL (rprec) :: ne_min = 0.0
165  REAL (rprec) :: te_min = 0.0
167  REAL (rprec) :: ti_min = 0.0
169  REAL (rprec) :: ze_min = 1.0
171  REAL (rprec), DIMENSION(:), POINTER :: sxrem_min => null()
173  REAL (rprec) :: pressure_fraction = 0.0
175  REAL (rprec), DIMENSION(:), POINTER :: coosig_wgts => null()
176 
178  TYPE (emission_class), POINTER :: emission => null()
180  REAL (rprec), DIMENSION(:,:), POINTER :: transmission => null()
181 
183  TYPE (equilibrium_class), POINTER :: equilibrium => null()
184 
186  REAL (rprec) :: grid_start
188  REAL (rprec) :: grid_step
190  REAL (rprec), DIMENSION(:), POINTER :: ne_grid => null()
192  REAL (rprec), DIMENSION(:,:), POINTER :: sxrem_grid => null()
194  REAL (rprec), DIMENSION(:), POINTER :: te_grid => null()
196  REAL (rprec), DIMENSION(:), POINTER :: ti_grid => null()
198  REAL (rprec), DIMENSION(:), POINTER :: ze_grid => null()
199 
201  REAL (rprec), DIMENSION(:), POINTER :: sxrem_te => null()
203  REAL (rprec), DIMENSION(:), POINTER :: sxrem_ratio => null()
204 
206  REAL (rprec) :: resonace_range
207 
209  REAL (rprec), DIMENSION(:), POINTER :: signal_factor => null()
211  REAL (rprec), DIMENSION(:), POINTER :: signal_offset => null()
212 
214  TYPE (path_int_class), POINTER :: int_params => null()
215  END TYPE
216 
217 !*******************************************************************************
218 ! INTERFACE BLOCKS
219 !*******************************************************************************
220 !-------------------------------------------------------------------------------
222 !-------------------------------------------------------------------------------
223  INTERFACE model_get_ne
224  MODULE PROCEDURE model_get_ne_cart, &
225  & model_get_ne_radial
226  END INTERFACE
227 
228 !-------------------------------------------------------------------------------
230 !-------------------------------------------------------------------------------
231  INTERFACE model_get_gp_ne
232  MODULE PROCEDURE model_get_gp_ne_ij, &
233  & model_get_gp_ne_pi, &
234  & model_get_gp_ne_pp
235  END INTERFACE
236 
237 !-------------------------------------------------------------------------------
239 !-------------------------------------------------------------------------------
240  INTERFACE model_get_te
241  MODULE PROCEDURE model_get_te_cart, &
242  & model_get_te_radial
243  END INTERFACE
244 
245 !-------------------------------------------------------------------------------
248 !-------------------------------------------------------------------------------
249  INTERFACE model_get_gp_te
250  MODULE PROCEDURE model_get_gp_te_ij, &
251  & model_get_gp_te_pi, &
252  & model_get_gp_te_pp
253  END INTERFACE
254 
255 !-------------------------------------------------------------------------------
257 !-------------------------------------------------------------------------------
258  INTERFACE model_get_ti
259  MODULE PROCEDURE model_get_ti_cart, &
260  & model_get_ti_radial
261  END INTERFACE
262 
263 !-------------------------------------------------------------------------------
265 !-------------------------------------------------------------------------------
266  INTERFACE model_get_gp_ti
267  MODULE PROCEDURE model_get_gp_ti_ij, &
268  & model_get_gp_ti_pi, &
269  & model_get_gp_ti_pp
270  END INTERFACE
271 
272 !-------------------------------------------------------------------------------
274 !-------------------------------------------------------------------------------
275  INTERFACE model_get_ze
276  MODULE PROCEDURE model_get_ze_cart, &
277  & model_get_ze_radial
278  END INTERFACE
279 
280 !-------------------------------------------------------------------------------
282 !-------------------------------------------------------------------------------
283  INTERFACE model_get_sxrem
284  MODULE PROCEDURE model_get_sxrem_cart, &
285  & model_get_sxrem_radial
286  END INTERFACE
287 
288 !-------------------------------------------------------------------------------
291 !-------------------------------------------------------------------------------
292  INTERFACE model_get_gp_sxrem
293  MODULE PROCEDURE model_get_gp_sxrem_ij, &
294  & model_get_gp_sxrem_pi, &
295  & model_get_gp_sxrem_pp
296  END INTERFACE
297 
298  CONTAINS
299 !*******************************************************************************
300 ! CONSTRUCTION SUBROUTINES
301 !*******************************************************************************
302 !-------------------------------------------------------------------------------
333 !-------------------------------------------------------------------------------
334  FUNCTION model_construct(ne_type, sxrem_type, te_type, ti_type, &
335  & ze_type, ne_unit, ne_min, te_min, ti_min, &
336  & ze_min, sxrem_min, pressure_fraction, &
337  & emission, equilibrium, sxrem_te, &
338  & sxrem_ratio, resonace_range, coosig_wgts, &
339  & state_flags, signal_factor, &
340  & signal_offset, int_params)
341  USE model_state
342 
343  IMPLICIT NONE
344 
345 ! Declare Arguments
346  TYPE (model_class), POINTER :: model_construct
347  CHARACTER (len=data_name_length), INTENT(in) :: ne_type
348  CHARACTER (len=data_name_length), DIMENSION(:), INTENT(in) :: &
349  & sxrem_type
350  CHARACTER (len=data_name_length), INTENT(in) :: te_type
351  CHARACTER (len=data_name_length), INTENT(in) :: ti_type
352  CHARACTER (len=data_name_length), INTENT(in) :: ze_type
353  REAL (rprec), INTENT(in) :: ne_unit
354  REAL (rprec), INTENT(in) :: ne_min
355  REAL (rprec), INTENT(in) :: te_min
356  REAL (rprec), INTENT(in) :: ti_min
357  REAL (rprec), INTENT(in) :: ze_min
358  REAL (rprec), DIMENSION(:), INTENT(in) :: sxrem_min
359  REAL (rprec), INTENT(in) :: pressure_fraction
360  TYPE (emission_class), POINTER :: emission
361  TYPE (equilibrium_class), POINTER :: equilibrium
362  REAL (rprec), DIMENSION(:), INTENT(in) :: sxrem_te
363  REAL (rprec), DIMENSION(:), INTENT(in) :: sxrem_ratio
364  REAL (rprec), INTENT(in) :: resonace_range
365  REAL (rprec), DIMENSION(:), INTENT(in) :: coosig_wgts
366  INTEGER, INTENT(in) :: state_flags
367  REAL (rprec), DIMENSION(:) :: signal_factor
368  REAL (rprec), DIMENSION(:) :: signal_offset
369  TYPE (path_int_class), POINTER :: int_params
370 
371 ! local variables
372  INTEGER :: i
373  INTEGER :: grid_size
374  REAL (rprec) :: start_time
375 
376 ! Start of executable code
377  start_time = profiler_get_start_time()
378 
379  ALLOCATE(model_construct)
380 
381  model_construct%state_flags = state_flags
382 
383  SELECT CASE (trim(adjustl(ne_type)))
384 
385  CASE ('none')
386  model_construct%ne_type = model_none_type
387 
388  CASE ('pp_ne')
389  model_construct%ne_type = model_ne_type
390 
391  CASE ('pp_te_p')
392  model_construct%ne_type = model_ne_te_p_type
393 
394  CASE DEFAULT
395  WRITE (*,*) 'ne type: ' // trim(adjustl(ne_type)) // &
396  & ' setting type to none.'
397  model_construct%ne_type = model_none_type
398 
399  END SELECT
400 
401  ALLOCATE(model_construct%sxrem_type(SIZE(sxrem_type)))
402  DO i = 1, SIZE(sxrem_type)
403 
404  SELECT CASE (trim(adjustl(sxrem_type(i))))
405 
406  CASE ('none')
407  model_construct%sxrem_type(i) = model_none_type
408 
409  CASE ('pp_sxrem')
410  model_construct%sxrem_type(i) = model_sxrem_type
411 
412  CASE ('pp_sxrem_te_ne')
413  model_construct%sxrem_type(i) = &
414  & model_sxrem_te_ne_type
415 
416  CASE DEFAULT
417  WRITE (*,*) &
418  & 'sxrem type: ' // trim(adjustl(sxrem_type(i))) // &
419  & ' setting type to none.'
420  model_construct%sxrem_type(i) = model_none_type
421 
422  END SELECT
423 
424  END DO
425 
426  SELECT CASE (trim(adjustl(te_type)))
427 
428  CASE ('none')
429  model_construct%te_type = model_none_type
430 
431  CASE ('pp_te')
432  model_construct%te_type = model_te_type
433 
435  CASE ('pp_ne_vmec_p', 'pp_ne_p')
436  model_construct%te_type = model_te_ne_p_type
437 
438  CASE DEFAULT
439  WRITE (*,*) 'te type: ' // trim(adjustl(te_type)) // &
440  & ' setting type to none.'
441  model_construct%te_type = model_none_type
442 
443  END SELECT
444 
445  SELECT CASE (trim(adjustl(ti_type)))
446 
447  CASE ('none')
448  model_construct%ti_type = model_none_type
449 
450  CASE ('pp_ti')
451  model_construct%ti_type = model_ti_type
452 
453  CASE DEFAULT
454  WRITE (*,*) 'ti type: ' // trim(adjustl(ti_type)) // &
455  & ' setting type to none.'
456  model_construct%ti_type = model_none_type
457 
458  END SELECT
459 
460  SELECT CASE (trim(adjustl(ze_type)))
461 
462  CASE ('none')
463  model_construct%ze_type = model_none_type
464 
465  CASE ('pp_ze')
466  model_construct%ze_type = model_ze_type
467 
468  CASE DEFAULT
469  WRITE (*,*) 'ze type: ' // trim(adjustl(te_type)) // &
470  & ' setting type to none.'
471  model_construct%ze_type = model_none_type
472 
473  END SELECT
474 
475 ! Cannot have the temperature derived from the denisty at the same time the
476 ! density is derived from the temperature.
477  CALL assert(.not.( &
478  & (model_construct%te_type .eq. model_te_ne_p_type) &
479  & .and. &
480  & (model_construct%ne_type .eq. model_ne_te_p_type)), &
481  & 'Cannot derive both the denisty and temperature' // &
482  & ' from pressure in the same model.')
483 
484  model_construct%ne_unit = ne_unit
485  model_construct%ne_min = ne_min
486  model_construct%te_min = te_min
487  model_construct%ti_min = ti_min
488  model_construct%ze_min = ze_min
489  ALLOCATE(model_construct%sxrem_min(SIZE(sxrem_min)))
490  model_construct%sxrem_min = sxrem_min
491  model_construct%pressure_fraction = pressure_fraction
492 
493  ALLOCATE(model_construct%coosig_wgts(SIZE(coosig_wgts)))
494  DO i = 1, SIZE(coosig_wgts)
495  model_construct%coosig_wgts(i)=coosig_wgts(i)
496  ENDDO
497 
498  model_construct%emission => emission
499  IF (ASSOCIATED(model_construct%emission)) THEN
500 
501  END IF
502 
503  model_construct%equilibrium => equilibrium
504 
505  grid_size = equilibrium_get_grid_size(equilibrium)
506 
507  IF (grid_size .gt. 0) THEN
508  CALL model_set_grid_params(model_construct, grid_size)
509 
510  ALLOCATE(model_construct%ne_grid(grid_size))
511  ALLOCATE(model_construct%sxrem_grid(grid_size, &
512  & SIZE(sxrem_type)))
513  ALLOCATE(model_construct%te_grid(grid_size))
514  ALLOCATE(model_construct%ti_grid(grid_size))
515  ALLOCATE(model_construct%ze_grid(grid_size))
516  END IF
517 
518 ! Find the size of the sxrem ratio arrays.
519  grid_size = minloc(sxrem_te(2:), dim=1)
520  IF (grid_size .gt. 1) THEN
521  ALLOCATE(model_construct%sxrem_te(grid_size))
522  model_construct%sxrem_te = sxrem_te(1:grid_size)
523 
524  ALLOCATE(model_construct%sxrem_ratio(grid_size))
525  model_construct%sxrem_ratio = sxrem_ratio(1:grid_size)
526  END IF
527 
528  ALLOCATE(model_construct%signal_factor(SIZE(signal_factor)))
529  model_construct%signal_factor = signal_factor
530 
531  ALLOCATE(model_construct%signal_offset(SIZE(signal_offset)))
532  model_construct%signal_offset = signal_offset
533 
534  model_construct%resonace_range = resonace_range
535 
536  model_construct%int_params => int_params
537 
538  CALL profiler_set_stop_time('model_construct', start_time)
539 
540  END FUNCTION
541 
542 !*******************************************************************************
543 ! DESTRUCTION SUBROUTINES
544 !*******************************************************************************
545 !-------------------------------------------------------------------------------
551 !-------------------------------------------------------------------------------
552  SUBROUTINE model_destruct(this)
553 
554  IMPLICIT NONE
555 
556 ! Declare Arguments
557  TYPE (model_class), POINTER :: this
558 
559 ! Start of executable code
560  IF (ASSOCIATED(this%sxrem_type)) THEN
561  DEALLOCATE(this%sxrem_type)
562  this%sxrem_type => null()
563  END IF
564 
565  IF (ASSOCIATED(this%emission)) THEN
566  CALL emission_destruct(this%emission)
567  this%emission => null()
568  END IF
569 
570  IF (ASSOCIATED(this%equilibrium)) THEN
571  CALL equilibrium_destruct(this%equilibrium)
572  this%equilibrium => null()
573  END IF
574 
575  IF (ASSOCIATED(this%sxrem_min)) THEN
576  DEALLOCATE(this%sxrem_min)
577  this%sxrem_min => null()
578  END IF
579 
580  IF (ASSOCIATED(this%ne_grid)) THEN
581  DEALLOCATE(this%ne_grid)
582  this%ne_grid => null()
583  END IF
584 
585  IF (ASSOCIATED(this%sxrem_grid)) THEN
586  DEALLOCATE(this%sxrem_grid)
587  this%sxrem_grid => null()
588  END IF
589 
590  IF (ASSOCIATED(this%te_grid)) THEN
591  DEALLOCATE(this%te_grid)
592  this%te_grid => null()
593  END IF
594 
595  IF (ASSOCIATED(this%ti_grid)) THEN
596  DEALLOCATE(this%ti_grid)
597  this%ti_grid => null()
598  END IF
599 
600  IF (ASSOCIATED(this%ze_grid)) THEN
601  DEALLOCATE(this%ze_grid)
602  this%ze_grid => null()
603  END IF
604 
605  IF (ASSOCIATED(this%sxrem_te)) THEN
606  DEALLOCATE(this%sxrem_te)
607  this%sxrem_te => null()
608  END IF
609 
610  IF (ASSOCIATED(this%sxrem_ratio)) THEN
611  DEALLOCATE(this%sxrem_ratio)
612  this%sxrem_ratio => null()
613  END IF
614 
615  IF (ASSOCIATED(this%coosig_wgts)) THEN
616  DEALLOCATE(this%coosig_wgts)
617  this%coosig_wgts => null()
618  END IF
619 
620  IF (ASSOCIATED(this%signal_factor)) THEN
621  DEALLOCATE(this%signal_factor)
622  this%signal_factor => null()
623  END IF
624 
625  IF (ASSOCIATED(this%signal_offset)) THEN
626  DEALLOCATE(this%signal_offset)
627  this%signal_offset => null()
628  END IF
629 
630  IF (ASSOCIATED(this%int_params)) THEN
631  DEALLOCATE(this%int_params)
632  this%int_params => null()
633  END IF
634 
635  DEALLOCATE(this)
636 
637  END SUBROUTINE
638 
639 !*******************************************************************************
640 ! SETTER SUBROUTINES
641 !*******************************************************************************
642 !-------------------------------------------------------------------------------
655 !-------------------------------------------------------------------------------
656  SUBROUTINE model_set_param(this, id, i_index, j_index, value, &
657  & eq_comm)
658 
659  IMPLICIT NONE
660 
661 ! Declare Arguments
662  TYPE (model_class), INTENT(inout) :: this
663  INTEGER, INTENT(in) :: id
664  INTEGER, INTENT(in) :: i_index
665  INTEGER, INTENT(in) :: j_index
666  REAL (rprec), INTENT(in) :: value
667  INTEGER, INTENT(in) :: eq_comm
668 
669 ! local variables
670  INTEGER :: i
671  REAL (rprec) :: start_time
672 
673 ! Start of executable code
674  start_time = profiler_get_start_time()
675 
676  SELECT CASE (id)
677 
678  CASE (model_ne_unit_id)
679  this%state_flags = ibset(this%state_flags, &
680  & model_state_ne_flag)
681  this%ne_unit = value
682 
683  CASE (model_ne_min_id)
684  this%state_flags = ibset(this%state_flags, &
685  & model_state_ne_flag)
686  this%ne_min = value
687 
688  CASE (model_te_min_id)
689  this%state_flags = ibset(this%state_flags, &
690  & model_state_te_flag)
691  this%te_min = value
692 
693  CASE (model_ti_min_id)
694  this%state_flags = ibset(this%state_flags, &
695  & model_state_ti_flag)
696  this%ti_min = value
697 
698  CASE (model_ze_min_id)
699  this%state_flags = ibset(this%state_flags, &
700  & model_state_ze_flag)
701  this%ze_min = value
702 
703  CASE (model_sxrem_min_id)
704  this%state_flags = ibset(this%state_flags, &
705  & model_state_sxrem_flag + &
706  & (i_index - 1))
707  this%sxrem_min(i_index) = value
708 
709  CASE (model_pressure_fraction_id)
710  IF (this%te_type .eq. model_te_ne_p_type) THEN
711  this%state_flags = ibset(this%state_flags, &
712  & model_state_te_flag)
713  END IF
714  IF (this%ne_type .eq. model_ne_te_p_type) THEN
715  this%state_flags = ibset(this%state_flags, &
716  & model_state_ne_flag)
717  END IF
718  this%pressure_fraction = value
719 
720  CASE (model_coosig_wgts_id)
721  this%coosig_wgts(i_index) = value
722 
723  CASE (model_signal_factor_id)
724  this%state_flags = ibset(this%state_flags, &
725  & model_state_signal_flag)
726  this%signal_factor(i_index) = value
727 
728  CASE (model_signal_offset_id)
729  this%state_flags = ibset(this%state_flags, &
730  & model_state_signal_flag)
731  this%signal_offset(i_index) = value
732 
733  CASE DEFAULT
734  CALL equilibrium_set_param(this%equilibrium, id, &
735  & i_index, j_index, value, eq_comm, &
736  & this%state_flags)
737 
738  END SELECT
739 
740 ! Some parts of the model depend on different parts of the model. Update the
741 ! state flags to refect these changes.
742 
743  IF ((this%ne_type .eq. model_ne_te_p_type) .and. &
744  & (btest(this%state_flags, model_state_te_flag))) THEN
745  this%state_flags = ibset(this%state_flags, model_state_ne_flag)
746  END IF
747 
748 ! There are multiple sxrem profiles. State flags bit position needs to be
749 ! off set by the i index.
750  DO i = 1, SIZE(this%sxrem_type)
751  IF ((this%sxrem_type(i) .eq. model_sxrem_te_ne_type) .and. &
752  & (btest(this%state_flags, model_state_te_flag) .or. &
753  & btest(this%state_flags, model_state_ne_flag))) THEN
754  this%state_flags = ibset(this%state_flags, &
755  & model_state_sxrem_flag + (i - 1))
756  END IF
757  END DO
758 
759  IF ((this%te_type .eq. model_te_ne_p_type) .and. &
760  & (btest(this%state_flags, model_state_ne_flag))) THEN
761  this%state_flags = ibset(this%state_flags, model_state_te_flag)
762  END IF
763 
764  CALL profiler_set_stop_time('model_set_param', start_time)
765 
766  END SUBROUTINE
767 
768 !-------------------------------------------------------------------------------
775 !-------------------------------------------------------------------------------
776  SUBROUTINE model_set_grid_params(this, size)
777 
778  IMPLICIT NONE
779 
780 ! Declare Arguments
781  TYPE (model_class), INTENT(inout) :: this
782  INTEGER, INTENT(in) :: size
783 
784 ! local variables
785  REAL (rprec) :: grid_stop
786  REAL (rprec) :: start_time
787 
788 ! Start of executable code
789  start_time = profiler_get_start_time()
790 
791  this%grid_start = equilibrium_get_grid_start(this%equilibrium)
792  grid_stop = equilibrium_get_grid_stop(this%equilibrium)
793 
794  this%grid_step = (grid_stop - this%grid_start)/(size - 1)
795 
796  CALL profiler_set_stop_time('model_set_grid_params', start_time)
797 
798  END SUBROUTINE
799 
800 !-------------------------------------------------------------------------------
806 !-------------------------------------------------------------------------------
807  SUBROUTINE model_set_grid_profiles(this)
808 
809  IMPLICIT NONE
810 
811 ! Declare Arguments
812  TYPE (model_class), INTENT(inout) :: this
813 
814 ! local variables
815  INTEGER :: i
816  INTEGER :: j
817  REAL (rprec) :: r
818  REAL (rprec) :: start_time
819 
820 ! Start of executable code
821  start_time = profiler_get_start_time()
822 
823  IF (ASSOCIATED(this%ne_grid) .and. &
824  & btest(this%state_flags, model_state_ne_flag)) THEN
825  DO i = 1, SIZE(this%ne_grid)
826  r = (i - 1)*this%grid_step + this%grid_start
827  this%ne_grid(i) = model_get_ne(this, r)
828  END DO
829  END IF
830 
831  IF (ASSOCIATED(this%sxrem_grid)) THEN
832  DO j = 1, SIZE(this%sxrem_grid, 2)
833  IF (btest(this%state_flags, &
834  & model_state_sxrem_flag + (j - 1))) THEN
835  DO i = 1, SIZE(this%sxrem_grid, 1)
836  r = (i - 1)*this%grid_step + this%grid_start
837  this%sxrem_grid(i,j) = model_get_sxrem(this, r, j)
838  END DO
839  END IF
840  END DO
841  END IF
842 
843  IF (ASSOCIATED(this%te_grid) .and. &
844  & btest(this%state_flags, model_state_te_flag)) THEN
845  DO i = 1, SIZE(this%te_grid)
846  r = (i - 1)*this%grid_step + this%grid_start
847  this%te_grid(i) = model_get_te(this, r)
848  END DO
849  END IF
850 
851  IF (ASSOCIATED(this%ti_grid) .and. &
852  & btest(this%state_flags, model_state_ti_flag)) THEN
853  DO i = 1, SIZE(this%ti_grid)
854  r = (i - 1)*this%grid_step + this%grid_start
855  this%ti_grid(i) = model_get_ti(this, r)
856  END DO
857  END IF
858 
859  IF (ASSOCIATED(this%ze_grid) .and. &
860  & btest(this%state_flags, model_state_ze_flag)) THEN
861  DO i = 1, SIZE(this%ze_grid)
862  r = (i - 1)*this%grid_step + this%grid_start
863  this%ze_grid(i) = model_get_ze(this, r)
864  END DO
865  END IF
866 
867  CALL profiler_set_stop_time('model_set_grid_params', start_time)
868 
869  END SUBROUTINE
870 
871 !*******************************************************************************
872 ! GETTER SUBROUTINES
873 !*******************************************************************************
874 !-------------------------------------------------------------------------------
883 !-------------------------------------------------------------------------------
884  FUNCTION model_get_param_id(this, param_name)
885 
886  IMPLICIT NONE
887 
888 ! Declare Arguments
889  INTEGER :: model_get_param_id
890  TYPE (model_class), INTENT(in) :: this
891  CHARACTER (len=*), INTENT(in) :: param_name
892 
893 ! local variables
894  REAL (rprec) :: start_time
895 
896 ! Start of executable code
897  start_time = profiler_get_start_time()
898 
899  SELECT CASE (trim(param_name))
900 
901  CASE ('ne_unit')
902  model_get_param_id = model_ne_unit_id
903 
904  CASE ('ne_min')
905  model_get_param_id = model_ne_min_id
906 
907  CASE ('te_min')
908  model_get_param_id = model_te_min_id
909 
910  CASE ('ti_min')
911  model_get_param_id = model_ti_min_id
912 
913  CASE ('ze_min')
914  model_get_param_id = model_ze_min_id
915 
916  CASE ('sxrem_min')
917  model_get_param_id = model_sxrem_min_id
918 
919  CASE ('pressure_fraction', 'e_pressure_fraction')
920  model_get_param_id = model_pressure_fraction_id
921 
922  CASE ('signal_factor', 'sfactor_spec_fac')
923  model_get_param_id = model_signal_factor_id
924 
925  CASE ('signal_offset', 'soffset_spec_fac')
926  model_get_param_id = model_signal_offset_id
927 
928  CASE ('ne_grid')
929  model_get_param_id = model_ne_grid_id
930 
931  CASE ('te_grid')
932  model_get_param_id = model_te_grid_id
933 
934  CASE ('ti_grid')
935  model_get_param_id = model_ti_grid_id
936 
937  CASE ('sxrem_grid')
938  model_get_param_id = model_sxrem_grid_id
939 
940  CASE ('ze_grid')
941  model_get_param_id = model_ze_grid_id
942 
943  CASE ('coosig_wgts')
944  model_get_param_id = model_coosig_wgts_id
945 
946  CASE DEFAULT
947  model_get_param_id = &
948  & equilibrium_get_param_id(this%equilibrium, param_name)
949 
950  END SELECT
951 
952  CALL profiler_set_stop_time('model_get_param_id', start_time)
953 
954  END FUNCTION
955 
956 !-------------------------------------------------------------------------------
968 !-------------------------------------------------------------------------------
969  FUNCTION model_get_param_value(this, id, i_index, j_index)
970 
971  IMPLICIT NONE
972 
973 ! Declare Arguments
974  REAL (rprec) :: model_get_param_value
975  TYPE (model_class), INTENT(in) :: this
976  INTEGER, INTENT(in) :: id
977  INTEGER, INTENT(in) :: i_index
978  INTEGER, INTENT(in) :: j_index
979 
980 ! local variables
981  REAL (rprec) :: start_time
982 
983 ! Start of executable code
984  start_time = profiler_get_start_time()
985 
986  SELECT CASE (id)
987 
988  CASE (model_ne_unit_id)
989  model_get_param_value = this%ne_unit
990 
991  CASE (model_ne_min_id)
992  model_get_param_value = this%ne_min
993 
994  CASE (model_te_min_id)
995  model_get_param_value = this%te_min
996 
997  CASE (model_ti_min_id)
998  model_get_param_value = this%ti_min
999 
1000  CASE (model_ze_min_id)
1001  model_get_param_value = this%ze_min
1002 
1003  CASE (model_sxrem_min_id)
1004  model_get_param_value = this%sxrem_min(i_index)
1005 
1006  CASE (model_pressure_fraction_id)
1007  model_get_param_value = this%pressure_fraction
1008 
1009  CASE (model_signal_factor_id)
1010  model_get_param_value = this%signal_factor(i_index)
1011 
1012  CASE (model_signal_offset_id)
1013  model_get_param_value = this%signal_offset(i_index)
1014 
1015 ! Not every equilibrium will provide a grid for these profiles.
1016  CASE (model_ne_grid_id)
1017  IF (ASSOCIATED(this%ne_grid)) THEN
1018  model_get_param_value = this%ne_grid(i_index)
1019  ELSE
1020  model_get_param_value = 0.0
1021  END IF
1022 
1023  CASE (model_te_grid_id)
1024  IF (ASSOCIATED(this%te_grid)) THEN
1025  model_get_param_value = this%te_grid(i_index)
1026  ELSE
1027  model_get_param_value = 0.0
1028  END IF
1029 
1030  CASE (model_ti_grid_id)
1031  IF (ASSOCIATED(this%ti_grid)) THEN
1032  model_get_param_value = this%ti_grid(i_index)
1033  ELSE
1034  model_get_param_value = 0.0
1035  END IF
1036 
1037  CASE (model_ze_grid_id)
1038  IF (ASSOCIATED(this%ze_grid)) THEN
1039  model_get_param_value = this%ze_grid(i_index)
1040  ELSE
1041  model_get_param_value = 1.0 !Default to 1.0
1042  END IF
1043 
1044  CASE (model_sxrem_grid_id)
1045  IF (ASSOCIATED(this%sxrem_grid)) THEN
1046  model_get_param_value = this%sxrem_grid(i_index, &
1047  & j_index)
1048  ELSE
1049  model_get_param_value = 0.0
1050  END IF
1051 
1052  CASE (model_coosig_wgts_id)
1053  IF (ASSOCIATED(this%coosig_wgts)) THEN
1054  model_get_param_value = this%coosig_wgts(i_index)
1055  ELSE
1056  model_get_param_value = 0.0
1057  END IF
1058 
1059  CASE DEFAULT
1060  model_get_param_value = &
1061  & equilibrium_get_param_value(this%equilibrium, id, &
1062  & i_index, j_index)
1063 
1064  END SELECT
1065 
1066  CALL profiler_set_stop_time('model_get_param_value', start_time)
1067 
1068  END FUNCTION
1069 
1070 !-------------------------------------------------------------------------------
1079 !-------------------------------------------------------------------------------
1080  FUNCTION model_get_param_name(this, id)
1081 
1082  IMPLICIT NONE
1083 
1084 ! Declare Arguments
1085  CHARACTER(len=data_name_length) :: model_get_param_name
1086  TYPE (model_class), INTENT(in) :: this
1087  INTEGER, INTENT(in) :: id
1088 
1089 ! local variables
1090  REAL (rprec) :: start_time
1091 
1092 ! Start of executable code
1093  start_time = profiler_get_start_time()
1094 
1095  SELECT CASE (id)
1096 
1097  CASE (model_ne_unit_id)
1098  model_get_param_name = 'ne_unit'
1099 
1100  CASE (model_ne_min_id)
1101  model_get_param_name = 'ne_min'
1102 
1103  CASE (model_te_min_id)
1104  model_get_param_name = 'te_min'
1105 
1106  CASE (model_ti_min_id)
1107  model_get_param_name = 'ti_min'
1108 
1109  CASE (model_ze_min_id)
1110  model_get_param_name = 'ze_min'
1111 
1112  CASE (model_sxrem_min_id)
1113  model_get_param_name = 'sxrem_min'
1114 
1115  CASE (model_pressure_fraction_id)
1116  model_get_param_name = 'pressure_fraction'
1117 
1118  CASE (model_signal_factor_id)
1119  model_get_param_name = 'signal_factor'
1120 
1121  CASE (model_signal_offset_id)
1122  model_get_param_name = 'signal_offset'
1123 
1124  CASE (model_ne_grid_id)
1125  model_get_param_name = 'ne_grid'
1126 
1127  CASE (model_te_grid_id)
1128  model_get_param_name = 'te_grid'
1129 
1130  CASE (model_ti_grid_id)
1131  model_get_param_name = 'ti_grid'
1132 
1133  CASE (model_sxrem_grid_id)
1134  model_get_param_name = 'sxrem_grid'
1135 
1136  CASE (model_ze_grid_id)
1137  model_get_param_name = 'ze_grid'
1138 
1139  CASE (model_coosig_wgts_id)
1140  model_get_param_name = 'coosig_wgts'
1141 
1142  CASE DEFAULT
1143  model_get_param_name = &
1144  & equilibrium_get_param_name(this%equilibrium, id)
1145 
1146  END SELECT
1147 
1148  CALL profiler_set_stop_time('model_get_param_name', start_time)
1149 
1150  END FUNCTION
1151 
1152 !-------------------------------------------------------------------------------
1160 !-------------------------------------------------------------------------------
1161  FUNCTION model_get_gp_ne_num_hyper_param(this)
1162 
1163  IMPLICIT NONE
1164 
1165 ! Declare Arguments
1166  INTEGER :: model_get_gp_ne_num_hyper_param
1167  TYPE (model_class), INTENT(in) :: this
1168 
1169 ! local variables
1170  REAL (rprec) :: start_time
1171 
1172 ! Start of executable code
1173  start_time = profiler_get_start_time()
1174 
1175  model_get_gp_ne_num_hyper_param = &
1176  & equilibrium_get_gp_ne_num_hyper_param(this%equilibrium)
1177 
1178  CALL profiler_set_stop_time('model_get_gp_ne_num_hyper_param', &
1179  & start_time)
1180 
1181  END FUNCTION
1182 
1183 !-------------------------------------------------------------------------------
1190 !-------------------------------------------------------------------------------
1191  FUNCTION model_get_ne_af(this)
1192 
1193  IMPLICIT NONE
1194 
1195 ! Declare Arguments
1196  REAL (rprec), DIMENSION(:), POINTER :: model_get_ne_af
1197  TYPE (model_class), INTENT(in) :: this
1198 
1199 ! local variables
1200  REAL (rprec) :: start_time
1201 
1202 ! Start of executable code
1203  start_time = profiler_get_start_time()
1204 
1205  model_get_ne_af => equilibrium_get_ne_af(this%equilibrium)
1206 
1207  CALL profiler_set_stop_time('model_get_ne_af', start_time)
1208 
1209  END FUNCTION
1210 
1211 !-------------------------------------------------------------------------------
1221 !-------------------------------------------------------------------------------
1222  FUNCTION model_get_gp_ne_ij(this, i, j)
1223 
1224  IMPLICIT NONE
1225 
1226 ! Declare Arguments
1227  REAL (rprec) :: model_get_gp_ne_ij
1228  TYPE (model_class), INTENT(in) :: this
1229  INTEGER, INTENT(in) :: i
1230  INTEGER, INTENT(in) :: j
1231 
1232 ! local variables
1233  REAL (rprec) :: start_time
1234 
1235 ! Start of executable code
1236  start_time = profiler_get_start_time()
1237 
1238  model_get_gp_ne_ij = this%ne_unit &
1239  & * equilibrium_get_gp_ne_ij(this%equilibrium, &
1240  & i, j)
1241  model_get_gp_ne_ij = max(model_get_gp_ne_ij, this%ne_min)
1242 
1243  CALL profiler_set_stop_time('model_get_gp_ne_ij', start_time)
1244 
1245  END FUNCTION
1246 
1247 !-------------------------------------------------------------------------------
1257 !-------------------------------------------------------------------------------
1258  FUNCTION model_get_gp_ne_pi(this, x_cart, i)
1259 
1260  IMPLICIT NONE
1261 
1262 ! Declare Arguments
1263  REAL (rprec) :: model_get_gp_ne_pi
1264  TYPE (model_class), INTENT(in) :: this
1265  REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
1266  INTEGER, INTENT(in) :: i
1267 
1268 ! local variables
1269  REAL (rprec) :: start_time
1270 
1271 ! Start of executable code
1272  start_time = profiler_get_start_time()
1273 
1274  model_get_gp_ne_pi = this%ne_unit &
1275  & * equilibrium_get_gp_ne_pi(this%equilibrium, &
1276  & x_cart, i)
1277  model_get_gp_ne_pi = max(model_get_gp_ne_pi, this%ne_min)
1278 
1279  CALL profiler_set_stop_time('model_get_gp_ne_pi', start_time)
1280 
1281  END FUNCTION
1282 
1283 !-------------------------------------------------------------------------------
1294 !-------------------------------------------------------------------------------
1295  FUNCTION model_get_gp_ne_pp(this, x_cart, y_cart)
1296 
1297  IMPLICIT NONE
1298 
1299 ! Declare Arguments
1300  REAL (rprec) :: model_get_gp_ne_pp
1301  TYPE (model_class), INTENT(in) :: this
1302  REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
1303  REAL (rprec), DIMENSION(3), INTENT(in) :: y_cart
1304 
1305 ! local variables
1306  REAL (rprec) :: start_time
1307 
1308 ! Start of executable code
1309  start_time = profiler_get_start_time()
1310 
1311  model_get_gp_ne_pp = this%ne_unit &
1312  & * equilibrium_get_gp_ne_pp(this%equilibrium, &
1313  & x_cart, y_cart)
1314  model_get_gp_ne_pp = max(model_get_gp_ne_pp, this%ne_min)
1315 
1316  CALL profiler_set_stop_time('model_get_gp_ne_pp', start_time)
1317 
1318  END FUNCTION
1319 
1320 !-------------------------------------------------------------------------------
1329 !-------------------------------------------------------------------------------
1330  FUNCTION model_get_ne_cart(this, x_cart)
1331 
1332  IMPLICIT NONE
1333 
1334 ! Declare Arguments
1335  REAL (rprec) :: model_get_ne_cart
1336  TYPE (model_class), INTENT(in) :: this
1337  REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
1338 
1339 ! local variables
1340  REAL (rprec) :: start_time
1341 
1342 ! Start of executable code
1343  start_time = profiler_get_start_time()
1344 
1345  SELECT CASE (this%ne_type)
1346 
1347  CASE (model_ne_type)
1348  model_get_ne_cart = equilibrium_get_ne(this%equilibrium, &
1349  & x_cart)
1350  model_get_ne_cart = max(this%ne_min, &
1351  & this%ne_unit*model_get_ne_cart)
1352 
1353  CASE (model_ne_te_p_type)
1354 ! Electron temperature of zero can cause divide by zero errors. Check the value
1355 ! of the temperature first. If it is zero return zero density.
1356  model_get_ne_cart = model_get_te(this, x_cart)
1357  IF (model_get_ne_cart .gt. 0.0) THEN
1358  model_get_ne_cart = ev_per_joule*this%pressure_fraction &
1359  & * equilibrium_get_p(this%equilibrium, &
1360  & x_cart) &
1361  & / model_get_ne_cart
1362  END IF
1363 
1364  CASE DEFAULT
1365  model_get_ne_cart = 0.0
1366 
1367  END SELECT
1368 
1369  CALL profiler_set_stop_time('model_get_ne_cart', start_time)
1370 
1371  END FUNCTION
1372 
1373 !-------------------------------------------------------------------------------
1382 !-------------------------------------------------------------------------------
1383  FUNCTION model_get_ne_radial(this, r)
1384 
1385  IMPLICIT NONE
1386 
1387 ! Declare Arguments
1388  REAL (rprec) :: model_get_ne_radial
1389  TYPE (model_class), INTENT(in) :: this
1390  REAL (rprec), INTENT(in) :: r
1391 
1392 ! local variables
1393  REAL (rprec) :: start_time
1394 
1395 ! Start of executable code
1396  start_time = profiler_get_start_time()
1397 
1398  SELECT CASE (this%ne_type)
1399 
1400  CASE (model_ne_type)
1401  model_get_ne_radial = equilibrium_get_ne(this%equilibrium, &
1402  & r)
1403  model_get_ne_radial = max(this%ne_min, &
1404  & this%ne_unit*model_get_ne_radial)
1405 
1406  CASE (model_ne_te_p_type)
1407 ! Electron temperature of zero can cause divide by zero errors. Check the value
1408 ! of the temperature first. If it is zero return zero density.
1409  model_get_ne_radial = model_get_te(this, r)
1410  IF (model_get_ne_radial .gt. 0.0) THEN
1411  model_get_ne_radial = ev_per_joule*this%pressure_fraction &
1412  & * equilibrium_get_p(this%equilibrium, &
1413  & r) &
1414  & / model_get_ne_radial
1415  END IF
1416 
1417  CASE DEFAULT
1418  model_get_ne_radial = 0.0_rprec
1419 
1420  END SELECT
1421 
1422  CALL profiler_set_stop_time('model_get_ne_radial', start_time)
1423 
1424  END FUNCTION
1425 
1426 !-------------------------------------------------------------------------------
1434 !-------------------------------------------------------------------------------
1435  FUNCTION model_get_gp_te_num_hyper_param(this)
1436 
1437  IMPLICIT NONE
1438 
1439 ! Declare Arguments
1440  INTEGER :: model_get_gp_te_num_hyper_param
1441  TYPE (model_class), INTENT(in) :: this
1442 
1443 ! local variables
1444  REAL (rprec) :: start_time
1445 
1446 ! Start of executable code
1447  start_time = profiler_get_start_time()
1448 
1449  model_get_gp_te_num_hyper_param = &
1450  & equilibrium_get_gp_te_num_hyper_param(this%equilibrium)
1451 
1452  CALL profiler_set_stop_time('model_get_gp_te_num_hyper_param', &
1453  & start_time)
1454 
1455  END FUNCTION
1456 
1457 !-------------------------------------------------------------------------------
1464 !-------------------------------------------------------------------------------
1465  FUNCTION model_get_te_af(this)
1466 
1467  IMPLICIT NONE
1468 
1469 ! Declare Arguments
1470  REAL (rprec), DIMENSION(:), POINTER :: model_get_te_af
1471  TYPE (model_class), INTENT(in) :: this
1472 
1473 ! local variables
1474  REAL (rprec) :: start_time
1475 
1476 ! Start of executable code
1477  start_time = profiler_get_start_time()
1478 
1479  model_get_te_af => equilibrium_get_te_af(this%equilibrium)
1480 
1481  CALL profiler_set_stop_time('model_get_te_af', start_time)
1482 
1483  END FUNCTION
1484 
1485 !-------------------------------------------------------------------------------
1495 !-------------------------------------------------------------------------------
1496  FUNCTION model_get_gp_te_ij(this, i, j)
1497 
1498  IMPLICIT NONE
1499 
1500 ! Declare Arguments
1501  REAL (rprec) :: model_get_gp_te_ij
1502  TYPE (model_class), INTENT(in) :: this
1503  INTEGER, INTENT(in) :: i
1504  INTEGER, INTENT(in) :: j
1505 
1506 ! local variables
1507  REAL (rprec) :: start_time
1508 
1509 ! Start of executable code
1510  start_time = profiler_get_start_time()
1511 
1512  model_get_gp_te_ij = equilibrium_get_gp_te_ij(this%equilibrium, &
1513  & i, j)
1514  model_get_gp_te_ij = max(model_get_gp_te_ij, this%te_min)
1515 
1516  CALL profiler_set_stop_time('model_get_gp_te_ij', start_time)
1517 
1518  END FUNCTION
1519 
1520 !-------------------------------------------------------------------------------
1531 !-------------------------------------------------------------------------------
1532  FUNCTION model_get_gp_te_pi(this, x_cart, i)
1533 
1534  IMPLICIT NONE
1535 
1536 ! Declare Arguments
1537  REAL (rprec) :: model_get_gp_te_pi
1538  TYPE (model_class), INTENT(in) :: this
1539  REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
1540  INTEGER, INTENT(in) :: i
1541 
1542 ! local variables
1543  REAL (rprec) :: start_time
1544 
1545 ! Start of executable code
1546  start_time = profiler_get_start_time()
1547 
1548  model_get_gp_te_pi = equilibrium_get_gp_te_pi(this%equilibrium, &
1549  & x_cart, i)
1550  model_get_gp_te_pi = max(model_get_gp_te_pi, this%te_min)
1551 
1552  CALL profiler_set_stop_time('model_get_gp_te_pi', start_time)
1553 
1554  END FUNCTION
1555 
1556 !-------------------------------------------------------------------------------
1566 !-------------------------------------------------------------------------------
1567  FUNCTION model_get_gp_te_pp(this, x_cart, y_cart)
1568 
1569  IMPLICIT NONE
1570 
1571 ! Declare Arguments
1572  REAL (rprec) :: model_get_gp_te_pp
1573  TYPE (model_class), INTENT(in) :: this
1574  REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
1575  REAL (rprec), DIMENSION(3), INTENT(in) :: y_cart
1576 
1577 ! local variables
1578  REAL (rprec) :: start_time
1579 
1580 ! Start of executable code
1581  start_time = profiler_get_start_time()
1582 
1583  model_get_gp_te_pp = equilibrium_get_gp_te_pp(this%equilibrium, &
1584  & x_cart, y_cart)
1585  model_get_gp_te_pp = max(model_get_gp_te_pp, this%te_min)
1586 
1587  CALL profiler_set_stop_time('model_get_gp_te_pp', start_time)
1588 
1589  END FUNCTION
1590 
1591 !-------------------------------------------------------------------------------
1600 !-------------------------------------------------------------------------------
1601  FUNCTION model_get_te_cart(this, x_cart)
1602 
1603  IMPLICIT NONE
1604 
1605 ! Declare Arguments
1606  REAL (rprec) :: model_get_te_cart
1607  TYPE (model_class), INTENT(in) :: this
1608  REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
1609 
1610 ! local variables
1611  REAL (rprec) :: start_time
1612 
1613 ! Start of executable code
1614  start_time = profiler_get_start_time()
1615 
1616  SELECT CASE (this%te_type)
1617 
1618  CASE (model_te_type)
1619  model_get_te_cart = equilibrium_get_te(this%equilibrium, &
1620  & x_cart)
1621  model_get_te_cart = max(this%te_min, model_get_te_cart)
1622 
1623  CASE (model_te_ne_p_type)
1624 ! Electron densities of zero can cause divide by zero errors. Check the value
1625 ! of the density first. If it is zero return zero temperature.
1626  model_get_te_cart = model_get_ne(this, x_cart)
1627  IF (model_get_te_cart .gt. 0.0) THEN
1628  model_get_te_cart = ev_per_joule*this%pressure_fraction &
1629  & * equilibrium_get_p(this%equilibrium, &
1630  & x_cart) &
1631  & / model_get_te_cart
1632  END IF
1633 
1634  CASE DEFAULT
1635  model_get_te_cart = 0.0_rprec
1636 
1637  END SELECT
1638 
1639  CALL profiler_set_stop_time('model_get_te_cart', start_time)
1640 
1641  END FUNCTION
1642 
1643 !-------------------------------------------------------------------------------
1652 !-------------------------------------------------------------------------------
1653  FUNCTION model_get_te_radial(this, r)
1654 
1655  IMPLICIT NONE
1656 
1657 ! Declare Arguments
1658  REAL (rprec) :: model_get_te_radial
1659  TYPE (model_class), INTENT(in) :: this
1660  REAL (rprec), INTENT(in) :: r
1661 
1662 ! local variables
1663  REAL (rprec) :: start_time
1664 
1665 ! Start of executable code
1666  start_time = profiler_get_start_time()
1667 
1668  SELECT CASE (this%te_type)
1669 
1670  CASE (model_te_type)
1671  model_get_te_radial = equilibrium_get_te(this%equilibrium, &
1672  & r)
1673  model_get_te_radial = max(this%te_min, model_get_te_radial)
1674 
1675  CASE (model_te_ne_p_type)
1676 ! Electron densities of zero can cause divide by zero errors. Check the value
1677 ! of the density first. If it is zero return zero temperature.
1678  model_get_te_radial = model_get_ne(this, r)
1679  IF (model_get_te_radial .gt. 0.0) THEN
1680  model_get_te_radial = ev_per_joule*this%pressure_fraction &
1681  & * equilibrium_get_p(this%equilibrium, &
1682  & r) &
1683  & / model_get_te_radial
1684  END IF
1685 
1686  CASE DEFAULT
1687  model_get_te_radial = 0.0_rprec
1688 
1689  END SELECT
1690 
1691  CALL profiler_set_stop_time('model_get_te_radial', start_time)
1692 
1693  END FUNCTION
1694 
1695 !-------------------------------------------------------------------------------
1703 !-------------------------------------------------------------------------------
1704  FUNCTION model_get_gp_ti_num_hyper_param(this)
1705 
1706  IMPLICIT NONE
1707 
1708 ! Declare Arguments
1709  INTEGER :: model_get_gp_ti_num_hyper_param
1710  TYPE (model_class), INTENT(in) :: this
1711 
1712 ! local variables
1713  REAL (rprec) :: start_time
1714 
1715 ! Start of executable code
1716  start_time = profiler_get_start_time()
1717 
1718  model_get_gp_ti_num_hyper_param = &
1719  & equilibrium_get_gp_ti_num_hyper_param(this%equilibrium)
1720 
1721  CALL profiler_set_stop_time('model_get_gp_ti_num_hyper_param', &
1722  & start_time)
1723 
1724  END FUNCTION
1725 
1726 !-------------------------------------------------------------------------------
1733 !-------------------------------------------------------------------------------
1734  FUNCTION model_get_ti_af(this)
1735 
1736  IMPLICIT NONE
1737 
1738 ! Declare Arguments
1739  REAL (rprec), DIMENSION(:), POINTER :: model_get_ti_af
1740  TYPE (model_class), INTENT(in) :: this
1741 
1742 ! local variables
1743  REAL (rprec) :: start_time
1744 
1745 ! Start of executable code
1746  start_time = profiler_get_start_time()
1747 
1748  model_get_ti_af => equilibrium_get_ti_af(this%equilibrium)
1749 
1750  CALL profiler_set_stop_time('model_get_ti_af', start_time)
1751 
1752  END FUNCTION
1753 
1754 !-------------------------------------------------------------------------------
1764 !-------------------------------------------------------------------------------
1765  FUNCTION model_get_gp_ti_ij(this, i, j)
1766 
1767  IMPLICIT NONE
1768 
1769 ! Declare Arguments
1770  REAL (rprec) :: model_get_gp_ti_ij
1771  TYPE (model_class), INTENT(in) :: this
1772  INTEGER, INTENT(in) :: i
1773  INTEGER, INTENT(in) :: j
1774 
1775 ! local variables
1776  REAL (rprec) :: start_time
1777 
1778 ! Start of executable code
1779  start_time = profiler_get_start_time()
1780 
1781  model_get_gp_ti_ij = equilibrium_get_gp_ti_ij(this%equilibrium, &
1782  & i, j)
1783  model_get_gp_ti_ij = max(model_get_gp_ti_ij, this%ti_min)
1784 
1785  CALL profiler_set_stop_time('model_get_gp_ti_ij', start_time)
1786 
1787  END FUNCTION
1788 
1789 !-------------------------------------------------------------------------------
1799 !-------------------------------------------------------------------------------
1800  FUNCTION model_get_gp_ti_pi(this, x_cart, i)
1801 
1802  IMPLICIT NONE
1803 
1804 ! Declare Arguments
1805  REAL (rprec) :: model_get_gp_ti_pi
1806  TYPE (model_class), INTENT(in) :: this
1807  REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
1808  INTEGER, INTENT(in) :: i
1809 
1810 ! local variables
1811  REAL (rprec) :: start_time
1812 
1813 ! Start of executable code
1814  start_time = profiler_get_start_time()
1815 
1816  model_get_gp_ti_pi = equilibrium_get_gp_ti_pi(this%equilibrium, &
1817  & x_cart, i)
1818  model_get_gp_ti_pi = max(model_get_gp_ti_pi, this%ti_min)
1819 
1820  CALL profiler_set_stop_time('model_get_gp_ti_pi', start_time)
1821 
1822  END FUNCTION
1823 
1824 !-------------------------------------------------------------------------------
1834 !-------------------------------------------------------------------------------
1835  FUNCTION model_get_gp_ti_pp(this, x_cart, y_cart)
1836 
1837  IMPLICIT NONE
1838 
1839 ! Declare Arguments
1840  REAL (rprec) :: model_get_gp_ti_pp
1841  TYPE (model_class), INTENT(in) :: this
1842  REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
1843  REAL (rprec), DIMENSION(3), INTENT(in) :: y_cart
1844 
1845 ! local variables
1846  REAL (rprec) :: start_time
1847 
1848 ! Start of executable code
1849  start_time = profiler_get_start_time()
1850 
1851  model_get_gp_ti_pp = equilibrium_get_gp_ti_pp(this%equilibrium, &
1852  & x_cart, y_cart)
1853  model_get_gp_ti_pp = max(model_get_gp_ti_pp, this%ti_min)
1854 
1855  CALL profiler_set_stop_time('model_get_gp_ti_pp', start_time)
1856 
1857  END FUNCTION
1858 
1859 !-------------------------------------------------------------------------------
1868 !-------------------------------------------------------------------------------
1869  FUNCTION model_get_ti_cart(this, x_cart)
1870 
1871  IMPLICIT NONE
1872 
1873 ! Declare Arguments
1874  REAL (rprec) :: model_get_ti_cart
1875  TYPE (model_class), INTENT(in) :: this
1876  REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
1877 
1878 ! local variables
1879  REAL (rprec) :: start_time
1880 
1881 ! Start of executable code
1882  start_time = profiler_get_start_time()
1883 
1884  SELECT CASE (this%ti_type)
1885 
1886  CASE (model_ti_type)
1887  model_get_ti_cart = equilibrium_get_ti(this%equilibrium, &
1888  & x_cart)
1889  model_get_ti_cart = max(this%ti_min, model_get_ti_cart)
1890 
1891  CASE DEFAULT
1892  model_get_ti_cart = 0.0_rprec
1893 
1894  END SELECT
1895 
1896  CALL profiler_set_stop_time('model_get_ti_cart', start_time)
1897 
1898  END FUNCTION
1899 
1900 !-------------------------------------------------------------------------------
1909 !-------------------------------------------------------------------------------
1910  FUNCTION model_get_ti_radial(this, r)
1911 
1912  IMPLICIT NONE
1913 
1914 ! Declare Arguments
1915  REAL (rprec) :: model_get_ti_radial
1916  TYPE (model_class), INTENT(in) :: this
1917  REAL (rprec), INTENT(in) :: r
1918 
1919 ! local variables
1920  REAL (rprec) :: start_time
1921 
1922 ! Start of executable code
1923  start_time = profiler_get_start_time()
1924 
1925  SELECT CASE (this%ti_type)
1926 
1927  CASE (model_ti_type)
1928  model_get_ti_radial = equilibrium_get_ti(this%equilibrium, &
1929  & r)
1930  model_get_ti_radial = max(this%ti_min, model_get_ti_radial)
1931 
1932  CASE DEFAULT
1933  model_get_ti_radial = 0.0_rprec
1934 
1935  END SELECT
1936 
1937  CALL profiler_set_stop_time('model_get_ti_radial', start_time)
1938 
1939  END FUNCTION
1940 
1941 !-------------------------------------------------------------------------------
1950 !-------------------------------------------------------------------------------
1951  FUNCTION model_get_ze_cart(this, x_cart)
1952 
1953  IMPLICIT NONE
1954 
1955 ! Declare Arguments
1956  REAL (rprec) :: model_get_ze_cart
1957  TYPE (model_class), INTENT(in) :: this
1958  REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
1959 
1960 ! local variables
1961  REAL (rprec) :: start_time
1962 
1963 ! Start of executable code
1964  start_time = profiler_get_start_time()
1965 
1966  SELECT CASE (this%ze_type)
1967 
1968  CASE (model_ze_type)
1969  model_get_ze_cart = equilibrium_get_ze(this%equilibrium, &
1970  & x_cart)
1971  model_get_ze_cart = max(this%ze_min, model_get_ze_cart)
1972 
1973  CASE DEFAULT
1974  model_get_ze_cart = 1.0 !Default to 1.0
1975 
1976  END SELECT
1977 
1978  CALL profiler_set_stop_time('model_get_ze_cart', start_time)
1979 
1980  END FUNCTION
1981 
1982 !-------------------------------------------------------------------------------
1991 !-------------------------------------------------------------------------------
1992  FUNCTION model_get_ze_radial(this, r)
1993 
1994  IMPLICIT NONE
1995 
1996 ! Declare Arguments
1997  REAL (rprec) :: model_get_ze_radial
1998  TYPE (model_class), INTENT(in) :: this
1999  REAL (rprec), INTENT(in) :: r
2000 
2001 ! local variables
2002  REAL (rprec) :: start_time
2003 
2004 ! Start of executable code
2005  start_time = profiler_get_start_time()
2006 
2007  SELECT CASE (this%ze_type)
2008 
2009  CASE (model_ze_type)
2010  model_get_ze_radial = equilibrium_get_ze(this%equilibrium, &
2011  & r)
2012  model_get_ze_radial = max(this%ze_min, model_get_ze_radial) &
2013 
2014  CASE DEFAULT
2015  model_get_ze_radial = 1.0 !Default to 1.0
2016 
2017  END SELECT
2018 
2019  CALL profiler_set_stop_time('model_get_ze_radial', start_time)
2020 
2021  END FUNCTION
2022 
2023 !-------------------------------------------------------------------------------
2032 !-------------------------------------------------------------------------------
2033  FUNCTION model_get_gp_sxrem_num_hyper_param(this, index)
2034 
2035  IMPLICIT NONE
2036 
2037 ! Declare Arguments
2038  INTEGER :: model_get_gp_sxrem_num_hyper_param
2039  TYPE (model_class), INTENT(in) :: this
2040  INTEGER, INTENT(in) :: index
2041 
2042 ! local variables
2043  REAL (rprec) :: start_time
2044 
2045 ! Start of executable code
2046  start_time = profiler_get_start_time()
2047 
2048  model_get_gp_sxrem_num_hyper_param = &
2049  & equilibrium_get_gp_sxrem_num_hyper_param(this%equilibrium, &
2050  & index)
2051 
2052  CALL profiler_set_stop_time('model_get_gp_sxrem_num_hyper_param', &
2053  & start_time)
2054 
2055  END FUNCTION
2056 
2057 !-------------------------------------------------------------------------------
2065 !-------------------------------------------------------------------------------
2066  FUNCTION model_get_sxrem_af(this, index)
2067 
2068  IMPLICIT NONE
2069 
2070 ! Declare Arguments
2071  REAL (rprec), DIMENSION(:), POINTER :: model_get_sxrem_af
2072  TYPE (model_class), INTENT(in) :: this
2073  INTEGER, INTENT(in) :: index
2074 
2075 ! local variables
2076  REAL (rprec) :: start_time
2077 
2078 ! Start of executable code
2079  start_time = profiler_get_start_time()
2080 
2081  model_get_sxrem_af => equilibrium_get_sxrem_af(this%equilibrium, &
2082  & index)
2083 
2084  CALL profiler_set_stop_time('model_get_sxrem_af', start_time)
2085 
2086  END FUNCTION
2087 
2088 !-------------------------------------------------------------------------------
2099 !-------------------------------------------------------------------------------
2100  FUNCTION model_get_gp_sxrem_ij(this, i, j, index)
2101 
2102  IMPLICIT NONE
2103 
2104 ! Declare Arguments
2105  REAL (rprec) :: model_get_gp_sxrem_ij
2106  TYPE (model_class), INTENT(in) :: this
2107  INTEGER, INTENT(in) :: i
2108  INTEGER, INTENT(in) :: j
2109  INTEGER, INTENT(in) :: index
2110 
2111 ! local variables
2112  REAL (rprec) :: start_time
2113 
2114 ! Start of executable code
2115  start_time = profiler_get_start_time()
2116 
2117  model_get_gp_sxrem_ij = &
2118  & equilibrium_get_gp_sxrem_ij(this%equilibrium, i, j, index)
2119  model_get_gp_sxrem_ij = max(model_get_gp_sxrem_ij, &
2120  & this%sxrem_min(index))
2121 
2122  CALL profiler_set_stop_time('model_get_gp_sxrem_ij', start_time)
2123 
2124  END FUNCTION
2125 
2126 !-------------------------------------------------------------------------------
2138 !-------------------------------------------------------------------------------
2139  FUNCTION model_get_gp_sxrem_pi(this, x_cart, i, index)
2140 
2141  IMPLICIT NONE
2142 
2143 ! Declare Arguments
2144  REAL (rprec) :: model_get_gp_sxrem_pi
2145  TYPE (model_class), INTENT(in) :: this
2146  REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
2147  INTEGER, INTENT(in) :: i
2148  INTEGER, INTENT(in) :: index
2149 
2150 ! local variables
2151  REAL (rprec) :: start_time
2152 
2153 ! Start of executable code
2154  start_time = profiler_get_start_time()
2155 
2156  model_get_gp_sxrem_pi = &
2157  & equilibrium_get_gp_sxrem_pi(this%equilibrium, x_cart, i, index)
2158  model_get_gp_sxrem_pi = max(model_get_gp_sxrem_pi, &
2159  & this%sxrem_min(index))
2160 
2161  CALL profiler_set_stop_time('model_get_gp_sxrem_pi', start_time)
2162 
2163  END FUNCTION
2164 
2165 !-------------------------------------------------------------------------------
2177 !-------------------------------------------------------------------------------
2178  FUNCTION model_get_gp_sxrem_pp(this, x_cart, y_cart, index)
2179 
2180  IMPLICIT NONE
2181 
2182 ! Declare Arguments
2183  REAL (rprec) :: model_get_gp_sxrem_pp
2184  TYPE (model_class), INTENT(in) :: this
2185  REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
2186  REAL (rprec), DIMENSION(3), INTENT(in) :: y_cart
2187  INTEGER, INTENT(in) :: index
2188 
2189 ! local variables
2190  REAL (rprec) :: start_time
2191 
2192 ! Start of executable code
2193  start_time = profiler_get_start_time()
2194 
2195  model_get_gp_sxrem_pp = &
2196  & equilibrium_get_gp_sxrem_pp(this%equilibrium, x_cart, y_cart, &
2197  & index)
2198  model_get_gp_sxrem_pp = max(model_get_gp_sxrem_pp, &
2199  & this%sxrem_min(index))
2200 
2201  CALL profiler_set_stop_time('model_get_gp_sxrem_pp', start_time)
2202 
2203  END FUNCTION
2204 
2205 !-------------------------------------------------------------------------------
2215 !-------------------------------------------------------------------------------
2216  FUNCTION model_get_sxrem_cart(this, x_cart, index)
2217 
2218  IMPLICIT NONE
2219 
2220 ! Declare Arguments
2221  REAL (rprec) :: model_get_sxrem_cart
2222  TYPE (model_class), INTENT(in) :: this
2223  REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
2224  INTEGER, INTENT(in) :: index
2225 
2226 ! local variables
2227  REAL (rprec) :: start_time
2228 
2229 ! Start of executable code
2230  start_time = profiler_get_start_time()
2231 
2232  SELECT CASE (this%sxrem_type(index))
2233 
2234  CASE (model_sxrem_type)
2235  model_get_sxrem_cart = &
2236  & equilibrium_get_sxrem(this%equilibrium, x_cart, index)
2237  model_get_sxrem_cart = max(model_get_sxrem_cart, &
2238  & this%sxrem_min(index))
2239 
2240  CASE (model_sxrem_te_ne_type)
2241  model_get_sxrem_cart = &
2242  & emission_get_emission(this%emission, &
2243  & model_get_te(this, x_cart), &
2244  & model_get_ne(this, x_cart), index)
2245 
2246  CASE DEFAULT
2247  model_get_sxrem_cart = 0.0_rprec
2248 
2249  END SELECT
2250 
2251  CALL profiler_set_stop_time('model_get_sxrem_cart', start_time)
2252 
2253  END FUNCTION
2254 
2255 !-------------------------------------------------------------------------------
2265 !-------------------------------------------------------------------------------
2266  FUNCTION model_get_sxrem_radial(this, r, index)
2267 
2268  IMPLICIT NONE
2269 
2270 ! Declare Arguments
2271  REAL (rprec) :: model_get_sxrem_radial
2272  TYPE (model_class), INTENT(in) :: this
2273  REAL (rprec), INTENT(in) :: r
2274  INTEGER, INTENT(in) :: index
2275 
2276 ! local variables
2277  REAL (rprec) :: start_time
2278 
2279 ! Start of executable code
2280  start_time = profiler_get_start_time()
2281 
2282  SELECT CASE (this%sxrem_type(index))
2283 
2284  CASE (model_sxrem_type)
2285  model_get_sxrem_radial = &
2286  & equilibrium_get_sxrem(this%equilibrium, r, index)
2287  model_get_sxrem_radial = max(model_get_sxrem_radial, &
2288  & this%sxrem_min(index))
2289 
2290  CASE (model_sxrem_te_ne_type)
2291  model_get_sxrem_radial = &
2292  & emission_get_emission(this%emission, &
2293  & model_get_te(this, r), &
2294  & model_get_ne(this, r), index)
2295 
2296  CASE DEFAULT
2297  model_get_sxrem_radial = 0.0_rprec
2298 
2299  END SELECT
2300 
2301  CALL profiler_set_stop_time('model_get_sxrem_radial', start_time)
2302 
2303  END FUNCTION
2304 
2305 !-------------------------------------------------------------------------------
2316 !-------------------------------------------------------------------------------
2317  FUNCTION model_get_sxrem_ratio(this, te)
2318  USE line_segment
2319 
2320  IMPLICIT NONE
2321 
2322 ! Declare Arguments
2323  REAL (rprec) :: model_get_sxrem_ratio
2324  TYPE (model_class), INTENT(in) :: this
2325  REAL (rprec), INTENT(in) :: te
2326 
2327 ! local variables
2328  REAL (rprec) :: start_time
2329 
2330 ! Start of executable code
2331  start_time = profiler_get_start_time()
2332 
2333  CALL line_seg(te, model_get_sxrem_ratio, this%sxrem_te, &
2334  & this%sxrem_ratio, SIZE(this%sxrem_te))
2335 
2336  CALL profiler_set_stop_time('model_get_sxrem_ratio', start_time)
2337 
2338  END FUNCTION
2339 
2340 !-------------------------------------------------------------------------------
2345 !-------------------------------------------------------------------------------
2346  FUNCTION model_get_ne_type(this)
2347 
2348  IMPLICIT NONE
2349 
2350 ! Declare Arguments
2351  CHARACTER (len=data_name_length) :: model_get_ne_type
2352  TYPE (model_class), INTENT(in) :: this
2353 
2354 ! local variables
2355  REAL (rprec) :: start_time
2356 
2357 ! Start of executable code
2358  start_time = profiler_get_start_time()
2359 
2360  SELECT CASE (this%ne_type)
2361 
2362  CASE (model_ne_type)
2363  model_get_ne_type = 'pp_ne'
2364 
2365  CASE (model_ne_te_p_type)
2366  model_get_ne_type = 'pp_te_p'
2367 
2368  CASE DEFAULT
2369  model_get_ne_type = 'none'
2370 
2371  END SELECT
2372 
2373  CALL profiler_set_stop_time('model_get_ne_type', start_time)
2374 
2375  END FUNCTION
2376 
2377 !-------------------------------------------------------------------------------
2382 !-------------------------------------------------------------------------------
2383  FUNCTION model_get_te_type(this)
2384 
2385  IMPLICIT NONE
2386 
2387 ! Declare Arguments
2388  CHARACTER (len=data_name_length) :: model_get_te_type
2389  TYPE (model_class), INTENT(in) :: this
2390 
2391 ! local variables
2392  REAL (rprec) :: start_time
2393 
2394 ! Start of executable code
2395  start_time = profiler_get_start_time()
2396 
2397  SELECT CASE (this%te_type)
2398 
2399  CASE (model_te_type)
2400  model_get_te_type = 'pp_te'
2401 
2402  CASE (model_te_ne_p_type)
2403  model_get_te_type = 'pp_ne_p'
2404 
2405  CASE DEFAULT
2406  model_get_te_type = 'none'
2407 
2408  END SELECT
2409 
2410  CALL profiler_set_stop_time('model_get_te_type', start_time)
2411 
2412  END FUNCTION
2413 
2414 !-------------------------------------------------------------------------------
2419 !-------------------------------------------------------------------------------
2420  FUNCTION model_get_ti_type(this)
2421 
2422  IMPLICIT NONE
2423 
2424 ! Declare Arguments
2425  CHARACTER (len=data_name_length) :: model_get_ti_type
2426  TYPE (model_class), INTENT(in) :: this
2427 
2428 ! local variables
2429  REAL (rprec) :: start_time
2430 
2431 ! Start of executable code
2432  start_time = profiler_get_start_time()
2433 
2434  SELECT CASE (this%te_type)
2435 
2436  CASE (model_ti_type)
2437  model_get_ti_type = 'pp_ti'
2438 
2439  CASE DEFAULT
2440  model_get_ti_type = 'none'
2441 
2442  END SELECT
2443 
2444  CALL profiler_set_stop_time('model_get_ti_type', start_time)
2445 
2446  END FUNCTION
2447 
2448 !-------------------------------------------------------------------------------
2453 !-------------------------------------------------------------------------------
2454  FUNCTION model_get_ze_type(this)
2455 
2456  IMPLICIT NONE
2457 
2458 ! Declare Arguments
2459  CHARACTER (len=data_name_length) :: model_get_ze_type
2460  TYPE (model_class), INTENT(in) :: this
2461 
2462 ! local variables
2463  REAL (rprec) :: start_time
2464 
2465 ! Start of executable code
2466  start_time = profiler_get_start_time()
2467 
2468  SELECT CASE (this%ze_type)
2469 
2470  CASE (model_ze_type)
2471  model_get_ze_type = 'pp_ze'
2472 
2473  CASE DEFAULT
2474  model_get_ze_type = 'none'
2475 
2476  END SELECT
2477 
2478  CALL profiler_set_stop_time('model_get_ze_type', start_time)
2479 
2480  END FUNCTION
2481 
2482 !-------------------------------------------------------------------------------
2488 !-------------------------------------------------------------------------------
2489  FUNCTION model_get_sxrem_type(this, index)
2490 
2491  IMPLICIT NONE
2492 
2493 ! Declare Arguments
2494  CHARACTER (len=data_name_length) :: model_get_sxrem_type
2495  TYPE (model_class), INTENT(in) :: this
2496  INTEGER, INTENT(in) :: index
2497 
2498 ! local variables
2499  REAL (rprec) :: start_time
2500 
2501 ! Start of executable code
2502  start_time = profiler_get_start_time()
2503 
2504  SELECT CASE (this%sxrem_type(index))
2505 
2506  CASE (model_sxrem_type)
2507  model_get_sxrem_type = 'pp_sxrem'
2508 
2509  CASE (model_sxrem_te_ne_type)
2510  model_get_sxrem_type = 'pp_sxrem_te_ne'
2511 
2512  CASE DEFAULT
2513  model_get_sxrem_type = 'none'
2514 
2515  END SELECT
2516 
2517  CALL profiler_set_stop_time('model_get_sxrem_type', start_time)
2518 
2519  END FUNCTION
2520 
2521 !-------------------------------------------------------------------------------
2529 !-------------------------------------------------------------------------------
2530  FUNCTION model_get_signal_factor(this, index)
2531 
2532  IMPLICIT NONE
2533 
2534 ! Declare Arguments
2535  REAL (rprec) :: model_get_signal_factor
2536  TYPE (model_class), INTENT(in) :: this
2537  INTEGER, INTENT(in) :: index
2538 
2539 ! local variables
2540  REAL (rprec) :: start_time
2541 
2542 ! Start of executable code
2543  start_time = profiler_get_start_time()
2544 
2545  IF (index .lt. 1) THEN
2546  model_get_signal_factor = 1.0
2547  ELSE
2548  model_get_signal_factor = this%signal_factor(index)
2549  END IF
2550 
2551  CALL profiler_set_stop_time('model_get_signal_factor', start_time)
2552 
2553  END FUNCTION
2554 
2555 !-------------------------------------------------------------------------------
2563 !-------------------------------------------------------------------------------
2564  FUNCTION model_get_signal_offset(this, index)
2565 
2566  IMPLICIT NONE
2567 
2568 ! Declare Arguments
2569  REAL (rprec) :: model_get_signal_offset
2570  TYPE (model_class), INTENT(in) :: this
2571  INTEGER, INTENT(in) :: index
2572 
2573 ! local variables
2574  REAL (rprec) :: start_time
2575 
2576 ! Start of executable code
2577  start_time = profiler_get_start_time()
2578 
2579  IF (index .lt. 1) THEN
2580  model_get_signal_offset = 0.0
2581  ELSE
2582  model_get_signal_offset = this%signal_offset(index)
2583  END IF
2584 
2585  CALL profiler_set_stop_time('model_get_signal_offset', start_time)
2586 
2587  END FUNCTION
2588 
2589 !*******************************************************************************
2590 ! QUERY SUBROUTINES
2591 !*******************************************************************************
2592 !-------------------------------------------------------------------------------
2601 !-------------------------------------------------------------------------------
2602  FUNCTION model_is_recon_param(this, id)
2603 
2604  IMPLICIT NONE
2605 
2606 ! Declare Arguments
2607  LOGICAL :: model_is_recon_param
2608  TYPE (model_class), INTENT(in) :: this
2609  INTEGER, INTENT(in) :: id
2610 
2611 ! local variables
2612  REAL (rprec) :: start_time
2613 
2614 ! Start of executable code
2615  start_time = profiler_get_start_time()
2616 
2617  SELECT CASE (id)
2618 
2619  CASE (model_ne_unit_id, model_ne_min_id, model_te_min_id, &
2620  & model_ti_min_id, model_sxrem_min_id, &
2621  & model_pressure_fraction_id, model_coosig_wgts_id, &
2622  & model_signal_factor_id, model_signal_offset_id)
2623  model_is_recon_param = .true.
2624 
2625  CASE DEFAULT
2626  model_is_recon_param = &
2627  & equilibrium_is_recon_param(this%equilibrium, id)
2628 
2629  END SELECT
2630 
2631  CALL profiler_set_stop_time('model_is_recon_param', start_time)
2632 
2633  END FUNCTION
2634 
2635 !*******************************************************************************
2636 ! UTILITY SUBROUTINES
2637 !*******************************************************************************
2638 !-------------------------------------------------------------------------------
2645 !-------------------------------------------------------------------------------
2646  SUBROUTINE model_reset_state(this)
2647 
2648  IMPLICIT NONE
2649 
2650 ! Declare Arguments
2651  TYPE (model_class), INTENT(inout) :: this
2652 
2653 ! local variables
2654  REAL (rprec) :: start_time
2655 
2656 ! Start of executable code
2657  start_time = profiler_get_start_time()
2658 
2659  CALL equilibrium_reset_state(this%equilibrium)
2660  CALL model_set_grid_profiles(this)
2661  this%state_flags = model_state_all_off
2662 
2663  CALL profiler_set_stop_time('model_reset_state', start_time)
2664 
2665  END SUBROUTINE
2666 
2667 !-------------------------------------------------------------------------------
2673 !-------------------------------------------------------------------------------
2674  SUBROUTINE model_save_state(this)
2675 
2676  IMPLICIT NONE
2677 
2678 ! Declare Arguments
2679  TYPE (model_class), INTENT(inout) :: this
2680 
2681 ! local variables
2682  REAL (rprec) :: start_time
2683 
2684 ! Start of executable code
2685  start_time = profiler_get_start_time()
2686 
2687  CALL equilibrium_save_state(this%equilibrium)
2688 
2689  CALL profiler_set_stop_time('model_save_state', start_time)
2690 
2691  END SUBROUTINE
2692 
2693 !-------------------------------------------------------------------------------
2705 !-------------------------------------------------------------------------------
2706  FUNCTION model_converge(this, num_iter, iou, eq_comm, param_name)
2707 
2708  IMPLICIT NONE
2709 
2710 ! Declare Arguments
2711  LOGICAL :: model_converge
2712  TYPE (model_class), INTENT(inout) :: this
2713  INTEGER, INTENT(inout) :: num_iter
2714  INTEGER, INTENT(in) :: iou
2715  INTEGER, INTENT(in) :: eq_comm
2716  CHARACTER (len=*), INTENT(in) :: param_name
2717 
2718 ! local variables
2719  INTEGER :: init_num_iter
2720  REAL (rprec) :: r
2721  INTEGER :: error
2722  REAL (rprec) :: start_time
2723 
2724 ! Start of executable code
2725  start_time = profiler_get_start_time()
2726 
2727  IF (this%equilibrium%force_solve) THEN
2728  this%state_flags = model_state_all_on
2729  END IF
2730 
2731  init_num_iter = num_iter
2732 
2733  IF (btest(this%state_flags, model_state_vmec_flag) .or. &
2734  & btest(this%state_flags, model_state_siesta_flag)) THEN
2735 #if defined (MPI_OPT)
2736  CALL mpi_bcast(mpi_equilibrium_task, 1, mpi_integer, 0, &
2737  & eq_comm, error)
2738  CALL mpi_bcast(this%state_flags, 1, mpi_integer, 0, eq_comm, &
2739  & error)
2740 #endif
2741 
2742  model_converge = equilibrium_converge(this%equilibrium, &
2743  & num_iter, iou, eq_comm, &
2744  & this%state_flags)
2745  ELSE
2746  model_converge = .true.
2747  END IF
2748 
2749 ! If this is the first time running make sure all signals are computed.
2750  IF (init_num_iter .eq. 1) THEN
2751  this%state_flags = model_state_all_on
2752  END IF
2753 
2754  IF (model_converge) THEN
2755 
2756  WRITE (*,1000) model_converge, num_iter, &
2757  & num_iter - init_num_iter, trim(param_name)
2758  WRITE (iou,1000) model_converge, num_iter, &
2759  & num_iter - init_num_iter, trim(param_name)
2760 
2761  CALL model_set_grid_profiles(this)
2762 
2763  END IF
2764 
2765  CALL profiler_set_stop_time('model_converge', start_time)
2766 
2767 1000 FORMAT('Model converged ',l,2(2x,i7),' ',a)
2768 
2769  END FUNCTION
2770 
2771 !-------------------------------------------------------------------------------
2780 !-------------------------------------------------------------------------------
2781  SUBROUTINE model_write(this, iou)
2782 
2783  IMPLICIT NONE
2784 
2785 ! Declare Arguments
2786  TYPE (model_class), INTENT(in) :: this
2787  INTEGER, INTENT(in) :: iou
2788 
2789 ! local variables
2790  INTEGER :: i
2791  REAL (rprec) :: start_time
2792 
2793 ! Start of executable code
2794  start_time = profiler_get_start_time()
2795 
2796  WRITE (iou,*)
2797  WRITE (iou,*) ' *** Model Parameters'
2798  WRITE (iou,*) 'model_ne_type is ', &
2799  & trim(model_get_ne_type(this))
2800 
2801  DO i = 1, SIZE(this%sxrem_type)
2802  WRITE (iou,*) 'model_sxrem_type is ', &
2803  & trim(model_get_sxrem_type(this, i))
2804  END DO
2805 
2806  WRITE (iou,*) 'model_te_type is ', &
2807  & trim(model_get_te_type(this))
2808  WRITE (iou,*) 'model_ti_type is ', &
2809  & trim(model_get_ti_type(this))
2810  WRITE (iou,*) 'model_ze_type is ', &
2811  & trim(model_get_ze_type(this))
2812  WRITE (iou, 1000) 'ne_pp_unit is ', this%ne_unit
2813  WRITE (iou, 1000) 'ne_min is ', this%ne_min
2814  WRITE (iou, 1000) 'te_min is ', this%te_min
2815  WRITE (iou, 1000) 'ti_min is ', this%ti_min
2816  WRITE (iou, 1000) 'ze_min is ', this%ze_min
2817  WRITE (iou, 1000) 'e_pressure_fraction is ', &
2818  & this%pressure_fraction
2819 
2820  IF (ASSOCIATED(this%coosig_wgts)) THEN
2821  DO i = 1, SIZE(this%coosig_wgts)
2822 ! Only write coosig_wgts if they are non-zero.
2823 ! @todo need better check
2824  IF (.NOT.(this%coosig_wgts(i) .EQ. 0.0)) THEN
2825  WRITE (iou,1001) i,this%coosig_wgts(i)
2826  END IF
2827  END DO
2828  END IF
2829 
2830  WRITE (iou, 1000) 'signal_factors are ', &
2831  & this%signal_factor
2832 
2833 1000 FORMAT(1x,a,2x,es12.5)
2834 1001 FORMAT(' coosig_wgt(',i4,') is ',es12.5)
2835 
2836  CALL equilibrium_write(this%equilibrium, iou)
2837 
2838  CALL profiler_set_stop_time('model_write', start_time)
2839 
2840  END SUBROUTINE
2841 
2842 !*******************************************************************************
2843 ! NETCDF SUBROUTINES
2844 !*******************************************************************************
2884 !-------------------------------------------------------------------------------
2895 !-------------------------------------------------------------------------------
2896  SUBROUTINE model_def_result(this, result_ncid, maxnsteps_dim_id, &
2897  & string_len_dim_id)
2898  USE ezcdf
2899 
2900  IMPLICIT NONE
2901 
2902 ! Declare Arguments
2903  TYPE (model_class), INTENT(in) :: this
2904  INTEGER, INTENT(in) :: result_ncid
2905  INTEGER, INTENT(in) :: maxnsteps_dim_id
2906  INTEGER, INTENT(in) :: string_len_dim_id
2907 
2908 ! local variables
2909  INTEGER :: status
2910  INTEGER :: model_grid_size_dim_id
2911  INTEGER :: model_num_sxrem_dim_id
2912  INTEGER :: model_num_coosig_w_dim_id
2913  INTEGER :: ne_type_var_id
2914  INTEGER :: te_type_var_id
2915  INTEGER :: ti_type_var_id
2916  INTEGER :: ze_type_var_id
2917  INTEGER :: sxrem_type_var_id
2918  INTEGER :: ne_unit_var_id
2919  INTEGER :: ne_min_var_id
2920  INTEGER :: te_min_var_id
2921  INTEGER :: ti_min_var_id
2922  INTEGER :: ze_min_var_id
2923  INTEGER :: pressure_fraction_var_id
2924  INTEGER :: ne_grid_var_id
2925  INTEGER :: te_grid_var_id
2926  INTEGER :: ti_grid_var_id
2927  INTEGER :: ze_grid_var_id
2928  INTEGER :: sxrem_grid_var_id
2929  INTEGER :: coosig_w_var_id
2930  REAL (rprec) :: start_time
2931 
2932 ! Start of executable code
2933  start_time = profiler_get_start_time()
2934 
2935 ! Define dimensions
2936  IF (ASSOCIATED(this%ne_grid) .or. &
2937  & ASSOCIATED(this%te_grid) .or. &
2938  & ASSOCIATED(this%ze_grid) .or. &
2939  & ASSOCIATED(this%sxrem_grid)) THEN
2940  status = nf_def_dim(result_ncid, 'model_grid_size', &
2941  & SIZE(this%ne_grid), &
2942  & model_grid_size_dim_id)
2943  ELSE
2944  status = nf_def_dim(result_ncid, 'model_grid_size', 1, &
2945  & model_grid_size_dim_id)
2946  END IF
2947  CALL assert_eq(status, nf_noerr, nf_strerror(status))
2948 
2949  IF (ASSOCIATED(this%sxrem_type)) THEN
2950  status = nf_def_dim(result_ncid, 'model_num_sxrem', &
2951  & SIZE(this%sxrem_type, 1), &
2952  & model_num_sxrem_dim_id)
2953  END IF
2954  CALL assert_eq(status, nf_noerr, nf_strerror(status))
2955 
2956  IF (ASSOCIATED(this%coosig_wgts)) THEN
2957  status = nf_def_dim(result_ncid, 'model_num_coosig', &
2958  & SIZE(this%coosig_wgts, 1), &
2959  & model_num_coosig_w_dim_id)
2960  END IF
2961  CALL assert_eq(status, nf_noerr, nf_strerror(status))
2962 
2963 ! Define variables
2964  status = nf_def_var(result_ncid, 'model_ne_type', nf_char, 1, &
2965  & (/ string_len_dim_id /), ne_type_var_id)
2966  CALL assert_eq(status, nf_noerr, nf_strerror(status))
2967 
2968  status = nf_def_var(result_ncid, 'model_te_type', nf_char, 1, &
2969  & (/ string_len_dim_id /), te_type_var_id)
2970  CALL assert_eq(status, nf_noerr, nf_strerror(status))
2971 
2972  status = nf_def_var(result_ncid, 'model_ti_type', nf_char, 1, &
2973  & (/ string_len_dim_id /), ti_type_var_id)
2974  CALL assert_eq(status, nf_noerr, nf_strerror(status))
2975 
2976  status = nf_def_var(result_ncid, 'model_ze_type', nf_char, 1, &
2977  & (/ string_len_dim_id /), ze_type_var_id)
2978  CALL assert_eq(status, nf_noerr, nf_strerror(status))
2979 
2980  IF (ASSOCIATED(this%sxrem_type)) THEN
2981  status = nf_def_var(result_ncid, 'model_sxrem_type', nf_char, &
2982  & 2, (/ string_len_dim_id, &
2983  & model_num_sxrem_dim_id /), &
2984  & sxrem_type_var_id)
2985  CALL assert_eq(status, nf_noerr, nf_strerror(status))
2986  END IF
2987 
2988  status = nf_def_var(result_ncid, 'ne_unit', nf_double, 1, &
2989  & (/ maxnsteps_dim_id /), ne_unit_var_id)
2990  CALL assert_eq(status, nf_noerr, nf_strerror(status))
2991 
2992  status = nf_def_var(result_ncid, 'ne_min', nf_double, 1, &
2993  & (/ maxnsteps_dim_id /), ne_min_var_id)
2994  CALL assert_eq(status, nf_noerr, nf_strerror(status))
2995 
2996  status = nf_def_var(result_ncid, 'te_min', nf_double, 1, &
2997  & (/ maxnsteps_dim_id /), te_min_var_id)
2998  CALL assert_eq(status, nf_noerr, nf_strerror(status))
2999 
3000  status = nf_def_var(result_ncid, 'ti_min', nf_double, 1, &
3001  & (/ maxnsteps_dim_id /), ti_min_var_id)
3002  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3003 
3004  status = nf_def_var(result_ncid, 'ze_min', nf_double, 1, &
3005  & (/ maxnsteps_dim_id /), ze_min_var_id)
3006  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3007 
3008  status = nf_def_var(result_ncid, 'pressure_fraction', nf_double, &
3009  & 1, (/ maxnsteps_dim_id /), &
3010  & pressure_fraction_var_id)
3011  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3012 
3013  IF (ASSOCIATED(this%ne_grid)) THEN
3014  status = nf_def_var(result_ncid, 'ne_grid', nf_double, 2, &
3015  & (/ model_grid_size_dim_id, &
3016  & maxnsteps_dim_id /), ne_grid_var_id)
3017  END IF
3018 
3019  IF (ASSOCIATED(this%te_grid)) THEN
3020  status = nf_def_var(result_ncid, 'te_grid', nf_double, 2, &
3021  & (/ model_grid_size_dim_id, &
3022  & maxnsteps_dim_id /), te_grid_var_id)
3023  END IF
3024 
3025  IF (ASSOCIATED(this%te_grid)) THEN
3026  status = nf_def_var(result_ncid, 'ti_grid', nf_double, 2, &
3027  & (/ model_grid_size_dim_id, &
3028  & maxnsteps_dim_id /), ti_grid_var_id)
3029  END IF
3030 
3031  IF (ASSOCIATED(this%ze_grid)) THEN
3032  status = nf_def_var(result_ncid, 'ze_grid', nf_double, 2, &
3033  & (/ model_grid_size_dim_id, &
3034  & maxnsteps_dim_id /), ze_grid_var_id)
3035  END IF
3036 
3037  IF (ASSOCIATED(this%sxrem_grid)) THEN
3038  status = nf_def_var(result_ncid, 'sxrem_grid', nf_double, 3, &
3039  & (/ model_grid_size_dim_id, &
3040  & model_num_sxrem_dim_id, &
3041  & maxnsteps_dim_id /), sxrem_grid_var_id)
3042  END IF
3043 
3044  IF (ASSOCIATED(this%coosig_wgts)) THEN
3045  status = nf_def_var(result_ncid, 'coosig_wgts', nf_double, 2, &
3046  & (/ model_num_coosig_w_dim_id, &
3047  & maxnsteps_dim_id /), coosig_w_var_id)
3048  END IF
3049 
3050  CALL equilibrium_def_result(this%equilibrium, result_ncid, &
3051  & maxnsteps_dim_id)
3052 
3053  CALL profiler_set_stop_time('model_def_result', start_time)
3054 
3055  END SUBROUTINE
3056 
3057 !-------------------------------------------------------------------------------
3064 !-------------------------------------------------------------------------------
3065  SUBROUTINE model_write_init_data(this, result_ncid)
3066  USE ezcdf
3067 
3068  IMPLICIT NONE
3069 
3070 ! Declare Arguments
3071  TYPE (model_class), INTENT(in) :: this
3072  INTEGER, INTENT(in) :: result_ncid
3073 
3074 ! Local variables
3075  INTEGER :: i, status
3076  INTEGER :: ne_type_var_id
3077  INTEGER :: te_type_var_id
3078  INTEGER :: ti_type_var_id
3079  INTEGER :: ze_type_var_id
3080  INTEGER :: sxrem_type_var_id
3081  REAL (rprec) :: start_time
3082 
3083 ! Start of executable code
3084  start_time = profiler_get_start_time()
3085 
3086  status = nf_inq_varid(result_ncid, 'model_ne_type', &
3087  & ne_type_var_id)
3088  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3089  status = nf_put_var_text(result_ncid, ne_type_var_id, &
3090  & model_get_ne_type(this))
3091  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3092 
3093  status = nf_inq_varid(result_ncid, 'model_te_type', &
3094  & te_type_var_id)
3095  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3096  status = nf_put_var_text(result_ncid, te_type_var_id, &
3097  & model_get_te_type(this))
3098  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3099 
3100  status = nf_inq_varid(result_ncid, 'model_ti_type', &
3101  & ti_type_var_id)
3102  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3103  status = nf_put_var_text(result_ncid, ti_type_var_id, &
3104  & model_get_ti_type(this))
3105  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3106 
3107  status = nf_inq_varid(result_ncid, 'model_ze_type', &
3108  & ze_type_var_id)
3109  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3110  status = nf_put_var_text(result_ncid, ze_type_var_id, &
3111  & model_get_ze_type(this))
3112  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3113 
3114  IF (ASSOCIATED(this%sxrem_type)) THEN
3115  status = nf_inq_varid(result_ncid, 'model_sxrem_type', &
3116  & sxrem_type_var_id)
3117  DO i = 1, SIZE(this%sxrem_type)
3118  status = nf_put_vara_text(result_ncid, sxrem_type_var_id, &
3119  & (/ 1, i /), &
3120  & (/ data_name_length, 1 /), &
3121  & model_get_sxrem_type(this, i))
3122  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3123  END DO
3124  END IF
3125 
3126  CALL equilibrium_write_init_data(this%equilibrium, result_ncid)
3127 
3128  CALL profiler_set_stop_time('model_write_init_data', start_time)
3129 
3130  END SUBROUTINE
3131 
3132 !-------------------------------------------------------------------------------
3140 !-------------------------------------------------------------------------------
3141  SUBROUTINE model_write_step_data(this, result_ncid, current_step)
3142  USE ezcdf
3143 
3144 ! Declare Arguments
3145  TYPE (model_class), INTENT(in) :: this
3146  INTEGER, INTENT(in) :: result_ncid
3147  INTEGER, INTENT(in) :: current_step
3148 
3149 ! Local variables
3150  INTEGER :: i, status
3151  INTEGER :: ne_unit_var_id
3152  INTEGER :: ne_min_var_id
3153  INTEGER :: te_min_var_id
3154  INTEGER :: ti_min_var_id
3155  INTEGER :: ze_min_var_id
3156  INTEGER :: pressure_fraction_var_id
3157  INTEGER :: ne_grid_var_id
3158  INTEGER :: te_grid_var_id
3159  INTEGER :: ti_grid_var_id
3160  INTEGER :: ze_grid_var_id
3161  INTEGER :: sxrem_grid_var_id
3162  INTEGER :: coosig_w_var_id
3163  REAL (rprec) :: start_time
3164 
3165 ! Start of executable code
3166  start_time = profiler_get_start_time()
3167 
3168  status = nf_inq_varid(result_ncid, 'ne_unit', ne_unit_var_id)
3169  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3170  status = nf_put_var1_double(result_ncid, ne_unit_var_id, &
3171  & current_step, this%ne_unit)
3172  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3173 
3174  status = nf_inq_varid(result_ncid, 'ne_min', ne_min_var_id)
3175  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3176  status = nf_put_var1_double(result_ncid, ne_min_var_id, &
3177  & current_step, this%ne_min)
3178  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3179 
3180  status = nf_inq_varid(result_ncid, 'te_min', te_min_var_id)
3181  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3182  status = nf_put_var1_double(result_ncid, te_min_var_id, &
3183  & current_step, this%te_min)
3184  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3185 
3186  status = nf_inq_varid(result_ncid, 'ti_min', ti_min_var_id)
3187  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3188  status = nf_put_var1_double(result_ncid, ti_min_var_id, &
3189  & current_step, this%ti_min)
3190  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3191 
3192  status = nf_inq_varid(result_ncid, 'ze_min', ze_min_var_id)
3193  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3194  status = nf_put_var1_double(result_ncid, ze_min_var_id, &
3195  & current_step, this%ze_min)
3196  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3197 
3198  status = nf_inq_varid(result_ncid, 'pressure_fraction', &
3199  & pressure_fraction_var_id)
3200  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3201  status = nf_put_var1_double(result_ncid, pressure_fraction_var_id, &
3202  & current_step, this%pressure_fraction)
3203  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3204 
3205  IF (ASSOCIATED(this%ne_grid)) THEN
3206  status = nf_inq_varid(result_ncid, 'ne_grid', ne_grid_var_id)
3207  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3208  status = nf_put_vara_double(result_ncid, ne_grid_var_id, &
3209  & (/ 1, current_step /), &
3210  & (/ SIZE(this%ne_grid), 1 /), &
3211  & this%ne_grid)
3212  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3213  END IF
3214 
3215  IF (ASSOCIATED(this%te_grid)) THEN
3216  status = nf_inq_varid(result_ncid, 'te_grid', te_grid_var_id)
3217  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3218  status = nf_put_vara_double(result_ncid, te_grid_var_id, &
3219  & (/ 1, current_step /), &
3220  & (/ SIZE(this%te_grid), 1 /), &
3221  & this%te_grid)
3222  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3223  END IF
3224 
3225  IF (ASSOCIATED(this%ti_grid)) THEN
3226  status = nf_inq_varid(result_ncid, 'ti_grid', ti_grid_var_id)
3227  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3228  status = nf_put_vara_double(result_ncid, ti_grid_var_id, &
3229  & (/ 1, current_step /), &
3230  & (/ SIZE(this%ti_grid), 1 /), &
3231  & this%ti_grid)
3232  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3233  END IF
3234 
3235  IF (ASSOCIATED(this%ze_grid)) THEN
3236  status = nf_inq_varid(result_ncid, 'ze_grid', ze_grid_var_id)
3237  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3238  status = nf_put_vara_double(result_ncid, ze_grid_var_id, &
3239  & (/ 1, current_step /), &
3240  & (/ SIZE(this%ze_grid), 1 /), &
3241  & this%ze_grid)
3242  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3243  END IF
3244 
3245  IF (ASSOCIATED(this%sxrem_grid)) THEN
3246  status = nf_inq_varid(result_ncid, 'sxrem_grid', &
3247  & sxrem_grid_var_id)
3248  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3249  status = nf_put_vara_double(result_ncid, sxrem_grid_var_id, &
3250  & (/ 1, 1, current_step /), &
3251  & (/ SIZE(this%sxrem_grid, 1), &
3252  & SIZE(this%sxrem_grid, 2), 1 /), &
3253  & this%sxrem_grid)
3254  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3255  END IF
3256 
3257  IF (ASSOCIATED(this%coosig_wgts)) THEN
3258  status = nf_inq_varid(result_ncid, 'coosig_wgts', &
3259  & coosig_w_var_id)
3260  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3261  status = nf_put_vara_double(result_ncid, coosig_w_var_id, &
3262  & (/ 1, current_step /), &
3263  & (/ SIZE(this%coosig_wgts), 1 /), &
3264  & this%coosig_wgts)
3265  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3266  END IF
3267 
3268  CALL equilibrium_write_step_data(this%equilibrium, result_ncid, &
3269  & current_step)
3270 
3271  CALL profiler_set_stop_time('model_write_step_data', start_time)
3272 
3273  END SUBROUTINE
3274 
3275 !-------------------------------------------------------------------------------
3283 !-------------------------------------------------------------------------------
3284  SUBROUTINE model_restart(this, result_ncid, current_step)
3285  USE ezcdf
3286 
3287  IMPLICIT NONE
3288 
3289 ! Declare Arguments
3290  TYPE (model_class), INTENT(inout) :: this
3291  INTEGER, INTENT(in) :: result_ncid
3292  INTEGER, INTENT(in) :: current_step
3293 
3294 ! Local variables
3295  INTEGER :: i, status
3296  INTEGER :: ne_unit_var_id
3297  INTEGER :: ne_min_var_id
3298  INTEGER :: te_min_var_id
3299  INTEGER :: ti_min_var_id
3300  INTEGER :: ze_min_var_id
3301  INTEGER :: pressure_fraction_var_id
3302  INTEGER :: ne_grid_var_id
3303  INTEGER :: te_grid_var_id
3304  INTEGER :: ti_grid_var_id
3305  INTEGER :: ze_grid_var_id
3306  INTEGER :: sxrem_grid_var_id
3307  INTEGER :: coosig_w_var_id
3308  REAL (rprec) :: start_time
3309 
3310 ! Start of executable code
3311  start_time = profiler_get_start_time()
3312 
3313  status = nf_inq_varid(result_ncid, 'ne_unit', ne_unit_var_id)
3314  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3315  status = nf_get_var1_double(result_ncid, ne_unit_var_id, &
3316  & current_step, this%ne_unit)
3317  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3318 
3319  status = nf_inq_varid(result_ncid, 'ne_min', ne_min_var_id)
3320  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3321  status = nf_get_var1_double(result_ncid, ne_min_var_id, &
3322  & current_step, this%ne_min)
3323  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3324 
3325  status = nf_inq_varid(result_ncid, 'te_min', te_min_var_id)
3326  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3327  status = nf_get_var1_double(result_ncid, te_min_var_id, &
3328  & current_step, this%te_min)
3329  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3330 
3331  status = nf_inq_varid(result_ncid, 'ti_min', ti_min_var_id)
3332  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3333  status = nf_get_var1_double(result_ncid, ti_min_var_id, &
3334  & current_step, this%ti_min)
3335  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3336 
3337  status = nf_inq_varid(result_ncid, 'ze_min', ze_min_var_id)
3338  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3339  status = nf_get_var1_double(result_ncid, ze_min_var_id, &
3340  & current_step, this%ze_min)
3341  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3342 
3343  status = nf_inq_varid(result_ncid, 'pressure_fraction', &
3344  & pressure_fraction_var_id)
3345  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3346  status = nf_get_var1_double(result_ncid, pressure_fraction_var_id, &
3347  & current_step, this%pressure_fraction)
3348  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3349 
3350  IF (ASSOCIATED(this%ne_grid)) THEN
3351  status = nf_inq_varid(result_ncid, 'ne_grid', ne_grid_var_id)
3352  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3353  status = nf_get_vara_double(result_ncid, ne_grid_var_id, &
3354  & (/ 1, current_step /), &
3355  & (/ SIZE(this%ne_grid), 1 /), &
3356  & this%ne_grid)
3357  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3358  END IF
3359 
3360  IF (ASSOCIATED(this%te_grid)) THEN
3361  status = nf_inq_varid(result_ncid, 'te_grid', te_grid_var_id)
3362  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3363  status = nf_get_vara_double(result_ncid, te_grid_var_id, &
3364  & (/ 1, current_step /), &
3365  & (/ SIZE(this%te_grid), 1 /), &
3366  & this%te_grid)
3367  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3368  END IF
3369 
3370  IF (ASSOCIATED(this%ti_grid)) THEN
3371  status = nf_inq_varid(result_ncid, 'ti_grid', ti_grid_var_id)
3372  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3373  status = nf_get_vara_double(result_ncid, ti_grid_var_id, &
3374  & (/ 1, current_step /), &
3375  & (/ SIZE(this%ti_grid), 1 /), &
3376  & this%ti_grid)
3377  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3378  END IF
3379 
3380  IF (ASSOCIATED(this%ze_grid)) THEN
3381  status = nf_inq_varid(result_ncid, 'ze_grid', ze_grid_var_id)
3382  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3383  status = nf_get_vara_double(result_ncid, ze_grid_var_id, &
3384  & (/ 1, current_step /), &
3385  & (/ SIZE(this%ze_grid), 1 /), &
3386  & this%ze_grid)
3387  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3388  END IF
3389 
3390  IF (ASSOCIATED(this%sxrem_grid)) THEN
3391  status = nf_inq_varid(result_ncid, 'sxrem_grid', &
3392  & sxrem_grid_var_id)
3393  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3394  status = nf_get_vara_double(result_ncid, sxrem_grid_var_id, &
3395  & (/ 1, 1, current_step /), &
3396  & (/ SIZE(this%sxrem_grid, 1), &
3397  & SIZE(this%sxrem_grid, 2), 1 /), &
3398  & this%sxrem_grid)
3399  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3400  END IF
3401 
3402  IF (ASSOCIATED(this%coosig_wgts)) THEN
3403  status = nf_inq_varid(result_ncid, 'coosig_wgts', &
3404  & coosig_w_var_id)
3405  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3406  status = nf_get_vara_double(result_ncid, coosig_w_var_id, &
3407  & (/ 1, current_step /), &
3408  & (/ SIZE(this%coosig_wgts), 1 /), &
3409  & this%coosig_wgts)
3410  CALL assert_eq(status, nf_noerr, nf_strerror(status))
3411  END IF
3412 
3413  CALL equilibrium_restart(this%equilibrium, result_ncid, &
3414  & current_step)
3415 
3416  this%state_flags = model_state_all_off
3417 
3418  CALL profiler_set_stop_time('model_restart', start_time)
3419 
3420  END SUBROUTINE
3421 
3422 !*******************************************************************************
3423 ! MPI SUBROUTINES
3424 !*******************************************************************************
3425 !-------------------------------------------------------------------------------
3433 !-------------------------------------------------------------------------------
3434  SUBROUTINE model_sync_state(this, recon_comm)
3435 
3436  IMPLICIT NONE
3437 
3438 ! Declare Arguments
3439  TYPE (model_class), INTENT(inout) :: this
3440  INTEGER, INTENT(in) :: recon_comm
3441 
3442 #if defined(MPI_OPT)
3443 ! local variables
3444  INTEGER :: error
3445  INTEGER :: grid_size
3446  REAL (rprec) :: start_time
3447 
3448 ! Start of executable code
3449  start_time = profiler_get_start_time()
3450 
3451  CALL equilibrium_sync_state(this%equilibrium, recon_comm)
3452 
3453  CALL mpi_bcast(this%state_flags, 1, mpi_integer, 0, recon_comm, &
3454  & error)
3455 
3456  grid_size = equilibrium_get_grid_size(this%equilibrium)
3457  IF (grid_size .gt. 0) THEN
3458  CALL mpi_bcast(this%ne_grid, grid_size, mpi_real8, 0, &
3459  & recon_comm, error)
3460  CALL mpi_bcast(this%sxrem_grid, &
3461  & grid_size*SIZE(this%sxrem_type), mpi_real8, 0, &
3462  & recon_comm, error)
3463  CALL mpi_bcast(this%te_grid, grid_size, mpi_real8, 0, &
3464  & recon_comm, error)
3465  CALL mpi_bcast(this%ti_grid, grid_size, mpi_real8, 0, &
3466  & recon_comm, error)
3467  CALL mpi_bcast(this%ze_grid, grid_size, mpi_real8, 0, &
3468  & recon_comm, error)
3469  END IF
3470 
3471  CALL profiler_set_stop_time('model_sync_state', start_time)
3472 #endif
3473 
3474  END SUBROUTINE
3475 
3476 !-------------------------------------------------------------------------------
3485 !-------------------------------------------------------------------------------
3486  SUBROUTINE model_sync_child(this, index, recon_comm)
3487 
3488  IMPLICIT NONE
3489 
3490 ! Declare Arguments
3491  TYPE (model_class), INTENT(inout) :: this
3492  INTEGER, INTENT(in) :: index
3493  INTEGER, INTENT(in) :: recon_comm
3494 
3495 #if defined(MPI_OPT)
3496 ! local variables
3497  INTEGER :: error
3498  INTEGER :: grid_size
3499  INTEGER :: mpi_rank
3500  REAL (rprec) :: start_time
3501 
3502 ! Start of executable code
3503  start_time = profiler_get_start_time()
3504 
3505  CALL equilibrium_sync_child(this%equilibrium, index, recon_comm)
3506 
3507  grid_size = equilibrium_get_grid_size(this%equilibrium)
3508  IF (grid_size .gt. 0) THEN
3509  CALL mpi_comm_rank(recon_comm, mpi_rank, error)
3510 
3511  IF (mpi_rank .eq. index) THEN
3512 
3513  CALL mpi_ssend(this%ne_grid, grid_size, mpi_real8, 0, &
3514  & mpi_rank, recon_comm, error)
3515  CALL mpi_ssend(this%sxrem_grid, &
3516  & grid_size*SIZE(this%sxrem_type), mpi_real8, &
3517  & 0, mpi_rank, recon_comm, error)
3518  CALL mpi_ssend(this%te_grid, grid_size, mpi_real8, 0, &
3519  & mpi_rank, recon_comm, error)
3520  CALL mpi_ssend(this%ti_grid, grid_size, mpi_real8, 0, &
3521  & mpi_rank, recon_comm, error)
3522  CALL mpi_ssend(this%ze_grid, grid_size, mpi_real8, 0, &
3523  & mpi_rank, recon_comm, error)
3524 
3525  ELSE IF (mpi_rank .eq. 0) THEN
3526 
3527  CALL mpi_recv(this%ne_grid, grid_size, mpi_real8, index, &
3528  & index, recon_comm, mpi_status_ignore, error)
3529  CALL mpi_recv(this%sxrem_grid, &
3530  & grid_size*SIZE(this%sxrem_type), mpi_real8, &
3531  & index, index, recon_comm, mpi_status_ignore, &
3532  & error)
3533  CALL mpi_recv(this%te_grid, grid_size, mpi_real8, index, &
3534  & index, recon_comm, mpi_status_ignore, error)
3535  CALL mpi_recv(this%ti_grid, grid_size, mpi_real8, index, &
3536  & index, recon_comm, mpi_status_ignore, error)
3537  CALL mpi_recv(this%ze_grid, grid_size, mpi_real8, index, &
3538  & index, recon_comm, mpi_status_ignore, error)
3539 
3540  END IF
3541  END IF
3542 
3543  CALL profiler_set_stop_time('model_sync_child', start_time)
3544 #endif
3545 
3546  END SUBROUTINE
3547 
3548  END MODULE
model::model_get_ne_af
real(rprec) function, dimension(:), pointer model_get_ne_af(this)
Gets the electron density profile af array.
Definition: model.f:1192
equilibrium::equilibrium_get_param_name
character(len=data_name_length) function equilibrium_get_param_name(this, id)
Gets the name of a reconstruction equilibrium parameter.
Definition: equilibrium.f:640
model::model_get_gp_ti_ij
real(rprec) function model_get_gp_ti_ij(this, i, j)
Get the ion temperature gp kernel value for the two indicies.
Definition: model.f:1766
model::model_get_ze
Interface for the model temperature profile values.
Definition: model.f:275
model::model_get_gp_sxrem_ij
real(rprec) function model_get_gp_sxrem_ij(this, i, j, index)
Get the soft x-ray emissivity gp kernel value for the two indicies.
Definition: model.f:2101
equilibrium::equilibrium_get_gp_ti_num_hyper_param
integer function equilibrium_get_gp_ti_num_hyper_param(this)
Get the number of ion temperature gp kernel hyper parameters.
Definition: equilibrium.f:1357
model_state::model_state_ze_flag
integer, parameter model_state_ze_flag
Effective charge profile changed bit position.
Definition: model_state.f:38
model::model_ti_min_id
integer, parameter model_ti_min_id
Parameter id for the minimum electron temperature.
Definition: model.f:102
model::model_get_sxrem_cart
real(rprec) function model_get_sxrem_cart(this, x_cart, index)
Gets the soft x-ray emissivity at a cartesian position.
Definition: model.f:2217
model::model_get_te_cart
real(rprec) function model_get_te_cart(this, x_cart)
Gets the electron temperature at a cartesian position.
Definition: model.f:1602
equilibrium::equilibrium_def_result
subroutine equilibrium_def_result(this, result_ncid, maxnsetps_dim_id)
Define NetCDF variables for the result file.
Definition: equilibrium.f:3618
model::model_ne_grid_id
integer, parameter model_ne_grid_id
Parameter id for the electrion density grid.
Definition: model.f:118
model::model_save_state
subroutine model_save_state(this)
Save the internal state of the model.
Definition: model.f:2675
equilibrium::equilibrium_get_sxrem_af
real(rprec) function, dimension(:), pointer equilibrium_get_sxrem_af(this, index)
Get the soft x-ray emissivity profile af array.
Definition: equilibrium.f:1833
model::model_get_signal_offset
real(rprec) function model_get_signal_offset(this, index)
Get the offset factor for a signal.
Definition: model.f:2565
equilibrium::equilibrium_get_ne
Interface for the equilibrium density profile values.
Definition: equilibrium.f:91
model::model_get_sxrem_radial
real(rprec) function model_get_sxrem_radial(this, r, index)
Gets the soft x-ray emissivity at a radial position.
Definition: model.f:2267
model::model_get_gp_ne_pp
real(rprec) function model_get_gp_ne_pp(this, x_cart, y_cart)
Get the electron density gp kernel value for the position and position.
Definition: model.f:1296
model::model_sync_state
subroutine model_sync_state(this, recon_comm)
Syncronize the model state to children.
Definition: model.f:3435
equilibrium::equilibrium_get_gp_sxrem_num_hyper_param
integer function equilibrium_get_gp_sxrem_num_hyper_param(this, index)
Get the number of soft x-ray emissivity gp kernel hyper parameters.
Definition: equilibrium.f:1786
equilibrium::equilibrium_is_recon_param
logical function equilibrium_is_recon_param(this, id)
Checks if a parameter id is a reconstruction parameter.
Definition: equilibrium.f:3259
model::model_sxrem_min_id
integer, parameter model_sxrem_min_id
Parameter id for the electrion fraction of the pressure.
Definition: model.f:108
equilibrium::equilibrium_get_gp_ti_pp
real(rprec) function equilibrium_get_gp_ti_pp(this, x_cart, y_cart)
Get the ion temperature gp kernel value for the position and position.
Definition: equilibrium.f:1550
model::model_get_ne_radial
real(rprec) function model_get_ne_radial(this, r)
Gets the electron density at a radial position.
Definition: model.f:1384
sxrem_ratio
Defines a feedback signal based on the temperature based on the ration of the soft x-ray emissivity p...
Definition: sxrem_ratio.f:16
equilibrium::equilibrium_write_step_data
subroutine equilibrium_write_step_data(this, result_ncid, current_step)
Write step data to NetCDF result file.
Definition: equilibrium.f:3702
model::model_get_gp_sxrem_num_hyper_param
integer function model_get_gp_sxrem_num_hyper_param(this, index)
Get the number of soft x-ray emission gp kernel hyper parameters.
Definition: model.f:2034
model::model_get_gp_ne_num_hyper_param
integer function model_get_gp_ne_num_hyper_param(this)
Get the number of electron density gp kernel hyper parameters.
Definition: model.f:1162
model::model_ne_unit_id
integer, parameter model_ne_unit_id
Parameter id for the electron density units.
Definition: model.f:96
emission::emission_destruct
subroutine emission_destruct(this)
Deconstruct a emission_class object.
Definition: emission.f:134
equilibrium
Defines the base class of the type equilibrium_class. Equilibrium is an abstract interface to the equ...
Definition: equilibrium.f:19
equilibrium::equilibrium_restart
subroutine equilibrium_restart(this, result_ncid, current_step)
Restart equilibrium.
Definition: equilibrium.f:3746
model::model_signal_factor_id
integer, parameter model_signal_factor_id
Parameter id for the modeled signal scale factors.
Definition: model.f:112
model_state::model_state_all_off
integer, parameter model_state_all_off
Set all flags off.
Definition: model_state.f:20
model::model_ze_type
integer, parameter, private model_ze_type
Effective charge model.
Definition: model.f:92
equilibrium::equilibrium_get_ti_af
real(rprec) function, dimension(:), pointer equilibrium_get_ti_af(this)
Get the ion temperature profile af array.
Definition: equilibrium.f:1402
equilibrium::equilibrium_get_param_id
integer function equilibrium_get_param_id(this, param_name)
Get the id for a reconstruction parameter.
Definition: equilibrium.f:532
equilibrium::equilibrium_get_te
Interface for the equilibrium electron temperature profile values.
Definition: equilibrium.f:108
model::model_set_grid_profiles
subroutine model_set_grid_profiles(this)
Sets grid profile values.
Definition: model.f:808
model::model_get_ne
Interface for the model density profile values.
Definition: model.f:223
model
Defines the base class of the type model_class. The model contains information not specific to the eq...
Definition: model.f:59
equilibrium::equilibrium_get_gp_ne_pp
real(rprec) function equilibrium_get_gp_ne_pp(this, x_cart, y_cart)
Get the electron density gp kernel value for the position and position.
Definition: equilibrium.f:881
equilibrium::equilibrium_get_gp_sxrem_pp
real(rprec) function equilibrium_get_gp_sxrem_pp(this, x_cart, y_cart, index)
Get the soft x-ray emissivity gp kernel value for the position and position.
Definition: equilibrium.f:1989
model::model_get_gp_te_ij
real(rprec) function model_get_gp_te_ij(this, i, j)
Get the electron temperature gp kernel value for the two indicies.
Definition: model.f:1497
equilibrium::equilibrium_get_gp_te_ij
real(rprec) function equilibrium_get_gp_te_ij(this, i, j)
Get the electron temperature gp kernel value for the two indicies.
Definition: equilibrium.f:1113
equilibrium::equilibrium_converge
logical function equilibrium_converge(this, num_iter, iou, eq_comm, state_flags)
Solves the equilibrium.
Definition: equilibrium.f:3362
model::model_get_gp_ne_ij
real(rprec) function model_get_gp_ne_ij(this, i, j)
Get the electron density gp kernel value for the two indicies.
Definition: model.f:1223
equilibrium::equilibrium_sync_child
subroutine equilibrium_sync_child(this, index, recon_comm)
Syncronize a child equilibrium state to the parent.
Definition: equilibrium.f:3828
model::model_def_result
subroutine model_def_result(this, result_ncid, maxnsteps_dim_id, string_len_dim_id)
Define NetCDF variables for the result file.
Definition: model.f:2898
model::model_get_sxrem
Interface for the model soft x-ray emissivity profile values.
Definition: model.f:283
model::model_get_ne_type
character(len=data_name_length) function model_get_ne_type(this)
Gets the electron density type as a string.
Definition: model.f:2347
model_state::model_state_te_flag
integer, parameter model_state_te_flag
Temperature profile changed bit position.
Definition: model_state.f:32
equilibrium::equilibrium_get_ti
Interface for the equilibrium ion temperature profile values.
Definition: equilibrium.f:126
equilibrium::equilibrium_get_gp_ti_ij
real(rprec) function equilibrium_get_gp_ti_ij(this, i, j)
Get the ion temperature gp kernel value for the two indicies.
Definition: equilibrium.f:1448
model::model_get_gp_te_num_hyper_param
integer function model_get_gp_te_num_hyper_param(this)
Get the number of electron temperature gp kernel hyper parameters.
Definition: model.f:1436
model::model_write
subroutine model_write(this, iou)
Write out the model to an output file.
Definition: model.f:2782
equilibrium::equilibrium_get_gp_sxrem_ij
real(rprec) function equilibrium_get_gp_sxrem_ij(this, i, j, index)
Get the electron density gp kernel value for the two indicies.
Definition: equilibrium.f:1881
model::model_te_type
integer, parameter, private model_te_type
Electron temperature model.
Definition: model.f:84
equilibrium::equilibrium_save_state
subroutine equilibrium_save_state(this)
Save the internal state of the equilibrium.
Definition: equilibrium.f:3449
model::model_write_step_data
subroutine model_write_step_data(this, result_ncid, current_step)
Write step data to NetCDF result file.
Definition: model.f:3142
model::model_sxrem_grid_id
integer, parameter model_sxrem_grid_id
Parameter id for the soft x-ray emissivity grid.
Definition: model.f:124
equilibrium::equilibrium_set_param
subroutine equilibrium_set_param(this, id, i_index, j_index, value, eq_comm, state_flags)
Sets the value of a reconstruction equilibrium parameter.
Definition: equilibrium.f:353
model::model_ti_type
integer, parameter, private model_ti_type
Ion temperature model.
Definition: model.f:89
model::model_get_te_af
real(rprec) function, dimension(:), pointer model_get_te_af(this)
Gets the electron temperature profile af array.
Definition: model.f:1466
equilibrium::equilibrium_get_gp_ti_pi
real(rprec) function equilibrium_get_gp_ti_pi(this, x_cart, i)
Get the ion temperature gp kernel value for the position and index.
Definition: equilibrium.f:1498
model::model_get_ti
Interface for the model ion temperature profile values.
Definition: model.f:258
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_ne_min_id
integer, parameter model_ne_min_id
Parameter id for the minimum electron density.
Definition: model.f:98
model::model_get_ti_type
character(len=data_name_length) function model_get_ti_type(this)
Gets the ion temperature type as a string.
Definition: model.f:2421
model::model_get_gp_te
Interface for the model guassian process electron temperature profile values.
Definition: model.f:249
equilibrium::equilibrium_destruct
subroutine equilibrium_destruct(this)
Deconstruct a equilibrium_class object.
Definition: equilibrium.f:300
equilibrium::equilibrium_get_te_af
real(rprec) function, dimension(:), pointer equilibrium_get_te_af(this)
Get the electron temperature profile af array.
Definition: equilibrium.f:1067
model_state
Contains parameters defining the bit positions for flags that mark changes in different parts of the ...
Definition: model_state.f:11
model::model_ze_grid_id
integer, parameter model_ze_grid_id
Parameter id for the effective charge grid.
Definition: model.f:126
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_signal_offset_id
integer, parameter model_signal_offset_id
Parameter id for the modeled signal offset factors.
Definition: model.f:114
integration_path
Module is part of the LIBSTELL. This modules contains code to define and integrate along an arbitray ...
Definition: integration_path.f:12
model::model_sxrem_type
integer, parameter, private model_sxrem_type
Soft X-ray Emissivity.
Definition: model.f:79
equilibrium::equilibrium_get_grid_size
integer function equilibrium_get_grid_size(this)
Get radial grid size.
Definition: equilibrium.f:2979
model::model_ne_type
integer, parameter, private model_ne_type
Electron denisty model.
Definition: model.f:74
model::model_class
Base class representing a model.
Definition: model.f:141
model::model_get_ze_cart
real(rprec) function model_get_ze_cart(this, x_cart)
Gets the effective charge at a cartesian position.
Definition: model.f:1952
model::model_get_sxrem_ratio
real(rprec) function model_get_sxrem_ratio(this, te)
Gets the soft x-ray emissivity ratio.
Definition: model.f:2318
model_state::model_state_ti_flag
integer, parameter model_state_ti_flag
Ion profile changed bit position.
Definition: model_state.f:34
model::model_get_te
Interface for the model electron temperature profile values.
Definition: model.f:240
model_state::model_state_vmec_flag
integer, parameter model_state_vmec_flag
VMEC Equilibrium changed bit position.
Definition: model_state.f:26
model::model_get_gp_ti
Interface for the model guassian process ion temperature profile values.
Definition: model.f:266
model::model_get_gp_ti_pp
real(rprec) function model_get_gp_ti_pp(this, x_cart, y_cart)
Get the electron temperature gp kernel value for the position and position.
Definition: model.f:1836
model::model_get_signal_factor
real(rprec) function model_get_signal_factor(this, index)
Get the scale factor for a signal.
Definition: model.f:2531
model_state::model_state_sxrem_flag
integer, parameter model_state_sxrem_flag
Soft x-ray emissivity profile changed bit position. This flag needs to always be the last flag an can...
Definition: model_state.f:46
model::ev_per_joule
real(rprec), parameter ev_per_joule
Conversion from Joules to eV.
Definition: model.f:131
model::model_pressure_fraction_id
integer, parameter model_pressure_fraction_id
Parameter id for the electrion fraction of the pressure.
Definition: model.f:104
model::model_restart
subroutine model_restart(this, result_ncid, current_step)
Restart the model.
Definition: model.f:3285
model::model_ti_grid_id
integer, parameter model_ti_grid_id
Parameter id for the ion temperature grid.
Definition: model.f:122
equilibrium::equilibrium_sync_state
subroutine equilibrium_sync_state(this, recon_comm)
Syncronize the equilibrium state to children.
Definition: equilibrium.f:3787
equilibrium::equilibrium_get_grid_start
real(rprec) function equilibrium_get_grid_start(this)
Get start of the radial grid.
Definition: equilibrium.f:3023
equilibrium::equilibrium_get_gp_sxrem_pi
real(rprec) function equilibrium_get_gp_sxrem_pi(this, x_cart, i, index)
Get the soft x-ray emissivity gp kernel value for the position and index.
Definition: equilibrium.f:1935
model::model_get_gp_ne_pi
real(rprec) function model_get_gp_ne_pi(this, x_cart, i)
Get the electron density gp kernel value for the position and index.
Definition: model.f:1259
equilibrium::equilibrium_get_grid_stop
real(rprec) function equilibrium_get_grid_stop(this)
Get stop of the radial grid.
Definition: equilibrium.f:3067
equilibrium::equilibrium_get_param_value
real(rprec) function equilibrium_get_param_value(this, id, i_index, j_index)
Gets the value of a reconstruction equilibrium parameter.
Definition: equilibrium.f:586
model::model_converge
logical function model_converge(this, num_iter, iou, eq_comm, param_name)
Solves the model.
Definition: model.f:2707
model::model_write_init_data
subroutine model_write_init_data(this, result_ncid)
Write inital data to NetCDF result file.
Definition: model.f:3066
model_state::model_state_ne_flag
integer, parameter model_state_ne_flag
Denisty profile changed bit position.
Definition: model_state.f:30
model::model_get_ze_type
character(len=data_name_length) function model_get_ze_type(this)
Gets the effective charge type as a string.
Definition: model.f:2455
model::model_get_gp_ne
Interface for the model guassian process density profile values.
Definition: model.f:231
emission::emission_get_emission
real(rprec) function emission_get_emission(this, te, ne, index)
Gets the emission as a function of energy for a fixed temperature.
Definition: emission.f:167
equilibrium::equilibrium_class
Base class representing a equilibrium.
Definition: equilibrium.f:50
model::model_get_sxrem_af
real(rprec) function, dimension(:), pointer model_get_sxrem_af(this, index)
Gets the soft x-ray emissivity profile af array.
Definition: model.f:2067
model::model_get_gp_sxrem
Interface for the mdoel guassian process soft x-ray emissivity profile values.
Definition: model.f:292
line_segment
Module is part of the LIBSTELL. This module contains code to create a profile constructed of line sig...
Definition: line_segment.f:13
model::model_sync_child
subroutine model_sync_child(this, index, recon_comm)
Syncronize a child model state to the parent.
Definition: model.f:3487
model_state::model_state_all_on
integer, parameter model_state_all_on
Set all flags on.
Definition: model_state.f:22
model::model_reset_state
subroutine model_reset_state(this)
Reset the internal state of the model.
Definition: model.f:2647
emission::emission_class
Base class representing the soft x-ray emission function.
Definition: emission.f:53
model::model_get_ti_radial
real(rprec) function model_get_ti_radial(this, r)
Gets the ion temperature at a radial position.
Definition: model.f:1911
model::model_set_param
subroutine model_set_param(this, id, i_index, j_index, value, eq_comm)
Sets the value of a reconstruction model parameter.
Definition: model.f:658
model::model_is_recon_param
logical function model_is_recon_param(this, id)
Determines if a parameter id is a reconstruction parameter.
Definition: model.f:2603
equilibrium::equilibrium_get_gp_te_pi
real(rprec) function equilibrium_get_gp_te_pi(this, x_cart, i)
Get the electron temperature gp kernel value for the position and index.
Definition: equilibrium.f:1164
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
model::model_construct
type(model_class) function, pointer model_construct(ne_type, sxrem_type, te_type, ti_type, ze_type, ne_unit, ne_min, te_min, ti_min, ze_min, sxrem_min, pressure_fraction, emission, equilibrium, sxrem_te, sxrem_ratio, resonace_range, coosig_wgts, state_flags, signal_factor, signal_offset, int_params)
Construct a model_class containing an equilibrium object.
Definition: model.f:341
model::model_get_gp_ti_pi
real(rprec) function model_get_gp_ti_pi(this, x_cart, i)
Get the ion temperature gp kernel value for the position and index.
Definition: model.f:1801
model::model_te_ne_p_type
integer, parameter, private model_te_ne_p_type
Electron temperature model is derived from the density and pressure.
Definition: model.f:86
model::model_get_ti_af
real(rprec) function, dimension(:), pointer model_get_ti_af(this)
Gets the ion temperature profile af array.
Definition: model.f:1735
equilibrium::equilibrium_get_gp_ne_pi
real(rprec) function equilibrium_get_gp_ne_pi(this, x_cart, i)
Get the electron density gp kernel value for the position and index.
Definition: equilibrium.f:829
model::model_te_grid_id
integer, parameter model_te_grid_id
Parameter id for the electrion temperature grid.
Definition: model.f:120
model::model_ne_te_p_type
integer, parameter, private model_ne_te_p_type
Electron denisty model is derived from the temperature and pressure.
Definition: model.f:76
model::model_get_sxrem_type
character(len=data_name_length) function model_get_sxrem_type(this, index)
Gets the soft x-ray emissivity type as a string.
Definition: model.f:2490
model::model_destruct
subroutine model_destruct(this)
Deconstruct a model_class object.
Definition: model.f:553
line_segment::line_seg
subroutine, public line_seg(x, y, xx, yy, n)
Interpolate a point on a line.
Definition: line_segment.f:41
equilibrium::equilibrium_get_gp_ne_num_hyper_param
integer function equilibrium_get_gp_ne_num_hyper_param(this)
Get the number of electron density gp kernel hyper parameters.
Definition: equilibrium.f:690
model::model_get_gp_ti_num_hyper_param
integer function model_get_gp_ti_num_hyper_param(this)
Get the number of ion temperature gp kernel hyper parameters.
Definition: model.f:1705
model::model_set_grid_params
subroutine model_set_grid_params(this, size)
Sets grid parameters.
Definition: model.f:777
equilibrium::equilibrium_reset_state
subroutine equilibrium_reset_state(this)
Reset the internal state of the equilibrium.
Definition: equilibrium.f:3487
model::model_get_gp_sxrem_pi
real(rprec) function model_get_gp_sxrem_pi(this, x_cart, i, index)
Get the soft x-ray emissivity gp kernel value for the position and index.
Definition: model.f:2140
model::model_coosig_wgts_id
integer, parameter model_coosig_wgts_id
Parameter id for the combination signal weights.
Definition: model.f:110
emission
Defines the base class of the type emission_class. This contains the X-Ray emission as function of te...
Definition: emission.f:38
model_state::model_state_signal_flag
integer, parameter model_state_signal_flag
Model state factor changed bit position.
Definition: model_state.f:40
equilibrium::equilibrium_get_p
Interface for the equilibrium pressure profile values.
Definition: equilibrium.f:170
model::model_get_ne_cart
real(rprec) function model_get_ne_cart(this, x_cart)
Gets the electron density at a cartesian position.
Definition: model.f:1331
model::model_get_ti_cart
real(rprec) function model_get_ti_cart(this, x_cart)
Gets the ion temperature at a cartesian position.
Definition: model.f:1870
model::model_get_gp_te_pp
real(rprec) function model_get_gp_te_pp(this, x_cart, y_cart)
Get the electron temperature gp kernel value for the position and position.
Definition: model.f:1568
model::model_get_te_type
character(len=data_name_length) function model_get_te_type(this)
Gets the electron temperature type as a string.
Definition: model.f:2384
equilibrium::equilibrium_get_gp_te_num_hyper_param
integer function equilibrium_get_gp_te_num_hyper_param(this)
Get the number of electron temperature gp kernel hyper parameters.
Definition: equilibrium.f:1022
model::model_te_min_id
integer, parameter model_te_min_id
Parameter id for the minimum electron temperature.
Definition: model.f:100
equilibrium::equilibrium_get_gp_ne_ij
real(rprec) function equilibrium_get_gp_ne_ij(this, i, j)
Get the electron density gp kernel value for the two indicies.
Definition: equilibrium.f:779
equilibrium::equilibrium_write
subroutine equilibrium_write(this, iou)
Write out the equilibrium to an output file.
Definition: equilibrium.f:3527
equilibrium::equilibrium_get_ze
Interface for the effective charge profile values.
Definition: equilibrium.f:144
model::model_get_te_radial
real(rprec) function model_get_te_radial(this, r)
Gets the electron temperature at a radial position.
Definition: model.f:1654
model::model_get_ze_radial
real(rprec) function model_get_ze_radial(this, r)
Gets the effective charge at a radial position.
Definition: model.f:1993
integration_path::path_int_class
Class containing the parameters of the integration method to use.
Definition: integration_path.f:42
model::model_get_gp_sxrem_pp
real(rprec) function model_get_gp_sxrem_pp(this, x_cart, y_cart, index)
Get the soft x-ray emissivity gp kernel value for the position and position.
Definition: model.f:2179
model::model_ze_min_id
integer, parameter model_ze_min_id
Parameter id for Z effective.
Definition: model.f:106
equilibrium::equilibrium_get_gp_te_pp
real(rprec) function equilibrium_get_gp_te_pp(this, x_cart, y_cart)
Get the electron temperature gp kernel value for the position and position.
Definition: equilibrium.f:1216
model::model_sxrem_te_ne_type
integer, parameter, private model_sxrem_te_ne_type
Soft X-ray Emissivity model is derived from the density and temperature.
Definition: model.f:81
model_state::model_state_siesta_flag
integer, parameter model_state_siesta_flag
SIESTA Equilibrium changed bit position.
Definition: model_state.f:28
equilibrium::equilibrium_write_init_data
subroutine equilibrium_write_init_data(this, result_ncid)
Write inital data to NetCDF result file.
Definition: equilibrium.f:3660
model::model_get_gp_te_pi
real(rprec) function model_get_gp_te_pi(this, x_cart, i)
Get the electron temperature gp kernel value for the position and index.
Definition: model.f:1533
model::model_none_type
integer, parameter, private model_none_type
No model.
Definition: model.f:71
equilibrium::equilibrium_get_sxrem
Interface for the equilibrium soft x-ray emissivity profile values.
Definition: equilibrium.f:152
equilibrium::equilibrium_get_ne_af
real(rprec) function, dimension(:), pointer equilibrium_get_ne_af(this)
Get the electron density profile af array.
Definition: equilibrium.f:735
Generated on Thu Mar 5 2020 15:49:26 for V3FIT by   doxygen 1.8.17