ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
Curap.f
Go to the documentation of this file.
1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 c
4 c vv(i) - vertical(z) SIZE of thin plate
5 c hh(i) - horisontal(r) SIZE of thin plate
6 c
7  SUBROUTINE trefw( NOUT, NTER, NINFW, NP,
8  * kd, rp1, zp1, rp2, zp2, resseg, curseg,
9  * nd, ntyd,
10  * rd, zd, vv, hh, resd, curd,
11  * r1, z1, r2, z2 )
12 c
13  include 'double.inc'
14 c
15  INTEGER kd(*), ntyd(*)
16  dimension rp1(*), zp1(*), rp2(*), zp2(*), resseg(*), curseg(*)
17 c
18  dimension rd(*), zd(*), vv(*), hh(*), resd(*), curd(*),
19  * r1(*), z1(*), r2(*), z2(*)
20 c
21  sqrt(x) = dsqrt(x)
22 c
23 c***************************************************************
24 c
25  write(fname,'(a,a)') path(1:kname),'blanfw.dat'
26  open(ninfw,file=fname,form='formatted')
27  !OPEN( NINFW, FILE='blanfw.dat')
28  READ(ninfw,*) rcefw
29  READ(ninfw,*) np
30  !WRITE(NOUT,*) ' '
31  !WRITE(NOUT,*) '***********************************'
32  !WRITE(NOUT,*) 'READING FROM FILE "BlanFW.DAT" ===>'
33  !WRITE(NOUT,*) ' '
34  !WRITE(NOUT,*) 'One-turn wall resistance (micro*Om) =',RCEFW
35  !WRITE(NOUT,*) 'Number of "basic wall segments" =',NP
36 c
37  nd = 0
38 c-----------------------------------------------------------------------
39  IF( np.NE.0 ) THEN
40 c
41  DO 33 l=1,np
42  33 READ(ninfw,*) kd(l), rp1(l), zp1(l), rp2(l), zp2(l), resseg(l),
43  * curseg(l)
44 c
45  DO 1 l=1,np
46  i = nd + 1
47  delr = (rp2(l) - rp1(l)) / kd(l)
48  delz = (zp2(l) - zp1(l)) / kd(l)
49  rd(i) = rp1(l) + 0.5d0*delr
50  zd(i) = zp1(l) + 0.5d0*delz
51  vv(i) = delz
52  hh(i) = delr
53  ddi = sqrt( hh(i)**2 + vv(i)**2 )
54  r1(i) = rp1(l)
55  z1(i) = zp1(l)
56  r2(i) = rp1(l) + delr
57  z2(i) = zp1(l) + delz
58 c
59  sssfw = ddi/rd(i)
60  IF( kd(l) .GT. 1 ) THEN
61  DO 2 k=1,kd(l)-1
62  rd(i+k) = rd(i+k-1) + delr
63  zd(i+k) = zd(i+k-1) + delz
64  vv(i+k) = vv(i)
65  hh(i+k) = hh(i)
66  r1(i+k) = r1(i+k-1) + delr
67  z1(i+k) = z1(i+k-1) + delz
68  r2(i+k) = r2(i+k-1) + delr
69  z2(i+k) = z2(i+k-1) + delz
70  sssfw = sssfw + ddi/rd(i+k)
71  2 CONTINUE
72  END IF
73 c
74  sssfw = sssfw * resseg(l)
75 c
76  DO 7 k=1,kd(l)
77  resd(i+k-1) = sssfw * rd(i+k-1)/ddi
78  ntyd(i+k-1) = 1
79  curd(i+k-1) = curseg(l) / kd(l)
80  7 CONTINUE
81 c
82  nd = nd + kd(l)
83  1 CONTINUE
84 c-----------------------------------------------------------------------
85 
86  fr_cam=0.d0
87  do i=1,np
88  fr_cam=fr_cam+1.d0/resseg(i)
89  enddo
90  fr_cam=1.d0/fr_cam
91 
92 
93 
94 
95  IF( rcefw.GT.0 ) THEN
96  sssfw = 0.0d0
97  DO 333 l=1,nd
98  333 sssfw = sssfw + sqrt( hh(l)**2 + vv(l)**2 )/rd(l)
99  sssfw = sssfw * rcefw
100  DO 77 l=1,nd
101  77 resd(l) = sssfw * rd(l) / sqrt( hh(l)**2 + vv(l)**2 )
102  END IF
103 c-----------------------------------------------------------------------
104 c--- computing of the one-turn resistance of blanfw.dat(in micro*om)
105 c
106  resce = 0.d0
107  DO 8 i=1,nd
108  8 resce = resce + 1.d0 / resd(i)
109  resce = 1.d0 / resce
110  !WRITE(NOUT,*) ' '
111  !WRITE(NOUT,*) 'Control one-turn wall resistance (micro*Om)'
112  !WRITE(NOUT,*) ' RESCE = ', RESCE
113 c-----------------------------------------------------------------------
114 c
115  !WRITE(NOUT,*) ' '
116  !WRITE(NOUT,*) 'RFW(L), ZFW(L), DFW(L), RESFW(L), CURFW(L)'
117  !WRITE(NOUT,*) 'L = 1,..,ND =', ND
118 c
119  DO 22 l=1,nd
120  dd = sqrt( hh(l)**2 + vv(l)**2 )
121  !WRITE(NOUT,122) RD(L), ZD(L), DD, RESD(L), CURD(L)
122  22 continue
123  122 FORMAT(2x,5e15.7)
124 c
125  !WRITE(NOUT,*) ' '
126  !WRITE(NOUT,*) 'R1(L), Z1(L), R2(L), Z2(L), RESFW(L)'
127  !WRITE(NOUT,*) 'L = 1,..,ND =', ND
128 c
129  DO 34 l=1,nd
130  !WRITE(NOUT,722) R1(L), Z1(L), R2(L), Z2(L), RESD(L)
131  34 continue
132  722 FORMAT(2x,5e15.7)
133  !WRITE(NOUT,*) ' '
134 c
135  END IF !!! ( for IF(NP.NE.0) )
136 c
137  CLOSE (ninfw)
138 c
139  RETURN
140  END
141 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
142 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
143 c
144 c dd(i) - vertical(z) SIZE of "FILAMENT" cross-section
145 c hh(i) - horisontal(r) SIZE of "FILAMENT" cross-section
146 c
147  SUBROUTINE fw_tcv( NOUT, NTER, NINFW, NP,
148  * kd, rp1, zp1, rp2, zp2, resseg, curseg,
149  * nd, ntyd,
150  * rd, zd, dd, hh, resd, curd,
151  * r1, z1, r2, z2 )
152 c
153  include 'double.inc'
154 c
155  INTEGER kd(1), ntyd(1)
156  dimension rp1(1), zp1(1), rp2(1), zp2(1), resseg(1), curseg(1)
157 c
158  dimension rd(1), zd(1), dd(1), hh(1), resd(1), curd(1),
159  * r1(1), z1(1), r2(1), z2(1)
160 c
161 c working arrays
162  dimension rs(200), zs(200)
163 c**********************************************************************
164 c
165  pi = 3.14159265358d0
166  pi2 = pi*2.d0
167 c
168 c**********************************************************************
169 c
170  write(fname,'(a,a)') path(1:kname),'fw_curr.dat'
171  open(ninfw,file=fname,form='formatted')
172  !OPEN(NINFW, FILE='fw_curr.dat')
173 c
174  READ(ninfw,*) np
175 c
176  !WRITE(NOUT,*) ' '
177  !WRITE(NOUT,*) '***********************************'
178  !WRITE(NOUT,*) 'READING FROM FILE "FW_curr.dat" ===>'
179  !WRITE(NOUT,*) ' '
180  !WRITE(NOUT,*) 'Number of "basic wall segments" =', NP
181 c
182  IF( np.NE.0 ) THEN
183  READ(ninfw,*) (curseg(i),i=1,np)
184 c----------------------------------------------
185 c transform from [a] to [ma]
186 c
187  DO 4433 i=1,np
188  curseg(i) = curseg(i) * 1.0d-06
189  4433 CONTINUE
190 c----------------------------------------------
191  END IF
192 c
193  CLOSE(ninfw)
194 c**********************************************************************
195  write(fname,'(a,a)') path(1:kname),'fw_geom.dat'
196  open(1,file=fname,form='formatted')
197  !OPEN(NINFW, FILE='fw_geom.dat')
198 c
199  READ(1,*) rty_fw
200  READ(1,*) np
201 c
202  !WRITE(NOUT,*) ' '
203  !WRITE(NOUT,*) '***********************************'
204  !WRITE(NOUT,*) 'READING FROM FILE "FW_geom.dat" ===>'
205  !WRITE(NOUT,*) ' '
206  !WRITE(NOUT,*) 'Wall resistivity (micro*Om*m) =', RTY_FW
207  !WRITE(NOUT,*) 'Number of "basic wall segments" =', NP
208 c
209  nd = 0
210 c-----------------------------------------------------------------------
211  IF( np.NE.0 ) THEN
212 c
213  DO 33 l=1,np
214  READ(1,*) kd(l), rp1(l), zp1(l), rp2(l), zp2(l)
215  33 CONTINUE
216 c
217 c resseg(l), curseg(l)
218 c-----------------------------
219  DO 7733 i=1,np
220 c
221  CALL divpar( rp1(i), zp1(i), rp2(i), zp2(i), 0.d0, 90.d0,
222  * curseg(i), kd(i),
223  * ndivre, ndivw, ndivh, rs, zs, ps, verc, horc )
224 c
225  DO 3 j=1,ndivre
226  l = nd + j
227  rd(l) = rs(j)
228  zd(l) = zs(j)
229  curd(l) = curseg(i)/ndivre
230  hh(l) = horc
231  dd(l) = verc
232  ntyd(l) = 2
233  r1(l) = 0.d0
234  z1(l) = 0.d0
235  r2(l) = 0.d0
236  z2(l) = 0.d0
237  3 CONTINUE
238 c
239  nd = nd + ndivre
240 
241  7733 CONTINUE
242 c***********************************************************************
243 c-----------------------------------------------------------------------
244 c--- computing of the one-turn resistance(in micro*om)
245 c resd(i) - for fw_vessel segments - i=1,...,nd
246 c resce - for fw_vessel
247 c
248  resce = 0.d0
249  DO 8 i=1,nd
250  resd(i) = rty_fw * pi2*rd(i) / ( hh(i)*dd(i) )
251  resce = resce + 1.d0 / resd(i)
252  8 CONTINUE
253  resce = 1.d0 / resce
254 c
255  !WRITE(NOUT,*) ' '
256  !WRITE(NOUT,*) 'Control one-turn wall resistance (micro*Om)'
257  !WRITE(NOUT,*) ' RESCE = ', RESCE
258 c-----------------------------------------------------------------------
259 c
260  !WRITE(NOUT,*) ' '
261  !WRITE(NOUT,*) 'RFW(L), ZFW(L), DFW(L), HFW(L)'
262  !WRITE(NOUT,*) 'L = 1,..,ND =', ND
263 c
264 c DO l=1,nd
265 c WRITE(nout,122) rd(l), zd(l), dd(l), hh(l)
266 c END DO
267  122 FORMAT(2x,4e15.7)
268 c
269  !WRITE(NOUT,*) ' '
270  !WRITE(NOUT,*) 'RESFW(L),L = 1,..,ND =', ND
271  !WRITE(NOUT,*) ' '
272  !WRITE(NOUT,722) (RESD(L),l=1,ND)
273  !WRITE(NOUT,*) ' '
274  !WRITE(NOUT,*) 'CURFW(L),L = 1,..,ND =', ND
275  !WRITE(NOUT,*) ' '
276  !WRITE(NOUT,722) (CURD(L),l=1,ND)
277  !WRITE(NOUT,*) ' '
278 c
279  722 FORMAT(2x,6e15.7)
280 c
281  END IF !!! ( for IF(NP.NE.0) )
282 c
283  CLOSE (1)
284 c
285  RETURN
286  END
287 c
288 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
289 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
290 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
291 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
292 c
293 c vv(i) - vertical(z) SIZE of thin plate
294 c hh(i) - horisontal(r) SIZE of thin plate
295 c
296 c
297  SUBROUTINE trebp( NOUT, NTER, NINFW, NP,
298  * kd, rp1, zp1, rp2, zp2, resseg, curseg,
299  * nd, ntyd,
300  * rd, zd, vv, hh, resd, curd,
301  * r1, z1, r2, z2 )
302 c
303  include 'double.inc'
304 c
305  INTEGER kd(1), ntyd(1)
306  dimension rp1(1), zp1(1), rp2(1), zp2(1), resseg(1), curseg(1)
307 c
308  dimension rd(1), zd(1), vv(1), hh(1), resd(1), curd(1),
309  * r1(1), z1(1), r2(1), z2(1)
310 c
311  sqrt(x) = dsqrt(x)
312 c
313 c***************************************************************
314 c
315  write(fname,'(a,a)') path(1:kname),'blanbp.dat'
316  open(ninfw,file=fname,form='formatted')
317  !OPEN(NINFW, FILE='blanbp.dat')
318  READ(ninfw,*) rcebp
319  READ(ninfw,*) np
320  !WRITE(NOUT,*) ' '
321  !WRITE(NOUT,*) '***********************************'
322  !WRITE(NOUT,*) 'READING FROM FILE "BlanBP.DAT" ===>'
323  !WRITE(NOUT,*) ' '
324  !WRITE(NOUT,*) 'One-turn wall resistance (micro*Om) =',RCEBP
325  !WRITE(NOUT,*) 'Number of "basic wall segments" =',NP
326  nd = 0
327 c-----------------------------------------------------------------------
328  IF( np.NE.0 ) THEN
329 c
330  DO 33 l=1,np
331  33 READ(ninfw,*) kd(l), rp1(l), zp1(l), rp2(l), zp2(l), resseg(l),
332  * curseg(l)
333 c
334  DO 1 l=1,np
335  i = nd + 1
336  delr = (rp2(l) - rp1(l)) / kd(l)
337  delz = (zp2(l) - zp1(l)) / kd(l)
338  rd(i) = rp1(l) + 0.5d0*delr
339  zd(i) = zp1(l) + 0.5d0*delz
340  vv(i) = delz
341  hh(i) = delr
342  ddi = sqrt( delr**2 + delz**2 )
343  r1(i) = rp1(l)
344  z1(i) = zp1(l)
345  r2(i) = rp1(l) + delr
346  z2(i) = zp1(l) + delz
347 c
348  sssfw = ddi/rd(i)
349  IF( kd(l) .GT. 1 ) THEN
350  DO 2 k=1,kd(l)-1
351  rd(i+k) = rd(i+k-1) + delr
352  zd(i+k) = zd(i+k-1) + delz
353  vv(i+k) = delz
354  hh(i+k) = delr
355  r1(i+k) = r1(i+k-1) + delr
356  z1(i+k) = z1(i+k-1) + delz
357  r2(i+k) = r2(i+k-1) + delr
358  z2(i+k) = z2(i+k-1) + delz
359  sssfw = sssfw + ddi/rd(i+k)
360  2 CONTINUE
361  END IF
362 c
363  sssfw = sssfw * resseg(l)
364 c
365  DO 7 k=1,kd(l)
366  resd(i+k-1) = sssfw * rd(i+k-1)/ddi
367  ntyd(i+k-1) = 1
368  curd(i+k-1) = curseg(l) / kd(l)
369  7 CONTINUE
370 c
371  nd = nd + kd(l)
372  1 CONTINUE
373 c-----------------------------------------------------------------------
374 c
375  IF( rcebp.GT.0 ) THEN
376  sssfw = 0.0d0
377  DO 333 l=1,nd
378  333 sssfw = sssfw + sqrt( hh(l)**2 + vv(l)**2 )/rd(l)
379  sssfw = sssfw * rcebp
380  DO 77 l=1,nd
381  77 resd(l) = sssfw * rd(l) / sqrt( hh(l)**2 + vv(l)**2 )
382  END IF
383 c-----------------------------------------------------------------------
384 c--- computing of the one-turn resistance of blanbp.dat(in micro*om)
385 c
386  resce = 0.d0
387  DO 8 i=1,nd
388  8 resce = resce + 1.d0 / resd(i)
389  resce = 1.d0 / resce
390  !WRITE(NOUT,*) ' '
391  !WRITE(NOUT,*) 'Control one-turn wall resistance (micro*Om)'
392  !WRITE(NOUT,*) ' RESCE = ', RESCE
393 c-----------------------------------------------------------------------
394 c
395  !WRITE(NOUT,*) ' '
396  !WRITE(NOUT,*) 'RBP(L), ZBP(L), DBP(L), RESBP(L), CURBP(L)'
397  !WRITE(NOUT,*) 'L = 1,..,ND =', ND
398 c
399  DO 22 l=1,nd
400  dd = sqrt( hh(l)**2 + vv(l)**2 )
401  !WRITE(NOUT,*) RD(L), ZD(L), DD, RESD(L), CURD(L)
402  22 continue
403 c
404  !WRITE(NOUT,*) ' '
405  !WRITE(NOUT,*) 'R1(L), Z1(L), R2(L), Z2(L), RESBP(L), CURBP(L)'
406  !WRITE(NOUT,*) 'L = 1,..,ND =', ND
407 c
408  DO 34 l=1,nd
409  !WRITE(NOUT,*) R1(L), Z1(L), R2(L), Z2(L), RESD(L), CURD(L)
410  34 continue
411  !WRITE(NOUT,*) ' '
412 c
413  END IF !!! ( for IF(NP.NE.0) )
414 c
415  CLOSE (ninfw)
416 c
417  RETURN
418  END
419 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
420 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
421 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
422 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
423 c
424 c vv(i) - vertical(z) SIZE of thin plate
425 c hh(i) - horisontal(r) SIZE of thin plate
426 c
427 c
428  SUBROUTINE trevv( NOUT, NTER, NINFW, NP,
429  * kd, rp1, zp1, rp2, zp2, resseg, curseg,
430  * nd, ntyd,
431  * rd, zd, vv, hh, resd, curd,
432  * r1, z1, r2, z2 )
433 c
434  include 'double.inc'
435 c
436  INTEGER kd(*), ntyd(*)
437  dimension rp1(*), zp1(*), rp2(*), zp2(*), resseg(*), curseg(*)
438 c
439  dimension rd(*), zd(*), vv(*), hh(*), resd(*), curd(*),
440  * r1(*), z1(*), r2(*), z2(*)
441 c
442  sqrt(x) = dsqrt(x)
443 c
444 c***************************************************************
445 c
446  write(fname,'(a,a)') path(1:kname),'vacves.dat'
447  open(ninfw,file=fname,form='formatted')
448  !OPEN(NINFW, FILE='vacves.dat')
449  READ(ninfw,*) rcevv
450  READ(ninfw,*) np
451  !WRITE(NOUT,*) ' '
452  !WRITE(NOUT,*) '***********************************'
453  !WRITE(NOUT,*) 'READING FROM FILE "VacVes.DAT" ===>'
454  !WRITE(NOUT,*) ' '
455  !WRITE(NOUT,*) 'One-turn wall resistance (micro*Om) =',RCEVV
456  !WRITE(NOUT,*) 'Number of "basic wall segments" =',NP
457 c
458  nd = 0
459 c-----------------------------------------------------------------------
460  IF( np.NE.0 ) THEN
461 c
462  DO 33 l=1,np
463  33 READ(ninfw,*) kd(l), rp1(l), zp1(l), rp2(l), zp2(l), resseg(l),
464  * curseg(l)
465 c
466  DO 1 l=1,np
467  i = nd + 1
468  delr = (rp2(l) - rp1(l)) / kd(l)
469  delz = (zp2(l) - zp1(l)) / kd(l)
470  rd(i) = rp1(l) + 0.5d0*delr
471  zd(i) = zp1(l) + 0.5d0*delz
472  vv(i) = delz
473  hh(i) = delr
474  ddi = sqrt( delr**2 + delz**2 )
475  r1(i) = rp1(l)
476  z1(i) = zp1(l)
477  r2(i) = rp1(l) + delr
478  z2(i) = zp1(l) + delz
479 c
480  sssfw = ddi/rd(i)
481  IF( kd(l) .GT. 1 ) THEN
482  DO 2 k=1,kd(l)-1
483  rd(i+k) = rd(i+k-1) + delr
484  zd(i+k) = zd(i+k-1) + delz
485  vv(i+k) = delz
486  hh(i+k) = delr
487  r1(i+k) = r1(i+k-1) + delr
488  z1(i+k) = z1(i+k-1) + delz
489  r2(i+k) = r2(i+k-1) + delr
490  z2(i+k) = z2(i+k-1) + delz
491  sssfw = sssfw + ddi/rd(i+k)
492  2 CONTINUE
493  END IF
494 c
495  sssfw = sssfw * resseg(l)
496 c
497  DO 7 k=1,kd(l)
498  resd(i+k-1) = sssfw * rd(i+k-1)/ddi
499  ntyd(i+k-1) = 1
500  curd(i+k-1) = curseg(l) / kd(l)
501  7 CONTINUE
502 c
503  nd = nd + kd(l)
504  1 CONTINUE
505 c-----------------------------------------------------------------------
506 c
507  IF( rcevv.GT.0 ) THEN
508  sssfw = 0.0d0
509  DO 333 l=1,nd
510  333 sssfw = sssfw + sqrt( hh(l)**2 + vv(l)**2 )/rd(l)
511  sssfw = sssfw * rcevv
512  DO 77 l=1,nd
513  77 resd(l) = sssfw * rd(l) / sqrt( hh(l)**2 + vv(l)**2 )
514  END IF
515 c-----------------------------------------------------------------------
516 c--- computing of the one-turn resistance of vacves.dat(in micro*om)
517 c
518  resce = 0.d0
519  DO 8 i=1,nd
520  8 resce = resce + 1.d0 / resd(i)
521  resce = 1.d0 / resce
522  !WRITE(NOUT,*) ' '
523  !WRITE(NOUT,*) 'Control one-turn wall resistance (micro*Om)'
524  !WRITE(NOUT,*) ' RESCE = ', RESCE
525 c-----------------------------------------------------------------------
526 c
527  !WRITE(NOUT,*) ' '
528  !WRITE(NOUT,*) 'RVV(L), ZVV(L), DVV(L), RESVV(L), CURVV(L)'
529  !WRITE(NOUT,*) 'L = 1,..,ND =', ND
530 c
531  DO 22 l=1,nd
532  dd = sqrt( hh(l)**2 + vv(l)**2 )
533  !WRITE(NOUT,*) RD(L), ZD(L), DD, RESD(L), CURD(L)
534  22 continue
535 c
536  !WRITE(NOUT,*) ' '
537  !WRITE(NOUT,*) 'R1(L), Z1(L), R2(L), Z2(L), RESVV(L), CURVV(L)'
538  !WRITE(NOUT,*) 'L = 1,..,ND =', ND
539 c
540  DO 34 l=1,nd
541  !WRITE(NOUT,*) R1(L), Z1(L), R2(L), Z2(L), RESD(L), CURD(L)
542  34 continue
543  !WRITE(NOUT,*) ' '
544 c
545  END IF !!! ( for IF(NP.NE.0) )
546 c
547  CLOSE (ninfw)
548 c
549  RETURN
550  END
551 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
552 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
553  SUBROUTINE segcur( NOUT, NTER, NSTART, NSEG, KD, BBB, PJK, RES,
554  * curseg, resseg )
555 c
556  include 'double.inc'
557 c
558  INTEGER kd(*)
559  dimension pjk(*), res(*)
560  dimension curseg(*), resseg(*)
561 c
562  l = nstart
563  DO 1 i=1,nseg
564  IF(i.GT.1) l=l+kd(i-1)
565  crtseg = 0.d0
566  rstseg = 0.d0
567  DO 2 j=1,kd(i)
568  crtseg = crtseg + pjk(l+j)
569  rstseg = rstseg + bbb/res(l+j)
570  2 CONTINUE
571  curseg(i) = crtseg
572  resseg(i) = 1.d0 / rstseg
573  1 CONTINUE
574 c
575  !WRITE(NOUT,*) ' '
576  !WRITE(NOUT,*) 'FW SEGMENT EDDY CURRENTS (mega*Am) = CFWSEG(I):'
577  !WRITE(NOUT,*) 'I=1,...,NSEGFW = ', NSEG
578 c WRITE(nout,101) ( curseg(i), i=1,nseg )
579  !!WRITE(NOUT,*) 'FW SEGMENT RESISTANCES (micro*Om) = RFWSEG(I):'
580  !WRITE(NOUT,*) 'I=1,...,NSEGFW = ', NSEG
581 c WRITE(nout,101) ( resseg(i), i=1,nseg )
582  !WRITE(NOUT,*) ' '
583 c
584  101 FORMAT(2x,5e14.7)
585 c
586  RETURN
587  END
588 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
589 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
590 
591 
592 
593 
trevv
subroutine trevv(NOUT, NTER, NINFW, NP,
Definition: Curap.f:428
trefw
subroutine trefw(NOUT, NTER, NINFW, NP,
Definition: Curap.f:7
trebp
subroutine trebp(NOUT, NTER, NINFW, NP,
Definition: Curap.f:297
fw_tcv
subroutine fw_tcv(NOUT, NTER, NINFW, NP,
Definition: Curap.f:147
phys_functions::r2
real(r8) function r2(a, x, xr, xs, yr, ys, psi, psir, F_dia)
Definition: phys_functions.f90:121
divpar
subroutine divpar(RC, ZC, WC, HC, AWC, AHC, CURC, NDIV, NDIVRE, NDIVW, NDIVH, RS, ZS, PS, VERS, HORS)
Definition: Trecur_2.f:311
segcur
subroutine segcur(NOUT, NTER, NSTART, NSEG, KD, BBB, PJK, RES,
Definition: Curap.f:553