V3FIT
write_coilsin.f
1  SUBROUTINE write_coilsin (iunit, istat)
2  USE stel_constants
3  USE coilsnamin
4  USE write_array_generic
5  IMPLICIT NONE
6 !-----------------------------------------------
7 ! D u m m y A r g u m e n t s
8 !-----------------------------------------------
9  INTEGER :: iunit, istat
10 !-----------------------------------------------
11 ! L o c a l V a r i a b l e s
12 !-----------------------------------------------
13  INTEGER :: i,j
14  REAL(rprec) :: tempc(nmid), temps(nmid)
15  REAL(rprec) :: temp2c(MAX(nsmid,num_vf)),
16  1 temp2s(MAX(nsmid,num_vf))
17 !-----------------------------------------------
18  istat = 0
19 
20 ! Write out two-dimensional arrays with indices explicitly
21 ! so that IF NFPDIM changes, the NAMELIST can still be READ
22 ! correctly
23 
24  WRITE(iunit,'(1x,a8)')'&COILSIN'
25  WRITE(iunit,'(1x,3a)') "BCOIL_FILE = '", trim(bcoil_file),"'"
26  WRITE(iunit,100) 'LRESTART = ', lrestart
27  WRITE(iunit,100) 'LSURFV = ', lsurfv
28  WRITE(iunit,100) 'LSADSFV = ', lsadsfv
29  WRITE(iunit,100) 'LVF = ', lvf
30  WRITE(iunit,100) 'LVFC = ', lvfc
31  WRITE(iunit,100) 'LVFVAR = ', lvfvar
32  WRITE(iunit,100) 'LVFR = ', lvfr
33  WRITE(iunit,100) 'LVFZ = ', lvfz
34  WRITE(iunit,100) 'LTFC = ', ltfc
35  WRITE(iunit,100) 'LTFCV = ', ltfcv
36  WRITE(iunit,100) 'LSADDLE = ', lsaddle
37  WRITE(iunit,100) 'LSMOD = ', lsmod
38  WRITE(iunit,100) 'LSPLINE = ', lspline
39  WRITE(iunit,100) 'LCTRLPT = ', lctrlpt
40  WRITE(iunit,100) 'LSPLBKP = ', lsplbkp
41  WRITE(iunit,100) 'LMODULAR = ', lmodular
42  WRITE(iunit,100) 'LMODCUR = ', lmodcur
43  WRITE(iunit,100) 'LSADCUR = ', lsadcur
44  WRITE(iunit,100) 'LSADSHAPE = ', lsadshape
45  WRITE(iunit,100) 'LPOLCUR = ', lpolcur
46  WRITE(iunit,100) 'LBNORM = ', lbnorm
47  WRITE(iunit,100) 'LBCOIL = ', lbcoil
48  WRITE(iunit,100) 'LBCOIL_CUR = ', lbcoil_cur
49  WRITE(iunit,100) 'LNCSX = ', lncsx
50  WRITE(iunit,100) 'LQOS = ', lqos
51  WRITE(iunit,100) 'LSYMM = ', lsymm
52  WRITE(iunit,100) 'LACCESS = ', laccess
53  WRITE(iunit,100) 'LAXIS = ', laxis
54  WRITE(iunit,200) 'NOPT_ALG = ', nopt_alg
55  WRITE(iunit,200) 'NOPT_WSURF = ', nopt_wsurf
56  WRITE(iunit,200) 'NITER_OPT = ',niter_opt, 'NSTEP = ', nstep
57  WRITE(iunit,200) 'NWDIM = ', nwdim
58  WRITE(iunit,200) 'NVF_FIX = ', nvf_fix
59  WRITE(iunit,200) 'NF_PHI = ',nf_phi
60  IF (nf_rho .gt. 0) THEN
61  WRITE(iunit,200) 'NF_RHO = ',nf_rho
62  END IF
63  WRITE(iunit,300) 'EPSFCN = ', epsfcn
64  WRITE(iunit,300) 'I_POL = ', i_pol
65  WRITE(iunit,300) 'I_TFC = ', i_tfc
66  WRITE(iunit,200) 'NMOD_COILS_PER_PERIOD = ',
67  1 nmod_coils_per_period
68  WRITE(iunit,200) 'NUM_VF = ', num_vf
69 ! Use following weights, etc., for both modular and saddle minimum
70 ! coil-plasma distance penalties
71  WRITE(iunit,300) 'DCP_WGT = ', dcp_wgt, 'DCP_exp = ', dcp_exp,
72  1 'DCP_TGT = ', dcp_tgt
73  WRITE(iunit,450) 'DPC_WGT = ', dpc_wgt
74  WRITE(iunit,450) 'VACFLD_WGT = ', vacfld_wgt
75  WRITE(iunit,450) 'MXB_WGT = ', mxb_wgt
76  IF (nmod_coils_per_period .GT. 0) THEN
77  CALL write_array(iunit,'DCC_WGT', dcc_wgt, nmid)
78  CALL write_array(iunit,'DCC_EXP', dcc_exp, nmid)
79  CALL write_array(iunit,'DCC_TGT', dcc_tgt, nmid)
80  CALL write_array(iunit,'LMOD_WGT',lmod_wgt, nmid)
81  CALL write_array(iunit,'LMOD_TGT',lmod_tgt, nmid)
82  CALL write_array(iunit,'RC_WGT', rc_wgt, nmid)
83  CALL write_array(iunit,'RC_EXP', rc_exp, nmid)
84  CALL write_array(iunit,'RC_TGT', rc_tgt, nmid)
85  CALL write_array(iunit,'CU_WGT', cu_wgt, nmid)
86  CALL write_array(iunit,'CU_TGT', cu_tgt, nmid)
87  END IF
88  IF (lmodular .AND. (.NOT.lsaddle)) THEN
89  CALL write_array(iunit,'YMIN_WGT', ymin_wgt, nmid)
90  CALL write_array(iunit,'YMIN_TGT', ymin_tgt, nmid)
91  END IF
92  IF (lsaddle) THEN
93  CALL write_array(iunit,'YMIN_WGT', ymin_wgt, nsmid)
94  CALL write_array(iunit,'YMIN_TGT', ymin_tgt, nsmid)
95  END IF
96  IF (lncsx) THEN
97  CALL write_array(iunit,'R_EXT', r_ext, nmid)
98  END IF
99  IF (laccess) THEN
100  WRITE(iunit,200) 'N_ACCESS = ', n_access
101  CALL write_array(iunit,'X0_ACCESS', x0_access, n_access)
102  CALL write_array(iunit,'Y0_ACCESS', y0_access, n_access)
103  CALL write_array(iunit,'Z0_ACCESS', z0_access, n_access)
104  CALL write_array(iunit,'X1_ACCESS', x1_access, n_access)
105  CALL write_array(iunit,'Y1_ACCESS', y1_access, n_access)
106  CALL write_array(iunit,'Z1_ACCESS', z1_access, n_access)
107  CALL write_array(iunit,'DAC_WGT', dac_wgt, n_access)
108  CALL write_array(iunit,'DAC_EXP', dac_exp, n_access)
109  CALL write_array(iunit,'DAC_TGT', dac_tgt, n_access)
110  END IF
111  IF (lbcoil) THEN
112  CALL write_array(iunit,'MC_BG', mc_bg, mbcoils)
113  CALL write_array(iunit,'LP_BG',lp_bg, mbcoils)
114  CALL write_array(iunit,'BCOIL_CUR', bcoil_cur, mbcoils)
115  END IF
116  IF (num_vf .GT. 0) THEN
117  CALL write_array(iunit,'LCC_VF', lcc_vf, num_vf)
118  CALL write_array(iunit,'CC_VF', cc_vf, num_vf)
119  CALL write_array(iunit,'RC_VF', rc_vf, num_vf)
120  CALL write_array(iunit,'ZC_VF', zc_vf, num_vf)
121  CALL write_array(iunit,'CVF_WGT', cvf_wgt, num_vf)
122  CALL write_array(iunit,'CVF_TGT', cvf_tgt, num_vf)
123  CALL write_array(iunit,'RVF_WGT', rvf_wgt, num_vf)
124  CALL write_array(iunit,'RVF_TGT', rvf_tgt, num_vf)
125  WRITE(iunit,200) 'NRVF_C = ', nrvf_c
126  IF (nrvf_c .GT. 0) THEN
127  DO j = 1, nrvf_c
128  DO i = 1, num_vf
129  temp2c(i) = rcfc_vf(i,j)
130  IF (abs(temp2c(i)) .lt. 1.e-10_dp) temp2c(i) = 0
131  temp2s(i) = rcfs_vf(i,j)
132  IF (abs(temp2s(i)) .lt. 1.e-10_dp) temp2s(i) = 0
133  END DO
134  CALL write_array(iunit,'RCFC_VF', temp2c, num_vf,j)
135  CALL write_array(iunit,'RCFS_VF', temp2s, num_vf,j)
136  END DO
137  END IF
138  END IF
139  IF (nmod_coils_per_period .gt. 0) THEN
140  CALL write_array(iunit,'CURMOD', curmod, nmid)
141  END IF
142  IF (nf_phi .GT. 0) THEN
143  DO j = 0,nf_phi
144  DO i = 1,nmid
145  tempc(i) = phic(i,j) !modular(i)%phic(j)
146  temps(i) = phis(i,j) !modular(i)%phis(j)
147  IF (abs(tempc(i)) .lt. 1.e-10_dp) tempc(i) = 0
148  IF (abs(temps(i)) .lt. 1.e-10_dp) temps(i) = 0
149  END DO
150  CALL write_array(iunit,'PHIC', tempc, nmid,j)
151  CALL write_array(iunit,'PHIS', temps, nmid,j)
152  END DO
153  END IF
154  IF (nf_rho .GT. 0) THEN
155  DO j = 0,nf_rho
156  DO i = 1,nmid
157  tempc(i) = rhoc(i,j) !modular(i)%rhoc(j)
158  temps(i) = rhos(i,j) !modular(i)%rhos(j)
159  IF (abs(tempc(i)) .lt. 1.e-10_dp) tempc(i) = 0
160  IF (abs(temps(i)) .lt. 1.e-10_dp) temps(i) = 0
161  END DO
162  CALL write_array(iunit,'RHOC', tempc, nmid,j)
163  CALL write_array(iunit,'RHOS', temps, nmid,j)
164  END DO
165  END IF
166 
167 ! 2/20/98 WHM Write out surface coefficients
168 
169  IF (numsurf .GT. 0) THEN
170  WRITE(iunit,200)'NUMSURF = ',numsurf
171  CALL write_array(iunit,'M_NUM', m_num, numsurf)
172  CALL write_array(iunit,'N_NUM', n_num, numsurf)
173  CALL write_array(iunit,'RMN_SF', rmn_sf, numsurf)
174  CALL write_array(iunit,'ZMN_SF', zmn_sf, numsurf)
175  END IF
176 
177 ! Saddle coil input parameters
178 
179  WRITE(iunit,200) 'NSAD_COILS_PER_PERIOD = ',nsad_coils_per_period
180  WRITE(iunit,200) 'NSAD_U = ',nsad_u
181  WRITE(iunit,200) 'NSAD_V = ',nsad_v
182  IF (nsad_coils_per_period .gt. 0) THEN
183  WRITE(iunit,200) 'NFILS = ',nfils
184  WRITE(iunit,300) 'DELN = ', deln, 'DELT = ', delt
185  CALL write_array(iunit,'NSAD_GROUP', nsad_group, nsmid)
186  CALL write_array(iunit,'CSAD_SCL', csad_scl, nsmid)
187  CALL write_array(iunit,'CURSAD', cursad, nsmid)
188  CALL write_array(iunit,'LS_CUR', ls_cur, nsmid)
189  CALL write_array(iunit,'CSC_WGT', csc_wgt, nsmid)
190  CALL write_array(iunit,'CSC_TGT', csc_tgt, nsmid)
191  CALL write_array(iunit,'DSC_WGT', dsc_wgt, nsmid)
192  CALL write_array(iunit,'DSC_EXP', dsc_exp, nsmid)
193  CALL write_array(iunit,'DSC_TGT', dsc_tgt, nsmid)
194 
195  DO j = 1, nsad_coils
196  CALL write_array(iunit, 'SC_DMIN_TGT',
197  1 sc_dmin_tgt(1:nsad_unique_coils,j),nsad_unique_coils,j)
198  CALL write_array(iunit, 'SC_DMIN_WGT',
199  1 sc_dmin_wgt(1:nsad_unique_coils,j),nsad_unique_coils,j)
200  END DO
201 
202  CALL write_array(iunit,'RS_WGT', rs_wgt, nsmid)
203  CALL write_array(iunit,'RS_EXP', rs_exp, nsmid)
204  CALL write_array(iunit,'RS_TGT', rs_tgt, nsmid)
205  CALL write_array(iunit,'CS_WGT', cs_wgt, nsmid)
206  CALL write_array(iunit,'CS_TGT', cs_tgt, nsmid)
207  CALL write_array(iunit,'LSAD_WGT', lsad_wgt, nsmid)
208  CALL write_array(iunit,'LSAD_TGT', lsad_tgt, nsmid)
209  CALL write_array(iunit,'RMAX_WGT', rmax_wgt, nsmid)
210  CALL write_array(iunit,'RMAX_TGT', rmax_tgt, nsmid)
211  CALL write_array(iunit,'SAD_V0', sad_v0, nsmid)
212  CALL write_array(iunit,'SAD_U0', sad_u0, nsmid)
213  CALL write_array(iunit,'DSCXP_WGT', dscxp_wgt, nsmid)
214  CALL write_array(iunit,'DSCXP_exp', dscxp_exp, nsmid)
215  CALL write_array(iunit,'DSCXP_TGT', dscxp_tgt, nsmid)
216  CALL write_array(iunit,'SCD_WGT', scd_wgt, nsmid)
217  CALL write_array(iunit,'SCD_TGT', scd_tgt, nsmid)
218  IF (lspline .and. lsplbkp) THEN
219  WRITE(iunit,350) 'BKP_WGT = ',bkp_wgt,'BKP_TGT = ',bkp_tgt
220  END IF
221  END IF
222  IF (nsad_v .GT. 0) THEN
223  DO j = 0,nsad_v
224  DO i = 1,nsmid
225  temp2c(i) = sad_v_c(i,j) !saddle(i)%v_c(j)
226  temp2s(i) = sad_v_s(i,j) !saddle(i)%v_s(j)
227  IF (abs(temp2c(i)) .lt. 1.e-10_dp) temp2c(i) = 0
228  IF (abs(temp2s(i)) .lt. 1.e-10_dp) temp2s(i) = 0
229  END DO
230  IF (lspline) THEN
231  CALL write_array(iunit,'NVAR_VC', nvar_vc(1:nsmid,j),
232  1 nsmid, j)
233  END IF
234  CALL write_array(iunit,'SAD_V_C', temp2c, nsmid, j)
235  CALL write_array(iunit,'SAD_V_S', temp2s, nsmid, j)
236  END DO
237  END IF
238  IF (nsad_u .GT. 0) THEN
239  DO j = 0,nsad_u
240  DO i = 1,nsmid
241  temp2c(i) = sad_u_c(i,j) !saddle(i)%u_c(j)
242  temp2s(i) = sad_u_s(i,j) !saddle(i)%u_s(j)
243  IF (abs(temp2c(i)) .lt. 1.e-10_dp) temp2c(i) = 0
244  IF (abs(temp2s(i)) .lt. 1.e-10_dp) temp2s(i) = 0
245  END DO
246  IF (lspline) THEN
247  CALL write_array(iunit,'NVAR_UC', nvar_uc(1:nsmid,j),
248  1 nsmid, j)
249  END IF
250  CALL write_array(iunit,'SAD_U_C', temp2c, nsmid, j)
251  CALL write_array(iunit,'SAD_U_S', temp2s, nsmid, j)
252  END DO
253  END IF
254 
255 ! Saddle surface coefficients
256 
257  IF (numsurf_sad .gt. 0) THEN
258  WRITE(iunit,200)'NUMSURF_SAD = ', numsurf_sad
259  CALL write_array(iunit,'M_SAD', m_sad, numsurf_sad)
260  CALL write_array(iunit,'N_SAD', n_sad, numsurf_sad)
261  CALL write_array(iunit,'RMN_SAD', rmn_sad, numsurf_sad)
262  CALL write_array(iunit,'ZMN_SAD', zmn_sad, numsurf_sad)
263  END IF
264 
265  WRITE(iunit,'(a)')'/'
266 
267  100 FORMAT(4(1x,a,l2,','))
268  200 FORMAT(4(1x,a,i6,','))
269  300 FORMAT(3(1x,a,1pe12.4,','))
270  350 FORMAT(2(1x,a,1pe12.4,','))
271  450 FORMAT(1x,a,1pe12.4,',')
272 
273 
274  END SUBROUTINE write_coilsin
write_array_generic::write_array
Definition: write_array_generic.f:11
Generated on Thu Mar 5 2020 15:49:23 for V3FIT by   doxygen 1.8.17