ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
_wrd.f
Go to the documentation of this file.
1  SUBROUTINE wrd_tim
2 
3  include 'double.inc'
4  include 'comtim.inc'
5  common /nostep/ kstep
6 
7  write(fname,'(a,a)') path(1:kname),'eq_tim.wr'
8  open(1,file=fname)
9  !open(1,file='eq_tim.wr')
10 
11  kwr=kstep
12 
13  write(1,*) kwr
14  write(1,*) (time_t(i),i=1,kwr)
15  write(1,*) (torcur(i),i=1,kwr)
16  write(1,*) (rm_t(i),i=1,kwr)
17  write(1,*) (zm_t(i),i=1,kwr)
18  write(1,*) (rxp_t(i),i=1,kwr)
19  write(1,*) (zxp_t(i),i=1,kwr)
20  write(1,*) (betpol_t(i),i=1,kwr)
21  write(1,*) (bettor_t(i),i=1,kwr)
22  write(1,*) (psim_t(i),i=1,kwr)
23  write(1,*) (psib_t(i),i=1,kwr)
24 
25  close(1)
26  !write(*,*) 'wrd_tim:writing is done','time=',time_t(kwr)
27 
28  return
29  end
30 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
31  SUBROUTINE eq_dump
32 
33  include 'double.inc'
34  include 'parevo.inc'
35  parameter(nkp=njlim)
36  include 'dim.inc'
37  include 'compol.inc'
38  include 'compol_add.inc'
39 
40  write(fname,'(a,a)') path(1:kname),'eq_dump.wr'
41  open(1,file=fname)
42  !open(1,file='eq_dump.wr')
43 
44  write(1,*) nr,nt,nr1,nt1,nr2,nt2,iplas,iplas1
45  write(1,*) rm,zm,psim,psip,rx0,zx0,rx1,zx1,rx2,zx2
46  write(1,*) psiax,psibon,ixp1,jxp1,ixp2,jxp2,fvac,fpv
47  write(1,*) alp,alpnew,tok,tokp,cnor,qcen,pscen,psipla
48  write(1,*) rl,zl,clr,clz,rolim,jrolim,iterbf
49 
50  write(1,*) ((r(i,j),i=1,nr),j=1,nt)
51  write(1,*) ((z(i,j),i=1,nr),j=1,nt)
52  write(1,*) ((ro(i,j),i=1,nr),j=1,nt)
53  write(1,*) ((cur(i,j),i=1,nr),j=1,nt)
54  write(1,*) ((psi(i,j),i=1,nr),j=1,nt)
55  write(1,*) ((ronor(i,j),i=1,nr),j=1,nt)
56  write(1,*) ((psie(i,j),i=1,nr),j=1,nt)
57  write(1,*) (teta(j),j=1,nt)
58  write(1,*) (q(i),i=1,iplas)
59  write(1,*) (f(i),i=1,iplas)
60  write(1,*) (dpdpsi(i),i=1,iplas)
61  write(1,*) (dfdpsi(i),i=1,iplas)
62  write(1,*) (psia(i),i=1,iplas)
63  write(1,*) (dpsda(i),i=1,iplas)
64 
65  close(1)
66  return
67  end
68 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
69  SUBROUTINE eq_dump_rd
70 
71  include 'double.inc'
72  include 'parevo.inc'
73  parameter(nkp=njlim)
74  include 'dim.inc'
75  include 'compol.inc'
76  include 'compol_add.inc'
77 
78  write(fname,'(a,a)') path(1:kname),'eq_dump.wr'
79  open(1,file=fname)
80  !open(1,file='eq_dump.wr')
81 
82  read(1,*) nr,nt,nr1,nt1,nr2,nt2,iplas,iplas1
83  read(1,*) rm,zm,psim,psip,rx0,zx0,rx1,zx1,rx2,zx2
84  read(1,*) psiax,psibon,ixp1,jxp1,ixp2,jxp2,fvac,fpv
85  read(1,*) alp,alpnew,tok,tokp,cnor,qcen,pscen,psipla
86  read(1,*) rl,zl,clr,clz,rolim,jrolim,iterbf
87 
88  read(1,*) ((r(i,j),i=1,nr),j=1,nt)
89  read(1,*) ((z(i,j),i=1,nr),j=1,nt)
90  read(1,*) ((ro(i,j),i=1,nr),j=1,nt)
91  read(1,*) ((cur(i,j),i=1,nr),j=1,nt)
92  read(1,*) ((psi(i,j),i=1,nr),j=1,nt)
93  read(1,*) ((ronor(i,j),i=1,nr),j=1,nt)
94  read(1,*) ((psie(i,j),i=1,nr),j=1,nt)
95  read(1,*) (teta(j),j=1,nt)
96  read(1,*) (q(i),i=1,iplas)
97  read(1,*) (f(i),i=1,iplas)
98  read(1,*) (dpdpsi(i),i=1,iplas)
99  read(1,*) (dfdpsi(i),i=1,iplas)
100  read(1,*) (psia(i),i=1,iplas)
101  read(1,*) (dpsda(i),i=1,iplas)
102 
103  close(1)
104  return
105  end
106 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
107  SUBROUTINE f_wrd
108 
109  include 'double.inc'
110  include 'parevo.inc'
111  parameter(nkp=njlim)
112  include 'dim.inc'
113  include 'compol.inc'
114  include 'compol_add.inc'
115 
116  common/compsf/ psf(nrp),sqtor(nrp)
117  common /com_jb/ bj_av(nrp),curfi_av(nrp)
118  common/com_but/ sigma(nrp),cbut_b(nrp)
119 
120  write(fname,'(a,a)') path(1:kname),'outp.wr'
121  open(1,file=fname)
122  !open(1,file='outp.wr')
123 
124  write(1,*) nr,nt,nr1,nt1,nr2,nt2,iplas
125 
126  write(1,*) ((r(i,j),i=1,nr),j=1,nt)
127  write(1,*) ((z(i,j),i=1,nr),j=1,nt)
128  write(1,*) ((g(i,j),i=1,nr),j=1,nt)
129  write(1,*) ((cur(i,j),i=1,nr),j=1,nt)
130  write(1,*) ((psi(i,j),i=1,nr),j=1,nt)
131  write(1,*) ((psii(i,j),i=1,nr),j=1,nt)
132  write(1,*) ((psie(i,j),i=1,nr),j=1,nt)
133  write(1,*) ((aex(i,j),i=1,nr),j=1,nt)
134  write(1,*) (q(i),i=1,iplas)
135  write(1,*) (f(i),i=1,iplas)
136  write(1,*) rm,zm,rx0,zx0,ctim,kstep
137  close(1)
138 
139  write(fname,'(a,a)') path(1:kname),'ddp.wr'
140  open(1,file=fname)
141  !open(1,file='ddp.wr')
142  write(1,*) iplas
143  write(1,*) (q(i),i=1,iplas)
144  write(1,*) (f(i),i=1,iplas)
145  write(1,*) (dfdpsi(i),i=1,iplas)
146  write(1,*) (psia(i),i=1,iplas)
147  write(1,*) (psf(i),i=1,iplas)
148  write(1,*) (dpdpsi(i),i=1,iplas)
149  write(1,*) (curfi_av(i),i=1,iplas)
150  write(1,*) (sigma(i),i=1,iplas)
151  write(1,*) (cbut_b(i),i=1,iplas)
152  write(1,*) ctim,kstep
153  close(1)
154 
155  write(fname,'(a,a)') path(1:kname),'dps.wr'
156  open(1,file=fname)
157  !open(1,file='dps.wr')
158  do i=1,iplas
159  ddps=psi(i,2)-psf(i)
160  write(1,*) ddps,i
161  enddo
162  close(1)
163 
164  !write(*,*) 'wrd:writting is done'
165 
166  RETURN
167  END
168 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
169  SUBROUTINE rdfb
170 
171  include 'double.inc'
172  include 'parevo.inc'
173  parameter(nkp=njlim)
174  include 'dim.inc'
175  include 'compol.inc'
176  include 'compol_add.inc'
177 
178  write(fname,'(a,a)') path(1:kname),'outfb.wr'
179  open(1,file=fname)
180  !open(1,file='outfb.wr')
181  !read(1,*) nr,nt,nr1,nt1,nr2,nt2,iplas
182  read(1,*) idum,nt,idum,nt1,idum,nt2,iplas
183  read(1,*) ((r(i,j),i=1,iplas),j=1,nt)
184  read(1,*) ((z(i,j),i=1,iplas),j=1,nt)
185  read(1,*) ((ro(i,j),i=1,iplas),j=1,nt)
186  read(1,*) ((ronor(i,j),i=1,iplas),j=1,nt)
187  read(1,*) (teta(j),j=1,nt)
188  read(1,*) ((cur(i,j),i=1,iplas),j=1,nt)
189  read(1,*) ((psin(i,j),i=1,iplas),j=1,nt)
190  read(1,*) (q(i),i=1,iplas)
191  read(1,*) (f(i),i=1,iplas)
192  read(1,*) (dfdpsi(i),i=1,iplas)
193  read(1,*) (dpdpsi(i),i=1,iplas)
194  read(1,*) (psia(i),i=1,iplas)
195  close(1)
196 
197 ! open(1,file='tab_bnd.dat')
198 ! write(1,*) nt2
199 ! do j=2,nt1
200 ! write(1,*) r(iplas,j),z(iplas,j)
201 ! enddo
202 ! close(1)
203 
204  RETURN
205  END
206 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
207 
208  SUBROUTINE out(rbnd,zbnd,zli3,betpol,bettot,parpla)
209 
210  include 'double.inc'
211  include 'parevo.inc'
212  parameter(nkp=njlim)
213  include 'dim.inc'
214  include 'compol.inc'
215  include 'compol_add.inc'
216 
217  dimension rbnd(*),zbnd(*),press(nrp)
218  dimension bro(nrp,ntp),btet(nrp,ntp)
219  dimension parpla(*)
220 
221  common /volpla/ vol_pl
222 
223 
224  write(fname,'(a,a)') path(1:kname),'out.pr'
225  open(1,file=fname)
226  !open(1,file='out.pr',form='formatted')
227 
228  do 100 j=1,nt
229 
230  rbnd(j)=r(iplas,j)
231  zbnd(j)=z(iplas,j)
232 
233  100 continue
234 
235  rmx=rm
236  rmn=rm
237 
238  zmx=zm
239  zmn=zm
240 
241  do 110 j=2,nt1
242 
243  if(rmx.lt.rbnd(j)) then
244 
245  rmx = rbnd(j)
246  z_rmx = zbnd(j)
247 
248  endif
249 
250  if(rmn.gt.rbnd(j)) then
251 
252  rmn = rbnd(j)
253  z_rmn = zbnd(j)
254 
255  endif
256 
257  if(zmx.lt.zbnd(j)) then
258 
259  zmx = zbnd(j)
260  r_zmx = rbnd(j)
261 
262  endif
263 
264  if(zmn.gt.zbnd(j)) then
265 
266  zmn = zbnd(j)
267  r_zmn = rbnd(j)
268 
269  endif
270 
271  110 continue
272 
273  a_cen=0.5d0*(rmx-rmn)
274  r_cen=0.5d0*(rmx+rmn)
275 
276  aspect=r_cen/a_cen
277 
278  write(1,*) ' right plasma bound:'
279  write(1,*) ' Rmax=',rmx,' z(rmax)=',z_rmx
280 
281  write(1,*) ' left plasma bound:'
282  write(1,*) ' Rmin=',rmn,' z(rmin)=',z_rmn
283 
284  write(1,*) ' upper plasma bound:'
285  write(1,*) ' Zmax=',zmx,' r(zmax)=',r_zmx
286 
287  write(1,*) ' lower plasma bound:'
288  write(1,*) ' Zmin=',zmn,' r(zmin)=',r_zmn
289 
290  write(1,*) ' minor plasma radius:'
291  write(1,*) 'a=',a_cen
292  write(1,*) ' major plasma radius:'
293  write(1,*) 'Rc=',r_cen
294 
295 c write(6,*) 'a',a_cen
296 c write(6,*) 'Rc',r_cen
297 
298  elong=(zmx-zmn)/(rmx-rmn)
299 
300  write(1,*) 'plasma elongation:'
301  write(1,*) 'el',elong
302 c write(6,*) 'el',elong
303 
304  triang=(r_cen-r_zmx)/a_cen
305 
306  write(1,*) 'plasma triangularity'
307  write(1,*) 'tr',triang
308 c write(6,*) 'tr',triang
309 
310 ccc--- pressure determination
311 
312  press(iplas)=0.d0
313 
314  press(iplas1)=dpdpsi(iplas)*(psi(iplas1,2)-psi(iplas,2))*0.5d0
315 
316  do i=iplas-2,1,-1
317 
318  press(i)=press(i+1)+dpdpsi(i+1)*(psi(i,2)-psi(i+2,2))*0.5d0
319 
320  enddo
321 
322 cccc---magnetic field determination
323 
324  do i=2,nr
325  do j=1,nt1
326 
327  bro(i,j)=(psi(i,j+1)-psi(i,j))/sr(i,j)
328 
329  enddo
330  enddo
331 
332  do i=1,nr1
333  do j=1,nt
334 
335  btet(i,j)=(psi(i,j)-psi(i+1,j))/st(i,j)
336 
337  enddo
338  enddo
339 
340  pint_s=0.d0
341  pint_v=0.d0
342  bint_v=0.d0
343  vol_pl=0.d0
344 
345  do i=1,iplas1
346  do j=2,nt1
347 
348  pint_s=pint_s+press(i)*s(i,j)
349  pint_v=pint_v+press(i)*vol(i,j)
350  vol_pl=vol_pl+vol(i,j)
351 
352  if(i.ne.1) then
353 
354  bp2_1=( bro(i,j)**2+btet(i,j)**2+
355  + 2.d0*bro(i,j)*btet(i,j)*cos1(i,j) )/sin1(i,j)
356 
357  bp2_2=( bro(i+1,j)**2+btet(i,j)**2+
358  + 2.d0*bro(i+1,j)*btet(i,j)*cos2(i,j) )/sin2(i,j)
359 
360  bp2_3=( bro(i+1,j)**2+btet(i,j+1)**2+
361  + 2.d0*bro(i+1,j)*btet(i,j+1)*cos3(i,j) )/sin3(i,j)
362 
363  bp2_4=( bro(i,j)**2+btet(i,j+1)**2+
364  + 2.d0*bro(i,j)*btet(i,j+1)*cos4(i,j) )/sin4(i,j)
365 
366  bp2_v=bp2_1*vol1(i,j)+bp2_2*vol2(i,j)+
367  + bp2_3*vol3(i,j)+bp2_4*vol4(i,j)
368 
369  else
370 
371  bp2_2=( bro(i+1,j)**2+btet(i,j)**2+
372  + 2.d0*bro(i+1,j)*btet(i,j)*cos2(i,j) )/sin2(i,j)
373 
374  bp2_3=( bro(i+1,j)**2+btet(i,j+1)**2+
375  + 2.d0*bro(i+1,j)*btet(i,j+1)*cos3(i,j) )/sin3(i,j)
376 
377  bp2_v= bp2_3*vol3(i,j)+bp2_2*vol2(i,j)
378 
379  endif
380 
381  bint_v=bint_v+bp2_v*2.d0*pi
382 
383  enddo
384  enddo
385 
386  paver=pint_v/vol_pl
387 
388  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
389  ! !
390  betpol=8.d0*pi*pint_s/tokp**2 !
391  !
392  zli3=2.d0*bint_v/(r_cen*tokp**2)!
393  !
394  bfvac=fvac/r_cen !
395  !
396  bettot=2.0d0*paver/bfvac**2 !
397  ! !
398  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
399 c write(6,*) 'BETpol',betpol
400 c write(6,*) 'BETtot',bettot
401 c write(6,*) 'Li3 ',zli3
402 c write(6,*) 'Fvac ',fvac
403 c write(6,*) 'BFvac_cen ',bfvac
404 c write(6,*) 'Paver ',paver
405 c write(6,*) 'cnor ',cnor
406 c write(6,*) 'Vol_pl',vol_pl
407 
408  write(1,*) nr,nt,nr1,nt1,nr2,nt2
409  write(1,*) 'alp=',alp
410  write(1,*) 'rxp=',rx0,'zxp=',zx0
411  write(1,*) 'rm =',rm,'zm =',zm
412  write(1,*) 'BETpol',betpol
413  write(1,*) 'BETtot',bettot
414  write(1,*) 'Li3 ',zli3
415 
416  parpla(1)=rmx
417  parpla(2)=z_rmx
418  parpla(3)=rmn
419  parpla(4)=z_rmn
420 
421  parpla(5)=zmx
422  parpla(6)=r_zmx
423  parpla(7)=zmn
424  parpla(8)=r_zmn
425 
426  parpla(9)=a_cen
427  parpla(10)=r_cen
428  parpla(11)=aspect
429  parpla(12)=elong
430  parpla(13)=triang
431  parpla(14)=alp
432 
433  do 10 i=1,nr
434 
435  write(1,*) 'teta'
436  write(1,*) (teta(j),j=1,nt)
437 
438  write(1,*) 'i=',i
439  write(1,*) 'r'
440  write(1,*) (r(i,j),j=1,nt)
441 
442  write(1,*) 'z'
443  write(1,*) (z(i,j),j=1,nt)
444 
445  write(1,*) 'g'
446  write(1,*) (g(i,j),j=1,nt)
447 
448  write(1,*) 'cur'
449  write(1,*) (cur(i,j),j=1,nt)
450 
451  write(1,*) 'psi'
452  write(1,*) (psi(i,j),j=1,nt)
453 
454  write(1,*) 'psii'
455  write(1,*) (psii(i,j),j=1,nt)
456 
457  write(1,*) 'psie'
458  write(1,*) (psie(i,j),j=1,nt)
459 
460  10 continue
461 
462  close(1)
463 
464  RETURN
465  END
466 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
467  SUBROUTINE out_test
468 
469  include 'double.inc'
470  include 'parevo.inc'
471  parameter(nkp=njlim)
472  include 'dim.inc'
473  include 'compol.inc'
474  include 'compol_add.inc'
475 
476  write(fname,'(a,a)') path(1:kname),'out_test.pr'
477  open(1,file=fname)
478  !open(1,file='out_test.pr',form='formatted')
479 
480  write(1,*) 'teta'
481  write(1,*) (teta(j),j=1,nt)
482 
483  write(1,*) 'r'
484  do i=1,nr
485  write(1,*) 'i=',i
486  write(1,*) (r(i,j),j=1,nt)
487  enddo
488 
489  write(1,*) 'z'
490  do i=1,nr
491  write(1,*) 'i=',i
492  write(1,*) (z(i,j),j=1,nt)
493  enddo
494 
495  write(1,*) 'g'
496  do i=1,nr
497  write(1,*) 'i=',i
498  write(1,*) (g(i,j),j=1,nt)
499  enddo
500 
501  write(1,*) 'cur'
502  do i=1,nr
503  write(1,*) 'i=',i
504  write(1,*) (cur(i,j),j=1,nt)
505  enddo
506 
507  write(1,*) 'psi'
508  do i=1,nr
509  write(1,*) 'i=',i
510  write(1,*) (psi(i,j),j=1,nt)
511  enddo
512 
513  write(1,*) 'psii'
514  do i=1,nr
515  write(1,*) 'i=',i
516  write(1,*) (psii(i,j),j=1,nt)
517  enddo
518 
519  write(1,*) 'psie'
520  do i=1,nr
521  write(1,*) 'i=',i
522  write(1,*) (psie(i,j),j=1,nt)
523  enddo
524 
525  close(1)
526 
527  RETURN
528  END
529 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
530 
531  SUBROUTINE f_rdd
532 
533  include'double.inc'
534  include 'parevo.inc'
535  parameter(nkp=njlim)
536  include'dim.inc'
537  include'compol.inc'
538  include 'compol_add.inc'
539 
540  write(fname,'(a,a)') path(1:kname),'out.wr'
541  open(1,file=fname)
542  !open(1,file='out.wr',status='old',form='formatted')
543 
544  read(1,*) ni,nj,ni1,nj1,ni2,nj2,nxb
545 
546  read(1,*) ((r(i,j),i=1,nr),j=1,nt)
547  read(1,*) ((z(i,j),i=1,nr),j=1,nt)
548  read(1,*) ((g(i,j),i=1,nr),j=1,nt)
549  read(1,*) ((cur(i,j),i=1,nr),j=1,nt)
550 
551  close(1)
552 
553  RETURN
554  END
555 
556 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
557 
558  SUBROUTINE rdrec
559 
560  include 'double.inc'
561  include 'parrc1.inc'
562  include 'comrec.inc'
563 
564 
565  write(fname,'(a,a)') path(1:kname),'rect.wr'
566  open(1,file=fname)
567  !open(1,file='rect.wr',status='old',form='formatted')
568 
569  read(1,*) ni,nj,ni1,nj1,ni2,nj2,imax,jmax
570 
571  read(1,*) (x(i),i=1,ni)
572  read(1,*) (y(j),j=1,nj)
573  read(1,*) ((u(i,j),i=1,ni),j=1,nj)
574  read(1,*) ((ue(i,j),i=1,ni),j=1,nj)
575  read(1,*) ((un(i,j),i=1,ni),j=1,nj)
576  read(1,*) ((ipr(i,j),i=1,ni),j=1,nj)
577  read(1,*) xm,ym,um,xx0,yx0,ux0,up,qcen,b0ax,r0ax
578  read(1,*) xx1,yx1,xx2,yx2
579  read(1,*) xmax,ymax,xmin,ymin
580 
581  close(1)
582 
583  RETURN
584  END
585 
586 
587  SUBROUTINE wr_step(numwr,time,istep)
588 c
589  include 'double.inc'
590  include 'parevo.inc'
591  parameter(nkp=njlim)
592  include 'dim.inc'
593  include 'compol.inc'
594  include 'compol_add.inc'
595 c
596  !dimension psiplb(*),psiexb(*)
597  character*40 str,dummy
598 
599  write(fname,'(a,a)') path(1:kname),'nmwr.wr'
600  open(1,file=fname)
601  !open(1,file='nmwr.wr',form='formatted')
602  write(1,*) numwr
603  close(1)
604 
605  if(numwr.lt.10) then
606  write(str,'(a,a,i1,a)') path(1:kname),'step',numwr,'.wr'
607  elseif(numwr.lt.100) then
608  write(str,'(a,a,i2,a)') path(1:kname),'step',numwr,'.wr'
609  elseif(numwr.lt.1000) then
610  write(str,'(a,a,i3,a)') path(1:kname),'step',numwr,'.wr'
611  else
612  write(str,'(a,a,i4,a)') path(1:kname),'step',numwr,'.wr'
613  endif
614 
615  open(1,file=str,form='formatted')
616  write(1,*) nr,nt,iplas,istep,dtim,ctim
617  write(1,*) ((r(i,j),i=1,iplas),j=1,nt)
618  write(1,*) ((z(i,j),i=1,iplas),j=1,nt)
619  write(1,*) ((ro(i,j),i=1,iplas),j=1,nt)
620  write(1,*) (teta(j),j=1,nt)
621  write(1,*) ((psi(i,j),i=1,iplas),j=1,nt)
622  write(1,*) ((psin(i,j),i=1,iplas),j=1,nt)
623  write(1,*) (psia(i),i=1,iplas)
624  !write(1,*) ((cur(i,j),i=1,iplas),j=1,nt)
625  write(1,*) (q(i),i=1,iplas)
626  write(1,*) (f(i),i=1,iplas)
627  write(1,*) (dfdpsi(i),i=1,iplas)
628  write(1,*) (dpdpsi(i),i=1,iplas)
629  write(1,*) psi_eav,rm,zm,psim-psip,psibon0,tok
630  close(1)
631 
632  write(fname,'(a,a)') path(1:kname),'wlist.wr'
633  open(1,file=fname)
634  !open(1,file='wlist.wr',form='formatted')
635  if(numwr.eq.1) then
636  write(1,*) str
637  else
638  do i=1,numwr-1
639  read(1,*) dummy
640  enddo
641  write(1,*) str
642  endif
643  close(1)
644 
645 c---------------------------------------------------------------
646  RETURN
647  END
648 
649 
650 c***************************************************************
subroutine f_wrd
Definition: _wrd.f:107
subroutine rdrec
Definition: _wrd.f:558
subroutine out(rbnd, zbnd, zli3, betpol, bettot, parpla)
Definition: _wrd.f:208
real(r8) function dpdpsi(psi_n)
subroutine wr_step(numwr, time, istep)
Definition: _wrd.f:587
subroutine rdfb
Definition: _wrd.f:169
subroutine out_test
Definition: _wrd.f:467
subroutine f_rdd
Definition: _wrd.f:531
subroutine wrd_tim
Definition: _wrd.f:1
subroutine eq_dump
Definition: _wrd.f:31
subroutine eq_dump_rd
Definition: _wrd.f:69
real(r8) function pressure(flux)