22 CHARACTER (len=*),
PARAMETER ::
code_name =
'V3RFUN'
35 CHARACTER (len=v3rfun_name_length) :: date_run
40 INTEGER :: kp_shell_store
43 INTEGER :: mdsig_list_iou
51 REAL (rprec),
DIMENSION(:),
POINTER :: extcur => null()
53 REAL (rprec),
DIMENSION(:),
POINTER :: rdiag => null()
56 REAL (rprec),
DIMENSION(:,:,:,:,:),
POINTER ::
59 REAL(rprec),
DIMENSION(:,:),
POINTER :: phi_grid_e => null()
61 REAL(rprec),
DIMENSION(:,:,:,:),
POINTER ::
64 REAL(rprec),
DIMENSION(:,:,:,:),
POINTER ::
69 REAL (rprec),
DIMENSION(:,:,:,:),
POINTER ::
72 REAL(rprec),
DIMENSION(:,:),
POINTER ::
75 REAL(rprec),
DIMENSION(:,:,:),
POINTER ::
78 REAL(rprec),
DIMENSION(:,:,:),
POINTER ::
107 CHARACTER (len=*),
INTENT(in) :: filename
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
117 REAL (rprec) :: start_time
120 start_time = profiler_get_start_time()
124 CALL date_and_time(date, time, zone)
134 temp_filename = trim(base_name) //
'_mdsig.LIST'
136 WRITE(*,*)
'list_filename is ', temp_filename
138 & trim(temp_filename),
'replace',
'formatted',
140 CALL assert_eq(0, status,
'v3rfun_context_construct' //
141 &
': Safe_open of ' // trim(temp_filename) //
' failed')
144 temp_filename = trim(base_name) //
'_MI'
146 WRITE(*,*)
'mi_filename is ', trim(temp_filename)
148 & trim(temp_filename),
'replace',
'formatted',
150 CALL assert_eq(0, status,
'v3rfun_context_construct' //
151 &
': Safe_open of ' // trim(temp_filename) //
' failed')
172 IF (mod(
kp, 2) .ne. 0)
THEN
173 WRITE (*,1500)
'kp',
kp
192 CALL profiler_set_stop_time(
'v3rfun_context_construct',
202 DO i = 1,
SIZE(coil_group)
205 status = coil_group(i)%ncoil
206 status = maxloc(abs(coil_group(i)%coils(1:status)%current),
209 & coil_group(i)%coils(status)%current
222 CALL profiler_set_stop_time(
'v3rfun_context_construct',
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.')
248 TYPE (v3rfun_context_class),
POINTER :: this
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
259 start_time = profiler_get_start_time()
270 IF (
SIZE(coil_group) .gt. nigroup)
THEN
271 WRITE (*,1200) nigroup
278 DO i = 1,
SIZE(coil_group)
280 WRITE (*,1400) i, trim(coil_group(i)%s_name)
284 CALL bsc_construct_rs(rotation_shift, 0.0_dp, 0.0_dp, 0.0_dp,
286 CALL bsc_rot_shift(coil_group(i), rotation_shift)
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)
296 & + mean_r*coil_group(i)%coils(j)%current
299 IF (current .ne. 0)
THEN
300 center = center/current
302 WRITE (*,1600) center
306 WRITE (*,1700) center
312 CALL bsc_rot_shift(coil_group(i), rotation_shift)
318 CALL profiler_set_stop_time(
319 &
'v3rfun_context_construct_field_coils', start_time)
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))
349 TYPE (v3rfun_context_class),
POINTER :: this
352 REAL (rprec) :: fperiod
356 REAL(rprec),
DIMENSION(3) :: xcyl
358 INTEGER :: k, l, i, j
359 REAL (rprec) :: start_time
362 start_time = profiler_get_start_time()
365 fperiod = twopi/nfp_bs
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))
374 ALLOCATE(this%pl_response_ss(
ir,
jz,this%kp_store,3))
387 xcyl(2) = phi0 + (l - 1)*fperiod
388 this%phi_grid_e(k,l) = xcyl(2)
390 xcyl(1) =
rmin + (i - 1)*delr
392 xcyl(3) =
zmin + (j - 1)*delz
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))
413 ALLOCATE(this%s_response_ss(i,this%kp_shell_store,3))
424 xcyl(2) = phi0 + (l - 1)*fperiod
425 this%phi_grid_shell(k,l) = xcyl(2)
438 CALL profiler_set_stop_time(
439 &
'v3rfun_context_construct_responce_grids', start_time)
459 TYPE (v3rfun_context_class),
POINTER :: this
462 CLOSE(this%mdsig_list_iou)
468 CALL cleanup_biotsavart
470 IF (
ASSOCIATED(this%coils))
THEN
475 IF (
ASSOCIATED(this%xcart_grid_e))
THEN
476 DEALLOCATE(this%xcart_grid_e)
477 this%xcart_grid_e => null()
480 IF (
ASSOCIATED(this%phi_grid_e))
THEN
481 DEALLOCATE(this%phi_grid_e)
482 this%phi_grid_e => null()
485 IF (
ASSOCIATED(this%pl_response))
THEN
486 DEALLOCATE(this%pl_response)
487 this%pl_response => null()
490 IF (
ASSOCIATED(this%pl_response_ss))
THEN
491 DEALLOCATE(this%pl_response_ss)
492 this%pl_response_ss => null()
495 IF (
ASSOCIATED(this%xcart_s_grid_e))
THEN
496 DEALLOCATE(this%xcart_s_grid_e)
497 this%xcart_s_grid_e => null()
500 IF (
ASSOCIATED(this%phi_grid_shell))
THEN
501 DEALLOCATE(this%phi_grid_shell)
502 this%phi_grid_shell => null()
505 IF (
ASSOCIATED(this%s_response))
THEN
506 DEALLOCATE(this%s_response)
507 this%s_response => null()
510 IF (
ASSOCIATED(this%s_response_ss))
THEN
511 DEALLOCATE(this%s_response_ss)
512 this%s_response_ss => null()
540 TYPE (v3rfun_context_class),
INTENT(inout) :: this
541 TYPE (diagnostic_dot_coil),
INTENT(in) :: d_coil
542 INTEGER,
INTENT(in) :: id_num
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
559 start_time = profiler_get_start_time()
561 WRITE (*,1000) id_num
565 DO i = 1,
SIZE(coil_group)
570 CALL bsc_fluxba(coil_group(i), d_coil%coil,
577 this%rdiag = this%rdiag*d_coil%factor
591 this%pl_response(i,j,k,1:3) = 0.0
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) +
604 this%pl_response = this%pl_response*d_coil%factor
615 DO k = 1,
SIZE(this%pl_response_ss, 3)
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)
644 DO j = 1,
SIZE(this%s_response, 1)
646 this%s_response(j,k,1:3) = 0.0
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) +
657 this%s_response = this%s_response*d_coil%factor
665 DO j = 1,
SIZE(this%s_response, 1)
669 jss =
SIZE(this%s_response, 1) + 2 - j
671 DO k = 1,
SIZE(this%s_response_ss, 2)
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)
697 a_r => this%pl_response_ss(:,:,:,1)
698 a_f => this%pl_response_ss(:,:,:,2)
699 a_z => this%pl_response_ss(:,:,:,3)
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)
706 a_r => this%pl_response(:,:,:,1)
707 a_f => this%pl_response(:,:,:,2)
708 a_z => this%pl_response(:,:,:,3)
710 a_s_r => this%s_response(:,:,1)
711 a_s_f => this%s_response(:,:,2)
712 a_s_z => this%s_response(:,:,3)
719 & this%rdiag, this%extcur,
724 & a_s_r, a_s_f, a_s_z,
730 temp_filename = trim(d_coil%id_name) //
'_mdsig.nc'
731 temp_filename = trim(adjustl(temp_filename))
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.')
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)
744 CALL bsc_cdf_define_coil(d_coil%coil, j,
'')
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)
754 CALL bsc_cdf_write_coil(d_coil%coil, j,
'')
760 WRITE(this%mdsig_list_iou,1100) id_num, trim(temp_filename)
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),
773 WRITE (this%mi_iou,*)
779 CALL profiler_set_stop_time(
'v3rfun_context_write_mrf',
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)
810 TYPE (v3rfun_context_class),
INTENT(inout) :: this
811 TYPE (diagnostic_dot_coil),
INTENT(in) :: d_coil
812 INTEGER,
INTENT(in) :: id_num
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
823 start_time = profiler_get_start_time()
825 WRITE (*,1000) id_num
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)
838 & this%rdiag, this%extcur)
843 temp_filename = trim(d_coil%id_name) //
'_mdsig.nc'
844 temp_filename = trim(adjustl(temp_filename))
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.')
851 CALL cdf_define(mdsig_iou,
'diagnostic_desc_d_type',
853 CALL cdf_define(mdsig_iou,
'diagnostic_desc_s_name',
855 CALL cdf_define(mdsig_iou,
'diagnostic_desc_l_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)
863 CALL cdf_write(mdsig_iou,
'diagnostic_desc_d_type', d_coil%d_type)
864 CALL cdf_write(mdsig_iou,
'diagnostic_desc_s_name',
866 CALL cdf_write(mdsig_iou,
'diagnostic_desc_l_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)
872 CALL cdf_close(mdsig_iou)
875 WRITE(this%mdsig_list_iou,1100) id_num, trim(temp_filename)
880 CALL profiler_set_stop_time(
'rfun_context_write_point',
883 1000
FORMAT(5x,
'Diagnostic #',i4)
884 1100
FORMAT(i4.4,x,a)
907 REAL (rprec),
DIMENSION(3),
INTENT(in) :: vcart
908 REAL (rprec),
INTENT(in) :: phi
918 cart2cyl_v(2) = -vcart(1)*sphi + vcart(2)*cphi