31
32
33
34 use element_mod , only : nixq
35
36
37
38#include "implicit_f.inc"
39
40
41
42#include "com01_c.inc"
43#include "com04_c.inc"
44#include "vect01_c.inc"
45#include "param_c.inc"
46#include "task_c.inc"
47
48
49
50 INTEGER ITASK,IPARG(NPARG,NGROUP),BHOLE(NMULT,*),IXQ(NIXQ,NUMELQ)
52
53
54
55 INTEGER NM, NG, JMUL, I, J, MX
56
57
58
59 DO nm=1,nmult
60 DO ng=itask+1,ngroup,nthread
61
62 IF (iparg(76, ng) == 1) cycle
63 jale=iparg(7,ng)
64 jeul=iparg(11,ng)
65 IF(jale+jeul == 0) cycle
66 IF(iparg(8,ng) == 1) cycle
67 jmul=iparg(20,ng)
68 llt=iparg(2,ng)
69 nft=iparg(3,ng)
70 lft=1
71 IF(jmul == 0)THEN
72 DO i=lft,llt
73 j=i+nft
74 mx=ixq(1,j)
75 bhole(nm,j)=mx
76 ENDDO
77
78
79
80
81
82
83 ELSE
84 DO i=lft,llt
85 j=i+nft
86 mx=ixq(1,j)
87 bhole(nm,j)=nint(pm( 20+nm,mx))
88 IF(nint(pm(185+nm,mx)) /= 0)bhole(nm,j)=-bhole(nm,j)
89 ENDDO
90 ENDIF
91 enddo
92 ENDDO
93
94 RETURN