Screamer Project  V3.3.1
Screamer Structure
 All Files Functions Variables
main_loop.f
Go to the documentation of this file.
1  subroutine main_loop
2 c
3 c-----Description-------------------------------------------------------
4 c
5 c Author/Date: Mathias Bavay 11/04
6 c Modifications:
7 c
8 c ----------------------------------------------------------------------
9 c
10 c Purpose: This subroutines performs the calculations.
11 c
12 c Called by: Program ZDEM
13 c
14 c Include the files with the various keywords and integer flags.
15 c
16  include 'zdemparm.h'
17  include 'zdempprm.h'
18 c
19 c Include the files specifying the array dimensions and the common blocks.
20 c
21  include 'zdemmax.h'
22  include 'zdemcomm.h'
23  include 'zdemwork.h'
24  include 'zdemout.h'
25  include 'zdemenv.h'
26  include 'zdemvars.h'
27  include 'zdemloop.h'
28 
29 c
30 c Include file with version string
31 c
32  include 'version.h'
33 
34 c----Buffer variable for C++ output-----------------------------------------
35  character(len=80)::buffer
36 c---------------------------------------------------------------------------
37 
38 c Print out time step to monitor run progress
39 c
40  iptold=iptime
41  if (tmax .le. 100.0e-6) then
42  iptime=tim*1.0e9
43  if (tmax .gt. 10.0e-6) then
44  jdiv=2000
45  else
46  jdiv=200
47  endif
48  if ((mod(iptime,jdiv).eq.0) .and.
49  & (iptold .ne. iptime)) then
50 c write (6, 212) iptime
51  write (buffer, 212) iptime
52  call writebuffer(buffer)
53  end if
54  212 format (' Time = ',i5,' ns')
55  else if ((tmax.gt.100.0e-6).and.(tmax.le.100.0e-3)) then
56  iptime=tim*1.0e6
57  if (tmax .gt. 10.0e-3) then
58  jdiv=2000
59  else
60  jdiv=200
61  endif
62  if ((mod(iptime,jdiv).eq.0) .and.
63  & (iptold .ne. iptime)) then
64  write (buffer, 220) iptime
65 c write (6, 220) iptime
66  call writebuffer(buffer)
67  end if
68  220 format (' Time = ',i5,' microsec')
69  else
70  iptime=tim*1.0e3
71  if (tmax .gt. 10.0) then
72  jdiv=2000
73  else
74  jdiv=200
75  endif
76  if ((mod(iptime,jdiv).eq.0) .and.
77  & (iptold .ne. iptime)) then
78  write (buffer, 221) iptime
79 c write (6, 221) iptime
80  call writebuffer(buffer)
81  end if
82  221 format (' Time = ',i5,' msec')
83  endif
84 
85 c
86 c
87 c branch connections - load bb,cc matrices
88 c Note that the do 211 loop will not be executed if nb=1 .
89 c
90  nelmt = nbe(nb)
91  do i = 1, nelmt
92  bb(i) = 0.0
93  cc(i) = 0.0
94  end do
95 c nbm = nb - 1 This line removed since nbm already defined!!!!
96  do 211 icb = 1, nbm
97  icbp = icb + 1
98  node_num = indexb(1,icb)
99  iexit_type = indexb(2,icb)
100  icx = (node_num-2)*k + 1 + nbe(icb)
101  icy = (node_num-1)*k + 1 + nbe(icb)
102 c
103 c Fill for top or end branch.
104 c
105  if (iexit_type .eq. topbranch) then
106  zib(node_num-1,1) = -zir(1,icbp)
107  zib(node_num,1) = -zib(node_num-1,1)
108  bb(icx+1) = +0.5
109  bb(icy+1) = -0.5
110  vsour(icb) = v(node_num-1,1) - v(node_num,1)
111  cc(icx) = -1.0
112  cc(icy) = +1.0
113  else
114  zib(node_num,1) = -zir(1,icbp)
115  bb(icy+1) = +0.5
116  vsour(icb) = v(node_num,1)
117  cc(icy) = -1.0
118  end if
119  211 continue
120 c
121 c Reset variable element values.
122 c
123  itab_counter=0
124 c------------------------------------------------------------------------
125 c
126  call get_model
127 c
128 c------------------------------------------------------------------------
129 c
130 c Reset MITL conductances
131 c
132  do imitl = 1, nmitline
133  if (indexmitl(5,imitl) .eq. mitline) then
134  call reset_mitl(imitl)
135  else if (indexmitl(5,imitl) .eq. pmitline) then
136  call reset_pmitl(imitl)
137  end if
138  end do
139 c
140 c -----------------------------------------------------------------------------
141 c
142 c Load the 'a' vector using the voltage and current equations at each node.
143 c
144 c A note about entering zero values: There is a divide by certain 'a' elements
145 c in the matrix solver, hence these elements may not be zero. These elements
146 c are:
147 c For the current equations: First and last nodes in a branch: a(ny+3)
148 c All other nodes in a branch: a(ny+4)
149 c For the voltage equations: First and last nodes in a branch: a(ny+4)
150 c All other nodes in a branch: a(ny+3)
151 c
152  k = 2
153  nrow = 3*k + 1
154 c
155 c Set the total number of elements in a.
156 c Then zero it.
157 c
158  nele = nrow * k * ntot
159  do i = 1, nele
160  a(i) = 0.0
161  end do
162 c
163 c Now enter the appropriate values into a.
164 c
165 c
166 c First, loop over the branches.
167 c
168  do 102 ib = 1, nb
169  nrx = nr(ib)
170  nzz = nrow * k * nadd_array(ib)
171  nrm = nrx - 1
172 c
173 c Loop over the nodes, from node 2 to the next-to-last using the general
174 c voltage and current equations.
175 c
176  do 5 i = 2, nrm
177 c
178 c Current equation, second row. a(ny+4) is the diagonal element
179 c and is never zero.
180 c
181  j = (i-1)*2 + 1
182  ny = nrow*j + nzz
183 c this is the -1 that always preceeds the AVi and the AIi in the row
184  a(ny+2) = -0.5
185 c a(ny+3) loads AVi, in this case it was not scaled by 2X as in the manual
186 c rht is the inverse time step
187  a(ny+3) = rht*c(i,ib) + 0.5*g(i,ib)
188 c this is the +1 that always follows the AVi and the AIi in the row
189  a(ny+4) = +0.5
190 c loads the value for BVi
191  a(ny+7) = (rht*c(i,ib) - 0.5*g(i,ib)) * v(i,ib)
192  & - 0.5 * (zir(i,ib)-zir(i-1,ib)) + 0.5*zib(i,ib)
193 c
194 c Voltage equation, first row. a(ny+3) is the diagonal element and is
195 c never zero.
196 c
197  ny = ny - nrow
198 c this is the -1 that always preceeds the AVi and the AIi in the row
199  a(ny+3) = -0.5
200 c loads AIi, it is not scaled by 2x
201  a(ny+4) = rht*zlr(i,ib) + 0.5*rr(i,ib)
202 c this is the +1 that always follows the AVi and the AIi in the row
203  a(ny+5) = +0.5
204 c loads the value for BIi
205  a(ny+7) = (rht*zlr(i,ib) - 0.5*rr(i,ib)) * zir(i,ib)
206  & + 0.5*(v(i,ib)-v(i+1,ib))
207 c loops to load up all of the nodes except the first and last nodes.
208  5 continue
209 c
210 c Do the first and last nodes of each branch separately because of
211 c boundary conditions and the possibility of sources.
212 c
213  nr2 = 2 * nrx
214 c
215 c First row. Current equation. a(ny+3) is the diagonal element and
216 c should not be zero.
217 c
218  ny = nzz
219 c
220 c If this is the first block, look for voltage and current sources.
221 c iblock sets the block type.
222 c
223  if (ib .eq. 1) then
224  iblock1 = iin(1,1,1)
225 c
226 c Voltage source for block 1 in branch 1 (current equation).
227 c Set the voltage at the new time.
228 c Note: that we are assuming that at most one voltage source block is
229 c present and that it is block 1 of branch 1.
230 c
231  if (iblock1 .eq. voltsource) then
232  call set_voltage(tim, 1, vtime)
233  a(ny+3) = +1.0
234  a(ny+7) = vtime
235 c
236 c Current source for block 1 in branch 1 (current equation).
237 c Note: that we are assuming that at most one current source block is
238 c present and that it is block 1 of branch 1.
239 c Here we set the voltage at node 1 = 0.
240 c
241  else if (iblock1 .eq. currsource) then
242  a(ny+3) = +1.0
243 c
244 c Anything else at the beginning (current equation).
245 c
246  else
247  any3 = 0.5*g(1,1) + rht*c(1,1)
248  if (abs(any3) .lt. 1.0e-6) then
249  a(ny+3) = 1.0e-6
250  else
251  a(ny+3) = any3
252  end if
253  a(ny+4) = +0.5
254  a(ny+7) = (-0.5*g(1,1) + rht*c(1,1))*v(1,1) - 0.5*zir(1,1)
255 c
256  end if
257 c
258 c First node for all but first branch (current equation).
259 c Set the voltage at the first node = 0, the branch connection is
260 c made elsewhere.
261 c
262  else
263  a(ny+3) = +1.0
264 c
265  end if
266 c
267 c Second row (voltage equation) for first node. a(ny+4) is the diagonal
268 c element and may not fall below 1e-6.
269 c Only need to modify the usual equation if we have a current source
270 c (as the first block in branch 1.
271 c
272  ny = nrow + nzz
273 c
274 c Current source, set the current at this time: I1 = I(t).
275 c
276  if ((ib .eq. 1) .and. (iin(1,1,1) .eq. currsource)) then
277  call set_current(tim, 1, ctime)
278  a(ny+4) = +1.0
279  a(ny+7) = ctime
280 c
281 c Every other block type.
282 c
283  else
284  a(ny+3) = -0.5
285  any4 = rht*zlr(1,ib) + 0.5*rr(1,ib)
286  if (abs(any4) .lt. 1.0e-6) then
287  a(ny+4) = 1.0e-6
288  else
289  a(ny+4) = any4
290  end if
291  a(ny+5) = +0.5
292  a(ny+7) = (rht*zlr(1,ib) - 0.5*rr(1,ib)) * zir(1,ib)
293  & + 0.5*(v(1,ib)-v(2,ib))
294 c
295  end if
296 c
297 c First row for last node. Current equation. a(ny+3) may not fall below
298 c 1e-6. Check for voltage or current source at end or normal termination.
299 c
300  ny = (nr2-2)*nrow + nzz
301 c
302 c Check the end of branch index which indicates a source or no source.
303 c If it is greater then zero, it is the index for the source.
304 c
305  if_vendsource = ivbranch_end(ib)
306  if_cendsource = icbranch_end(ib)
307 c
308 c Voltage source
309 c
310  if (if_vendsource .gt. 0) then
311  call set_voltage(tim, if_vendsource, vtime)
312  a(ny+3) = +1.0
313  a(ny+7) = vtime
314 c
315 c Normal termination, any other block including a current source (cendsource).
316 c
317  else
318  a(ny+2) = -0.5
319  any3 = rht*c(nrx,ib) + 0.5*g(nrx,ib)
320  if (abs(any3) .lt. 1.0e-6) then
321  a(ny+3) = 1.0e-6
322  else
323  a(ny+3) = any3
324  end if
325  a(ny+4) = +0.5
326  a(ny+7) = (rht*c(nrx,ib) - 0.5*g(nrx,ib)) * v(nrx,ib)
327  & - 0.5*(zir(nrx,ib)-zir(nrx-1,ib))
328  end if
329 c
330 c Second row for last node, voltage equation. a(ny+4) can not be zero.
331 c Set the current flowing in or out of the branch.
332 c
333  ny = (nr2-1)*nrow + nzz
334 c
335 c Current source and SCL current source.
336 c
337  if (if_cendsource .gt. 0) then
338  itypcs = itypcend(if_cendsource)
339  if (itypcs .eq. cendsource) then
340  call set_current(tim, if_cendsource, ctime)
341  a(ny+4) = +1.0
342  a(ny+7) = ctime
343  else if (itypcs .eq. csclsource) then
344  vcond = v(nrx,ib)
345  call set_sclcurr(tim, vcond, if_cendsource, ctime)
346  a(ny+4) = +1.0
347  a(ny+7) = ctime
348  end if
349 c
350 c Termination without a current source, set for no current in the branch.
351 c
352  else
353  a(ny+4) = 1.0
354  end if
355 
356 c
357  102 continue
358 c
359 c
360 c invert the matrix to find the new voltages and currents.
361 c
362  k = 2
363  n = ntot
364  nk = n*k
365  nm1 = n-1
366  m = 3*k+1
367  km = k*m
368  kmm = k-m
369  k2p1 = k*2+1
370  mp1 = m+1
371  nkm = n*k*m
372  nkp1 = nk+1
373  k2p2 = k2p1+1
374  mm1 = m-1
375  km1 = k-1
376 c
377  do 51 i51 = 1, n
378  ia = (i51-1)*km+kmm
379  iib = ia+k2p1
380  i1km = i51*km
381 c
382  l1 = 1
383  do l = 1, nbm
384  if (i51 .gt. nbv(l)) l1=l1+1
385  end do
386  l2 = (i51-1)*k
387 c
388  do 52 i52 = 1, k
389  ia = ia+mp1
390  iib = iib+m
391  ic = ia
392  id = iib
393  ie = i52+1
394  l6 = l2+i52
395  l8 = k+k-i52
396  l13 = (i51-1)*nrow*k+i52*nrow
397  raia = 1.0/a(ia)
398  do i53 = ia, iib
399  a(i53) = a(i53)*raia
400  end do
401 c
402 c divide bb along row with pivotal diag element
403 c
404  if ((nb .gt. 1) .and. (i51 .le. nbv(nbm))) then
405  do l3 = l1, nbm
406  ip = nbe(l3)+l6
407  bb(ip) = raia*bb(ip)
408  end do
409  end if
410 c
411 c do 54 will not be executed if ie > k (FORTRAN 77)
412 c
413  do 54 i54 = ie, k
414  ic = ic+m
415  id = id+m
416  if (a(ic) .ne. 0.0) then
417  aic = a(ic)
418  ik = ia-ic
419  do i55 = ic, id
420  if = i55 + ik
421  a(i55) = a(i55)-a(if)*aic
422  end do
423 c
424 c modify bb along row for rest of block
425 c
426  if ((nb .gt. 1) .and. (i51 .le. nbv(nbm))) then
427  do l3 = l1, nbm
428  iq = nbe(l3)+l6
429  ip = iq+i54-1
430  bb(ip) = bb(ip)-bb(iq)*aic
431  end do
432  end if
433 c
434  end if
435  54 continue
436 c
437  if (i51.eq.n) go to 66
438  ig = i1km+i52-m
439  ih = i1km
440  do 56 i56 = 1, k
441  ig = ig+m
442  ih = ih+m
443  ii = ih-k-1
444  if (a(ig) .ne. 0.0) then
445  l7 = k-i52+i56
446  aig = a(ig)
447  il = ia-ig
448  do i58 = ig, ii
449  ij = il+i58
450  a(i58) = a(i58)-a(ij)*aig
451  end do
452  a(ih) = a(ih)-a(iib)*aig
453 c
454 c modify bb along row for next block down
455 c
456  if ((nb .gt. 1) .and. (i51 .le. nbv(nbm))) then
457  do l3 = l1, nbm
458  iq = nbe(l3)+l6
459  ip = iq+l7
460  bb(ip) = bb(ip)-bb(iq)*aig
461  end do
462  end if
463 c
464  end if
465  56 continue
466 c
467 c modify cc matrix here
468 c
469  if ((nb .gt. 1) .and. (i51 .le. nbv(nbm))) then
470  do 309 l3 = l1, nbm
471  iq = nbe(l3)+l6
472  l10 = nbe(l3)+k
473  l11 = nbv(l3)*nrow*k+k+k
474  l12 = nbv(l3)*k+1
475  if (cc(iq) .ne. 0.0) then
476  cmx = cc(iq)
477  ip = iq+l8
478  if (ip.gt.nbe(l3+1)) ip=nbe(l3+1)
479  iax = ia-1
480  do l4 = iq, ip
481  iax = iax+1
482  cc(l4) = cc(l4)-cmx*a(iax)
483  end do
484 c
485 c modify cc element with bb above
486 c
487  l3m = l3-1
488  if (l1 .le. l3m) then
489  do l5 = l1, l3m
490  iq = nbv(l5)*k+l10
491  ip = nbe(l5)+l6
492  cc(iq) = cc(iq)-cmx*bb(ip)
493  end do
494  end if
495 c
496 c modify a element with bb above
497 c
498  ip = nbe(l3)+l6
499  iq = l11
500  a(iq) = a(iq)-cmx*bb(ip)
501 c
502 c modify bb element with bb above
503 c
504  l3p = l3+1
505  if (l3p .le. nbm) then
506  do l5 = l3p, nbm
507  ip = nbe(l5)+l6
508  iq = nbe(l5)+l12
509  bb(iq) = bb(iq)-cmx*bb(ip)
510  end do
511  end if
512 c
513 c modify last a column
514 c
515  ip = l13
516  iq = nbv(l3)*nrow*k+nrow
517  a(iq) = a(iq)-cmx*a(ip)
518  end if
519  309 continue
520  end if
521 c
522 c
523  66 continue
524  52 continue
525  51 continue
526 c
527  jf = nkm
528  jg = jf-k
529  jh = jg-1
530  x(nk) = a(jf)
531 c
532  do j1 = 2, k
533  jg = jg-mp1
534  jh = jh-m
535  jis = nkp1-j1
536  ji = jis
537  jl = jf-m*(j1-1)
538  sum = a(jl)
539  do j2 = jg, jh
540  ji =ji+1
541  sum = sum-a(j2)*x(ji)
542  end do
543  x(jis) = sum
544  end do
545 c
546  do j3 = 1, nm1
547  ja = n-j3
548  l14 = (ja-1)*k+k+1
549  jb = ja*km+k2p2
550  jc = ja*km+mm1
551  jk = ja*k+1
552 c
553  do j4 = 1, k
554  jb = jb-mp1
555  jc = jc-m
556  jd = jc+1
557  sum = a(jd)
558  jes = jk-j4
559  je = jes
560 c
561  do j5 = jb, jc
562  je = je+1
563  sum = sum-a(j5)*x(je)
564  end do
565 c
566  l1 = n-j3
567  if (l1 .le. nbv(nbm)) then
568  l2 = 1
569  do ib = 1, nb
570  if(l1.gt.nbv(ib)) l2=l2+1
571  end do
572 c
573  if (l2 .le. nbm) then
574  do l3 = l2, nbm
575  iq = nbe(l3)+l14-j4
576  ip = (nbv(l3)+1)*k
577  sum = sum-bb(iq)*x(ip)
578  end do
579  end if
580  end if
581 c
582  x(jes) = sum
583  end do
584  end do
585 c
586 c end - invert matrix - soln. matrix x
587 c
588  do ib = 1, nb
589  nzz = nadd_array(ib) * k
590  nrx = nr(ib)
591 c
592  do i = 1, nrx
593  j = (i-1)*2 + 1 + nzz
594  vn(i,ib) = x(j)
595  zirn(i,ib) = x(j+1)
596  end do
597  end do
598 c
599 
600  call energy_checks
601 
602 c
603 c Fill the file-table-ufo-pff-csv-sfc arrays with the
604 c appropriate numbers.
605 c
606  if (numout .gt. 0) then
607  call build_out(tim, timehalf, ht, rht)
608  end if
609 c
610 c If we have reached a printing cycle (icycle = ncycle) then
611 c print out current status at the half time step.
612 c
613  if (icycle .ge. ncycle) then
614  icycle = 0
615  call cycle_print(i2, tim-0.5*ht, esour, eind, ecap, econ,
616  & eres, elossind, elosscap, error)
617  end if
618 c
619 c Now put the new values of V and I into the old V and I arrays for the
620 c next iteration.
621 c
622  do ib = 1, nb
623  nrx = nr(ib)
624  do i = 1, nrx
625  vold(i,ib)=v(i,ib)
626  v(i,ib) = vn(i,ib)
627  zirold(i,ib)=zir(i,ib)
628  zir(i,ib) = zirn(i,ib)
629  end do
630  end do
631 
632  return
633  end
634 
c *****************************************************************************c Common blocks for SCREAMER output and tabling c & numout
Definition: zdemout.h:47
subroutine set_sclcurr(time, volt, index, current)
Definition: setsclcr.f:1
subroutine main_loop
Definition: main_loop.f:1
subroutine set_voltage(time, index, voltage)
Definition: setvoltg.f:1
subroutine build_out(tim, timehalf, timestep, rtimstep)
Definition: bldoutfl.f:1
subroutine cycle_print(icycle, time, esour, eind, ecap, econ, eres, elossind, elosscap, error)
Definition: cyclprnt.f:1
subroutine reset_pmitl(index)
Definition: rstpmitl.f:1
c *****************************************************************************c Various format statements for read_screamer_data output c To get these into made format to be characters c for each line c
Definition: zdemfmt.h:7
subroutine energy_checks
Definition: energy_checks.f:1
subroutine get_model
Definition: models.f:1
subroutine set_current(time, index, current)
Definition: setcurrn.f:1
subroutine reset_mitl(index)
Definition: rstmitl.f:1