2 USE vparams,
ONLY: rprec, dp, mpol1d, ntord, ndatafmax
9 INTEGER,
PARAMETER :: mpol_default = 6
10 INTEGER,
PARAMETER :: ntor_default = 0
11 INTEGER,
PARAMETER :: ns_default = 31
12 INTEGER :: nfp, ncurr, nsin, niter, nstep, nvacskip, mpol, ntor,
13 1 ntheta, nzeta, mfilter_fbdy, nfilter_fbdy,
14 2 max_main_iterations, omp_num_threads
15 INTEGER,
DIMENSION(100) :: ns_array, niter_array
16 INTEGER :: imse, isnodes, itse, ipnodes, iopt_raxis,
17 1 imatch_phiedge, nflxs
18 INTEGER,
DIMENSION(nbsetsp) :: nbfld
19 INTEGER,
DIMENSION(nfloops) :: indxflx
20 INTEGER,
DIMENSION(nbcoilsp,nbsetsp) :: indxbfld
21 REAL(rprec),
DIMENSION(-ntord:ntord,0:mpol1d) ::
23 REAL(rprec) :: time_slice, curtor, delt, ftol, tcon0,
24 1 gamma, phiedge, phidiam, sigma_current, sigma_delphid, tensi,
25 2 tensp, tensi2, fpolyi, presfac, mseangle_offset, pres_offset,
26 3 mseangle_offsetm, spres_ped, bloat, pres_scale,
28 REAL(rprec),
DIMENSION(0:20) :: am, ai, ac
29 REAL(rprec),
DIMENSION(1:20) :: aphi
30 CHARACTER(len=20) :: pcurr_type
31 CHARACTER(len=20) :: piota_type
32 CHARACTER(len=20) :: pmass_type
33 REAL(rprec),
DIMENSION(ndatafmax) :: am_aux_s, am_aux_f,
34 1 ai_aux_s, ai_aux_f, ac_aux_s, ac_aux_f
38 REAL(rprec),
DIMENSION(0:20) :: ah, at
41 REAL(rprec),
DIMENSION(0:ntord) :: raxis, zaxis
42 REAL(rprec),
DIMENSION(0:ntord) :: raxis_cc, raxis_cs,
44 REAL(rprec),
DIMENSION(100) :: ftol_array
45 REAL(rprec),
DIMENSION(nigroup),
TARGET :: extcur
46 REAL(rprec),
DIMENSION(nmse) :: mseprof
47 REAL(rprec),
DIMENSION(ntse) :: rthom, datathom, sigma_thom
48 REAL(rprec),
DIMENSION(nmse) :: rstark, datastark,
50 REAL(rprec),
DIMENSION(nfloops) :: dsiobt, sigma_flux
51 REAL(rprec),
DIMENSION(nbcoilsp,nbsetsp) :: bbc, sigma_b
52 REAL(rprec),
DIMENSION(ndatafmax) :: psa, pfa, isa, ifa
53 LOGICAL :: lpofr, lmac, lfreeb, lrecon, loldout, ledge_dump,
54 1 lasym, lforbal, lrfp, lmove_axis,
59 a , lspectrum_dump, loptim
61 REAL(rprec) :: fgiveup
64 CHARACTER(len=200) :: mgrid_file
65 CHARACTER(len=10) :: precon_type
66 CHARACTER(len=120) :: arg1
67 CHARACTER(len=100) :: input_extension
69 namelist /indata/ mgrid_file, time_slice, nfp, ncurr, nsin,
70 1 niter, nstep, nvacskip, delt, ftol, gamma, am, ai, ac, aphi,
71 1 pcurr_type, pmass_type, piota_type,
72 1 am_aux_s, am_aux_f, ai_aux_s, ai_aux_f, ac_aux_s, ac_aux_f,
74 2 rbc, zbs, rbs, zbc, spres_ped, pres_scale, raxis_cc, zaxis_cs,
75 3 raxis_cs, zaxis_cc, mpol, ntor, ntheta, nzeta, mfilter_fbdy,
76 3 nfilter_fbdy, niter_array,
77 4 ns_array, ftol_array, tcon0, precon_type, prec2d_threshold,
78 4 curtor, sigma_current, extcur, omp_num_threads,
79 5 phiedge, psa, pfa, isa, ifa, imatch_phiedge, iopt_raxis,
80 6 tensi, tensp, mseangle_offset, mseangle_offsetm, imse,
81 7 isnodes, rstark, datastark, sigma_stark, itse, ipnodes,
82 8 presfac, pres_offset, rthom, datathom, sigma_thom, phidiam,
83 9 sigma_delphid, tensi2, fpolyi, nflxs, indxflx, dsiobt,
84 a sigma_flux, nbfld, indxbfld, bloat, raxis, zaxis,
85 a bbc, sigma_b, lpofr, lforbal, lfreeb, lmove_axis, lrecon, lmac,
86 b lasym, ledge_dump, lspectrum_dump, loptim, lrfp,
87 c loldout, lwouttxt, ldiagno, lfull3d1out, max_main_iterations,
91 namelist /mseprofile/ mseprof
95 SUBROUTINE read_indata_namelist (iunit, istat)
96 INTEGER,
INTENT(IN) :: iunit
97 INTEGER,
INTENT(OUT) :: istat
107 ntheta = 0; nzeta = 0
108 ns_array = 0; ns_array(1) = ns_default
111 rbc = 0; rbs = 0; zbs = 0; zbc = 0
121 ftol_array = 0; ftol_array(1) = ftol
122 am = 0; ai = 0; ac = 0; aphi = 0; aphi(1) = 1
124 raxis_cc = 0; zaxis_cs = 0; raxis_cs = 0; zaxis_cc = 0
125 mfilter_fbdy = -1; nfilter_fbdy = -1
127 precon_type =
'NONE'; prec2d_threshold = 1.e-30_dp
129 extcur = 0; phiedge = 1;
144 max_main_iterations = 1
151 pcurr_type =
'power_series'
152 piota_type =
'power_series'
153 pmass_type =
'power_series'
157 at(0) = 1; at(1:) = 0
165 READ (iunit, nml=indata, iostat=istat)
167 IF (all(niter_array == -1)) niter_array = niter
181 WHERE (raxis .ne. 0.0_dp)
186 WHERE (zaxis .ne. 0.0_dp)
192 raxis_cs(0) = 0; zaxis_cs(0) = 0
194 IF(max_main_iterations .GT. 1) lmoreiter=.true.
196 END SUBROUTINE read_indata_namelist
198 SUBROUTINE read_mse_namelist (iunit, istat)
199 INTEGER :: iunit, istat
201 READ (iunit, nml=mseprofile, iostat=istat)
203 END SUBROUTINE read_mse_namelist
205 END MODULE vmec_input