OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fralnk.F File Reference
#include "implicit_f.inc"
#include "scr07_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine fralnk (ikad, key0, kvel, nalelk)
subroutine fralnk2 (ikad, key0, kalelink, nalelk)

Function/Subroutine Documentation

◆ fralnk()

subroutine fralnk ( integer, dimension(0:*) ikad,
character, dimension(*) key0,
integer kvel,
integer nalelk )

Definition at line 37 of file fralnk.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE message_mod
42 USE names_and_titles_mod, ONLY: ncharline100
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER IKAD(0:*),KVEL,NALELK
51 CHARACTER KEY0(*)*5
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "scr07_c.inc"
56#include "units_c.inc"
57C-----------------------------------------------
58C E x t e r n a l F u n c t i o n s
59C-----------------------------------------------
60 INTEGER IXYZ, NVAR
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I, N, NBC, K, KK, NS, K4,IKEY, M1, M2,IERR
65 CHARACTER KEY2*5, KEY3*5, KEY4*5
66 CHARACTER(LEN=NCHARLINE100) :: CARTE
67C-----------------------------------------------
68C S o u r c e L i n e s
69C-----------------------------------------------
70 k=0
71 kk = 0
72 ierr=0
73 ikey=kvel
74
75 DO n=1,nalelk
76 READ(iusc1,
77 . rec=ikad(ikey)+k,
78 . fmt='(7X,A,1X,A,1X,I5,1X,A,20X,I10)',
79 . err=9990)
80 . key2,key3,k4,key4,nbc
81 k=k+1
82 IF(key2=='TRA '.OR.key2=='ROT ')THEN
83 k=k+nbc
84 cycle
85 ENDIF
86 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
87 READ(iusc2,*,err=9990,END=9990)M1,m2
88 IF(m1<=0.OR.m2<=0)GOTO 9990 !Negative main node null or negative not allowed
89 !IF(KEY4(1:5)=='GRNOD')M1=-M1 !Tag on ale link for specific treatment in lectur.F
90
91 !---------------------------------!
92 ! ALE LINK DEFINED FROM NODES !
93 !---------------------------------!
94 IF(key4(1:5)/='GRNOD')THEN
95 k=k+1
96 kk=k
97 ns=0
98 !counting number of nodes
99 DO i=1,nbc-1
100 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
101 k=k+1
102 ns=ns+nvar(carte)
103 IF(ns==0)THEN
104 ierr=1
105 ENDIF
106 ENDDO
107 !checking input
108 IF(ierr==1)THEN
109 WRITE(istdo,*)
110 . ' ** ERROR : NODE ID(S) NOT FOUND IN ALE LINK CARD'
111 WRITE(iout ,*)
112 . ' ** error : node id(s) not found in ale link card'
113 CALL ARRET(2)
114 END IF
115 !array size for allocation (LINALE(SLINALE))
116 LLINAL=LLINAL+NS+6
117 !---------------------------------!
118 ! ALE LINK DEFINED FROM GRNOD !
119 !---------------------------------!
120 ELSEIF(KEY4(1:5)=='grnod')THEN
121 K=K+1
122 KK=K
123 NS=0
124 !counting number of nodes
125 DO I=1,NBC-1
126 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990)CARTE
127 K=K+1
128.AND. IF(NVAR(CARTE)>1M1<0)THEN !one single id per line
129 IERR=1
130 ENDIF
131.AND. IF(NVAR(CARTE)==1NS>0)THEN !grnod already defined on a previous line
132 IERR=1
133 ENDIF
134.AND. IF(NVAR(CARTE)==1NS==0)THEN !first single definition
135 NS=1
136 ENDIF
137 ENDDO
138 !checking input
139 IF(IERR==1)THEN
140 WRITE(ISTDO,*)
141 . ' ** error : single grnod id not found in ale link card'
142 WRITE(IOUT ,*)
143 . ' ** error : single grnod id not found in ale link card'
144 CALL ARRET(2)
145 END IF
146 NS=-NS
147 !array size for allocation (LINALE(SLINALE))
148 LLINAL=LLINAL+1+6
149 ENDIF
150
151 WRITE(IIN,'(3i10,5x,i3.3,i10)')M1,M2,NS,IXYZ(KEY3),K4
152 CALL READ10(IKAD(IKEY)+KK,NBC-1,KEY0(IKEY))
153
154 ENDDO !next N (ALE LINK)
155
156 RETURN
157 9990 CONTINUE
158 CALL ANCMSG(MSGID=73,ANMODE=ANINFO,
159 . C1=KEY0(IKEY))
160 CALL ARRET(0)
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002
nvar
integer function nvar(text)
Definition nvar.F:32
wriusc2
subroutine wriusc2(irec, nbc, key0)
Definition wriusc2.F:60

◆ fralnk2()

subroutine fralnk2 ( integer, dimension(0:*) ikad,
character, dimension(*) key0,
integer kalelink,
integer nalelk )

Definition at line 177 of file fralnk.F.

