V3FIT
diagnostic_dot.f
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
2 ! The @fixed_width, @begin_table, @item2 and @end_table commands are custom
3 ! defined commands in Doxygen.in. They are defined under ALIASES. For the page
4 ! created here, the 80 column limit is exceeded. Arguments of aliases are
5 ! separated by ','. If you intended ',' to be a string you must use an escaped
6 ! comma '\,'.
7 !
126 !-------------------------------------------------------------------------------
127 !*******************************************************************************
130 !
131 ! Note separating the Doxygen comment block here so detailed decription is
132 ! found in the Module not the file.
133 !
136 !*******************************************************************************
138  USE stel_kinds
139  USE stel_constants
140  USE bsc_t
141  USE profiler
142 
143  IMPLICIT NONE
144 
145 !*******************************************************************************
146 ! diagnostic_dot module parameters
147 !*******************************************************************************
149  INTEGER, PARAMETER :: diagnostic_dot_line_len = 200
151  INTEGER, PARAMETER :: diagnostic_dot_id_name = 30
152 
153 !*******************************************************************************
154 ! DERIVED-TYPE DECLARATIONS
155 ! 1) diagnostic_dot_coil
156 !
157 !*******************************************************************************
158 !-------------------------------------------------------------------------------
160 !-------------------------------------------------------------------------------
163  REAL (rprec) :: factor
165  CHARACTER (len=2) :: units
167  CHARACTER (len=diagnostic_dot_id_name) :: d_type
169  CHARACTER (len=diagnostic_dot_id_name) :: id_name
170 
172  REAL (rprec), DIMENSION(3) :: position
174  REAL (rprec), DIMENSION(3) :: direction
175 
177  TYPE (bsc_coil), POINTER :: coil => null()
179  TYPE (diagnostic_dot_coil), POINTER :: next => null()
180  END TYPE
181 
182  CONTAINS
183 
184 !*******************************************************************************
185 ! CONSTRUCTION SUBROUTINES
186 !*******************************************************************************
187 !-------------------------------------------------------------------------------
195 !-------------------------------------------------------------------------------
196  FUNCTION diagnostic_dot_construct(filename)
197  USE safe_open_mod
198 
199  IMPLICIT NONE
200 
201 ! Declare Arguments
203  CHARACTER (len=*), INTENT(in) :: filename
204 
205 ! local variables
206  TYPE (diagnostic_dot_coil), POINTER :: current_coil
207  TYPE (diagnostic_dot_coil), POINTER :: new_coil
208  INTEGER :: status
209  INTEGER :: iou
210  CHARACTER (len=diagnostic_dot_line_len) :: line
211  INTEGER :: line_number
212  REAL (rprec) :: start_time
213 
214 ! Start of executable code
215  start_time = profiler_get_start_time()
216 
217  diagnostic_dot_construct => null()
218  new_coil => null()
219  current_coil => null()
220 
221 ! Open the diagnostic dot file.
222  CALL safe_open(iou, status, filename, 'old', 'formatted')
223 
224 ! Read lines until a keywood is reached. Read the first line out side the loop.
225 ! Once a keyword is reached, hand off to the appropriate parsing function. The
226 ! parsing functions will update the next line when keyword is reached.
227  READ (iou, '(a)', iostat=status) line
228  line_number = 1
229 
230  DO
231  SELECT CASE (trim(line))
232 
233  CASE DEFAULT
234  READ (iou, '(a)', iostat=status) line
235  line_number = line_number + 1
236 
237  CASE ('end_of_file')
238  EXIT
239 
240  CASE ('flux_loop')
241  new_coil => &
242  & diagnostic_dot_parse_filaments(iou, line, line_number, &
243  & .false., 'Wb')
244  new_coil%d_type = 'flux_loop'
245 
246  CASE ('flux_loop_circular')
247  new_coil => &
248  & diagnostic_dot_parse_probe(iou, line, line_number, &
249  & .false., 'Wb')
250  new_coil%d_type = 'flux_loop_circular'
251 
252  CASE ('magnetic_probe')
253  new_coil => &
254  & diagnostic_dot_parse_probe(iou, line, line_number, &
255  & .false., 'T')
256  new_coil%d_type = 'magnetic_probe'
257 
258  CASE ('magnetic_probe_tokamak')
259  new_coil => &
260  & diagnostic_dot_parse_probe(iou, line, line_number, &
261  & .true., 'T')
262  new_coil%d_type = 'magnetic_probe_tokamak'
263 
264  CASE ('rogowski', 'b_rogowski')
265  new_coil => &
266  & diagnostic_dot_parse_filaments(iou, line, line_number, &
267  & .true., 'T')
268  new_coil%d_type = 'b_rogowski'
269 
270  CASE ('i_rogowski')
271  new_coil => &
272  & diagnostic_dot_parse_filaments(iou, line, line_number, &
273  & .true., 'A')
274  new_coil%d_type = 'i_rogowski'
275 
276  CASE ('f_rogowski')
277  new_coil => &
278  & diagnostic_dot_parse_filaments(iou, line, line_number, &
279  & .true., 'Wb')
280  new_coil%d_type = 'f_rogowski'
281 
282  CASE ('s_rogowski')
283  new_coil => diagnostic_dot_parse_s_rogowski(iou, line, &
284  & line_number)
285  new_coil%d_type = 's_rogowski'
286 
287  CASE ('b_point_probe')
288  new_coil => &
289  & diagnostic_dot_parse_point(iou, line, line_number, &
290  & 'T', .true.)
291  new_coil%d_type = 'b_point_probe'
292 
293  CASE ('b_point_probe_cyl')
294  new_coil => &
295  & diagnostic_dot_parse_point(iou, line, line_number, &
296  & 'T', .false.)
297  new_coil%d_type = 'b_point_probe'
298 
299  END SELECT
300 
301 ! Check that the current coil was associtaed before assiging the pointer. When
302 ! a diagnostic dot file line is read but doens't contain a keyword, a new
303 ! coil does not get allocated. If a new coil was created check to see if it is
304 ! the first coils. Otherwise assign it to the next coil and move the current
305 ! coil to the new coil.
306  IF (ASSOCIATED(new_coil)) THEN
307  IF (.not.ASSOCIATED(diagnostic_dot_construct)) THEN
308  current_coil => new_coil
309  diagnostic_dot_construct => current_coil
310  ELSE
311  current_coil%next => new_coil
312  current_coil => current_coil%next
313  END IF
314  END IF
315 
316  new_coil => null()
317  END DO
318 
319  CLOSE(iou)
320 
321  CALL profiler_set_stop_time('diagnostic_dot_construct', &
322  & start_time)
323 
324  END FUNCTION
325 
326 !*******************************************************************************
327 ! DESTRUCTION SUBROUTINES
328 !*******************************************************************************
329 !-------------------------------------------------------------------------------
335 !-------------------------------------------------------------------------------
336  SUBROUTINE diagnostic_dot_destruct(list)
337 
338  IMPLICIT NONE
339 
340 ! Declare Arguments
341  TYPE (diagnostic_dot_coil), POINTER :: list
342 
343 ! local variables
344  TYPE (diagnostic_dot_coil), POINTER :: current_coil
345 
346 ! Start of executable code
347  DO WHILE(ASSOCIATED(list))
348 
349 ! Check if the end of the list has been reached yet. If this is not the last
350 ! node, point current_coil to the start of the linked list. Move the start of
351 ! the list to next node. current_coil still points to the last node. With the
352 ! list pointing to the next node, erase the current node. Otherwise erase the
353 ! list.
354  IF (ASSOCIATED(list%next)) THEN
355  current_coil => list
356  list => list%next
357 
358  IF (ASSOCIATED(current_coil%coil)) THEN
359  DEALLOCATE(current_coil%coil)
360  current_coil%coil => null()
361  END IF
362 
363  DEALLOCATE(current_coil)
364  ELSE
365  DEALLOCATE(list)
366  END IF
367 
368  END DO
369 
370  END SUBROUTINE
371 
372 !*******************************************************************************
373 ! UTILITY SUBROUTINES
374 !*******************************************************************************
375 !-------------------------------------------------------------------------------
386 !-------------------------------------------------------------------------------
387  SUBROUTINE diagnostic_dot_error(subject, line, line_number, &
388  & caller)
389 
390  IMPLICIT NONE
391 
392 ! Declare Arguments
393  CHARACTER (len=*), INTENT(in) :: subject
394  CHARACTER (len=*), INTENT(in) :: line
395  INTEGER, INTENT(in) :: line_number
396  CHARACTER (len=*), INTENT(in) :: caller
397 
398 ! Start of executable code
399  IF (len(subject) .eq. 4) THEN
400  WRITE (*,1000) subject, line_number
401  ELSE
402  WRITE (*,1100) subject, line_number
403  END IF
404  WRITE (*,1200) line
405  WRITE (*,1300) caller
406  CALL exit(1)
407 
408 1000 FORMAT('Failed to read ', a4,' on line: ',i6)
409 1100 FORMAT('Failed to read ', a6,' on line: ',i6)
410 1200 FORMAT(a)
411 1300 FORMAT('Called from: ',a)
412 
413  END SUBROUTINE
414 
415 !-------------------------------------------------------------------------------
425 !-------------------------------------------------------------------------------
426  FUNCTION diagnostic_dot_parse_name(iou, line, line_number, caller)
427 
428  IMPLICIT NONE
429 
430 ! Declare Arguments
431  CHARACTER (len=diagnostic_dot_id_name) :: &
433  INTEGER :: iou
434  CHARACTER (len=diagnostic_dot_line_len), INTENT(out) :: line
435  INTEGER, INTENT(inout) :: line_number
436  CHARACTER (len=*), INTENT(in) :: caller
437 
438 ! local variables
439  INTEGER :: status
440  REAL (rprec) :: start_time
441 
442 ! Start of executable code
443  start_time = profiler_get_start_time()
444 
445  status = 0
446  READ (iou,1000,iostat=status) line
447  line_number = line_number + 1
448 
449  IF (status .ne. 0) THEN
450  CALL diagnostic_dot_error('name', line, line_number, caller)
451  END IF
452 
453  diagnostic_dot_parse_name = trim(line)
454 
455  CALL profiler_set_stop_time('diagnostic_dot_parse_name', &
456  & start_time)
457 
458 1000 FORMAT(a)
459 
460  END FUNCTION
461 
462 !-------------------------------------------------------------------------------
472 !-------------------------------------------------------------------------------
473  FUNCTION diagnostic_dot_parse_real(iou, line, line_number, caller)
474 
475  IMPLICIT NONE
476 
477 ! Declare Arguments
478  REAL (rprec) :: diagnostic_dot_parse_real
479  INTEGER :: iou
480  CHARACTER (len=diagnostic_dot_line_len), INTENT(out) :: line
481  INTEGER, INTENT(inout) :: line_number
482  CHARACTER (len=*), INTENT(in) :: caller
483 
484 ! local variables
485  INTEGER :: status
486  REAL (rprec) :: start_time
487 
488 ! Start of executable code
489  start_time = profiler_get_start_time()
490 
491  status = 0
492  READ (iou,1000,iostat=status) line
493  line_number = line_number + 1
494  READ (line,*,iostat=status) diagnostic_dot_parse_real
495 
496  IF (status .ne. 0) THEN
497  CALL diagnostic_dot_error('real', line, line_number, caller)
498  END IF
499 
500  CALL profiler_set_stop_time('diagnostic_dot_parse_real', &
501  & start_time)
502 
503 1000 FORMAT(a)
504 
505  END FUNCTION
506 
507 !-------------------------------------------------------------------------------
518 !-------------------------------------------------------------------------------
519  FUNCTION diagnostic_dot_parse_node(iou, line, line_number, status)
520 
521  IMPLICIT NONE
522 
523 ! Declare Arguments
524  REAL (rprec), DIMENSION(3) :: diagnostic_dot_parse_node
525  INTEGER :: iou
526  CHARACTER (len=diagnostic_dot_line_len), INTENT(out) :: line
527  INTEGER, INTENT(inout) :: line_number
528  INTEGER, INTENT(out) :: status
529 
530 ! local variables
531  REAL (rprec) :: start_time
532 
533 ! Start of executable code
534  start_time = profiler_get_start_time()
535 
536  status = 0
537  READ (iou,1000,iostat=status) line
538  line_number = line_number + 1
539  READ (line,*,iostat=status) diagnostic_dot_parse_node
540 
541  CALL profiler_set_stop_time('diagnostic_dot_parse_node', &
542  & start_time)
543 
544 1000 FORMAT(a)
545 
546  END FUNCTION
547 
548 !-------------------------------------------------------------------------------
560 !-------------------------------------------------------------------------------
561  FUNCTION diagnostic_dot_parse_node4(iou, line, line_number, &
562  & status)
563 
564  IMPLICIT NONE
565 
566 ! Declare Arguments
567  REAL (rprec), DIMENSION(4) :: diagnostic_dot_parse_node4
568  INTEGER :: iou
569  CHARACTER (len=diagnostic_dot_line_len), INTENT(out) :: line
570  INTEGER, INTENT(inout) :: line_number
571  INTEGER, INTENT(out) :: status
572 
573 ! local variables
574  REAL (rprec) :: start_time
575 
576 ! Start of executable code
577  start_time = profiler_get_start_time()
578 
579  status = 0
580  READ (iou,1000,iostat=status) line
581  line_number = line_number + 1
582  READ (line,*,iostat=status) diagnostic_dot_parse_node4
583 
584  CALL profiler_set_stop_time('diagnostic_dot_parse_node4', &
585  & start_time)
586 
587 1000 FORMAT(a)
588 
589  END FUNCTION
590 
591 !-------------------------------------------------------------------------------
601 !-------------------------------------------------------------------------------
602  FUNCTION diagnostic_dot_parse_s_rogowski(iou, line, line_number)
603 
604  IMPLICIT NONE
605 
606 ! Declare Arguments
607  TYPE (diagnostic_dot_coil), POINTER :: &
609  INTEGER :: iou
610  CHARACTER (len=diagnostic_dot_line_len), INTENT(out) :: line
611  INTEGER, INTENT(inout) :: line_number
612 
613 ! local variables
614  REAL (rprec), DIMENSION(:,:), POINTER :: coil
615  REAL (rprec), DIMENSION(:,:), POINTER :: coil_temp
616  REAL (rprec), DIMENSION(4) :: node
617  INTEGER :: num_coil
618  CHARACTER (len=diagnostic_dot_id_name) :: id_name
619  INTEGER :: status
620  REAL (rprec) :: start_time
621 
622 ! Start of executable code
623  start_time = profiler_get_start_time()
624 
625 ! Start with 8 coil nodes. The nodes will get reallocated as the coil fills up.
626  ALLOCATE(coil(4,8))
627  num_coil = 0
628  coil_temp => null()
629 
630 ! Read the id name.
631  id_name = diagnostic_dot_parse_name(iou, line, line_number, &
632  & 'diagnostic_dot_parse_s_rogowski')
633 
634  status = 0
635  DO WHILE(status .eq. 0)
636  node = diagnostic_dot_parse_node4(iou, line, line_number, &
637  & status)
638 
639  IF (status .eq. 0) THEN
640 ! If the coil array is full, double it's size in a new array and copy all the
641 ! data. Delete the coil array and point it to the new array.
642  IF (num_coil + 1 .gt. SIZE(coil, 2)) THEN
643  ALLOCATE(coil_temp(4,2*SIZE(coil, 2)))
644  coil_temp(:,1:SIZE(coil, 2)) = coil
645  DEALLOCATE(coil)
646  coil => coil_temp
647  coil_temp => null()
648  END IF
649 
650  num_coil = num_coil + 1
651  coil(:,num_coil) = node
652  END IF
653 
654  END DO
655 
657 ! Construct the coil.
659  ALLOCATE(diagnostic_dot_parse_s_rogowski%coil)
660  diagnostic_dot_parse_s_rogowski%next => null()
661  diagnostic_dot_parse_s_rogowski%units = trim('wb')
662  diagnostic_dot_parse_s_rogowski%id_name = id_name
663 
665  & 'fil_rogo_s', trim(id_name), '', 1.0_dp, &
666  & coil(1:3,1:num_coil), &
667  & sen=coil(4,1:num_coil - 1))
669 
670  DEALLOCATE(coil)
671 
672  CALL profiler_set_stop_time('diagnostic_dot_parse_s_rogowski', &
673  & start_time)
674 
675  END FUNCTION
676 
677 !-------------------------------------------------------------------------------
691 !-------------------------------------------------------------------------------
692  FUNCTION diagnostic_dot_parse_filaments(iou, line, line_number, &
693  & is_rogowski, units)
694 
695  IMPLICIT NONE
696 
697 ! Declare Arguments
698  TYPE (diagnostic_dot_coil), POINTER :: &
700  INTEGER :: iou
701  CHARACTER (len=diagnostic_dot_line_len), INTENT(out) :: line
702  INTEGER, INTENT(inout) :: line_number
703  LOGICAL, INTENT(in) :: is_rogowski
704  CHARACTER (len=*), INTENT(in) :: units
705 
706 ! local variables
707  REAL (rprec), DIMENSION(:,:), POINTER :: coil
708  REAL (rprec), DIMENSION(:,:), POINTER :: coil_temp
709  REAL (rprec), DIMENSION(3) :: node
710  INTEGER :: num_coil
711  INTEGER :: status
712  CHARACTER (len=diagnostic_dot_id_name) :: id_name
713  REAL (rprec) :: num_turns
714  REAL (rprec) :: area
715  REAL (rprec) :: start_time
716 
717 ! Start of executable code
718  start_time = profiler_get_start_time()
719 
720 ! Start with 8 coil nodes. The nodes will get reallocated as the coil fills up.
721  ALLOCATE(coil(3,8))
722  num_coil = 0
723  coil_temp => null()
724 
725 ! Read the id name.
726  id_name = diagnostic_dot_parse_name(iou, line, line_number, &
727  & 'diagnostic_dot_parse_filaments')
728 
729  IF (is_rogowski) THEN
730 ! Read the radius and area
731  line = diagnostic_dot_parse_name(iou, line, line_number, &
732  & 'diagnostic_dot_parse_filaments')
733  READ(line,*,iostat=status) num_turns, area
734  IF (status .ne. 0) THEN
735  CALL diagnostic_dot_error('spec', line, line_number, &
736  & 'diagnostic_dot_parse_filaments')
737  END IF
738  IF (num_turns*area .eq. 0.0) THEN
739  WRITE (*,1000) num_turns, area
740  END IF
741  END IF
742 
743  status = 0
744  DO WHILE(status .eq. 0)
745 
746  node = diagnostic_dot_parse_node(iou, line, line_number, &
747  & status)
748 
749  IF (status .eq. 0) THEN
750 ! If the coil array is full, double it's size in a new array and copy all the
751 ! data. Delete the coil array and point it to the new array.
752  IF (num_coil + 1 .gt. SIZE(coil, 2)) THEN
753  ALLOCATE(coil_temp(3,2*SIZE(coil, 2)))
754  coil_temp(:,1:SIZE(coil, 2)) = coil
755  DEALLOCATE(coil)
756  coil => coil_temp
757  coil_temp => null()
758  END IF
759 
760  num_coil = num_coil + 1
761  coil(:,num_coil) = node
762  END IF
763 
764  END DO
765 
766 ! Check to see if the coil is closed. Borrow the node variable to avoid
767 ! defining new ones since it is not used anymore. Rogowski coils do not need to
768 ! be closed.
769  IF (.not.is_rogowski .and. num_coil .gt. 2) THEN
770  node(1) = sum((coil(1,2:num_coil) - coil(1,1:num_coil - 1))**2)
771  node(2) = sum((coil(2,2:num_coil) - coil(2,1:num_coil - 1))**2)
772  node(3) = sum((coil(3,2:num_coil) - coil(3,1:num_coil - 1))**2)
773 
774 ! Store the average length^2 in node(1)
775  node(1) = sum(node)/num_coil
776 
777 ! Store the length^2 between the last and first nodes in node(2)
778  node(2) = sum((coil(:,1) - coil(:,num_coil))**2)
779 
780  IF (node(2)/node(1) .lt. 1.0e-12) THEN
781  num_coil = num_coil - 1
782  END iF
783  END IF
784 
785 ! Construct the coil.
787  ALLOCATE(diagnostic_dot_parse_filaments%coil)
788  diagnostic_dot_parse_filaments%next => null()
789  diagnostic_dot_parse_filaments%units = trim(units)
790  diagnostic_dot_parse_filaments%id_name = id_name
791 
792  IF (is_rogowski) THEN
794  & 'fil_rogo', trim(id_name), '', 1.0_dp, &
795  & coil(:,1:num_coil), anturns=num_turns, &
796  & xsarea=area)
797  ELSE
799  & 'fil_loop', trim(id_name), '', 1.0_dp, &
800  & coil(:,1:num_coil))
801  END IF
802 
803  SELECT CASE (trim(units))
804 
805  CASE ('T')
806  diagnostic_dot_parse_filaments%factor = 1.0/(num_turns*area)
807 
808  CASE ('A')
810  & 1.0/(diagnostic_dot_parse_filaments%coil%ave_n_area* &
811  & 2.0e-7*twopi)
812 
813  CASE DEFAULT
814  diagnostic_dot_parse_filaments%factor = 1.0
815 
816  END SELECT
817 
818  DEALLOCATE(coil)
819 
820  CALL profiler_set_stop_time('diagnostic_dot_parse_filaments', &
821  & start_time)
822 
823 1000 FORMAT('Number of turns (',i6,') x cross section area (',i6, &
824  & ') cannot be zero.')
825 
826  END FUNCTION
827 
828 !-------------------------------------------------------------------------------
842 !-------------------------------------------------------------------------------
843  FUNCTION diagnostic_dot_parse_probe(iou, line, line_number, &
844  & is_tokamak, units)
845 
846  IMPLICIT NONE
847 
848 ! Declare Arguments
849  TYPE (diagnostic_dot_coil), POINTER :: &
851  INTEGER :: iou
852  CHARACTER (len=diagnostic_dot_line_len), INTENT(out) :: line
853  INTEGER, INTENT(inout) :: line_number
854  LOGICAL, INTENT(in) :: is_tokamak
855  CHARACTER (len=*), INTENT(in) :: units
856 
857 ! local variables
858  CHARACTER (len=diagnostic_dot_id_name) :: id_name
859  REAL (rprec) :: radius
860  REAL (rprec) :: pitch
861  REAL (rprec), DIMENSION(3) :: center
862  REAL (rprec), DIMENSION(3) :: normal
863  INTEGER :: status
864  REAL (rprec) :: start_time
865 
866 ! Start of executable code
867  start_time = profiler_get_start_time()
868 
869 ! Parse the id.
870  id_name = diagnostic_dot_parse_name(iou, line, line_number, &
871  & 'diagnostic_dot_parse_probe')
872 
873  IF (is_tokamak) THEN
874 ! Parse the magnetic probe spec. Borrow the normal to hold the r, phi, z
875 ! position.
876  status = 0
877  READ (iou,1000, iostat=status) line
878 
879  IF (status .ne. 0) THEN
880  CALL diagnostic_dot_error('spec', line, line_number, &
881  & 'diagnostic_dot_parse_magnetic_probe_tokamak')
882  END IF
883 
884  READ (line,*,iostat=status) radius, normal, pitch
885  IF (status .ne. 0) THEN
886  CALL diagnostic_dot_error('spec', line, line_number, &
887  & 'diagnostic_dot_parse_magnetic_probe_tokamak')
888  END IF
889 ! Translate into a bsc_coil. Once all the elements are set over write the
890 ! values
891  normal(2) = normal(2)*degree
892  pitch = pitch*degree
893  center(1) = normal(1)*cos(normal(2))
894  center(2) = normal(1)*sin(normal(2))
895  center(3) = normal(3)
896  normal(1) = cos(pitch)*cos(normal(2))
897  normal(2) = cos(pitch)*sin(normal(2))
898  normal(3) = sin(pitch)
899  ELSE
900 ! Parse the radius.
901  radius = diagnostic_dot_parse_real(iou, line, line_number, &
902  & 'diagnostic_dot_parse_probe')
903 
904 ! Parse the center.
905  center = diagnostic_dot_parse_node(iou, line, line_number, &
906  & status)
907  IF (status .ne. 0) THEN
908  CALL diagnostic_dot_error('center', line, line_number, &
909  & 'diagnostic_dot_parse_probe')
910  END IF
911 
912 ! Parse the normal.
913  normal = diagnostic_dot_parse_node(iou, line, line_number, &
914  & status)
915  IF (status .ne. 0) THEN
916  CALL diagnostic_dot_error('normal', line, line_number, &
917  & 'diagnostic_dot_parse_probe')
918  END IF
919  END IF
920 
921 ! Construct the coil.
923  ALLOCATE(diagnostic_dot_parse_probe%coil)
924  diagnostic_dot_parse_probe%next => null()
925  diagnostic_dot_parse_probe%units = trim(units)
926  diagnostic_dot_parse_probe%id_name = id_name
927 
928  SELECT CASE (trim(units))
929 
930  CASE ('T')
931  diagnostic_dot_parse_probe%factor = 1.0/(pi*radius*radius)
932 
933  CASE DEFAULT
934  diagnostic_dot_parse_probe%factor = 1.0
935 
936  END SELECT
937 
938  CALL bsc_construct(diagnostic_dot_parse_probe%coil, 'fil_circ', &
939  & id_name, '', 1.0_dp, rcirc=radius, &
940  & xcent=center(1:3), enhat=normal(1:3))
941 
942 ! The function that called this expects a next line to already be read.
943  READ (iou,1000,iostat=status) line
944  line_number = line_number + 1
945 
946  CALL profiler_set_stop_time('diagnostic_dot_parse_probe', &
947  & start_time)
948 
949 1000 FORMAT(a)
950 
951  END FUNCTION
952 
953 !-------------------------------------------------------------------------------
968 !-------------------------------------------------------------------------------
969  FUNCTION diagnostic_dot_parse_point(iou, line, line_number, &
970  & units, is_cart)
972 
973  IMPLICIT NONE
974 
975 ! Declare Arguments
976  TYPE (diagnostic_dot_coil), POINTER :: &
978  INTEGER :: iou
979  CHARACTER (len=diagnostic_dot_line_len), INTENT(out) :: line
980  INTEGER, INTENT(inout) :: line_number
981  CHARACTER (len=*), INTENT(in) :: units
982  LOGICAL, INTENT(in) :: is_cart
983 
984 ! local variables
985  CHARACTER (len=diagnostic_dot_id_name) :: id_name
986  REAL (rprec), DIMENSION(3) :: position
987  REAL (rprec), DIMENSION(3) :: direction
988  INTEGER :: status
989  REAL (rprec) :: start_time
990 
991 ! Start of executable code
992  start_time = profiler_get_start_time()
993 
994  id_name = diagnostic_dot_parse_name(iou, line, line_number, &
995  & 'diagnostic_dot_parse_point')
996 
997  position = diagnostic_dot_parse_node(iou, line, line_number, &
998  & status)
999  IF (status .ne. 0) THEN
1000  CALL diagnostic_dot_error('position', line, line_number, &
1001  & 'diagnostic_dot_parse_point')
1002  END IF
1003 
1004  direction = diagnostic_dot_parse_node(iou, line, line_number, &
1005  & status)
1006  IF (status .ne. 0) THEN
1007  CALL diagnostic_dot_error('direction', line, line_number, &
1008  & 'diagnostic_dot_parse_point')
1009  END IF
1010 
1011 ! Normalize to a unit vector.
1012  direction = direction/sqrt(dot_product(direction, direction))
1013 
1014 ! Convert to internal cylindical coordinates. If already cylindrical convert
1015 ! the phi direction to radians.
1016  IF (is_cart) THEN
1017  direction = cart_to_cyl_vec(position, direction)
1018  position = cart_to_cyl(position)
1019  ELSE
1020  position(2) = position(2)*degree
1021  END IF
1022 
1023 ! Construct the coil.
1024  ALLOCATE(diagnostic_dot_parse_point)
1025 
1026  diagnostic_dot_parse_point%id_name = id_name
1027  diagnostic_dot_parse_point%next => null()
1028  diagnostic_dot_parse_point%position = position
1029  diagnostic_dot_parse_point%direction = direction
1030  diagnostic_dot_parse_point%units = trim(units)
1031 
1032 ! The function that called this expects a next line to already be read.
1033  READ (iou,1000,iostat=status) line
1034  line_number = line_number + 1
1035 
1036  CALL profiler_set_stop_time('diagnostic_dot_parse_point', &
1037  & start_time)
1038 
1039 1000 FORMAT(a)
1040 
1041  END FUNCTION
1042 
1043  END MODULE
diagnostic_dot::diagnostic_dot_coil
A single coil. A coil set is structured as a singly linked list.
Definition: diagnostic_dot.f:161
profiler
Defines functions for measuring an tabulating performance of function and subroutine calls....
Definition: profiler.f:13
coordinate_utilities
Module is part of the LIBSTELL. This modules containes code to convert from different coordinate syst...
Definition: coordinate_utilities.f:12
diagnostic_dot::diagnostic_dot_parse_node
real(rprec) function, dimension(3) diagnostic_dot_parse_node(iou, line, line_number, status)
Parse a node.
Definition: diagnostic_dot.f:520
diagnostic_dot
Module for opening and reading a diagnostic dot file. The file format for these files are documented ...
Definition: diagnostic_dot.f:137
diagnostic_dot::diagnostic_dot_id_name
integer, parameter diagnostic_dot_id_name
Maximum id name.
Definition: diagnostic_dot.f:151
diagnostic_dot::diagnostic_dot_error
subroutine diagnostic_dot_error(subject, line, line_number, caller)
Report error.
Definition: diagnostic_dot.f:389
coordinate_utilities::cart_to_cyl_vec
pure real(rprec) function, dimension(3) cart_to_cyl_vec(cart, vec)
Convert vector from cartesian coordinates to cylindical coordinates.
Definition: coordinate_utilities.f:126
profiler::profiler_get_start_time
real(rprec) function profiler_get_start_time()
Gets the start time of profiled function.
Definition: profiler.f:194
diagnostic_dot::diagnostic_dot_destruct
subroutine diagnostic_dot_destruct(list)
Deconstruct a diagnostic_dot_coil list.
Definition: diagnostic_dot.f:337
diagnostic_dot::diagnostic_dot_parse_filaments
type(diagnostic_dot_coil) function, pointer diagnostic_dot_parse_filaments(iou, line, line_number, is_rogowski, units)
Parse coils defined by filaments.
Definition: diagnostic_dot.f:694
diagnostic_dot::diagnostic_dot_parse_s_rogowski
type(diagnostic_dot_coil) function, pointer diagnostic_dot_parse_s_rogowski(iou, line, line_number)
Parse coils defined by filaments connected in series.
Definition: diagnostic_dot.f:603
diagnostic_dot::diagnostic_dot_construct
type(diagnostic_dot_coil) function, pointer diagnostic_dot_construct(filename)
Construct the coil diagnostics.
Definition: diagnostic_dot.f:197
diagnostic_dot::diagnostic_dot_parse_node4
real(rprec) function, dimension(4) diagnostic_dot_parse_node4(iou, line, line_number, status)
Parse a node with sensitivity.
Definition: diagnostic_dot.f:563
diagnostic_dot::diagnostic_dot_line_len
integer, parameter diagnostic_dot_line_len
Maximum line length.
Definition: diagnostic_dot.f:149
coordinate_utilities::cart_to_cyl
pure real(rprec) function, dimension(3), public cart_to_cyl(cart)
Convert a point from cartes cartesian coordinates to cylindical coordinates.
Definition: coordinate_utilities.f:40
diagnostic_dot::diagnostic_dot_parse_point
type(diagnostic_dot_coil) function, pointer diagnostic_dot_parse_point(iou, line, line_number, units, is_cart)
Parse a point field measurement.
Definition: diagnostic_dot.f:971
profiler::profiler_set_stop_time
subroutine profiler_set_stop_time(symbol_name, start_time)
Gets the end time of profiled function.
Definition: profiler.f:121
bsc_t::bsc_construct
Definition: bsc_T.f:181
diagnostic_dot::diagnostic_dot_parse_probe
type(diagnostic_dot_coil) function, pointer diagnostic_dot_parse_probe(iou, line, line_number, is_tokamak, units)
Parse a circular flux loop or magnetic probe.
Definition: diagnostic_dot.f:845
diagnostic_dot::diagnostic_dot_parse_name
character(len=diagnostic_dot_id_name) function diagnostic_dot_parse_name(iou, line, line_number, caller)
Parse a name.
Definition: diagnostic_dot.f:427
bsc_t::bsc_coil
Definition: bsc_T.f:127
diagnostic_dot::diagnostic_dot_parse_real
real(rprec) function diagnostic_dot_parse_real(iou, line, line_number, caller)
Parse a real.
Definition: diagnostic_dot.f:474