V3FIT
v3rfun_context.f
Go to the documentation of this file.
1 !*******************************************************************************
4 !
5 ! Note separating the Doxygen comment block here so detailed decription is
6 ! found in the Module not the file.
7 !
10 !*******************************************************************************
11  MODULE v3rfun_context
12  USE v3rfun_input
13  USE diagnostic_dot
14  USE biotsavart
15 
16  IMPLICIT NONE
17 
18 !*******************************************************************************
19 ! v3rfun context module parameters
20 !*******************************************************************************
22  CHARACTER (len=*), PARAMETER :: code_name = 'V3RFUN'
23 
24 !*******************************************************************************
25 ! DERIVED-TYPE DECLARATIONS
26 ! 1) v3rfun context
27 !
28 !*******************************************************************************
29 !-------------------------------------------------------------------------------
32 !-------------------------------------------------------------------------------
33  TYPE v3rfun_context_class
35  CHARACTER (len=v3rfun_name_length) :: date_run
36 
38  INTEGER :: kp_store
40  INTEGER :: kp_shell_store
41 
43  INTEGER :: mdsig_list_iou
45  INTEGER :: mi_iou
46 
48  TYPE (diagnostic_dot_coil), POINTER :: coils => null()
49 
51  REAL (rprec), DIMENSION(:), POINTER :: extcur => null()
53  REAL (rprec), DIMENSION(:), POINTER :: rdiag => null()
54 
56  REAL (rprec), DIMENSION(:,:,:,:,:), POINTER :: &
57  & xcart_grid_e => null()
59  REAL(rprec), DIMENSION(:,:), POINTER :: phi_grid_e => null()
61  REAL(rprec), DIMENSION(:,:,:,:), POINTER :: &
62  & pl_response => null()
64  REAL(rprec), DIMENSION(:,:,:,:), POINTER :: &
65  & pl_response_ss => null()
66 
69  REAL (rprec), DIMENSION(:,:,:,:), POINTER :: &
70  & xcart_s_grid_e => null()
72  REAL(rprec), DIMENSION(:,:), POINTER :: &
73  & phi_grid_shell => null()
75  REAL(rprec), DIMENSION(:,:,:), POINTER :: &
76  & s_response => null()
78  REAL(rprec), DIMENSION(:,:,:), POINTER :: &
79  & s_response_ss => null()
80  END TYPE
81 
82 !*******************************************************************************
83 ! INTERFACE BLOCKS
84 !*******************************************************************************
85  PRIVATE :: cart2cyl_v
86 
87  CONTAINS
88 !*******************************************************************************
89 ! CONSTRUCTION SUBROUTINES
90 !*******************************************************************************
91 !-------------------------------------------------------------------------------
97 !-------------------------------------------------------------------------------
98  FUNCTION v3rfun_context_construct(filename)
99  USE v3_utilities
100  USE safe_open_mod
101  USE magnetic_response
102 
103  IMPLICIT NONE
104 
105 ! Declare Arguments
106  TYPE (v3rfun_context_class), POINTER :: v3rfun_context_construct
107  CHARACTER (len=*), INTENT(in) :: filename
108 
109 ! local variables
110  CHARACTER (len=v3rfun_file_length) :: temp_filename
111  CHARACTER (len=v3rfun_file_length) :: base_name
112  CHARACTER (len=8) :: date
113  CHARACTER (len=10) :: time
114  CHARACTER (len=5) :: zone
115  INTEGER :: i
116  INTEGER :: status
117  REAL (rprec) :: start_time
118 
119 ! Start of executable code
120  start_time = profiler_get_start_time()
121 
122  ALLOCATE(v3rfun_context_construct)
123 
124  CALL date_and_time(date, time, zone)
125  v3rfun_context_construct%date_run = date // ' ' // time // &
126  & ' ' // zone
127 
128 ! Read namelist input file.
129  CALL v3rfun_input_read_namelist(filename)
130 
131 ! Open the output file.
132  base_name = name_diagnostic_dot(index(name_diagnostic_dot, '/', &
133  & .true.) + 1:)
134  temp_filename = trim(base_name) // '_mdsig.LIST'
135  v3rfun_context_construct%mdsig_list_iou = 0
136  WRITE(*,*) 'list_filename is ', temp_filename
137  CALL safe_open(v3rfun_context_construct%mdsig_list_iou, status, &
138  & trim(temp_filename), 'replace', 'formatted', &
139  & delim_in='none')
140  CALL assert_eq(0, status, 'v3rfun_context_construct' // &
141  & ': Safe_open of ' // trim(temp_filename) // ' failed')
142 
143  IF (l_read_coils_dot) THEN
144  temp_filename = trim(base_name) // '_MI'
145  v3rfun_context_construct%mi_iou = 0
146  WRITE(*,*) 'mi_filename is ', trim(temp_filename)
147  CALL safe_open(v3rfun_context_construct%mi_iou, status, &
148  & trim(temp_filename), 'replace', 'formatted', &
149  & delim_in='none')
150  CALL assert_eq(0, status, 'v3rfun_context_construct' // &
151  & ': Safe_open of ' // trim(temp_filename) // ' failed')
152 
153 ! Write mutual inductance file header.
154  WRITE(v3rfun_context_construct%mi_iou,1000) code_name
155  WRITE(v3rfun_context_construct%mi_iou,1100) &
156  & magnetic_response_current
157  WRITE(v3rfun_context_construct%mi_iou,1200) &
158  & trim(v3rfun_context_construct%date_run)
159  WRITE(v3rfun_context_construct%mi_iou,1300) &
160  & trim(name_coils_dot)
161  WRITE(v3rfun_context_construct%mi_iou,1400) &
162  & trim(name_diagnostic_dot)
163  WRITE(v3rfun_context_construct%mi_iou,*)
164  ELSE
165  nfp_bs = n_field_periods_nli
166  END IF
167 
168 ! Check stellarator symmetric grid sizes.
169  IF (lstell_sym) THEN
170  zmax = max(abs(zmax), abs(zmin))
171  zmin = -zmax
172  IF (mod(kp, 2) .ne. 0) THEN
173  WRITE (*,1500) 'kp', kp
174  CALL exit(1)
175  END IF
176  v3rfun_context_construct%kp_store = kp/2 + 1
177 
178  IF (use_con_shell .and. mod(kp_shell, 2) .ne. 0) THEN
179  WRITE (*,1500) 'kp_shell', kp_shell
180  CALL exit(1)
181  END IF
182  v3rfun_context_construct%kp_shell_store = kp_shell/2 + 1
183  ELSE
184  v3rfun_context_construct%kp_store = kp
185  v3rfun_context_construct%kp_shell_store = kp_shell
186  END IF
187 
188  v3rfun_context_construct%coils => null()
189  v3rfun_context_construct%coils => &
190  & diagnostic_dot_construct(name_diagnostic_dot)
191 
192  CALL profiler_set_stop_time('v3rfun_context_construct', &
193  & start_time)
194 
195  IF (l_read_coils_dot) THEN
196  CALL v3rfun_context_construct_field_coils( &
197  & v3rfun_context_construct)
198 
199  ALLOCATE(v3rfun_context_construct%rdiag(SIZE(coil_group)))
200  ALLOCATE(v3rfun_context_construct%extcur(SIZE(coil_group)))
201 
202  DO i = 1, SIZE(coil_group)
203 ! Find extcur array element for computing scaled inductance matrix lines taken
204 ! out of makegrid code.
205  status = coil_group(i)%ncoil
206  status = maxloc(abs(coil_group(i)%coils(1:status)%current), &
207  & 1)
208  v3rfun_context_construct%extcur(i) = &
209  & coil_group(i)%coils(status)%current
210  END DO
211 
212  WHERE (v3rfun_context_construct%extcur .eq. 0.0)
213  v3rfun_context_construct%extcur = 1.0
214  END WHERE
215 
216 
217  END IF
218 
219  CALL v3rfun_context_construct_responce_grids( &
220  & v3rfun_context_construct)
221 
222  CALL profiler_set_stop_time('v3rfun_context_construct', &
223  & start_time)
224 
225 1000 FORMAT(' MUTUAL INDUCTANCES computed by ',a)
226 1100 FORMAT(' code version is ',a)
227 1200 FORMAT(' Date run: ',a)
228 1300 FORMAT(' Field coil information from ',a)
229 1400 FORMAT(' Diagnostic information from ',a)
230 1500 FORMAT(a,' (',i4, &
231  & ') must be even when using stellarator symmetry.')
232 
233  END FUNCTION
234 
235 !-------------------------------------------------------------------------------
242 !-------------------------------------------------------------------------------
243  SUBROUTINE v3rfun_context_construct_field_coils(this)
244 
245  IMPLICIT NONE
246 
247 ! Declare Arguments
248  TYPE (v3rfun_context_class), POINTER :: this
249 
250 ! local variables
251  INTEGER :: i, j
252  REAL (rprec) :: current
253  REAL (rprec), DIMENSION(3) :: center
254  REAL (rprec), DIMENSION(3) :: mean_r
255  TYPE (bsc_rs) :: rotation_shift
256  REAL (rprec) :: start_time
257 
258 ! Start of executable code
259  start_time = profiler_get_start_time()
260 
261  IF (name_coils_dot .eq. '') THEN
262  WRITE (*,1000) l_read_coils_dot
263  CALL exit(1)
264  END IF
265 
266  CALL parse_coils_file(name_coils_dot)
267  WRITE (*,1100) trim(name_coils_dot), SIZE(coil_group)
268 
269 ! Rotate and shift the constructed coils.
270  IF (SIZE(coil_group) .gt. nigroup) THEN
271  WRITE (*,1200) nigroup
272  CALL exit(1)
273  END IF
274 
275  WRITE (*,*)
276  WRITE (*,1300)
277 
278  DO i = 1, SIZE(coil_group)
279  WRITE (*,*)
280  WRITE (*,1400) i, trim(coil_group(i)%s_name)
281 
282 ! Generate rotation shift for first shift and apply.
283  center = 0.0
284  CALL bsc_construct_rs(rotation_shift, 0.0_dp, 0.0_dp, 0.0_dp, &
285  & center, cg_shift_1(i,:))
286  CALL bsc_rot_shift(coil_group(i), rotation_shift)
287  WRITE (*,1500) cg_shift_1(i,:)
288 
289  IF (l_rot_coil_center(i)) THEN
290 ! Compute current-averaged center of coil group.
291  current = 0.0
292  DO j = 1, coil_group(i)%ncoil
293  current = current + coil_group(i)%coils(j)%current
294  CALL bsc_mean_r(coil_group(i)%coils(j), mean_r)
295  center = center &
296  & + mean_r*coil_group(i)%coils(j)%current
297  END DO
298 
299  IF (current .ne. 0) THEN
300  center = center/current
301  END IF
302  WRITE (*,1600) center
303  ELSE
304  center = cg_rot_xcent(i,:)
305  END IF
306  WRITE (*,1700) center
307 
308 ! Generate rotation shift for second shift and apply.
309  CALL bsc_construct_rs(rotation_shift, cg_rot_theta(i), &
310  & cg_rot_phi(i), cg_rot_angle(i), &
311  & center, cg_shift_2(i,:))
312  CALL bsc_rot_shift(coil_group(i), rotation_shift)
313  WRITE (*,1800) cg_rot_theta(i), cg_rot_phi(i), &
314  & cg_rot_angle(i)
315  WRITE (*,1900) cg_shift_2(i,:)
316  END DO
317 
318  CALL profiler_set_stop_time( &
319  & 'v3rfun_context_construct_field_coils', start_time)
320 
321 1000 FORMAT('Expected field coil when l_read_coils_dot = ',l)
322 1100 FORMAT('Coils file ',a,' read, number of coil groups is ',i4)
323 1200 FORMAT('Number of coil groups exceeds max size (',i3,').', &
324  & 'Increase nigroup in LIBSTELL/Sources/Modules/vsvd0.f')
325 1300 FORMAT('Rotate and Shift of the Coil Groups')
326 1400 FORMAT('Coil Group ',i4,' with s_name ',a)
327 1500 FORMAT(' First Shift = ',3(2x,es12.5))
328 1600 FORMAT(' Current-Averaged center of cg = ',3(2x,es12.5))
329 1700 FORMAT(' Center of Rotation Used = ',3(2x,es12.5))
330 1800 FORMAT(' Rotation theta, phi, angle = ',3(2x,es12.5))
331 1900 FORMAT(' Second Shift = ',3(2x,es12.5))
332 
333  END SUBROUTINE
334 
335 !-------------------------------------------------------------------------------
342 !-------------------------------------------------------------------------------
343  SUBROUTINE v3rfun_context_construct_responce_grids(this)
344  USE coordinate_utilities
345 
346  IMPLICIT NONE
347 
348 ! Declare Arguments
349  TYPE (v3rfun_context_class), POINTER :: this
350 
351 ! local variables
352  REAL (rprec) :: fperiod
353  REAL (rprec) :: delr
354  REAL (rprec) :: delz
355  REAL (rprec) :: delp
356  REAL(rprec), DIMENSION(3) :: xcyl
357  REAL(rprec) :: phi0
358  INTEGER :: k, l, i, j
359  REAL (rprec) :: start_time
360 
361 ! Start of executable code
362  start_time = profiler_get_start_time()
363 
364 ! Set the grid differental elements
365  fperiod = twopi/nfp_bs
366  delr = (rmax - rmin)/(ir - 1)
367  delz = (zmax - zmin)/(jz - 1)
368  delp = fperiod/kp
369 
370  ALLOCATE(this%xcart_grid_e(ir,jz,kp,nfp_bs,3))
371  ALLOCATE(this%phi_grid_e(kp,nfp_bs))
372  ALLOCATE(this%pl_response(ir,jz,kp,3))
373  IF (lstell_sym) THEN
374  ALLOCATE(this%pl_response_ss(ir,jz,this%kp_store,3))
375  ENDIF
376 
377 ! Compute the coordinates, store them in xcart_grid_e. Also compute and store
378 ! (in phi_grid_e) the phi values
379 !$OMP PARALLEL
380 !$OMP& DEFAULT(SHARED)
381 !$OMP& PRIVATE(i,j,k,l,xcyl,phi0)
382 !$OMP DO
383 !$OMP& SCHEDULE(STATIC)
384  DO k = 1, kp
385  phi0 = (k - 1)*delp
386  DO l = 1, nfp_bs
387  xcyl(2) = phi0 + (l - 1)*fperiod
388  this%phi_grid_e(k,l) = xcyl(2)
389  DO i = 1, ir
390  xcyl(1) = rmin + (i - 1)*delr
391  DO j = 1, jz
392  xcyl(3) = zmin + (j - 1)*delz
393  this%xcart_grid_e(i,j,k,l,1:3) = cyl_to_cart(xcyl)
394  END DO ! over j
395  END DO ! over i
396  END DO ! over l
397  END DO ! over k
398 !$OMP END DO
399 !$OMP END PARALLEL
400 
401  IF (use_con_shell) THEN
402 ! Set the conducting shell grid differental elements. Reuse the delz as the
403 ! grid spaceing in the u direction, Reuse delr as value of u. Reuse i as the
404 ! number of u grid points.
405  i = max(int(nfp_bs*kp_shell*minor_radius/major_radius), 10)
406  delz = twopi/i
407  delp = fperiod/kp_shell
408 
409  ALLOCATE(this%xcart_s_grid_e(i,kp_shell,nfp_bs,3))
410  ALLOCATE(this%phi_grid_shell(kp_shell,nfp_bs))
411  ALLOCATE(this%s_response(i,kp_shell,3))
412  IF (lstell_sym) THEN
413  ALLOCATE(this%s_response_ss(i,this%kp_shell_store,3))
414  END IF
415 
416 !$OMP PARALLEL
417 !$OMP& DEFAULT(SHARED)
418 !$OMP& PRIVATE(j,k,l,xcyl,delr,phi0)
419 !$OMP DO
420 !$OMP& SCHEDULE(STATIC)
421  DO k = 1, kp_shell
422  phi0 = (k - 1)*delp
423  DO l = 1, nfp_bs
424  xcyl(2) = phi0 + (l - 1)*fperiod
425  this%phi_grid_shell(k,l) = xcyl(2)
426  DO j = 1, i
427  delr = (j - 1)*delz
428  xcyl(1) = major_radius + minor_radius*cos(delr)
429  xcyl(3) = minor_radius*sin(delr)
430  this%xcart_s_grid_e(j,k,l,1:3) = cyl_to_cart(xcyl)
431  END DO ! over j
432  END DO ! over l
433  END DO ! over k
434 !$OMP END DO
435 !$OMP END PARALLEL
436  END IF
437 
438  CALL profiler_set_stop_time( &
439  & 'v3rfun_context_construct_responce_grids', start_time)
440 
441  END SUBROUTINE
442 
443 !*******************************************************************************
444 ! DESTRUCTION SUBROUTINES
445 !*******************************************************************************
446 !-------------------------------------------------------------------------------
453 !-------------------------------------------------------------------------------
454  SUBROUTINE v3rfun_context_destruct(this)
455 
456  IMPLICIT NONE
457 
458 ! Declare Arguments
459  TYPE (v3rfun_context_class), POINTER :: this
460 
461 ! Start of executable code
462  CLOSE(this%mdsig_list_iou)
463 
464  IF (l_read_coils_dot) THEN
465  CLOSE(this%mi_iou)
466  END IF
467 
468  CALL cleanup_biotsavart
469 
470  IF (ASSOCIATED(this%coils)) THEN
471  CALL diagnostic_dot_destruct(this%coils)
472  this%coils => null()
473  END IF
474 
475  IF (ASSOCIATED(this%xcart_grid_e)) THEN
476  DEALLOCATE(this%xcart_grid_e)
477  this%xcart_grid_e => null()
478  END IF
479 
480  IF (ASSOCIATED(this%phi_grid_e)) THEN
481  DEALLOCATE(this%phi_grid_e)
482  this%phi_grid_e => null()
483  END IF
484 
485  IF (ASSOCIATED(this%pl_response)) THEN
486  DEALLOCATE(this%pl_response)
487  this%pl_response => null()
488  END IF
489 
490  IF (ASSOCIATED(this%pl_response_ss)) THEN
491  DEALLOCATE(this%pl_response_ss)
492  this%pl_response_ss => null()
493  END IF
494 
495  IF (ASSOCIATED(this%xcart_s_grid_e)) THEN
496  DEALLOCATE(this%xcart_s_grid_e)
497  this%xcart_s_grid_e => null()
498  END IF
499 
500  IF (ASSOCIATED(this%phi_grid_shell)) THEN
501  DEALLOCATE(this%phi_grid_shell)
502  this%phi_grid_shell => null()
503  END IF
504 
505  IF (ASSOCIATED(this%s_response)) THEN
506  DEALLOCATE(this%s_response)
507  this%s_response => null()
508  END IF
509 
510  IF (ASSOCIATED(this%s_response_ss)) THEN
511  DEALLOCATE(this%s_response_ss)
512  this%s_response_ss => null()
513  END IF
514 
515  DEALLOCATE(this)
516 
517  END SUBROUTINE
518 
519 !*******************************************************************************
520 ! UTILITY SUBROUTINES
521 !*******************************************************************************
522 !-------------------------------------------------------------------------------
531 !-------------------------------------------------------------------------------
532  SUBROUTINE v3rfun_context_write_mrf(this, d_coil, id_num)
533  USE magnetic_response
534  USE v3_utilities
535  USE bsc_cdf
536 
537  IMPLICIT NONE
538 
539 ! Declare Arguments
540  TYPE (v3rfun_context_class), INTENT(inout) :: this
541  TYPE (diagnostic_dot_coil), INTENT(in) :: d_coil
542  INTEGER, INTENT(in) :: id_num
543 
544 ! local variables
545  INTEGER :: i, j, k, l
546  INTEGER :: iss, jss, kss
547  REAL(rprec), DIMENSION(3) :: acart
548  TYPE (magnetic_response_class), POINTER :: response
549  CHARACTER (len=v3rfun_file_length) :: temp_filename
550  REAL(rprec), DIMENSION(:,:,:), POINTER :: a_r
551  REAL(rprec), DIMENSION(:,:,:), POINTER :: a_f
552  REAL(rprec), DIMENSION(:,:,:), POINTER :: a_z
553  REAL(rprec), DIMENSION(:,:), POINTER :: a_s_r
554  REAL(rprec), DIMENSION(:,:), POINTER :: a_s_f
555  REAL(rprec), DIMENSION(:,:), POINTER :: a_s_z
556  REAL (rprec) :: start_time
557 
558 ! Start of executable code
559  start_time = profiler_get_start_time()
560 
561  WRITE (*,1000) id_num
562 
563 ! Coil Response ---------------------------------------------------------------
564  IF (l_read_coils_dot) THEN
565  DO i = 1, SIZE(coil_group)
566 ! Super conducting coils are steady state and will not induce a signal in
567 ! integrated magnetic diagnostics. For those coils set the mutual inductance to
568 ! zero.
569  IF (.not.is_super_con(i)) THEN
570  CALL bsc_fluxba(coil_group(i), d_coil%coil, &
571  & len_integrate_ddc, this%rdiag(i))
572  ELSE
573  this%rdiag(i) = 0.0
574  END IF
575  END DO
576 
577  this%rdiag = this%rdiag*d_coil%factor
578  END IF
579 
580 ! Plasma Response -------------------------------------------------------------
581 ! Parallelize the outer most loops. Any local variables inside the loop must
582 ! be private.
583 !$OMP PARALLEL
584 !$OMP& DEFAULT(SHARED)
585 !$OMP& PRIVATE(i,j,k,l,acart)
586 !$OMP DO
587 !$OMP& SCHEDULE(STATIC)
588  DO i = 1, ir
589  DO j = 1, jz
590  DO k = 1, kp
591  this%pl_response(i,j,k,1:3) = 0.0
592  DO l = 1, nfp_bs
593  CALL bsc_a(d_coil%coil, &
594  & this%xcart_grid_e(i,j,k,l,1:3), acart)
595  this%pl_response(i,j,k,1:3) = &
596  & this%pl_response(i,j,k,1:3) + &
597  & cart2cyl_v(acart, this%phi_grid_e(k,l))
598  END DO ! l, field periods
599  END DO ! k
600  END DO ! j
601  END DO ! i
602 !$OMP END DO
603 !$OMP END PARALLEL
604  this%pl_response = this%pl_response*d_coil%factor
605 
606 ! When using stellator symmetry, only half of the field period needs to be
607 ! stored due to the symmetry. A vertical point will have the same current as a
608 ! the symmetric point below the midplane. The counter point to point j is found
609 ! from by counting the grid in reverse.
610  IF (lstell_sym) THEN
611  DO i = 1, ir
612  iss = i
613  DO j = 1, jz
614  jss = jz + 1 - j
615  DO k = 1, SIZE(this%pl_response_ss, 3)
616  IF (k .eq. 1) THEN
617  kss = 1
618  ELSE
619  kss = kp + 2 - k
620  END IF
621  this%pl_response_ss(i,j,k,1) = &
622  & this%pl_response(i,j,k,1) - &
623  & this%pl_response(iss,jss,kss,1)
624  this%pl_response_ss(i,j,k,2) = &
625  & this%pl_response(i,j,k,2) + &
626  & this%pl_response(iss,jss,kss,2)
627  this%pl_response_ss(i,j,k,3) = &
628  & this%pl_response(i,j,k,3) + &
629  & this%pl_response(iss,jss,kss,3)
630  END DO ! k
631  END DO ! j
632  END DO ! i
633  END IF ! lstell_sym
634 
635 ! Conducting Shell Response ---------------------------------------------------
636  IF (use_con_shell) THEN
637 ! Parallelize the outer most loops. Any local variables inside the loop must
638 ! be private.
639 !$OMP PARALLEL
640 !$OMP& DEFAULT(SHARED)
641 !$OMP& PRIVATE(j,k,l,acart)
642 !$OMP DO
643 !$OMP& SCHEDULE(STATIC)
644  DO j = 1, SIZE(this%s_response, 1)
645  DO k = 1, kp_shell
646  this%s_response(j,k,1:3) = 0.0
647  DO l = 1, nfp_bs
648  CALL bsc_a(d_coil%coil, &
649  & this%xcart_s_grid_e(j,k,l,1:3), acart)
650  this%s_response(j,k,1:3) = this%s_response(j,k,1:3) + &
651  & cart2cyl_v(acart, this%phi_grid_shell(k,l))
652  END DO
653  END DO
654  END DO
655 !$OMP END DO
656 !$OMP END PARALLEL
657  this%s_response = this%s_response*d_coil%factor
658 
659 ! When using stellator symmetry, only half of the field period needs to be
660 ! stored due to the symmetry. A poloidal point will have the same current as a
661 ! the symmetric point below the midplane. The j=1 point corresponds to the
662 ! same u position on the opposite side of the field perior. For j!=0, the
663 ! symmetry point is found by counting indices backwards.
664  IF (lstell_sym) THEN
665  DO j = 1, SIZE(this%s_response, 1)
666  IF (j .eq. 1) THEN
667  jss = 1
668  ELSE
669  jss = SIZE(this%s_response, 1) + 2 - j
670  END IF
671  DO k = 1, SIZE(this%s_response_ss, 2)
672  IF (k .eq. 1) THEN
673  kss = 1
674  ELSE
675  kss = kp_shell + 2 - k
676  END IF
677 
678  this%s_response_ss(j,k,1) = this%s_response(j,k,1) &
679  & - this%s_response(jss,kss,1)
680  this%s_response_ss(j,k,2) = this%s_response(j,k,2) &
681  & + this%s_response(jss,kss,2)
682  this%s_response_ss(j,k,3) = this%s_response(j,k,3) &
683  & + this%s_response(jss,kss,3)
684  END DO
685  END DO
686  END IF
687  END IF
688 
689 ! Assign the response function grids to pointers.
690  a_r => null()
691  a_f => null()
692  a_z => null()
693  a_s_r => null()
694  a_s_f => null()
695  a_s_z => null()
696  IF (lstell_sym) THEN
697  a_r => this%pl_response_ss(:,:,:,1)
698  a_f => this%pl_response_ss(:,:,:,2)
699  a_z => this%pl_response_ss(:,:,:,3)
700  IF (use_con_shell) THEN
701  a_s_r => this%s_response_ss(:,:,1)
702  a_s_f => this%s_response_ss(:,:,2)
703  a_s_z => this%s_response_ss(:,:,3)
704  END IF
705  ELSE
706  a_r => this%pl_response(:,:,:,1)
707  a_f => this%pl_response(:,:,:,2)
708  a_z => this%pl_response(:,:,:,3)
709  IF (use_con_shell) THEN
710  a_s_r => this%s_response(:,:,1)
711  a_s_f => this%s_response(:,:,2)
712  a_s_z => this%s_response(:,:,3)
713  END IF
714  ENDIF
715 
716 ! Construct a responce object.
717  response => magnetic_response_construct(code_name, this%date_run, &
718  & d_coil%id_name, &
719  & this%rdiag, this%extcur, &
720  & kp, kp_shell, &
721  & rmin, rmax, zmin, zmax, &
722  & nfp_bs, lstell_sym, &
723  & a_r, a_f, a_z, &
724  & a_s_r, a_s_f, a_s_z, &
725  & 0.0_dp)
726 
727 ! Write Coil Response ---------------------------------------------------------
728 ! Open up an mdsig file, for netcdf writing. Borrow the i variable to store the
729 ! status. Borrow the j variable as the netcdf input/output unit.
730  temp_filename = trim(d_coil%id_name) // '_mdsig.nc'
731  temp_filename = trim(adjustl(temp_filename))
732  i = 0
733  CALL cdf_open(j, trim(temp_filename), 'w', i)
734  CALL assert_eq(0, i, 'mdsig file ' // trim(temp_filename) // &
735  & ' failed to open.')
736 
737 ! Define NetCDF variables.
738  CALL cdf_define(j, 'diagnostic_desc_d_type', d_coil%d_type)
739  CALL cdf_define(j, 'diagnostic_desc_s_name', d_coil%id_name)
740  CALL cdf_define(j, 'diagnostic_desc_l_name', d_coil%id_name)
741  CALL cdf_define(j, 'diagnostic_desc_units', d_coil%units)
742  CALL cdf_define(j, 'diagnostic_desc_sigma_default', 0.0)
743  CALL magnetic_response_define(response, j)
744  CALL bsc_cdf_define_coil(d_coil%coil, j, '')
745 
746 ! Write NetCDF variables. The cdf_write subroutine switches from define mode to
747 ! write mode.
748  CALL cdf_write(j, 'diagnostic_desc_d_type', d_coil%d_type)
749  CALL cdf_write(j, 'diagnostic_desc_s_name', d_coil%id_name)
750  CALL cdf_write(j, 'diagnostic_desc_l_name', d_coil%id_name)
751  CALL cdf_write(j, 'diagnostic_desc_units', d_coil%units)
752  CALL cdf_write(j, 'diagnostic_desc_sigma_default', 0.0)
753  CALL magnetic_response_write(response, j)
754  CALL bsc_cdf_write_coil(d_coil%coil, j, '')
755 
756 ! Close NetCDF file.
757  CALL cdf_close(j)
758 
759 ! Write entry in list file
760  WRITE(this%mdsig_list_iou,1100) id_num, trim(temp_filename)
761 
762 ! Write to Mutual Inductance file
763  IF (l_read_coils_dot) THEN
764  WRITE (this%mi_iou,1200) id_num
765  WRITE (this%mi_iou,1300) trim(d_coil%id_name)
766  WRITE (this%mi_iou,1400) trim(d_coil%d_type)
767  WRITE (this%mi_iou,1500) trim(d_coil%units)
768  WRITE (this%mi_iou,1600)
769  DO i = 1, SIZE(coil_group)
770  WRITE (this%mi_iou,1700) i, trim(coil_group(i)%s_name), &
771  & this%rdiag(i)
772  END DO
773  WRITE (this%mi_iou,*)
774  END IF
775 
776 ! Cleanup
777  CALL magnetic_response_destruct(response)
778 
779  CALL profiler_set_stop_time('v3rfun_context_write_mrf', &
780  & start_time)
781 
782 1000 FORMAT(5x,'Diagnostic #',i4)
783 1100 FORMAT(i4.4,x,a)
784 1200 FORMAT('Diagnostic Coil:',3x,i4)
785 1300 FORMAT('Short Name:',8x,a)
786 1400 FORMAT('MDDC Type:',9x,a)
787 1500 FORMAT('Signal units:',6x,a)
788 1600 FORMAT(3x,'i',1x,'ID',12x,'Inductance')
789 1700 FORMAT(i4,1x,a11,2x,es14.6)
790  END SUBROUTINE
791 
792 !-------------------------------------------------------------------------------
801 !-------------------------------------------------------------------------------
802  SUBROUTINE v3rfun_context_write_point(this, d_coil, id_num)
803  USE magnetic_response
804  USE v3_utilities
805  USE ezcdf
806 
807  IMPLICIT NONE
808 
809 ! Declare Arguments
810  TYPE (v3rfun_context_class), INTENT(inout) :: this
811  TYPE (diagnostic_dot_coil), INTENT(in) :: d_coil
812  INTEGER, INTENT(in) :: id_num
813 
814 ! local variables
815  INTEGER :: i
816  INTEGER :: mdsig_iou
817  REAL (rprec), DIMENSION(3) :: b_vec
818  TYPE (magnetic_response_class), POINTER :: response
819  CHARACTER (len=v3rfun_file_length) :: temp_filename
820  REAL (rprec) :: start_time
821 
822 ! Start of executable code
823  start_time = profiler_get_start_time()
824 
825  WRITE (*,1000) id_num
826 
827  IF (l_read_coils_dot) THEN
828  DO i = 1, SIZE(coil_group)
829  CALL bsc_b(coil_group(i), d_coil%position, b_vec)
830  this%rdiag(i) = dot_product(b_vec, d_coil%direction)
831  END DO
832  END IF
833 
834  response => magnetic_response_construct(code_name, this%date_run, &
835  & d_coil%id_name, &
836  & d_coil%position, &
837  & d_coil%direction, &
838  & this%rdiag, this%extcur)
839 
840 ! Write Coil Response ---------------------------------------------------------
841 ! Open up an mdsig file, for netcdf writing. Borrow the i variable to store the
842 ! status.
843  temp_filename = trim(d_coil%id_name) // '_mdsig.nc'
844  temp_filename = trim(adjustl(temp_filename))
845  mdsig_iou = 0
846  CALL cdf_open(mdsig_iou, trim(temp_filename), 'w', i)
847  CALL assert_eq(0, i, 'mdsig file ' // trim(temp_filename) // &
848  & ' failed to open.')
849 
850 ! Define NetCDF variables.
851  CALL cdf_define(mdsig_iou, 'diagnostic_desc_d_type', &
852  & d_coil%d_type)
853  CALL cdf_define(mdsig_iou, 'diagnostic_desc_s_name', &
854  & d_coil%id_name)
855  CALL cdf_define(mdsig_iou, 'diagnostic_desc_l_name', &
856  & d_coil%id_name)
857  CALL cdf_define(mdsig_iou, 'diagnostic_desc_units', d_coil%units)
858  CALL cdf_define(mdsig_iou, 'diagnostic_desc_sigma_default', 0.0)
859  CALL magnetic_response_define(response, mdsig_iou)
860 
861 ! Write NetCDF variables. The cdf_write subroutine switches from define mode to
862 ! write mode.
863  CALL cdf_write(mdsig_iou, 'diagnostic_desc_d_type', d_coil%d_type)
864  CALL cdf_write(mdsig_iou, 'diagnostic_desc_s_name', &
865  & d_coil%id_name)
866  CALL cdf_write(mdsig_iou, 'diagnostic_desc_l_name', &
867  & d_coil%id_name)
868  CALL cdf_write(mdsig_iou, 'diagnostic_desc_units', d_coil%units)
869  CALL cdf_write(mdsig_iou, 'diagnostic_desc_sigma_default', 0.0)
870  CALL magnetic_response_write(response, mdsig_iou)
871 
872  CALL cdf_close(mdsig_iou)
873 
874 ! Write entry in list file
875  WRITE(this%mdsig_list_iou,1100) id_num, trim(temp_filename)
876 
877 ! Cleanup
878  CALL magnetic_response_destruct(response)
879 
880  CALL profiler_set_stop_time('rfun_context_write_point', &
881  & start_time)
882 
883 1000 FORMAT(5x,'Diagnostic #',i4)
884 1100 FORMAT(i4.4,x,a)
885  END SUBROUTINE
886 
887 !*******************************************************************************
888 ! PRIVATE
889 !*******************************************************************************
890 !-------------------------------------------------------------------------------
900 !-------------------------------------------------------------------------------
901  FUNCTION cart2cyl_v(vcart, phi)
902 
903  IMPLICIT NONE
904 
905 ! Declare Arguments
906  REAL (rprec), DIMENSION(3) :: cart2cyl_v
907  REAL (rprec), DIMENSION(3), INTENT(in) :: vcart
908  REAL (rprec), INTENT(in) :: phi
909 
910 ! local variables
911  REAL (rprec) :: cphi
912  REAL (rprec) :: sphi
913 
914 ! Start of executable code
915  cphi = cos(phi)
916  sphi = sin(phi)
917  cart2cyl_v(1) = vcart(1)*cphi + vcart(2)*sphi
918  cart2cyl_v(2) = -vcart(1)*sphi + vcart(2)*cphi
919  cart2cyl_v(3) = vcart(3)
920 
921  END FUNCTION
922 
923  END MODULE
v3rfun_input::name_coils_dot
character(len=v3rfun_file_length) name_coils_dot
Filename for the field coils.
Definition: v3rfun_input.f:133
diagnostic_dot::diagnostic_dot_coil
A single coil. A coil set is structured as a singly linked list.
Definition: diagnostic_dot.f:161
coordinate_utilities
Module is part of the LIBSTELL. This modules containes code to convert from different coordinate syst...
Definition: coordinate_utilities.f:12
magnetic_response::magnetic_response_construct
Interface for the construction of magnetic_response_class types using magnetic_response_construct_new...
Definition: magnetic_response.f:216
v3rfun_input::major_radius
real(rprec) major_radius
Shell major radius for shell grid.
Definition: v3rfun_input.f:168
v3rfun_input::cg_rot_xcent
real(rprec), dimension(nigroup, 3) cg_rot_xcent
Position of center of rotation.
Definition: v3rfun_input.f:183
diagnostic_dot
Module for opening and reading a diagnostic dot file. The file format for these files are documented ...
Definition: diagnostic_dot.f:137
v3rfun_input::cg_shift_2
real(rprec), dimension(nigroup, 3) cg_shift_2
Vector to shift all the coils after rotation.
Definition: v3rfun_input.f:181
v3rfun_context::v3rfun_context_class
Base class representing a v3rfun context. This contains all memory needed to operate v3rfun.
Definition: v3rfun_context.f:33
v3_utilities::assert_eq
Definition: v3_utilities.f:62
v3rfun_context::code_name
character(len= *), parameter code_name
Name of this code.
Definition: v3rfun_context.f:22
v3rfun_input::l_rot_coil_center
logical, dimension(nigroup) l_rot_coil_center
Controls the center of rotation.
Definition: v3rfun_input.f:195
magnetic_response::magnetic_response_define
subroutine magnetic_response_define(this, mdsig_iou)
Defines the variables for the NETCDF file.
Definition: magnetic_response.f:955
v3rfun_input::kp
integer kp
Number of toroidal grid points.
Definition: v3rfun_input.f:152
v3rfun_context::v3rfun_context_destruct
subroutine v3rfun_context_destruct(this)
Deconstruct a v3rfun_context_class object.
Definition: v3rfun_context.f:455
v3rfun_context::v3rfun_context_write_mrf
subroutine v3rfun_context_write_mrf(this, d_coil, id_num)
Write out a magnetic coil response function.
Definition: v3rfun_context.f:533
v3rfun_input::zmin
real(rprec) zmin
Minimum Z for plasma grid.
Definition: v3rfun_input.f:163
v3rfun_input::use_con_shell
logical use_con_shell
Computes the response function for a conducting shell.
Definition: v3rfun_input.f:145
v3rfun_context::v3rfun_context_construct_field_coils
subroutine v3rfun_context_construct_field_coils(this)
Construct and initialize the field coil objects.
Definition: v3rfun_context.f:244
magnetic_response::magnetic_response_write
subroutine magnetic_response_write(this, mdsig_iou)
Write variables to the NETCDF file.
Definition: magnetic_response.f:1050
v3rfun_context::v3rfun_context_write_point
subroutine v3rfun_context_write_point(this, d_coil, id_num)
Write out a point probe response.
Definition: v3rfun_context.f:803
v3rfun_input::name_diagnostic_dot
character(len=v3rfun_file_length) name_diagnostic_dot
Filename for the diagnostic coils.
Definition: v3rfun_input.f:135
v3rfun_input
This file contains all the variables and maximum sizes of the inputs for a V3RFUN namelist input file...
Definition: v3rfun_input.f:112
v3rfun_input::jz
integer jz
Number of vertical grid points.
Definition: v3rfun_input.f:150
v3rfun_input::minor_radius
real(rprec) minor_radius
Shell minor radius for shell grid.
Definition: v3rfun_input.f:170
v3rfun_input::is_super_con
logical, dimension(nigroup) is_super_con
Tag super conducting coils.
Definition: v3rfun_input.f:176
diagnostic_dot::diagnostic_dot_destruct
subroutine diagnostic_dot_destruct(list)
Deconstruct a diagnostic_dot_coil list.
Definition: diagnostic_dot.f:337
v3rfun_input::v3rfun_input_read_namelist
subroutine v3rfun_input_read_namelist(namelist_file)
Reads the namelist input file.
Definition: v3rfun_input.f:226
v3rfun_context::cart2cyl_v
real(rprec) function, dimension(3), private cart2cyl_v(vcart, phi)
Converts a vector from Cartesian coordinates to cylindrical coordinates.
Definition: v3rfun_context.f:902
coordinate_utilities::cyl_to_cart
pure real(rprec) function, dimension(3), public cyl_to_cart(cyl)
Convert a point from cylindical coordinates to cartesian coordinates.
Definition: coordinate_utilities.f:67
diagnostic_dot::diagnostic_dot_construct
type(diagnostic_dot_coil) function, pointer diagnostic_dot_construct(filename)
Construct the coil diagnostics.
Definition: diagnostic_dot.f:197
v3rfun_input::rmax
real(rprec) rmax
Maximum R for plasma grid.
Definition: v3rfun_input.f:161
v3rfun_context
Defines a v3rfun_context_class object to contain all the memory for running v3rfun.
Definition: v3rfun_context.f:11
v3rfun_input::cg_rot_angle
real(rprec), dimension(nigroup) cg_rot_angle
Angle to rotate about axis of rotation. Left hand convention. Put left thumb along axis of rotation,...
Definition: v3rfun_input.f:191
magnetic_response::magnetic_response_destruct
subroutine magnetic_response_destruct(this)
Deconstruct a magnetic_response_class object.
Definition: magnetic_response.f:695
v3rfun_input::len_integrate_ddc
real(rprec) len_integrate_ddc
Integration length in meters.
Definition: v3rfun_input.f:173
v3rfun_context::v3rfun_context_construct
type(v3rfun_context_class) function, pointer v3rfun_context_construct(filename)
Construct a v3rfun_context_class object.
Definition: v3rfun_context.f:99
v3rfun_input::zmax
real(rprec) zmax
Maximum Z for plasma grid.
Definition: v3rfun_input.f:165
v3rfun_input::n_field_periods_nli
integer n_field_periods_nli
Number of field periods.
Definition: v3rfun_input.f:156
v3rfun_input::ir
integer ir
Number of radial grid points.
Definition: v3rfun_input.f:148
v3rfun_input::cg_rot_theta
real(rprec), dimension(nigroup) cg_rot_theta
Spherical polar angle to specify axis of rotation.
Definition: v3rfun_input.f:185
v3rfun_input::cg_rot_phi
real(rprec), dimension(nigroup) cg_rot_phi
Spherical azimuthal angle to specify axis of rotation.
Definition: v3rfun_input.f:187
v3rfun_input::lstell_sym
logical lstell_sym
Control for stellarator symmetry.
Definition: v3rfun_input.f:141
v3rfun_input::kp_shell
integer kp_shell
Number of shell toroidal grid points.
Definition: v3rfun_input.f:154
magnetic_response
Defines the base class of the type magnetic_response_class.
Definition: magnetic_response.f:11
magnetic_response::magnetic_response_current
character(len= *), parameter magnetic_response_current
Version for the MDSIG files. This version adds the point diagnostics.
Definition: magnetic_response.f:28
v3rfun_input::cg_shift_1
real(rprec), dimension(nigroup, 3) cg_shift_1
Vector to shift all the coils before rotation.
Definition: v3rfun_input.f:179
v3rfun_context::v3rfun_context_construct_responce_grids
subroutine v3rfun_context_construct_responce_grids(this)
Allocate and initialize the response function arrays.
Definition: v3rfun_context.f:344
v3rfun_input::rmin
real(rprec) rmin
Minimum R for plasma grid.
Definition: v3rfun_input.f:159
v3rfun_input::l_read_coils_dot
logical l_read_coils_dot
Control to ignore the coils dot file.
Definition: v3rfun_input.f:143
Generated on Thu Mar 5 2020 15:49:26 for V3FIT by   doxygen 1.8.17