43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
71 USE reader_old_mod , ONLY : line
72 USE user_id_mod , ONLY : id_limit
73
74
75
76#include "implicit_f.inc"
77
78
79
80#include "analyse_name.inc"
81
82
83
84#include "scr17_c.inc"
85#include "com01_c.inc"
86#include "com04_c.inc"
87#include "param_c.inc"
88#include "units_c.inc"
89
90
91
92
95 my_real,
INTENT(IN)::geo(npropg,*)
96 INTEGER,INTENT(IN)::ITAB(*)
97 INTEGER,INTENT(IN)::ITABM1(*)
98 INTEGER,INTENT(IN)::IPART(LIPART1,*)
99 INTEGER,INTENT(IN)::IGEO(NPROPGI,*)
100 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(NSUBMOD)
101
102 INTEGER,INTENT(OUT)::IXRI(4,*)
103
106 my_real,
INTENT(INOUT)::rivet(*)
107 INTEGER,INTENT(IN)::(*)
108
109
110
111 INTEGER NLOCAL
113
114
115
116 INTEGER I, I1, I2, PID,MT,IPID,J,N,STAT,P,IF1,IF2
117 INTEGER CPT,INDEX_PART
118 CHARACTER MESS*40, MESS2*40
120 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_RIVET,IPART_RIVET
121
122
123
124 INTEGER USR2SYS
125 DATA mess/'RIVET OR SPOTWELD DEFINITION '/
126
127
128
129
130 ALLOCATE (sub_rivet(nrivet),stat=stat)
131 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'SUB_RIVET')
132 sub_rivet(1:nrivet) = 0
133 ALLOCATE (ipart_rivet(nrivet),stat=stat)
134 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'IPART_RIVET')
135 ipart_rivet(1:nrivet) = 0
136 index_part = 1
137
138
139
140 CALL cpp_rivet_read(ixri,4,ipart_rivet,sub_rivet)
141
142
143
144 DO i=1,nrivet
145
146
147
148 IF( ipart(4,index_part) /= ipart_rivet(i) )THEN
149 DO j=1,npart
150 IF(ipart(4,j)== ipart_rivet(i) ) index_part = j
151 ENDDO
152 ENDIF
153 IF(ipart(4,index_part) /= ipart_rivet(i)) THEN
154 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,
155 . c1="RIVET",
156 . i1=ipart_rivet(i),
157 . i2=ipart_rivet(i),
158 . prmod=msg_cumu)
159 ENDIF
160 ipart_rivet(i) = index_part
161 mt=ipart(1,index_part)
162 ipid=ipart(2,index_part)
163 ixri(1,i)=ipid
164 IF (ixri(4,i)>id_limit%GLOBAL) THEN
165 CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,i1=ixri(4,i),c1=line,c2=
'/RIVET')
166 ENDIF
167 ENDDO
168
169 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,prmod=msg_print)
170
171
172 DO j=1,nrivet
173 ixri(2,j)=
usr2sys(ixri(2,j),itabm1,mess,ixri(4,nrivet))
174 ixri(3,j)=
usr2sys(ixri(3,j),itabm1,mess,ixri(4,nrivet))
175 CALL anodset(ixri(2,j), check_2n)
176 CALL anodset(ixri(3,j), check_2n)
177 ENDDO
178 DO p = 1, nspmd
179 DO j=1,nrivet
182 IF (if1==1.OR.if2==1) THEN
185 ENDIF
186 ENDDO
187 ENDDO
188
189
190
191 CALL vdouble(ixri(4,1),4,nrivet,mess,0,bid)
192
193 DO j=1,nrivet
194 if1 = 0
195 DO p = 1, nspmd
196 if1 = if1 +
nlocal(ixri(2,j),p)
197 ENDDO
198 IF (if1==0) THEN
201 ENDIF
202 ENDDO
203 CALL rivet0(v,vr,ms,in,ixri,rivet,geo,itab,ikine)
204
205 i1=1
206 i2=min0(50,nrivet)
207
208 90 WRITE (iout,300)
209 DO i=i1,i2
210 pid=igeo(1,ixri(1,i))
211 WRITE (iout,270) i,ixri(4,i),pid,itab(ixri(2,i)),itab(ixri(3,i)
212 ENDDO
213 IF(i2==nrivet)RETURN
214 i1=i1+50
215 i2=min0(i2+50,nrivet)
216 GOTO 90
217
218 IF(ALLOCATED(sub_rivet)) DEALLOCATE(sub_rivet)
219 IF(ALLOCATED(ipart_rivet)) DEALLOCATE(ipart_rivet)
220
221
222 270 FORMAT(6i10)
223 300 FORMAT(/' RIVET ' /
224 + ,' -------'/
225 + ' LOC-EL GLO-EL GEOM NODE1 NODE2')
226 RETURN
void anodset(int *id, int *type)
subroutine ifrontplus(n, p)
subroutine rivet0(v, vr, ms, in, ixri, rivet, geo, itab, ikine)
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
integer function usr2sys(iu, itabm1, mess, id)
subroutine vdouble(list, ilist, nlist, mess, ir, rlist)