ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
B_wrd.f
Go to the documentation of this file.
1  SUBROUTINE wrb
2 
3  include 'double.inc'
4  include 'dim.inc'
5  include 'compol.inc'
6 
7  common /compsf/ psf(nrp), sqtor(nrp)
8  common/selcon/ psi_d(nrp),fi_d(nrp),f_d(nrp),ri_d(nrp),
9  * ps_pnt(nrp),del_psb,psi_bn1
10 
11  common /com_jb/ bj_av(nrp),curfi_av(nrp)
12  common /com_b2/ b2_av(nrp)
13 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
14  common/savt0/ psi0(nrp),fi0(nrp),f0(nrp),ri0(nrp),q0(nrp),
15  * dpsidt(nrp),dfidt(nrp),rm0,ac0n,skcen0
16 
17 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
18  common /com_volt/ upls(nrp)
19  common /fp_dot/ dfpdt(1000),nna1
20 
21 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
22  character*10 case(6)
23 
24 ! dimension psirz(np,np),fpol(np),pres(np),ffprim(np),
25 ! * pprime(np),qpsi(np),rbbbs(nbp),zbbbs(nbp),
26 ! * rlim(np),zlim(np)
27 
28  character*10 etitl(5), date
29 
30  common
31  * /c_kpr/kpr
32 
33  if(kpr.lt.0) return
34 
35  write(fname,'(a,a)') path(1:kname),'outp.wr'
36  open(1,file=fname)
37  !open(1,file='outp.wr')
38  write(1,*) nr,nt,nr1,nt1,nr2,nt2,iplas
39  write(1,*) ((r(i,j),i=1,iplas),j=1,nt)
40  write(1,*) ((z(i,j),i=1,iplas),j=1,nt)
41  write(1,*) ((cur(i,j),i=1,iplas),j=1,nt)
42  write(1,*) ((psi(i,j),i=1,iplas),j=1,nt)
43  write(1,*) (q(i),i=1,iplas)
44  write(1,*) (f(i),i=1,iplas)
45  close(1)
46 
47  write(fname,'(a,a)') path(1:kname),'ddp.wr'
48  open(1,file=fname)
49  !open(1,file='ddp.wr')
50  write(1,*) iplas
51  write(1,*) (q(i),i=1,iplas)
52  write(1,*) (f(i),i=1,iplas)
53  write(1,*) (dfdpsi(i),i=1,iplas)
54  write(1,*) (psia(i),i=1,iplas)
55  write(1,*) (sqtor(i),i=1,iplas)
56  !write(1,*) (dpsidt(i),i=1,iplas)
57  !write(1,*) (upls(i),i=1,iplas)
58  write(1,*) (dpdpsi(i),i=1,iplas)
59  write(1,*) (bj_av(i),i=1,iplas)
60  !write(1,*) (curfi_av(i),i=1,iplas)
61  write(1,*) (b2_av(i),i=1,iplas)
62  !write(1,*) nna1
63  !write(1,*) (dfpdt(i),i=1,nna1)
64  close(1)
65  write(fname,'(a,a)') path(1:kname),'tabppf.wr'
66  open(1,file=fname)
67  !open(1,file='tabppf.wr')
68  write(1,*) iplas
69  do i=1,iplas
70  write(1,*) 1.d0-psia(i),dpdpsi(i),dfdpsi(i)
71  enddo
72  close(1)
73 
74 ! open(1,file='dps.wr')
75 ! do i=1,iplas
76 ! ddps=psia(i)*psim-psi_d(i)
77 ! ddfi=flx_fi(i)-fi_d(i)
78 ! ddf=f(i)-f_d(i)
79 ! write(1,*) ddps,ddfi,ddf,i
80 ! enddo
81 ! write(1,*) ' dpsidt from promat'
82 ! write(1,*) (ps_pnt(i),i=1,iplas)
83 ! write(1,*) 'del_psb from promat',del_psb
84 !
85 ! close(1)
86 
87  write(fname,'(a,a)') path(1:kname),'q.wr'
88  open(1,file=fname)
89  !open(1,file='q.wr')
90  do i=1,iplas
91  if(i.ne.iplas) then
92  write(1,*) 1.d0-0.5d0*(psia(i)+psia(i+1)),0.5d0*q(i)/pi,i
93  else
94  write(1,*) 1.d0-psia(i),0.5d0*q(i)/pi,i
95  endif
96  enddo
97  close(1)
98 
99  nrr=iplas
100 
101  write(fname,'(a,a)') path(1:kname),'efit_comp.wr'
102  open(1,file=fname)
103  !open(1,file='efit_comp.wr')
104 
105  write(1,2022) nrr,nt
106  write(1,2020) rm,zm,psim*0.4d0*pi,psip*0.4d0*pi,tok*1.d3
107  write(1,2020) (f(i)*0.4d0*pi,i=1,nrr-1)
108  write(1,2020) (dpdpsi(i)*1.d7/4.d0/pi,i=1,nrr)
109  write(1,2020) (dfdpsi(i)*0.4d0*pi,i=1,nrr)
110  write(1,2020) ((r(i,j),i=1,nrr),j=1,nt)
111  write(1,2020) ((z(i,j),i=1,nrr),j=1,nt)
112  write(1,2020) ((psi(i,j)*0.4d0*pi,i=1,nrr),j=1,nt)
113  write(1,2020) (q(i),i=1,nrr-1)
114  write(1,2020) (r(nrr,j),z(nrr,j),j=1,nt)
115 
116  close(1)
117 
118  write(fname,'(a,a)') path(1:kname),'tab_bnd.wr'
119  open(1,file=fname)
120  !open(1,file='tab_bnd.wr')
121  write(1,*) nt1
122  do ib=1,nt1
123  write(1,*) r(iplas,ib),z(iplas,ib)
124  enddo
125  close(1)
126 
127  ! open(1,file='gato_equi.wr')
128  ! write (1,1000) date
129  ! write (1,1000) (etitl(i),i=1,nft)
130  ! close(1
131 
132  1000 format(6a8)
133  1010 format(3i5)
134  3000 format(1p4e19.12)
135 
136  2000 format(6a8,3i4)
137  2020 format(5e16.9)
138  2022 format(2i5)
139 
140  ! write(*,*) 'wrb:writing iz done'
141  !pause 'wrb:pause'
142  RETURN
143  END
144 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
145  SUBROUTINE rd_step(numwr,dt,time,istep,psex_bnd,psi0_bnd)
146 c
147  include 'double.inc'
148  include 'dim.inc'
149  include 'compol.inc'
150 c
151  !dimension psiplb(*),psiexb(*)
152  character*40 str,dummy
153 
154  write(fname,'(a,a)') path(1:kname),'nmwr.wr'
155  open(1,file=fname,form='formatted')
156  !open(1,file='nmwr.wr',form='formatted')
157  read(1,*) numbwr
158  close(1)
159 
160  if(numwr.lt.10) then
161  write(str,'(a,a,i1,a)') path(1:kname),'step',numwr,'.wr'
162  elseif(numwr.lt.100) then
163  write(str,'(a,a,i2,a)') path(1:kname),'step',numwr,'.wr'
164  else
165  write(str,'(a,a,i3,a)') path(1:kname),'step',numwr,'.wr'
166  endif
167 
168  open(1,file=str,form='formatted')
169  read(1,*) nr,nt,iplas,istep,dt,time
170  read(1,*) psex_bnd,rm,zm,psim,psi0_bnd,platok
171  read(1,*) ((r(i,j),i=1,iplas),j=1,nt)
172  read(1,*) ((z(i,j),i=1,iplas),j=1,nt)
173  read(1,*) ((ro(i,j),i=1,iplas),j=1,nt)
174  read(1,*) (teta(j),j=1,nt)
175  read(1,*) ((psi(i,j),i=1,iplas),j=1,nt)
176  read(1,*) ((psin(i,j),i=1,iplas),j=1,nt)
177  read(1,*) (psia(i),i=1,iplas)
178  !read(1,*) ((cur(i,j),i=1,iplas),j=1,nt)
179  !read(1,*) (q(i),i=1,iplas)
180  !read(1,*) (f(i),i=1,iplas)
181  !read(1,*) (dfdpsi(i),i=1,iplas)
182  !read(1,*) (dpdpsi(i),i=1,iplas)
183  close(1)
184 
185  !open(1,file='wlist.wr',form='formatted')
186  ! if(numwr.eq.1) then
187  ! write(1,*) str
188  ! else
189  ! do i=1,numwr-1
190  ! read(1,*) dummy
191  ! enddo
192  ! write(1,*) str
193  ! endif
194  !close(1)
195 
196 c---------------------------------------------------------------
197  RETURN
198  END
199 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
200  SUBROUTINE wrb0
201 
202  include 'double.inc'
203  include 'dim.inc'
204  include 'compol.inc'
205 
206  common /compsf/ psf(nrp), sqtor(nrp)
207  common/selcon/ psi_d(nrp),fi_d(nrp),f_d(nrp),ri_d(nrp),
208  * ps_pnt(nrp),del_psb,psi_bn1
209 
210  common /com_jb/ bj_av(nrp),curfi_av(nrp)
211  common /com_b2/ b2_av(nrp)
212 
213  character*10 case(6)
214 
215 ! dimension psirz(np,np),fpol(np),pres(np),ffprim(np),
216 ! * pprime(np),qpsi(np),rbbbs(nbp),zbbbs(nbp),
217 ! * rlim(np),zlim(np)
218 
219  character*10 etitl(5), date
220 
221 
222 
223  write(fname,'(a,a)') path(1:kname),'outp0.wr'
224  open(1,file=fname,form='formatted')
225  !open(1,file='outp0.wr')
226  write(1,*) nr,nt,nr1,nt1,nr2,nt2,iplas
227  write(1,*) ((r(i,j),i=1,iplas),j=1,nt)
228  write(1,*) ((z(i,j),i=1,iplas),j=1,nt)
229  write(1,*) ((cur(i,j),i=1,iplas),j=1,nt)
230  write(1,*) ((psi(i,j),i=1,iplas),j=1,nt)
231  write(1,*) (q(i),i=1,iplas)
232  write(1,*) (f(i),i=1,iplas)
233  close(1)
234 
235  write(fname,'(a,a)') path(1:kname),'ddp0.wr'
236  open(1,file=fname,form='formatted')
237  !open(1,file='ddp0.wr')
238  write(1,*) iplas
239  write(1,*) (q(i),i=1,iplas)
240  write(1,*) (f(i),i=1,iplas)
241  write(1,*) (dfdpsi(i),i=1,iplas)
242  write(1,*) (psia(i),i=1,iplas)
243  write(1,*) (sqtor(i),i=1,iplas)
244  write(1,*) (dpdpsi(i),i=1,iplas)
245  write(1,*) (curfi_av(i),i=1,iplas)
246  write(1,*) (b2_av(i),i=1,iplas)
247  close(1)
248 
249  write(fname,'(a,a)') path(1:kname),'dps.wr'
250  open(1,file=fname,form='formatted')
251  !open(1,file='dps.wr')
252  do i=1,iplas
253  ddps=psia(i)*psim-psi_d(i)
254  ddfi=flx_fi(i)-fi_d(i)
255  ddf=f(i)-f_d(i)
256  write(1,*) ddps,ddfi,ddf,i
257  enddo
258  write(1,*) ' dpsidt from promat'
259  write(1,*) (ps_pnt(i),i=1,iplas)
260  write(1,*) 'del_psb from promat',del_psb
261 
262  close(1)
263 
264  write(fname,'(a,a)') path(1:kname),'q0.wr'
265  open(1,file=fname,form='formatted')
266  !open(1,file='q0.wr')
267  do i=1,iplas
268  if(i.ne.iplas) then
269  write(1,*) 1.d0-0.5d0*(psia(i)+psia(i+1)),0.5d0*q(i)/pi,i
270  else
271  write(1,*) 1.d0-psia(i),0.5d0*q(i)/pi,i
272  endif
273  enddo
274  close(1)
275 
276  nrr=iplas
277 
278  write(fname,'(a,a)') path(1:kname),'efit_comp.wr'
279  open(1,file=fname,form='formatted')
280  !open(1,file='efit_comp.wr')
281 
282  write(1,2000) nrr,nt
283  write(1,2020) rm,zm,psim*0.4d0*pi,psip*0.4d0*pi,tok*1.d3
284  write(1,2020) (f(i)*0.4d0*pi,i=1,nrr-1)
285  write(1,2020) (dpdpsi(i)*1.d7/4.d0/pi,i=1,nrr)
286  write(1,2020) (dfdpsi(i)*0.4d0*pi,i=1,nrr)
287  write(1,2020) ((r(i,j),i=1,nrr),j=1,nt)
288  write(1,2020) ((z(i,j),i=1,nrr),j=1,nt)
289  write(1,2020) ((psi(i,j)*0.4d0*pi,i=1,nrr),j=1,nt)
290  write(1,2020) (q(i),i=1,nrr-1)
291  write(1,2020) (r(nrr,j),z(nrr,j),j=1,nt)
292 
293  close(1)
294 
295  ! open(1,file='gato_equi.wr')
296  ! write (1,1000) date
297  ! write (1,1000) (etitl(i),i=1,nft)
298  ! close(1
299 
300  1000 format(6a8)
301  1010 format(3i5)
302  3000 format(1p4e19.12)
303 
304  2000 format(6a8,3i4)
305  2020 format(5e16.9)
306  2022 format(2i5)
307 
308  write(*,*) 'wrb:writing iz done'
309  !pause 'wrb:pause'
310  RETURN
311  END
312 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
313 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
314 
315  SUBROUTINE out_b
316 
317  include 'double.inc'
318  include 'dim.inc'
319  include 'compol.inc'
320 
321 ! write(17,*) '**************************************************'
322 ! write(17,*) 'Print from "call out_b":'
323 ! write(17,*) '---------------------'
324 ! write(17,*) 'Grid size parameters:'
325 ! write(17,*) ' '
326 ! write(17,*) 'iplas =',iplas
327 ! write(17,*) 'nr =',nr
328 ! write(17,*) 'nt =',nt
329 ! write(17,*) '---------------------------'
330 ! write(17,*) 'COMMON /com_pt/ parameters:'
331 ! write(17,*) ' '
332 ! write(17,*) 'Mag. axis coordinates:'
333 ! write(17,*) 'rm =',rm
334 ! write(17,*) 'zm =',zm
335 ! write(17,*) ' '
336 ! write(17,*) 'psiax =',psiax
337 ! write(17,*) 'psibon=',psibon
338 ! write(17,*) 'psipla=',psipla
339 ! write(17,*) 'psip =',psip
340 ! write(17,*) 'psim =',psim
341 ! write(17,*) '---------------------------'
342 ! write(17,*) 'COMMON /com_cn/ parameters:'
343 ! write(17,*) ' '
344 ! write(17,*) 'tok =',tok
345 ! write(17,*) 'tokp =',tokp
346 ! write(17,*) 'cnor =',cnor
347 ! write(17,*) 'qcen =',qcen
348 ! write(17,*) 'b0ax =',b0ax
349 ! write(17,*) '*************************************************'
350 ! write(17,*) 'q(i): i=1,iplas =', iplas
351 ! write(17,*) ' '
352 ! write(17,*) (q(i), i=1,iplas)
353 ! write(17,*) '*************************************************'
354 ! write(17,*) 'f(i): i=1,iplas =', iplas
355 ! write(17,*) ' '
356 ! write(17,*) (f(i), i=1,iplas)
357 ! write(17,*) '*************************************************'
358 ! write(17,*) 'dfdpsi(i): i=1,iplas =', iplas
359 ! write(17,*) ' '
360 ! write(17,*) (dfdpsi(i), i=1,iplas)
361 ! write(17,*) '*************************************************'
362 ! write(17,*) 'dpdpsi(i): i=1,iplas =', iplas
363 ! write(17,*) ' '
364 ! write(17,*) (dpdpsi(i), i=1,iplas)
365 ! write(17,*) '*************************************************'
366 
367 c do 10 i=1,iplas,5
368 
369 c write(17,*) 'r(i,j): j=1,nt; i=',i
370 c write(17,*) (r(i,j),j=1,nt)
371 c write(17,*) 'z(i,j): j=1,nt; i=',i
372 c write(17,*) (z(i,j),j=1,nt)
373 c write(17,*) 'cur(i,j): j=1,nt; i=',i
374 c write(17,*) (cur(i,j),j=1,nt)
375 c write(17,*) 'psi(i,j): j=1,nt; i=',i
376 c write(17,*) (psi(i,j),j=1,nt)
377 
378 c 10 continue
379 
380  RETURN
381  END
382 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
383  SUBROUTINE wrdump(numwr,time,istep,psiplb,psiexb,psimag,flu_tor)
384 c
385  include 'double.inc'
386  include 'dim.inc'
387  include 'compol.inc'
388 c
389  dimension psiplb(*),psiexb(*),psimag(*),flu_tor(*)
390  character*40 str,dummy
391 
392  write(fname,'(a,a)') path(1:kname),'nmwr.wr'
393  open(1,file=fname,form='formatted')
394  !open(1,file='nmwr.wr',form='formatted')
395  write(1,*) numwr
396  close(1)
397 
398  if(numwr.lt.10) then
399  write(str,'(a,a,i1,a)') path(1:kname),'writ',numwr,'.wr'
400  else
401  if(numwr.lt.100) then
402  write(str,'(a,a,i2,a)') path(1:kname),'writ',numwr,'.wr'
403  else
404  write(str,'(a,a,i3,a)') path(1:kname),'writ',numwr,'.wr'
405  endif
406  endif
407 
408  open(1,file=str,form='formatted')
409  write(1,*) nr,nt,nr1,nt1,nr2,nt2,iplas,istep
410  write(1,*) ((r(i,j),i=1,iplas),j=1,nt)
411  write(1,*) ((z(i,j),i=1,iplas),j=1,nt)
412  write(1,*) ((cur(i,j),i=1,iplas),j=1,nt)
413  write(1,*) ((psi(i,j),i=1,iplas),j=1,nt)
414  write(1,*) (q(i),i=1,iplas)
415  write(1,*) (f(i),i=1,iplas)
416  write(1,*) (dfdpsi(i),i=1,iplas)
417  write(1,*) (psia(i),i=1,iplas)
418  write(1,*) (dpdpsi(i),i=1,iplas)
419  write(1,*) (psiplb(i),i=1,istep)
420  write(1,*) (psiexb(i),i=1,istep)
421  write(1,*) (psimag(i),i=1,istep)
422  write(1,*) (psimag(i),i=1,istep)
423  write(1,*) (flu_tor(i),i=1,istep)
424  close(1)
425 
426  write(fname,'(a,a)') path(1:kname),'wlist.wr'
427  open(1,file=fname,form='formatted')
428  !open(1,file='wlist.wr',form='formatted')
429  if(numwr.eq.1) then
430  write(1,*) str
431  else
432  do i=1,numwr-1
433  read(1,*) dummy
434  enddo
435  write(1,*) str
436  endif
437  close(1)
438 
439 c---------------------------------------------------------------
440  RETURN
441  END
442 
443 
444 c***************************************************************
445 !********************************************************************
446 
447  subroutine tab_efit( tokf, psax, eqdfn, rax,zax, b0,r0 )
448 
449  use ppf_modul
450  use bnd_modul
451 
452  include 'double.inc'
453  parameter(np=1000,nbp=np*4)
454 
455  real*8 ps(np),p(np),f(np),q(np)
456  character*10 case(6)
457 
458  dimension psirz(np,np),
459  * rbbbs(nbp),zbbbs(nbp)
460 
461  common/com_eqd/ fpol(np),pres(np),qpsi(np),
462  * ffprim(np),pprime(np),
463  * rlimtr(np),zlimtr(np),case,simag,sibry,
464  * idum,nw,nh,limitr
465 
466 ! dimension psirz(np,np),fpol(np),pres(np),ffprim(np),
467 ! * pprime(np),qpsi(np),rbbbs(nbp),zbbbs(nbp),
468 ! * rlim(np),zlim(np)
469 
470  common/efites/ fcefit,rcentr,iefit
471  common/comefi/ x(np),y(np),u(np,np)
472  common /c_kpr/ kpr
473  character*40 eqdfn
474 
475 
476 c--------------------------------------------------------------------
477  iefit=1
478  pi=3.1415926535898d0
479  amu0=0.4d0*pi
480 
481  write(*,*) '************************* '
482  write(*,*) ' Entry of subr."tab_efit":'
483  write(*,*) '------------------------- '
484 
485  write(fname,'(a,a40)') path(1:kname),eqdfn
486  open(1,file=fname,form='formatted')
487  !open(1,file=eqdfn)
488 
489  read(1,2000) (case(i),i=1,6),idum,nw,nh
490  write(*,*) idum,nw,nh
491 
492  read(1,2020) rdim,zdim,rcentr,rleft,zmid
493  read(1,2020) rmaxis,zmzxis,simag,sibry,bcentr
494  read(1,2020) current,simag,xdum,rmaxis,xdum
495  read(1,2020) zmaxis,xdum,sibry,xdum,xdum
496  read(1,2020) (fpol(i),i=1,nw)
497  read(1,2020) (pres(i),i=1,nw)
498  read(1,2020) (ffprim(i),i=1,nw)
499  read(1,2020) (pprime(i),i=1,nw)
500  read(1,2020) ((psirz(i,j),i=1,nw),j=1,nh)
501  read(1,2020) (qpsi(i),i=1,nw)
502  read(1,2022) nbbbs,limitr
503  read(1,2020) (rbbbs(i),zbbbs(i),i=1,nbbbs)
504  read(1,2020) (rlimtr(i),zlimtr(i),i=1,limitr)
505 
506  close(1)
507 
508  p_intgr=0.0d0
509 
510  do i=1,nw
511  p_intgr=p_intgr+pprime(i)
512  enddo
513 
514  if(p_intgr.lt.0.d0) then
515  i_sign=-1
516  else
517  i_sign= 1
518  endif
519 
520  simag=simag*i_sign
521  sibry=sibry*i_sign
522  bcentr=dabs(bcentr)
523  current=dabs(current)
524  do i=1,nw
525  fpol(i)=fpol(i)*i_sign
526  ffprim(i)=ffprim(i)*i_sign
527  pprime(i)=pprime(i)*i_sign
528  do j=1,nh
529  psirz(i,j)=psirz(i,j)*i_sign
530  enddo
531  enddo
532 
533  rax = rmaxis
534  zax = zmaxis
535 
536  !b0 = -bcentr*10.d0/4.d0/pi
537  b0 = bcentr
538  r0 = rcentr
539  f0c = b0*rcentr
540 
541 ! write(*,*) 'efit:b0,fvac,rcentr',b0,f0c,rcentr
542  !fvefit=-fpol(nw)*10.d0/4.d0/pi
543  fvefit=fpol(nw)
544 ! write(*,*) 'efit:fvefit',fvefit
545 
546  2000 format(6a8,3i4)
547  2020 format(5e16.9)
548  2022 format(2i5)
549 
550 c------------------------------------------------
551 
552  if(allocated(pstab))
553  % deallocate( pstab, pptab, fptab )
554  allocate( pstab(nw), pptab(nw), fptab(nw) )
555 
556  nutab=nw
557 ! write(fname,'(a,a)') path(1:kname),'tabppf.dat'
558 ! open(1,file=fname,form='formatted')
559 ! !open(1,file='tabppf.dat')
560 
561 ! write(1,*) nw
562  do i=1,nw
563  pstab(i)= dfloat(i-1)/dfloat(nw-1)
564  pptab(i)= pprime(i)*amu0*1.d-6
565  fptab(i)= ffprim(i)
566 
567 ! !write(1,*) ps(i),-pprime(i)*1.d-6,-ffprim(i)*10.d0/(4.d0*pi)
568 ! write(1,*) ps(i),pprime(i)*amu0*1.d-6,ffprim(i)
569  enddo
570 
571 ! close(1)
572  !deallocate( pstab, pptab, fptab )
573 
574 
575 c------------------------------------------------
576 ! write(fname,'(a,a)') path(1:kname),'tab_q.dat'
577 ! open(1,file=fname,form='formatted')
578 ! !open(1,file='tab_q.dat')
579 !
580 ! write(1,*) nw
581 ! do i=1,nw
582 ! write(1,*) ps(i),qpsi(i)
583 ! enddo
584 !
585 ! close(1)
586 c------------------------------------------------
587  if(allocated(rbtab))
588  % deallocate( rbtab, zbtab )
589  allocate( rbtab(nbbbs), zbtab(nbbbs) )
590 
591 ! write(fname,'(a,a)') path(1:kname),'tab_bnd.dat'
592 ! open(1,file=fname,form='formatted')
593 ! !open(1,file='tab_bnd.dat')
594 
595 ! write(1,*) nbbbs
596 ! write(6,*) 'nbbbs',nbbbs
597 
598  j=0
599  do i=nbbbs,1,-1
600  j=j+1
601  !write(1,*) rbbbs(i),zbbbs(i)
602  rbtab(j)=rbbbs(i)
603  zbtab(j)=zbbbs(i)
604  enddo
605 
606  close(1)
607 
608  !deallocate( rbtab, zbtab )
609 c------------------------------------------------
610 
611 ! write(*,*) 'rmaxis, zmaxis == ', rmaxis, zmaxis
612 ! write(*,*) 'current = ', current
613 ! write(*,*) 'simag, sibry == ', simag, sibry
614 
615 ! write(*,*) '------ '
616 ! write(*,*) 'Files: '
617 ! write(*,*) ' "tabppf.dat", "tab_q.dat", "tab_bnd.dat" '
618 ! write(*,*) 'have been created'
619 ! write(*,*) '-----------------'
620  !stop
621 c------------------------------------------------
622 !
623 ! write(fname,'(a,a)') path(1:kname),'fpol.wr'
624 ! open(1,file=fname,form='formatted')
625 ! !open(1,file='fpol.wr')
626 ! write(1,*) (fpol(i),i=1,nw)
627 ! close(1)
628 c------------------------------------------------
629 
630  !fcefit = -fpol(nw)*10.d0/4.d0/pi
631  fcefit = fpol(nw)
632  tokf = current*1.d-6
633  !psax = (sibry-simag)*10.d0/4.d0/pi
634  psax = -(sibry-simag)
635 
636 ! write(* ,*) '------------------------- '
637 ! write(* ,*) ' Exit of subr."tab_efit".'
638 ! write(* ,*) '************************* '
639 ! write(17,*) '------------------------- '
640 ! write(17,*) ' Exit of subr."tab_efit".'
641 ! write(17,*) '************************* '
642 
643  return
644  end
645 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
646  SUBROUTINE wr_spik
647 
648  include 'double.inc'
649  include 'dim.inc'
650  include 'compol.inc'
651 
652  common
653  * /c_kpr/kpr
654 
655  if(kpr.lt.0) return
656 
657  write(fname,'(a,a)') path(1:kname),'spik.wr'
658  open(1,file=fname,form='formatted')
659  !open(1,file='spik.wr',FORM='UNFORMATTED',STATUS='UNKNOWN')
660  nm=iplas*nt1
661  write(1,*) iplas,nt1,nm,psim,psibon,1
662  !write(1) iplas,nt1,nm,psim,psibon,1
663  !write(1,*) 'psn'
664  write(1,*)(dsqrt(1.d0-psia(i)),i=1,iplas),
665  * (dpdpsi(i),i=1,iplas),
666  * (dfdpsi(i),i=1,iplas),
667  * (r(1,j),j=1,nt1),
668  * (z(1,j),j=1,nt1),
669  * (r(iplas,j),j=1,nt1),
670  * (z(iplas,j),j=1,nt1),
671  * ((ro(i,j)/ro(iplas,j),j=1,nt1),i=1,iplas),
672  * (q(i)/2.d0/pi,i=1,iplas),fvac
673  close(1)
674 
675 
676  RETURN
677  END
678 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
679 
680 
681 
682 
683 
684 
out_b
subroutine out_b
Definition: B_wrd.f:315
wrb0
subroutine wrb0
Definition: B_wrd.f:200
analytical_functions::date
REAL(R8) function date(X, T)
Definition: analytical_functions.f90:177
tab_efit
subroutine tab_efit(tokf, psax, eqdfn, rax, zax, b0, r0)
Definition: B_wrd.f:447
helena21_mod::dpdpsi
real(r8) function dpdpsi(psi_n)
Definition: helena21_mod.f90:122
bnd_modul
Definition: bnd_modul.f90:1
wrb
subroutine wrb
Definition: B_wrd.f:1
current
subroutine current(GEOMETRY, PROFILES, TRANSPORT, SOURCES, EVOLUTION, CONTROL, j_boun, ifail, failstring)
CURRENT TRANSPORT EQUATION.
Definition: main_plasma.f90:205
wr_spik
subroutine wr_spik
Definition: B_wrd.f:646
phys_functions::p
real(r8) function p(a, x, xr, xs, yr, ys, psi, psir, F_dia)
Definition: phys_functions.f90:383
rd_step
subroutine rd_step(numwr, dt, time, istep, psex_bnd, psi0_bnd)
Definition: B_wrd.f:145
wrdump
subroutine wrdump(numwr, time, istep, psiplb, psiexb, psimag, flu_tor)
Definition: B_wrd.f:383