38
39
40
42
43
44
45#include "implicit_f.inc"
46
47
48
49#include "com08_c.inc"
50
51
52
53
54
55
56
57
58 INTEGER I_STOK,NSN,INACTI,IFQ,NUM_IMP,IND_IMP(*),
59 . NIN, , ITIED
60 INTEGER CAND_N(*),CAND_E(*),CAND_A(*), IFPEN(*),
61 . CAND_T
62
64 . cand_fx(*),cand_fy(*),cand_fz(*),cand_p(*),cand_tf,
65 . stfns(*),cand_f(8,*)
66
67
68
69 INTEGER I, I_ST0,N,NN,K,NI,
70 . IGET(I_STOK),IPUT(I_STOK)
71
72
73 DO 100 n=1,nsn+3
74 100 cand_a(n) = 0
75
76
77
78
79 IF(num_imp>0)THEN
80 DO i=1,i_stok
81 iput(i)=0
82 END DO
83 DO n=1,num_imp
84 i= ind_imp(n)
85 iput(i)=1
86 END DO
87 IF(ifq>0)THEN
88
89 IF((inacti==5.OR.inacti==6.OR.inacti==7)
90 . .AND.tt==zero)THEN
91 DO i=1,i_stok
92 ifpen(i)=1
93 END DO
94 END IF
95
96 DO i=1,i_stok
97 IF(ifpen(i) == 0.AND.iput(i)==0) THEN
98 cand_n(i) = nsn+1
99 ELSEIF(tt>zero)THEN
100
101
102 ni = cand_n(i)
103 IF(ni>nsnl) THEN
104
105 ni = ni-nsnl
106 IF((
stifi(nin)%P(ni) == 0.0).AND.iput(i)==0)
THEN
107 ifpen(i) = 0
108 cand_n(i) = nsn+1
109 ENDIF
110 ELSE
111
112 IF((stfns(ni) == 0.0).AND.iput(i)==0)THEN
113 ifpen(i) = 0
114 cand_n(i) = nsn+1
115 ENDIF
116 ENDIF
117 ENDIF
118 ENDDO
119 ELSEIF(inacti==5.OR.inacti==6.OR.inacti==7)THEN
120 DO i=1,i_stok
121 IF(cand_p(i)==zero.AND.iput(i)==0)THEN
122 cand_n(i) = nsn+1
123 ENDIF
124 ENDDO
125 ELSE
126 DO i=1,i_stok
127 IF(iput(i) == 0) THEN
128 cand_n(i) = nsn+1
129 ENDIF
130 ENDDO
131 ENDIF
132 ELSEIF(ifq>0)THEN
133
134 IF((inacti==5.OR.inacti==6.OR.inacti==7)
135 . .AND.tt==zero)THEN
136 DO i=1,i_stok
137 ifpen(i)=1
138 END DO
139 END IF
140
141 IF(itied==0)THEN
142 DO i=1,i_stok
143
144 IF(ifpen(i) == 0) THEN
145 cand_n(i) = nsn+1
146 ELSEIF(tt>zero)THEN
147
148
149 ni = cand_n(i)
150 IF(ni>nsnl) THEN
151
152 ni = ni-nsnl
153 IF(
stifi(nin)%P(ni) == zero)
THEN
154 ifpen(i) = 0
155 cand_n(i) = nsn+1
156 ENDIF
157 ELSE
158
159 IF(stfns(ni) == zero)THEN
160 ifpen(i) = 0
161 cand_n(i) = nsn+1
162 ENDIF
163 ENDIF
164 ENDIF
165 ENDDO
166 ELSE
167 DO i=1,i_stok
168
169 IF(ifpen(i) == 0 .AND. cand_f(1,i) == zero) THEN
170 cand_n(i) = nsn+1
171 ELSEIF(tt>zero)THEN
172
173
174 ni = cand_n(i)
175 IF(ni>nsnl) THEN
176
177 ni = ni-nsnl
178 IF(
stifi(nin)%P(ni) == zero)
THEN
179 ifpen(i) = 0
180 cand_f(1,i) = zero
181 cand_n(i) = nsn+1
182 ENDIF
183 ELSE
184
185 IF(stfns(ni) == zero)THEN
186 ifpen(i) = 0
187 cand_f(1,i) = zero
188 cand_n(i) = nsn+1
189 ENDIF
190 ENDIF
191 ENDIF
192 ENDDO
193 END IF
194
195 ELSEIF(inacti==5.OR.inacti==6.OR.inacti==7)THEN
196 IF(itied == 0)THEN
197 DO i=1,i_stok
198 IF(cand_p(i)==zero)THEN
199 cand_n(i) = nsn+1
200 ENDIF
201 ENDDO
202 ELSE
203 DO i=1,i_stok
204 IF(cand_p(i)==zero .AND. cand_f(1,i) == zero)THEN
205 cand_n(i) = nsn+1
206 ELSEIF(tt>zero)THEN
207
208
209 ni = cand_n(i)
210 IF(ni>nsnl) THEN
211
212 ni = ni-nsnl
213 IF(
stifi(nin)%P(ni) == zero)
THEN
214 cand_f(1,i) = zero
215 cand_n(i) = nsn+1
216 ENDIF
217 ELSE
218
219 IF(stfns(ni) == zero)THEN
220 cand_f(1,i) = zero
221 cand_n(i) = nsn+1
222 ENDIF
223 ENDIF
224 ENDIF
225 ENDDO
226 END IF
227 ELSEIF(itied/=0)THEN
228 DO i=1,i_stok
229 IF(cand_fTHEN
230 cand_n(i) = nsn+1
231 ELSEIF(tt>zero)THEN
232
233
234 ni = cand_n(i)
235 IF(ni>nsnl) THEN
236
237 ni = ni-nsnl
238 IF(
stifi(nin)%P(ni) == zero)
THEN
239 cand_f(1,i) = zero
240 cand_n(i) = nsn+1
241 ENDIF
242 ELSE
243
244 IF(stfns(ni) == zero)THEN
245 cand_f(1,i) = zero
246 cand_n(i) = nsn+1
247 ENDIF
248 ENDIF
249 ENDIF
250 ENDDO
251 ELSE
252 DO i=1,i_stok
253
254 cand_n(i) = nsn+1
255 ENDDO
256 ENDIF
257
258
259
260
261 DO 300 i=1,i_stok
262 nn = cand_n(i) + 2
263 cand_a(nn) = cand_a(nn) + 1
264 300 CONTINUE
265
266
267
268
269 cand_a(1) = 1
270 cand_a(2) = 1
271 DO 400 n=3,nsn+2
272 400 cand_a(n) = cand_a(n) + cand_a(n-1)
273
274
275
276
277
278 DO 500 i=1,i_stok
279 nn = cand_n(i) + 1
280 k = cand_a(nn)
281 iput(i) = k
282 iget(k) = i
283 cand_a(nn) = cand_a(nn) + 1
284 500 CONTINUE
285
286
287
288
289
290 DO n=1,num_imp
291 k=ind_imp(n)
292 i = iput(k)
293 ind_imp(n)=i
294 END DO
295
296 IF(ifq>0.AND.(inacti==5.OR.inacti==6.OR.inacti==7).AND.itied/=0)THEN
297 DO k=1,i_stok
298 i = iget(k)
299
300 cand_t = cand_n(k)
301 cand_n(k) = cand_n(i)
302 cand_n(i) = cand_t
303
304 cand_t = cand_e(k)
305 cand_e(k) = cand_e(i)
306 cand_e(i) = cand_t
307
308 cand_tf = cand_f(1,k)
309 cand_f(1,k) = cand_f(1,i)
310 cand_f(1,i) = cand_tf
311
312 cand_tf = cand_f(2,k)
313 cand_f(2,k) = cand_f(2,i)
314 cand_f(2,i) = cand_tf
315
316 cand_tf = cand_f(3,k)
317 cand_f(3,k) = cand_f(3,i)
318 cand_f(3,i) = cand_tf
319
320 cand_tf = cand_f(4,k)
321 cand_f(4,k) = cand_f(4,i)
322 cand_f(4,i) = cand_tf
323
324 cand_tf = cand_f(5,k)
325 cand_f(5,k) = cand_f(5,i)
326 cand_f(5,i) = cand_tf
327
328 cand_tf = cand_f(6,k)
329 cand_f(6,k) = cand_f(6,i)
330 cand_f(6,i) = cand_tf
331
332 cand_tf = cand_f(7,k)
333 cand_f(7,k) = cand_f(7,i)
334 cand_f(7,i) = cand_tf
335
336 cand_tf = cand_f(8,k)
337 cand_f(8,k) = cand_f(8,i)
338 cand_f(8,i) = cand_tf
339
340 cand_tf = cand_fx(k)
341 cand_fx(k) = cand_fx(i)
342 cand_fx(i) = cand_tf
343
344 cand_tf = cand_fy(k)
345 cand_fy(k) = cand_fy(i)
346 cand_fy(i) = cand_tf
347
348 cand_tf = cand_fz(k)
349 cand_fz(k) = cand_fz(i)
350 cand_fz(i) = cand_tf
351
352 cand_tf = cand_p(k)
353 cand_p(k) = cand_p(i)
354 cand_p(i) = cand_tf
355
356 cand_t = ifpen(k)
357 ifpen(k) = ifpen(i)
358 ifpen(i) = cand_t
359
360 iput(i) = iput(k)
361 iget(iput(i)) = i
362 ENDDO
363 ELSEIF(ifq>0.AND.(inacti==5.OR.inacti==6.OR.inacti==7))THEN
364 DO k=1,i_stok
365 i = iget(k)
366
367 cand_t = cand_n(k)
368 cand_n(k) = cand_n(i)
369 cand_n(i) = cand_t
370
371 cand_t = cand_e(k)
372 cand_e(k) = cand_e(i)
373 cand_e(i) = cand_t
374
375 cand_tf = cand_fx(k)
376 cand_fx(k) = cand_fx(i)
377 cand_fx(i) = cand_tf
378
379 cand_tf = cand_fy(k)
380 cand_fy(k) = cand_fy(i)
381 cand_fy(i) = cand_tf
382
383 cand_tf = cand_fz(k)
384 cand_fz(k) = cand_fz(i)
385 cand_fz(i) = cand_tf
386
387 cand_tf = cand_p(k)
388 cand_p(k) = cand_p(i)
389 cand_p(i) = cand_tf
390
391 cand_t = ifpen(k)
392 ifpen(k) = ifpen(i)
393 ifpen(i) = cand_t
394
395 iput(i) = iput(k)
396 iget(iput(i)) = i
397 ENDDO
398 ELSEIF(ifq>0.AND.itied/=0)THEN
399 DO k=1,i_stok
400 i = iget(k)
401
402 cand_t = cand_n(k)
403 cand_n(k) = cand_n(i)
404 cand_n(i) = cand_t
405
406 cand_t = cand_e(k)
407 cand_e(k) = cand_e(i)
408 cand_e(i) = cand_t
409
410 cand_tf = cand_f(1,k)
411 cand_f(1,k) = cand_f(1,i)
412 cand_f(1,i) = cand_tf
413
414 cand_tf = cand_f(2,k)
415 cand_f(2,k) = cand_f(2,i)
416 cand_f(2,i) = cand_tf
417
418 cand_tf = cand_f(3,k)
419 cand_f(3,k) = cand_f(3,i)
420 cand_f(3,i) = cand_tf
421
422 cand_tf = cand_f(4,k)
423 cand_f(4,k) = cand_f(4,i)
424 cand_f(4,i) = cand_tf
425
426 cand_tf = cand_f(5,k)
427 cand_f(5,k) = cand_f(5,i)
428 cand_f(5,i) = cand_tf
429
430 cand_tf = cand_f(6,k)
431 cand_f(6,k) = cand_f(6,i)
432 cand_f(6,i) = cand_tf
433
434 cand_tf = cand_f(7,k)
435 cand_f(7,k) = cand_f(7,i)
436 cand_f(7,i) = cand_tf
437
438 cand_tf = cand_f(8,k)
439 cand_f(8,k) = cand_f(8,i)
440 cand_f(8,i) = cand_tf
441
442 cand_tf = cand_fx(k)
443 cand_fx(k) = cand_fx(i)
444 cand_fx(i) = cand_tf
445
446 cand_tf = cand_fy(k)
447 cand_fy(k) = cand_fy(i)
448 cand_fy(i) = cand_tf
449
450 cand_tf = cand_fz(k)
451 cand_fz(k) = cand_fz(i)
452 cand_fz(i) = cand_tf
453
454 cand_t = ifpen(k)
455 ifpen(k) = ifpen(i)
456 ifpen(i) = cand_t
457
458 iput(i) = iput(k)
459 iget(iput(i)) = i
460 ENDDO
461 ELSEIF(ifq>0)THEN
462 DO k=1,i_stok
463 i = iget(k)
464
465 cand_t = cand_n(k)
466 cand_n(k) = cand_n(i)
467 cand_n(i) = cand_t
468
469 cand_t = cand_e(k)
470 cand_e(k) = cand_e(i)
471 cand_e(i) = cand_t
472
473 cand_tf = cand_fx(k)
474 cand_fx(k) = cand_fx(i)
475 cand_fx(i) = cand_tf
476
477 cand_tf = cand_fy(k)
478 cand_fy(k) = cand_fy(i)
479 cand_fy(i) = cand_tf
480
481 cand_tf = cand_fz(k)
482 cand_fz(k) = cand_fz(i)
483 cand_fz(i) = cand_tf
484 cand_t = ifpen(k)
485 ifpen(k) = ifpen(i)
486 ifpen(i) = cand_t
487
488 iput(i) = iput(k)
489 iget(iput(i)) = i
490 ENDDO
491 ELSEIF((inacti==5.OR.inacti==6.OR.inacti==7).AND.itied/=0)THEN
492 DO k=1,i_stok
493 i = iget(k)
494
495 cand_t = cand_n(k)
496 cand_n(k) = cand_n(i)
497 cand_n(i) = cand_t
498
499 cand_t = cand_e(k)
500 cand_e(k) = cand_e(i)
501 cand_e(i) = cand_t
502
503 cand_tf = cand_f(1,k)
504 cand_f(1,k) = cand_f(1,i)
505 cand_f(1,i) = cand_tf
506
507 cand_tf = cand_f(2,k)
508 cand_f(2,k) = cand_f(2,i)
509 cand_f(2,i) = cand_tf
510
511 cand_tf = cand_f(3,k)
512 cand_f(3,k) = cand_f(3,i)
513 cand_f(3,i) = cand_tf
514
515 cand_tf = cand_f(4,k)
516 cand_f(4,k) = cand_f(4,i)
517 cand_f(4,i) = cand_tf
518
519 cand_tf = cand_f(5,k)
520 cand_f(5,k) = cand_f(5,i)
521 cand_f(5,i) = cand_tf
522
523 cand_tf = cand_f(6,k)
524 cand_f(6,k) = cand_f(6,i)
525 cand_f(6,i) = cand_tf
526
527 cand_tf = cand_f(7,k)
528 cand_f(7,k) = cand_f(7,i)
529 cand_f(7,i) = cand_tf
530
531 cand_tf = cand_f(8,k)
532 cand_f(8,k) = cand_f(8,i)
533 cand_f(8,i) = cand_tf
534
535 cand_tf = cand_p(k)
536 cand_p(k) = cand_p(i)
537 cand_p(i) = cand_tf
538
539 iput(i) = iput(k)
540 iget(iput(i)) = i
541 ENDDO
542 ELSEIF(inacti==5.OR.inacti==6.OR.inacti==7)THEN
543 DO k=1,i_stok
544 i = iget(k)
545
546 cand_t = cand_n(k)
547 cand_n(k) = cand_n(i)
548 cand_n(i) = cand_t
549
550 cand_t = cand_e(k)
551 cand_e(k) = cand_e(i)
552 cand_e(i) = cand_t
553
554 cand_tf = cand_p(k)
555 cand_p(k) = cand_p(i)
556 cand_p(i) = cand_tf
557
558 iput(i) = iput(k)
559 iget(iput(i)) = i
560 ENDDO
561 ELSEIF(itied/=0)THEN
562 DO k=1,i_stok
563 i = iget(k)
564
565 cand_t = cand_n(k)
566 cand_n(k) = cand_n(i)
567 cand_n(i) = cand_t
568
569 cand_t = cand_e(k)
570 cand_e(k) = cand_e(i)
571 cand_e(i) = cand_t
572
573 cand_tf = cand_f(1,k)
574 cand_f(1,k) = cand_f(1,i)
575 cand_f(1,i) = cand_tf
576
577 cand_tf = cand_f(2,k)
578 cand_f(2,k) = cand_f(2,i)
579 cand_f(2,i) = cand_tf
580
581 cand_tf = cand_f(3,k)
582 cand_f(3,k) = cand_f(3,i)
583 cand_f(3,i) = cand_tf
584
585 cand_tf = cand_f(4,k)
586 cand_f(4,k) = cand_f(4,i)
587 cand_f(4,i) = cand_tf
588
589 cand_tf = cand_f(5,k)
590 cand_f(5,k) = cand_f(5,i)
591 cand_f(5,i) = cand_tf
592
593 cand_tf = cand_f(6,k)
594 cand_f(6,k) = cand_f(6,i)
595 cand_f(6,i) = cand_tf
596
597 cand_tf = cand_f(7,k)
598 cand_f(7,k) = cand_f(7,i)
599 cand_f(7,i) = cand_tf
600
601 cand_tf = cand_f(8,k)
602 cand_f(8,k) = cand_f(8,i)
603 cand_f(8,i) = cand_tf
604
605 iput(i) = iput(k)
606 iget(iput(i)) = i
607 ENDDO
608 ELSEIF(num_imp>0)THEN
609 DO k=1,i_stok
610 i = iget(k)
611
612 cand_t = cand_n(k)
613 cand_n(k) = cand_n(i)
614 cand_n(i) = cand_t
615
616 cand_t = cand_e(k)
617 cand_e(k) = cand_e(i)
618 cand_e(i) = cand_t
619
620 cand_tf = cand_p(k)
621 cand_p(k) = cand_p(i)
622 cand_p(i) = cand_tf
623
624 iput(i) = iput(k)
625 iget(iput(i)) = i
626 ENDDO
627 ELSE
628 DO k=1,i_stok
629 i = iget(k)
630
631 cand_t = cand_n(k)
632 cand_n(k) = cand_n(i)
633 cand_n(i) = cand_t
634
635 cand_t = cand_e(k)
636 cand_e(k) = cand_e(i)
637 cand_e(i) = cand_t
638
639 iput(i) = iput(k)
640 iget(iput(i)) = i
641 ENDDO
642
643 ENDIF
644
645
646
647 i_stok = cand_a(nsn+1) - 1
648 cand_a(nsn+2) = cand_a(nsn+1)
649
650 RETURN
type(real_pointer), dimension(:), allocatable stifi