V3FIT
init_saddle_wsurf.f
1  SUBROUTINE init_saddle_wsurf (nvariables, xvariables)
2 !-----------------------------------------------
3 ! M o d u l e s
4 !-----------------------------------------------
5  USE saddle_surface
6  USE mpi_params
7  IMPLICIT NONE
8 !-----------------------------------------------
9 ! L o c a l V a r i a b l e s
10 !-----------------------------------------------
11  INTEGER :: nb, mb, ik
12  REAL(rprec), ALLOCATABLE, DIMENSION(:,:) :: rbc_in, zbs_in
13  REAL(rprec) :: delta
14  INTEGER, INTENT(out) :: nvariables
15  REAL(rprec) :: xvariables(*)
16  EXTERNAL unique_boundary, convert_boundary,
17  1 unique_boundary_pg, convert_boundary_pg
18 !-----------------------------------------------
19  IF (nopt_wsurf .eq. -1) THEN
20  xvariables(1:numsurf_sad) = rmn_sad(:numsurf_sad)
21  xvariables(numsurf_sad+1:2*numsurf_sad) = zmn_sad(:numsurf_sad)
22  nvariables = 2*numsurf_sad
23  RETURN
24  END IF
25 
26  irm0_bdy = 0; izm0_bdy = 0; irho_bdy = 0;
27 
28  ntor_opt = max(maxval(n_sad(1:numsurf_sad)),
29  1 abs(minval(n_sad(1:numsurf_sad))))
30  mpol_opt = max(maxval(m_sad(1:numsurf_sad)),
31  1 abs(minval(m_sad(1:numsurf_sad))))
32  IF (nopt_wsurf .eq. 1) mpol_opt = mpol_opt + 1
33  ik = (2*ntor_opt+1)*(mpol_opt+1)
34 
35  ALLOCATE (nbrho_opt(ik), mbrho_opt(ik),
36  1 rbc(-ntor_opt:ntor_opt,0:mpol_opt),
37  2 zbs(-ntor_opt:ntor_opt,0:mpol_opt),
38  3 rbc_in(-ntor_opt:ntor_opt,0:mpol_opt),
39  4 zbs_in(-ntor_opt:ntor_opt,0:mpol_opt),
40  5 rhobc(-ntor_opt:ntor_opt,0:mpol_opt),
41  6 nrz0_opt(2*(ntor_opt+1)),
42  7 delta_mn(-ntor_opt:ntor_opt,-mpol_opt:mpol_opt))
43 
44  rbc = 0
45  zbs = 0
46  nvariables = 0
47 
48  DO ik = 1, numsurf_sad
49  mb = m_sad(ik)
50 
51  IF (mb .eq. 0) THEN
52  nb = n_sad(ik)
53  IF (nb .ge. 0) THEN
54  rbc(nb, mb) = rmn_sad(ik)
55  zbs(nb, mb) = -zmn_sad(ik)
56  ELSE
57  nb = -nb
58  rbc(nb, mb) = rmn_sad(ik)
59  zbs(nb, mb) = zmn_sad(ik)
60  END IF ! mb=0
61 
62  ELSE
63  nb = -n_sad(ik)
64  rbc(nb, mb) = rmn_sad(ik)
65  zbs(nb, mb) = zmn_sad(ik)
66  END IF
67 
68  END DO
69 
70  IF (nopt_wsurf .eq. 0) THEN
71 
72  rbc_in = rbc
73  zbs_in = zbs !copy and store m=0 components
74 
75 !
76 ! check IF conversion was made or IF original bdy already in proper form
77 ! IF NOPT_BOUNDARY=0, USE HIRSHMAN/BRESLAU REPRESENTATION
78 ! =1, USE PG (PAUL GARABEDIAN) DELTA_MN REPRESENTATION
79 !
80  CALL convert_boundary(rbc, zbs, rhobc, mpol_opt, ntor_opt)
81 
82  CALL unique_boundary(rbc_in, zbs_in, rhobc, mpol_opt,
83  1 ntor_opt, mpol_opt, ntor_opt, mpol_opt)
84  delta = sum((rbc - rbc_in)**2)/rbc(0,1)**2
85  1 + sum((zbs - zbs_in)**2)/zbs(0,1)**2
86 
87  IF (delta.gt.1.e-8_dp .and. myid.eq.master)
88  1 WRITE(*,10) 100*(one-delta)
89 
90  10 FORMAT(' Input boundary representation was converted!',/,
91  1 ' Reliability of conversion = ',f7.2,'%')
92 
93  DO nb = -ntor_opt, ntor_opt
94  IF (rbc(nb,0).ne.zero .or. zbs(nb,0).ne.zero) THEN
95  nvariables = nvariables + 1
96  n_sad(nvariables) = nb
97  m_sad(nvariables) = 0
98  irm0_bdy = irm0_bdy + 1
99  nrz0_opt(irm0_bdy) = nb
100  xvariables(nvariables) = rbc(nb,0)
101  END IF
102  END DO
103 
104  DO ik = 1, irm0_bdy
105  nb = n_sad(ik)
106  IF (nb .ne. 0) THEN
107  izm0_bdy = izm0_bdy + 1
108  nvariables = nvariables + 1
109  nrz0_opt(nvariables) = nb
110  xvariables(nvariables) = zbs(nb,0)
111  END IF
112  END DO
113 
114  ik = irm0_bdy
115 
116  DO mb = 0, mpol_opt
117  DO nb = -ntor_opt, ntor_opt
118  IF (mb .ne. 0) THEN
119  ik = ik+1
120  n_sad(ik) = nb
121  m_sad(ik) = mb
122  END IF
123  IF (rhobc(nb,mb) .ne. zero
124  1 .and. (mb .ne. 0 .or. nb .ge. 0)) THEN
125  nvariables = nvariables + 1
126  irho_bdy = irho_bdy + 1
127  nbrho_opt(irho_bdy) = nb
128  mbrho_opt(irho_bdy) = mb
129  xvariables(nvariables) = rhobc(nb,mb)
130  END IF
131  END DO
132  END DO
133 
134  numsurf_sad = ik
135 
136  IF (numsurf_sad .gt. nsurf) stop ' NUMSURF_SAD > NSURF '
137 
138  END IF
139 
140  IF (nopt_wsurf.eq.1) THEN
141  CALL convert_boundary_pg(rbc,zbs,delta_mn,mpol_opt,ntor_opt)
142 
143  DO nb = -ntor_opt, ntor_opt
144  DO mb = -mpol_opt, mpol_opt
145  IF (delta_mn(nb,mb) .ne. zero
146  1 .and. .not.(nb .eq.0 .and. mb .eq. 0)) THEN
147  irho_bdy = irho_bdy + 1
148  nvariables = nvariables + 1
149  nbrho_opt(irho_bdy) = nb
150  mbrho_opt(irho_bdy) = mb
151  xvariables(nvariables) = delta_mn(nb,mb)
152  END IF
153  END DO
154  END DO
155 
156  END IF
157 
158  DEALLOCATE (rbc_in, zbs_in)
159 
160  END SUBROUTINE init_saddle_wsurf