178C-----------------------------------------------
179C M o d u l e s
180C-----------------------------------------------
181 USE message_mod
182 USE names_and_titles_mod, ONLY: ncharline100
183C-----------------------------------------------
184C I m p l i c i t T y p e s
185C-----------------------------------------------
186#include "implicit_f.inc"
187C-----------------------------------------------
188C D u m m y A r g u m e n t s
189C-----------------------------------------------
190 INTEGER IKAD(0:*),KALELINK,NALELK
191 CHARACTER KEY0(*)*5
192C-----------------------------------------------
193C C o m m o n B l o c k s
194C-----------------------------------------------
195#include "scr07_c.inc"
196#include "units_c.inc"
197C-----------------------------------------------
198C E x t e r n a l F u n c t i o n s
199C-----------------------------------------------
200 INTEGER IXYZ, NVAR
201C-----------------------------------------------
202C L o c a l V a r i a b l e s
203C-----------------------------------------------
204 INTEGER I, N, NBC, K, KK, NS, IKEY, M1, M2, IFORM,IERR
205 CHARACTER KEY1*5, KEY2*5, KEY3*5, KEY4*5
206 CHARACTER(LEN=NCHARLINE100) :: CARTE
207C
208 k=0
209 ierr=0
210 ikey=kalelink
211 n=0
212 DO WHILE(n<nalelk)
213 READ(iusc1,rec=ikad(ikey)+k,
214 . fmt='(7X,A,1X,A,1X,I5,1X,A,1X,A,13X,I10)',
215 . err=9990) key1 , key2 , iform , key3 , key4 , nbc
216 ! 'LINK','VEL' ,'Iform' ,'XYZ' ,'GRNOD' ,...NBC
217 IF(key1(1:5)/='LINK ')THEN
218 k=k+1
219 cycle
220 ENDIF
221 n=n+1
222 !---------------------------------!
223 ! /ALE/LINK/OFF !
224 !---------------------------------!
225 IF(key2(1:5)=='OFF ')THEN
226 ns=0
227 k=k+1
228 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
229 kk=k
230 DO i=0,nbc-1
231 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
232 k=k+1
233 ns=ns+nvar(carte)
234 ENDDO
235 WRITE(iin,'(3I10,5X,I3.3,I10)')-2,-2,ns,0,0
236 CALL read10(ikad(ikey)+kk,nbc,key0(ikey))
237
238 !---------------------------------!
239 ! /ALE/LINK/ON !
240 !---------------------------------!
241 ELSEIF(key2(1:5)=='ON ')THEN
242 ns=0
243 k=k+1
244 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
245 kk=k
246 DO i=0,nbc-1
247 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
248 k=k+1
249 ns=ns+nvar(carte)
250 ENDDO
251 WRITE(iin,'(3I10,5X,I3.3,I10)')-1,-1,ns,0,0
252 CALL read10(ikad(ikey)+kk,nbc,key0(ikey))
253
254 !---------------------------------!
255 ! '/ALE/LINK/VEL/*' !
256 !---------------------------------!
257 ELSEIF(key2(1:5)=='VEL ')THEN
258 k=k+1
259 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
260 READ(iusc2,*,err=9990,END=9990)M1,m2
261 IF(m1<=0.OR.m2<=0)GOTO 9990 !Negative main node null or negative not allowed
262 k=k+1
263 kk=k
264 ns=0
265 !---------------------------------!
266 ! ALE LINK DEFINED FROM NODES !
267 !---------------------------------!
268 IF(key4(1:5)=='NODES'.OR.key4(1:5)==' ')THEN
269 DO i=1,nbc-1
270 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
271 k=k+1
272 ns=ns+nvar(carte)
273 ENDDO
274 llinal=llinal+ns+6
275 !WRITE(IIN,'(3I10,5X,I3.3,I10)')M1,M2,NS,IXYZ(KEY3),IFORM
276 !CALL READ10(IKAD(IKEY)+KK,NBC-1,KEY0(IKEY))
277 !---------------------------------!
278 ! ALE LINK DEFINED FROM GRNOD !
279 !---------------------------------!
280 ELSEIF(key4(1:5)=='GRNOD')THEN
281 DO i=1,nbc-1
282 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
283 k=k+1
284 IF(nvar(carte)>1.AND.m1<0)THEN !one single id per line
285 ierr=1
286 ENDIF
287 IF(nvar(carte)==1.AND.ns>0)THEN !grnod already defined on a previous line
288 ierr=1
289 ENDIF
290 IF(nvar(carte)==1.AND.ns==0)THEN !first single definition
291 ns=1
292 ENDIF
293 ENDDO
294 !checking input
295 IF(ierr==1)THEN
296 WRITE(istdo,*)
297 . ' ** ERROR : SINGLE GRNOD ID NOT FOUND IN ALE LINK CARD'
298 WRITE(iout ,*)
299 . ' ** ERROR : SINGLE GRNOD ID NOT FOUND IN ALE LINK CARD'
300 CALL arret(2)
301 END IF
302 ns=-ns
303 llinal=llinal+1+6
304 ENDIF
305 !---------------------------------!
306 WRITE(iin,'(3I10,5X,I3.3,I10)')m1,m2,ns,ixyz(key3),iform
307 CALL read10(ikad(ikey)+kk,nbc-1,key0(ikey))
308
309 ENDIF !(KEY2=='VEL ')
310 ENDDO
311C
312 RETURN
313C
314 9990 CONTINUE
315 CALL ancmsg(msgid=73,anmode=aninfo,
316 . c1=key0(ikey))
317 CALL arret(0)
ixyz
integer function ixyz(chr)
Definition ixyz.F:34
read10
subroutine read10(irec, nbc, key0)
Definition read10.F:34
ancmsg
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)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87