OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
freform.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23C
24!||====================================================================
25!|| fredec0 ../starter/source/starter/freform.F
26!||--- called by ------------------------------------------------------
27!|| lecig3d ../starter/source/elements/ige3d/lecig3d.F
28!|| nbadigemesh ../starter/source/elements/ige3d/nbadigemesh.F
29!||--- calls -----------------------------------------------------
30!|| ancmsg ../starter/source/output/message/message.F
31!|| freerr ../starter/source/starter/freform.F
32!|| my_exit ../starter/source/output/analyse/analyse.c
33!||--- uses -----------------------------------------------------
34!|| format_mod ../starter/share/modules1/format_mod.F90
35!|| message_mod ../starter/share/message_module/message_mod.F
36!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
37!||====================================================================
38 SUBROUTINE fredec0(ID)
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE message_mod
43 USE names_and_titles_mod , ONLY : ncharfield
44 USE format_mod , ONLY : lfield, fmt_i
45 USE reader_old_mod , ONLY : kline
46 USE user_id_mod , ONLY : id_limit
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "scr17_c.inc"
55C-----------------------------------------------
56 INTEGER IOP,ID
57 CHARACTER(LEN=NCHARFIELD) :: MOT1
58 INTEGER I,J1,J2
59C-----------------------------------------------
60C /KEYW/int_id
61C-----------------------------------------------
62 i=2
63 DO WHILE(kline(i:i)/='/')
64 i=i+1
65 IF(i>ncharline)CALL freerr(0)
66 ENDDO
67 i=i+1
68 IF(i>ncharline)CALL freerr(0)
69 j1=i
70 mot1=kline(j1:j1-1+lfield)
71 READ(mot1,err=999,fmt=fmt_i)id
72 IF (id>id_limit%GLOBAL.OR.id<=0) THEN
73 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,
74 . i1=id,c1=kline)
75 ENDIF
76C
77 RETURN
78 999 CALL freerr(0)
79 CALL my_exit(2)
80 END
81C
82!||====================================================================
83!|| fredec4 ../starter/source/starter/freform.F
84!||--- calls -----------------------------------------------------
85!|| freerr ../starter/source/starter/freform.F
86!||--- uses -----------------------------------------------------
87!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
88!||====================================================================
89 SUBROUTINE fredec4(COPT)
90C-----------------------------------------------
91C M o d u l e s
92C-----------------------------------------------
93 USE names_and_titles_mod , ONLY : ncharfield, ncharline
94 USE reader_old_mod , ONLY : kline
95C-----------------------------------------------
96C I m p l i c i t T y p e s
97C-----------------------------------------------
98#include "implicit_f.inc"
99C-----------------------------------------------
100C C o m m o n B l o c k s
101C-----------------------------------------------
102#include "scr17_c.inc"
103C
104 CHARACTER(LEN=NCHARFIELD) :: COPT
105C
106 INTEGER I,J1,J2,J
107C-----------------------------------------------
108C /KEYW/int_type/int_id
109C-----------------------------------------------
110 i=2
111 DO WHILE(kline(i:i)/='/')
112 i=i+1
113
114 IF(i>ncharline)CALL freerr(0)
115 ENDDO
116 i=i+1
117
118 IF(i>ncharline)CALL freerr(0)
119 j1=i
120 DO WHILE(kline(i:i)/='/')
121 i=i+1
122 IF(i>ncharline)CALL freerr(0)
123
124 ENDDO
125 j2=i-1
126 copt=kline(j1:j2)
127C
128 RETURN
129 END
130!||====================================================================
131!|| fredec5 ../starter/source/starter/freform.F
132!||--- calls -----------------------------------------------------
133!|| ancmsg ../starter/source/output/message/message.F
134!|| my_exit ../starter/source/output/analyse/analyse.c
135!||--- uses -----------------------------------------------------
136!|| format_mod ../starter/share/modules1/format_mod.F90
137!|| message_mod ../starter/share/message_module/message_mod.F
138!|| reader_old_mod ../starter/share/modules1/reader_old_mod.f90
139!||====================================================================
140 SUBROUTINE fredec5(COPT,ID)
141C-----------------------------------------------
142C M o d u l e s
143C-----------------------------------------------
144 USE reader_old_mod , ONLY : kline
145 USE message_mod
146 USE names_and_titles_mod , ONLY : ncharkey, ncharfield,ncharline
147 USE format_mod , ONLY : lfield, fmt_i
148 USE user_id_mod , ONLY : id_limit
149C-----------------------------------------------
150C I m p l i c i t T y p e s
151C-----------------------------------------------
152#include "implicit_f.inc"
153C-----------------------------------------------
154C C o m m o n B l o c k s
155C-----------------------------------------------
156#include "scr17_c.inc"
157C-----------------------------------------------
158 INTEGER ID
159 CHARACTER(LEN=NCHARKEY) :: COPT
160C-----------------------------------------------
161 CHARACTER(LEN=NCHARFIELD) :: MOT1
162 INTEGER I,J1,J2,J
163C-----------------------------------------------
164C /keyw or
165C /KEYW/KEYW2/int_id
166C-----------------------------------------------
167 i=2
168
169 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
170 i=i+1
171 ENDDO
172 copt=' '
173 i=i+1
174
175 IF(i>ncharline)RETURN
176 j1=i
177
178 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
179 i=i+1
180 ENDDO
181 j2=i-1
182 copt=kline(j1:j2)
183C
184 id=0
185 i=i+1
186 i=min(i,ncharline)
187 IF(i>ncharline-lfield+1)RETURN
188 j1=i
189 DO WHILE(kline(i:i)/='/')
190 i=i+1
191 IF(i>ncharline)EXIT
192 ENDDO
193 j2=i-1
194
195 j2=min(i-1+lfield,j2)
196 mot1=kline(j1:j2)
197
198 READ(mot1,err=999,fmt=fmt_i)id
199C
200 IF (id>id_limit%GLOBAL.OR.id<=0) THEN
201 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,
202 . i1=id,c1=kline)
203 ENDIF
204
205C
206 RETURN
207 999 CALL freerr(0)
208 CALL my_exit(2)
209 END
210!||====================================================================
211!|| fredec6 ../starter/source/starter/freform.F
212!||--- uses -----------------------------------------------------
213!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
214!||====================================================================
215 SUBROUTINE fredec6(COPT,COPT2)
216C-----------------------------------------------
217C M o d u l e s
218C-----------------------------------------------
219 USE names_and_titles_mod , ONLY : ncharkey,ncharline
220 USE reader_old_mod , ONLY : kline
221C-----------------------------------------------
222C I m p l i c i t T y p e s
223C-----------------------------------------------
224#include "implicit_f.inc"
225C-----------------------------------------------
226C C o m m o n B l o c k s
227C-----------------------------------------------
228#include "scr17_c.inc"
229C-----------------------------------------------
230 CHARACTER(LEN=NCHARKEY) :: COPT,COPT2
231C-----------------------------------------------
232 INTEGER I,J1,J2,J
233C-----------------------------------------------
234C /KEYW/KEYW2/KEYW3
235C-----------------------------------------------
236 i=2
237
238 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
239 i=i+1
240 ENDDO
241 copt=' '
242 i=i+1
243
244 IF(i>ncharline)RETURN
245 j1=i
246
247 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
248 i=i+1
249 ENDDO
250 j2=i-1
251 copt=kline(j1:j2)
252C
253 copt2=' '
254 i=i+1
255 i=min(i,ncharline)
256 j1=i
257
258 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
259 i=i+1
260 ENDDO
261
262 IF(i>ncharline)RETURN
263 j2=i-1
264 copt2=kline(j1:j2)
265C
266 RETURN
267 END
268!||====================================================================
269!|| nodgrnr5 ../starter/source/starter/freform.F
270!||--- called by ------------------------------------------------------
271!|| hm_read_bcs_nrf ../starter/source/boundary_conditions/hm_read_bcs_nrf.F90
272!|| hm_read_bcs_wall ../starter/source/boundary_conditions/hm_read_bcs_wall.F90
273!|| hm_read_cload ../starter/source/loads/general/cload/hm_read_cload.f
274!|| hm_read_cyljoint ../starter/source/constraints/general/cyl_joint/hm_read_cyljoint.F
275!|| hm_read_grav ../starter/source/loads/general/grav/hm_read_grav.F
276!|| hm_read_impacc ../starter/source/constraints/general/impvel/hm_read_impacc.F
277!|| hm_read_imptemp ../starter/source/constraints/thermic/hm_read_imptemp.F
278!|| hm_read_load_centri ../starter/source/loads/general/load_centri/hm_read_load_centri.F
279!|| hm_read_merge ../starter/source/constraints/general/merge/hm_read_merge.F
280!|| hm_read_xelem ../starter/source/elements/reader/hm_read_xelem.F
281!|| lecsec42 ../starter/source/tools/sect/hm_read_sect.F
282!|| lecsec4bolt ../starter/source/tools/sect/lecsec4bolt.F
283!|| read_dfs_detcord ../starter/source/initial_conditions/detonation/read_dfs_detcord.F
284!|| read_dfs_detline ../starter/source/initial_conditions/detonation/read_dfs_detline.f
285!|| read_dfs_detplan ../starter/source/initial_conditions/detonation/read_dfs_detplan.F
286!|| read_dfs_detpoint ../starter/source/initial_conditions/detonation/read_dfs_detpoint.F
287!|| read_dfs_wave_shaper ../starter/source/initial_conditions/detonation/read_dfs_wave_shaper.f
288!|| read_impdisp ../starter/source/constraints/general/impvel/read_impdisp.F
289!|| read_impvel ../starter/source/constraints/general/impvel/read_impvel.F
290!|| read_impvel_lagmul ../starter/source/constraints/general/impvel/read_impvel_lagmul.F
291!||--- calls -----------------------------------------------------
292!|| ancmsg ../starter/source/output/message/message.F
293!||--- uses -----------------------------------------------------
294!|| message_mod ../starter/share/message_module/message_mod.F
295!||====================================================================
296 INTEGER FUNCTION nodgrnr5(IGU ,IGS ,IBUF,IGRNOD,
297 . ITABM1 ,MESS )
298C-----------------------------------------------
299C M o d u l e s
300C-----------------------------------------------
301 USE groupdef_mod
302 USE message_mod
303C-----------------------------------------------
304C I m p l i c i t T y p e s
305C-----------------------------------------------
306#include "implicit_f.inc"
307C-----------------------------------------------
308C C o m m o n B l o c k s
309C-----------------------------------------------
310#include "com04_c.inc"
311C-----------------------------------------------
312 INTEGER igu,igs,ibuf(*),itabm1(*)
313 CHARACTER mess*40
314C-----------------------------------------------
315 TYPE (group_) , DIMENSION(NGRNOD) :: igrnod
316C-----------------------------------------------
317 INTEGER i
318C=======================================================================
319 nodgrnr5 = 0
320 IF (igu > 0) THEN
321 igs=0
322 DO i=1,ngrnod
323 IF(igrnod(i)%ID == igu) THEN
324 igs=i
325 nodgrnr5 = igrnod(igs)%NENTITY
326 EXIT
327 ENDIF
328 ENDDO
329C
330 IF (igs == 0)THEN
331 CALL ancmsg(msgid=53,
332 . msgtype=msgerror,
333 . anmode=aninfo,
334 . c1= mess,
335 . i1=igu)
336 RETURN
337 ENDIF
338C
339 DO i=1,nodgrnr5
340 ibuf(i)=igrnod(igs)%ENTITY(i)
341 ENDDO
342 ENDIF
343C---
344 RETURN
345 END
346!||====================================================================
347!|| nodgrnr6 ../starter/source/starter/freform.F
348!||--- called by ------------------------------------------------------
349!|| hm_read_rbe2 ../starter/source/constraints/general/rbe2/hm_read_rbe2.F
350!|| hm_read_rbody ../starter/source/constraints/general/rbody/hm_read_rbody.F
351!|| hm_read_rbody_lagmul ../starter/source/constraints/general/rbody/hm_read_rbody_lagmul.F
352!||--- calls -----------------------------------------------------
353!|| ancmsg ../starter/source/output/message/message.F
354!||--- uses -----------------------------------------------------
355!|| message_mod ../starter/share/message_module/message_mod.F
356!||====================================================================
357 INTEGER FUNCTION nodgrnr6(M ,IGU ,IGS ,IBUF,IGRNOD,
358 . ITABM1 ,MESS ,ID )
359C-----------------------------------------------
360C M o d u l e s
361C-----------------------------------------------
362 USE groupdef_mod
363 USE message_mod
364C-----------------------------------------------
365C I m p l i c i t T y p e s
366C-----------------------------------------------
367#include "implicit_f.inc"
368C-----------------------------------------------
369C C o m m o n B l o c k s
370C-----------------------------------------------
371#include "com04_c.inc"
372C-----------------------------------------------
373C THIS FUNCTION REMOVES main NODE FROM SECND NODAL SET
374C IN THE KINEMATIC CONSTRAINT DEFINITION
375C-----------------------------------------------
376 INTEGER m,igu,igs,id,ibuf(*),itabm1(*)
377 CHARACTER mess*40
378C-----------------------------------------------
379 TYPE (group_) , DIMENSION(NGRNOD) :: igrnod
380C-----------------------------------------------
381 INTEGER i, mflag
382C=======================================================================
383 nodgrnr6 = 0
384 IF (igu > 0) THEN
385 igs=0
386 DO i=1,ngrnod
387 IF(igrnod(i)%ID == igu) THEN
388 igs=i
389 nodgrnr6 = igrnod(igs)%NENTITY
390 EXIT
391 ENDIF
392 ENDDO
393C
394 IF (igs == 0)THEN
395 CALL ancmsg(msgid=53,
396 . msgtype=msgerror,
397 . anmode=aninfo,
398 . c1= mess,
399 . i1=igu)
400 RETURN
401 ENDIF
402C
403 mflag=0
404 DO i=1,nodgrnr6
405 IF(igrnod(igs)%ENTITY(i)==m) THEN
406 mflag=1
407 ELSE
408 ibuf(i-mflag)=igrnod(igs)%ENTITY(i)
409 ENDIF
410 ENDDO
411 IF(mflag==1) THEN
412 nodgrnr6=nodgrnr6-1
413 CALL ancmsg(msgid=1624,
414 . msgtype=msgwarning,
415 . anmode=aninfo_blind_1,
416 . i1=id)
417 ENDIF
418 ENDIF
419C---
420 RETURN
421 END
422!||====================================================================
423!|| grfind ../starter/source/starter/freform.F
424!||--- called by ------------------------------------------------------
425!|| r2r_check ../starter/source/coupling/rad2rad/r2r_check.F
426!||--- calls -----------------------------------------------------
427!|| ancmsg ../starter/source/output/message/message.F
428!||--- uses -----------------------------------------------------
429!|| message_mod ../starter/share/message_module/message_mod.F
430!||====================================================================
431 INTEGER FUNCTION grfind(IGU,IGRNOD,MESS)
432C-----------------------------------------------
433C M o d u l e s
434C-----------------------------------------------
435 USE message_mod
436 USE groupdef_mod
437C-----------------------------------------------
438C I m p l i c i t T y p e s
439C-----------------------------------------------
440#include "implicit_f.inc"
441C-----------------------------------------------
442C C o m m o n B l o c k s
443C-----------------------------------------------
444#include "com04_c.inc"
445C-----------------------------------------------
446 INTEGER igu
447 CHARACTER mess*40
448C-----------------------------------------------
449 TYPE (group_) ,DIMENSION(NGRNOD) :: igrnod
450C-----------------------------------------------
451 INTEGER i,ig
452C-----------------------------------------------
453 ig=0
454 DO i=1,ngrnod
455 IF(igrnod(i)%ID==igu)THEN
456 ig=i
457 ENDIF
458 ENDDO
459C
460 IF(ig==0)THEN
461 CALL ancmsg(msgid=53,
462 . msgtype=msgerror,
463 . anmode=aninfo,
464 . i1=igu,
465 . c1='IN NODE GROUP SEARCH')
466 RETURN
467 ENDIF
468 grfind = ig
469C----
470 RETURN
471 END
472C
473C
474!||====================================================================
475!|| freerr ../starter/source/starter/freform.F
476!||--- called by ------------------------------------------------------
477!|| fredec0 ../starter/source/starter/freform.F
478!|| fredec4 ../starter/source/starter/freform.F
479!|| fredec_2key_4id ../starter/source/starter/freform.F
480!|| fredec_2key_4id_t ../starter/source/starter/freform.F
481!|| fredec_key_3id_t ../starter/source/starter/freform.F
482!|| hm_read_inivel ../starter/source/initial_conditions/general/inivel/hm_read_inivel.F
483!|| hm_read_monvol_type1 ../starter/source/airbag/hm_read_monvol_type1.F
484!|| hm_read_monvol_type10 ../starter/source/airbag/hm_read_monvol_type10.f
485!|| hm_read_monvol_type11 ../starter/source/airbag/hm_read_monvol_type11.F
486!|| hm_read_monvol_type2 ../starter/source/airbag/hm_read_monvol_type2.F
487!|| hm_read_monvol_type3 ../starter/source/airbag/hm_read_monvol_type3.F
488!|| hm_read_monvol_type4 ../starter/source/airbag/hm_read_monvol_type4.F
489!|| hm_read_monvol_type5 ../starter/source/airbag/hm_read_monvol_type5.F
490!|| hm_read_monvol_type6 ../starter/source/airbag/hm_read_monvol_type6.F
491!|| hm_read_monvol_type7 ../starter/source/airbag/hm_read_monvol_type7.F
492!|| hm_read_monvol_type8 ../starter/source/airbag/hm_read_monvol_type8.F
493!|| hm_read_monvol_type9 ../starter/source/airbag/hm_read_monvol_type9.F
494!||--- calls -----------------------------------------------------
495!|| ancmsg ../starter/source/output/message/message.F
496!||--- uses -----------------------------------------------------
497!|| message_mod ../starter/share/message_module/message_mod.F
498!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
499!||====================================================================
500 SUBROUTINE freerr(IT)
501C-----------------------------------------------
502C M o d u l e s
503C-----------------------------------------------
504 USE reader_old_mod , ONLY : kline, line, key0, kcur, irec
505 USE message_mod
506C-----------------------------------------------
507C I m p l i c i t T y p e s
508C-----------------------------------------------
509#include "implicit_f.inc"
510C-----------------------------------------------
511C C o m m o n B l o c k s
512C-----------------------------------------------
513#include "scr17_c.inc"
514#include "units_c.inc"
515C-----------------------------------------------
516C D u m m y A r g u m e n t s
517C-----------------------------------------------
518 INTEGER IT
519C-----------------------------------------------
520C L o c a l V a r i a b l e s
521C-----------------------------------------------
522 INTEGER IT1
523C=======================================================================
524 it1 = it
525 IF(it1==3)THEN
526 it1=0
527 READ(iin,rec=irec,err=999,fmt='(A)')line
528 it1=1
529 999 CONTINUE
530 ENDIF
531 IF(it1==0)THEN
532 CALL ancmsg(msgid=54,
533 . anmode=aninfo,
534 . msgtype=msgerror,
535 . c1=kline)
536 ELSEIF(it1==1)THEN
537 CALL ancmsg(msgid=55,
538 . anmode=aninfo,
539 . msgtype=msgerror,
540 . c1=key0(kcur),
541 . c2=kline,
542 . c3=line)
543 ENDIF
544 END
545!||====================================================================
546!|| fretitl ../starter/source/starter/freform.F
547!||--- called by ------------------------------------------------------
548!|| hm_preread_bcscyc ../starter/source/constraints/general/bcs/lecbcscyc.F
549!|| hm_preread_sphio ../starter/source/loads/sph/hm_preread_sphio.F
550!|| hm_read_bcs ../starter/source/constraints/general/bcs/hm_read_bcs.F
551!|| hm_read_cluster ../starter/source/output/cluster/hm_read_cluster.F
552!|| hm_read_cyljoint ../starter/source/constraints/general/cyl_joint/hm_read_cyljoint.F
553!|| hm_read_friction ../starter/source/interfaces/friction/reader/hm_read_friction.F
554!|| hm_read_frm ../starter/source/tools/skew/hm_read_frm.F
555!|| hm_read_funct ../starter/source/tools/curve/hm_read_funct.F
556!|| hm_read_fxb1 ../starter/source/constraints/fxbody/hm_read_fxb.F
557!|| hm_read_gauge ../starter/source/output/gauge/hm_read_gauge.F
558!|| hm_read_gjoint ../starter/source/constraints/general/gjoint/hm_read_gjoint.F
559!|| hm_read_inter_fsi ../starter/source/interfaces/reader/hm_read_inter_fsi.F
560!|| hm_read_inter_lagdt_type07 ../starter/source/interfaces/int07/hm_read_inter_lagdt_type07.F
561!|| hm_read_inter_lagmul ../starter/source/interfaces/reader/hm_read_inter_lagmul.F
562!|| hm_read_inter_struct ../starter/source/interfaces/reader/hm_read_inter_struct.F
563!|| hm_read_intsub ../starter/source/output/subinterface/hm_read_intsub.F
564!|| hm_read_link ../starter/source/constraints/rigidlink/hm_read_rlink.F
565!|| hm_read_mat ../starter/source/materials/mat/hm_read_mat.F90
566!|| hm_read_merge ../starter/source/constraints/general/merge/hm_read_merge.F
567!|| hm_read_mpc ../starter/source/constraints/general/mpc/hm_read_mpc.F
568!|| hm_read_nbcs ../starter/source/constraints/general/bcs/hm_read_nbcs.F
569!|| hm_read_part ../starter/source/model/assembling/hm_read_part.F
570!|| hm_read_properties ../starter/source/properties/hm_read_properties.F
571!|| hm_read_rbe2 ../starter/source/constraints/general/rbe2/hm_read_rbe2.F
572!|| hm_read_rbe3 ../starter/source/constraints/general/rbe3/hm_read_rbe3.F
573!|| hm_read_rbody ../starter/source/constraints/general/rbody/hm_read_rbody.F
574!|| hm_read_rbody_lagmul ../starter/source/constraints/general/rbody/hm_read_rbody_lagmul.F
575!|| hm_read_retractor ../starter/source/tools/seatbelts/hm_read_retractor.F
576!|| hm_read_rwall_cyl ../starter/source/constraints/general/rwall/hm_read_rwall_cyl.F
577!|| hm_read_rwall_lagmul ../starter/source/constraints/general/rwall/hm_read_rwall_lagmul.F
578!|| hm_read_rwall_paral ../starter/source/constraints/general/rwall/hm_read_rwall_paral.F
579!|| hm_read_rwall_plane ../starter/source/constraints/general/rwall/hm_read_rwall_plane.F
580!|| hm_read_rwall_spher ../starter/source/constraints/general/rwall/hm_read_rwall_spher.F
581!|| hm_read_rwall_therm ../starter/source/constraints/general/rwall/hm_read_rwall_therm.F
582!|| hm_read_skw ../starter/source/tools/skew/hm_read_skw.F
583!|| hm_read_slipring ../starter/source/tools/seatbelts/hm_read_slipring.F
584!|| hm_read_spcnd ../starter/source/constraints/sph/hm_read_spcnd.F
585!|| hm_read_thchecksum ../starter/source/output/th/hm_read_thchecksum.F90
586!|| hm_read_thgrne ../starter/source/output/th/hm_read_thgrne.F
587!|| hm_read_thgrns ../starter/source/output/th/hm_read_thgrns.F
588!|| hm_read_thgrou ../starter/source/output/th/hm_read_thgrou.F
589!|| hm_read_thgrsens ../starter/source/output/th/hm_read_thgrsens.F
590!|| hm_read_thgrsurf ../starter/source/output/th/hm_read_thgrsurf.F
591!|| hm_read_thpart ../starter/source/output/thpart/hm_read_thpart.F
592!|| hm_thgrki_vent ../starter/source/output/th/hm_thgrki_vent.F
593!|| lecacc ../starter/source/tools/accele/lecacc.F
594!|| lecsec42 ../starter/source/tools/sect/hm_read_sect.F
595!|| lecstack_ply ../starter/source/properties/composite_options/stack/lecstack_ply.F
596!|| prelecsec ../starter/source/tools/sect/prelecsec.F
597!|| prelecsec4bolt ../starter/source/tools/sect/prelecsec4bolt.f
598!|| r2r_void ../starter/source/coupling/rad2rad/r2r_void.F
599!|| read_impdisp ../starter/source/constraints/general/impvel/read_impdisp.F
600!|| read_impdisp_fgeo ../starter/source/constraints/general/impvel/read_impdisp_fgeo.F
601!|| read_impvel ../starter/source/constraints/general/impvel/read_impvel.F
602!|| read_impvel_fgeo ../starter/source/constraints/general/impvel/read_impvel_fgeo.F
603!|| read_impvel_lagmul ../starter/source/constraints/general/impvel/read_impvel_lagmul.F
604!|| read_monvol ../starter/source/airbag/read_monvol.F
605!|| w_gr_entity_e ../starter/source/restart/ddsplit/w_gr_entity.F
606!|| w_gr_entity_n ../starter/source/restart/ddsplit/w_gr_entity.F
607!|| w_gr_entity_p ../starter/source/restart/ddsplit/w_gr_entity.F
608!|| w_islin_str ../starter/source/restart/ddsplit/w_islin_str.F
609!|| w_isurf_str ../starter/source/restart/ddsplit/w_isurf_str.F
610!|| w_subset_str ../starter/source/restart/ddsplit/w_subset_str.F
611!|| write_sensors ../starter/source/tools/sensor/write_sensors.F
612!||--- uses -----------------------------------------------------
613!||====================================================================
614 SUBROUTINE fretitl(TITR,IASC,L)
615C-----------------------------------------------
616C M o d u l e s
617C-----------------------------------------------
618 USE names_and_titles_mod , ONLY : ncharline
619C-----------------------------------------------
620C I m p l i c i t T y p e s
621C-----------------------------------------------
622#include "implicit_f.inc"
623C-----------------------------------------------
624C D u m m y A r g u m e n t s
625C-----------------------------------------------
626 INTEGER L,IASC(*)
627 CHARACTER TITR*(*)
628C-----------------------------------------------
629C L o c a l V a r i a b l e s
630C-----------------------------------------------
631 INTEGER I,J, JMAX
632C-----------------------------------------------
633 j=1
634 jmax=min(ncharline,len(titr))
635 DO i=1,l
636 iasc(i)= ichar(titr(j:j))*65536
637 j = j+1
638 IF(j>jmax) EXIT ! Replacing ncharline by JMAX
639 iasc(i)= iasc(i) + ichar(titr(j:j))*256
640 j = j+1
641 IF(j>jmax) EXIT
642 iasc(i)= iasc(i) + ichar(titr(j:j))
643 j = j+1
644 IF(j>jmax) EXIT
645 ENDDO
646 RETURN
647 END
648!||====================================================================
649!|| fretitl2 ../starter/source/starter/freform.F
650!||--- called by ------------------------------------------------------
651!|| addmaspart ../starter/source/tools/admas/addmaspart.F
652!|| ale_euler_init ../starter/source/materials/ale/ale_euler_init.F
653!|| bsigini ../starter/source/elements/beam/bsigini.F
654!|| buserini ../starter/source/elements/beam/buserini.F
655!|| c3grhead ../starter/source/elements/sh3n/coque3n/c3grhead.F
656!|| c3grtails ../starter/source/elements/sh3n/coque3n/c3grtails.F
657!|| c3init3 ../starter/source/elements/sh3n/coque3n/c3init3.F
658!|| c3inmas ../starter/source/elements/sh3n/coque3n/c3inmas.F
659!|| cbainit3 ../starter/source/elements/shell/coqueba/cbainit3.F
660!|| cgrtails ../starter/source/elements/shell/coque/cgrtails.F
661!|| checkmp ../starter/source/elements/initia/initia.F
662!|| checkrby ../starter/source/constraints/general/rbody/checkrby.F
663!|| chekmp2 ../starter/source/elements/initia/initia.F
664!|| chkfunct ../starter/source/tools/curve/lecfun.F
665!|| chktyp2 ../starter/source/interfaces/interf1/chktyp2.F
666!|| cinit3 ../starter/source/elements/shell/coque/cinit3.F
667!|| cinmas ../starter/source/elements/shell/coque/cinmas.F
668!|| cm27in3 ../starter/source/materials/mat/mat027/cm27in3.F
669!|| cmatini4 ../starter/source/materials/mat_share/cmatini4.F
670!|| corthini ../starter/source/elements/shell/coque/corthini.F
671!|| csigini ../starter/source/elements/shell/coque/csigini.F
672!|| csigini4 ../starter/source/elements/shell/coqueba/scigini4.F
673!|| cuserini4 ../starter/source/elements/shell/coqueba/cuserini4.F
674!|| desout ../starter/source/output/outp/desout.F
675!|| ecrsub2 ../starter/source/model/assembling/hm_read_subset.F
676!|| fsdcod ../starter/source/system/fsdcod.F
677!|| genani1 ../starter/source/output/anim/genani1.F
678!|| hireorbe3 ../starter/source/constraints/general/rbe3/hm_read_rbe3.F
679!|| hm_read_fxb1 ../starter/source/constraints/fxbody/hm_read_fxb.F
680!|| hm_read_inistate_d00 ../starter/source/elements/initia/hm_read_inistate_d00.F
681!|| hm_read_intsub ../starter/source/output/subinterface/hm_read_intsub.F
682!|| hm_read_merge ../starter/source/constraints/general/merge/hm_read_merge.F
683!|| hm_read_nonlocal ../starter/source/materials/nonlocal/hm_read_nonlocal.F
684!|| hm_read_part ../starter/source/model/assembling/hm_read_part.F
685!|| hm_read_prop04 ../starter/source/properties/spring/hm_read_prop04.F
686!|| hm_read_prop09 ../starter/source/properties/shell/hm_read_prop09.F
687!|| hm_read_prop10 ../starter/source/properties/shell/hm_read_prop10.F
688!|| hm_read_prop11 ../starter/source/properties/shell/hm_read_prop11.F
689!|| hm_read_prop16 ../starter/source/properties/shell/hm_read_prop16.F
690!|| hm_read_prop17 ../starter/source/properties/shell/hm_read_prop17.F
691!|| hm_read_prop19 ../starter/source/properties/shell/hm_read_prop19.F
692!|| hm_read_prop26 ../starter/source/properties/spring/hm_read_prop26.F
693!|| hm_read_prop_generic ../starter/source/properties/hm_read_prop_generic.F
694!|| hm_read_properties ../starter/source/properties/hm_read_properties.F
695!|| hm_read_rbody ../starter/source/constraints/general/rbody/hm_read_rbody.F
696!|| hm_read_sphcel ../starter/source/elements/reader/hm_read_sphcel.F
697!|| hm_read_subset ../starter/source/model/assembling/hm_read_subset.F
698!|| hm_read_thchecksum ../starter/source/output/th/hm_read_thchecksum.F90
699!|| hm_read_thgrki ../starter/source/output/th/hm_read_thgrki.F
700!|| hm_read_thgrki_rbody ../starter/source/output/th/hm_read_thgrki_rbody.F
701!|| hm_read_thgrne ../starter/source/output/th/hm_read_thgrne.F
702!|| hm_read_thgrns ../starter/source/output/th/hm_read_thgrns.F
703!|| hm_read_thgrsens ../starter/source/output/th/hm_read_thgrsens.F
704!|| hm_read_thgrsurf ../starter/source/output/th/hm_read_thgrsurf.F
705!|| hm_read_xref ../starter/source/loads/reference_state/xref/hm_read_xref.F
706!|| hm_thgrki_vent ../starter/source/output/th/hm_thgrki_vent.F
707!|| ini_fxbody ../starter/source/constraints/fxbody/ini_fxbody.F
708!|| iniguser ../starter/source/system/iniguser.F
709!|| inintr ../starter/source/interfaces/interf1/inintr.F
710!|| inintr2 ../starter/source/interfaces/inter3d1/inintr2.F
711!|| inintr_thkvar ../starter/source/interfaces/interf1/inintr_thkvar.F
712!|| inintsub ../starter/source/interfaces/interf1/inintsub.F
713!|| inintsub_11 ../starter/source/output/subinterface/inintsub_11.F
714!|| inintsub_25 ../starter/source/output/subinterface/inintsub_25.F
715!|| inintsub_7 ../starter/source/output/subinterface/inintsub_7.F
716!|| inirbe2 ../starter/source/constraints/general/rbe2/hm_read_rbe2.F
717!|| inirbe3 ../starter/source/constraints/general/rbe3/hm_read_rbe3.F
718!|| initia ../starter/source/elements/initia/initia.F
719!|| inivoid ../starter/source/elements/initia/inivoid.F
720!|| inter_dcod_friction ../starter/source/interfaces/reader/inter_dcod_friction.F
721!|| inter_dcod_function ../starter/source/interfaces/reader/inter_dcod_function.F
722!|| inter_dcod_sensor ../starter/source/interfaces/reader/inter_dcod_sensor.F
723!|| itagsl2 ../starter/source/interfaces/inter3d1/itagsl2.F
724!|| kinchk ../starter/source/constraints/general/kinchk.F
725!|| lcgeo19 ../starter/source/elements/shell/coque/lcgeo19.F
726!|| lecins ../starter/source/interfaces/interf1/lecins.F
727!|| lecint ../starter/source/interfaces/interf1/lecint.F
728!|| lecstack_ply ../starter/source/properties/composite_options/stack/lecstack_ply.F
729!|| lecstamp ../starter/source/interfaces/interf1/lecstamp.F
730!|| lgmini_bc ../starter/source/tools/lagmul/lgmini_bc.F
731!|| lgmini_fxv ../starter/source/tools/lagmul/lgmini_fxv.F
732!|| lgmini_gj ../starter/source/tools/lagmul/lgmini_gj.F
733!|| lgmini_i2 ../starter/source/tools/lagmul/lgmini_i2.F
734!|| lgmini_i7 ../starter/source/tools/lagmul/lgmini_i7.F
735!|| lgmini_mpc ../starter/source/tools/lagmul/lgmini_mpc.F
736!|| lgmini_rby ../starter/source/tools/lagmul/lgmini_rby.F
737!|| lgmini_rwl ../starter/source/tools/lagmul/lgmini_rwl.F
738!|| m20dcod ../starter/source/system/fsdcod.F
739!|| matini ../starter/source/materials/mat_share/matini.F
740!|| multifluid_init3 ../starter/source/multifluid/multifluid_init3.F
741!|| newdbl2 ../starter/source/system/sysfus.F
742!|| outpart ../starter/source/elements/initia/initia.F
743!|| outpart5 ../starter/source/elements/initia/initia.F
744!|| pgrtails ../starter/source/elements/beam/pgrtails.F
745!|| pornod ../starter/source/ale/pornod.F
746!|| q4init2 ../starter/source/elements/solid_2d/quad4/q4init2.F
747!|| qgrhead ../starter/source/elements/solid_2d/quad/qgrhead.F
748!|| qgrtails ../starter/source/elements/solid_2d/quad/qgrtails.F
749!|| qinit2 ../starter/source/elements/solid_2d/quad/qinit2.F
750!|| qmorth2 ../starter/source/elements/solid_2d/quad/qmorth2.F
751!|| rcheckmass ../starter/source/elements/spring/rcheckmass.f
752!|| remn_i2op ../starter/source/interfaces/inter3d1/i7remnode.F
753!|| remn_i2op_edg25 ../starter/source/interfaces/int25/i25remlin.F
754!|| remn_self24 ../starter/source/interfaces/inter3d1/remn_self24.F
755!|| ri2_int24p_ini ../starter/source/interfaces/inter3d1/i7remnode.F
756!|| rigid_mat ../starter/source/materials/mat/mat019/rigid_mat.F
757!|| rini33_rb ../starter/source/elements/joint/rjoint/rini33_rb.F
758!|| rini45_rb ../starter/source/elements/joint/rjoint/rini45_rb.F
759!|| rinit3 ../starter/source/elements/spring/rinit3.F
760!|| rkini3 ../starter/source/elements/spring/rkini3.F
761!|| s10init3 ../starter/source/elements/solid/solide10/s10init3.F
762!|| s16init3 ../starter/source/elements/thickshell/solide16/s16init3.F
763!|| s20init3 ../starter/source/elements/solid/solide20/s20init3.F
764!|| s4init3 ../starter/source/elements/solid/solide4/s4init3.F
765!|| s4refsta3 ../starter/source/elements/solid/solide4/s4refsta3.F
766!|| s6cinit3 ../starter/source/elements/thickshell/solide6c/s6cinit3.F
767!|| s8cinit3 ../starter/source/elements/thickshell/solide8c/s8cinit3.F
768!|| s8zinit3 ../starter/source/elements/solid/solide8z/s8zinit3.F
769!|| scaleini ../starter/source/elements/initia/scaleini.F
770!|| scinit3 ../starter/source/elements/thickshell/solidec/scinit3.F
771!|| scmorth3 ../starter/source/elements/thickshell/solidec/scmorth3.F
772!|| sgrtails ../starter/source/elements/solid/solide/sgrtails.F
773!|| sinit3 ../starter/source/elements/solid/solide/sinit3.F
774!|| smorth3 ../starter/source/elements/solid/solide/smorth3.F
775!|| sms_init ../starter/source/ams/sms_init.F
776!|| spgrtails ../starter/source/elements/sph/spgrtails.F
777!|| sphdcod ../starter/source/elements/sph/sphdcod.F
778!|| st_qaprint_clusters ../starter/source/output/qaprint/st_qaprint_clusters.F
779!|| st_qaprint_constraints ../starter/source/output/qaprint/st_qaprint_constraints.F
780!|| st_qaprint_friction ../starter/source/output/qaprint/st_qaprint_friction.F
781!|| st_qaprint_interfaces ../starter/source/output/qaprint/st_qaprint_interfaces.F
782!|| st_qaprint_loads ../starter/source/output/qaprint/st_qaprint_loads.F
783!|| st_qaprint_materials ../starter/source/output/qaprint/st_qaprint_materials.F
784!|| st_qaprint_model_tools ../starter/source/output/qaprint/st_qaprint_model_tools.F
785!|| st_qaprint_output_databases ../starter/source/output/qaprint/st_qaprint_output_databases.F
786!|| st_qaprint_properties ../starter/source/output/qaprint/st_qaprint_properties.F
787!|| st_qaprint_thgrou ../starter/source/output/qaprint/st_qaprint_time_histories.F
788!|| suinit3 ../starter/source/elements/elbuf_init/suinit3.F
789!|| t3grhead ../starter/source/elements/solid_2d/tria/t3grhead.F
790!|| t3grtails ../starter/source/elements/solid_2d/tria/t3grtails.F
791!|| thprin ../starter/source/output/th/thprin.F
792!|| tinit3 ../starter/source/elements/truss/tinit3.F
793!|| updmat ../starter/source/materials/updmat.F
794!|| write_i_c_debug ../starter/source/output/tools/write_debug.F
795!|| xinit3 ../starter/source/elements/xelem/xinit3.F
796!||--- uses -----------------------------------------------------
797!||====================================================================
798 SUBROUTINE fretitl2(TITR,IASC,L)
799C-----------------------------------------------
800C M o d u l e s
801C-----------------------------------------------
802 USE names_and_titles_mod , ONLY : nchartitle
803C-----------------------------------------------
804C I m p l i c i t T y p e s
805C-----------------------------------------------
806#include "implicit_f.inc"
807C-----------------------------------------------
808C D u m m y A r g u m e n t s
809C-----------------------------------------------
810 INTEGER L,IASC(*)
811 CHARACTER TITR*(*)
812C-----------------------------------------------
813C L o c a l V a r i a b l e s
814C-----------------------------------------------
815 INTEGER I,J
816C-----------------------------------------------
817 j=1
818 DO i=1,l
819 titr(j:j)=char(iasc(i)/65536)
820 j=j+1
821 IF(j>nchartitle) EXIT
822 titr(j:j)=char(mod(iasc(i),65536)/256)
823 j=j+1
824 IF(j>nchartitle) EXIT
825 titr(j:j)=char(mod(iasc(i),256))
826 j=j+1
827 IF(j>nchartitle) EXIT
828 ENDDO
829 RETURN
830 END
831!||====================================================================
832!|| nextsla ../starter/source/starter/freform.F
833!||--- called by ------------------------------------------------------
834!|| sz_r2r ../starter/source/coupling/rad2rad/routines_r2r.F
835!||--- calls -----------------------------------------------------
836!|| my_exit ../starter/source/output/analyse/analyse.c
837!||--- uses -----------------------------------------------------
838!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
839!||====================================================================
840 SUBROUTINE nextsla
841C-----------------------------------------------
842C M o d u l e s
843C-----------------------------------------------
844 USE reader_old_mod , ONLY : line, kline, key0, kcur, lkey0, irec
845C-----------------------------------------------
846C I m p l i c i t T y p e s
847C-----------------------------------------------
848#include "implicit_f.inc"
849C-----------------------------------------------
850C C o m m o n B l o c k s
851C-----------------------------------------------
852#include "scr17_c.inc"
853#include "units_c.inc"
854C-----------------------------------------------
855 IF (irec<=0) THEN
856 irec=1
857 READ(iin,rec=irec,err=999,fmt='(A)')line
858 ELSE
859 READ(iin,rec=irec,err=999,fmt='(A)')line
860 DO WHILE(line(1:1)/='/')
861 irec=irec+1
862 READ(iin,rec=irec,err=999,fmt='(A)')line
863 ENDDO
864 END IF
865 IF(line(2:1+lkey0(kcur))/=key0(kcur)(1:lkey0(kcur)))GOTO 999
866 kline=line
867 RETURN
868 999 CALL freerr(1)
869 CALL my_exit(2)
870 END
871
872!||====================================================================
873!|| fredec_2key_id_or_key_id ../starter/source/starter/freform.F
874!||--- calls -----------------------------------------------------
875!|| ancmsg ../starter/source/output/message/message.F
876!|| my_exit ../starter/source/output/analyse/analyse.c
877!||--- uses -----------------------------------------------------
878!|| format_mod ../starter/share/modules1/format_mod.F90
879!|| message_mod ../starter/share/message_module/message_mod.F
880!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
881!||====================================================================
882 SUBROUTINE fredec_2key_id_or_key_id(KEY2,KEY3,UID,SUB_ID)
883C-----------------------------------------------
884C M o d u l e s
885C-----------------------------------------------
886 USE message_mod
887 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield, ncharline
888 USE format_mod , ONLY : fmt_i
889 USE reader_old_mod , ONLY : kline
890 USE user_id_mod , ONLY : id_limit
891C-----------------------------------------------
892C I m p l i c i t T y p e s
893C-----------------------------------------------
894#include "implicit_f.inc"
895C-----------------------------------------------
896C C o m m o n B l o c k s
897C-----------------------------------------------
898#include "scr17_c.inc"
899C-----------------------------------------------
900 INTEGER UID,SUB_ID
901 CHARACTER(LEN=NCHARTITLE) :: TITR
902 CHARACTER(LEN=NCHARKEY) :: KEY2,KEY3
903C-----------------------------------------------
904 INTEGER I,J1,J2,J3,J, JMAX
905 CHARACTER(LEN=NCHARFIELD) :: MOT1
906C-----------------------------------------------
907C /KEYW/KEY2/KEY3/u_id
908C /KEYW/KEY2/u_id
909C /KEYW/u_id
910C-----------------------------------------------
911
912 jmax = ncharline
913
914C Pass KEY1
915 uid=0
916 sub_id = 0
917 i=2
918 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
919 i=i+1
920 ENDDO
921 key2=' '
922 key3=' '
923 i=i+1
924 IF(i>ncharline)RETURN
925C Read KEY2
926 j1=i
927 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
928 i=i+1
929 ENDDO
930 IF (i>=ncharline) THEN
931 mot1=kline(j1:i)
932 IF (kline(j1:min(jmax,j1+2))/='AUX' .AND.
933 . kline(j1:min(jmax,j1+3))/='EPSP' .AND.
934 . kline(j1:min(jmax,j1+5))/='EPSP_F' .AND.
935 . kline(j1:min(jmax,j1+4))/='ORTHO' .AND.
936 . kline(j1:min(jmax,j1+5))/='STRA_F' .AND.
937 . kline(j1:min(jmax,j1+5))/='STRS_F' .AND.
938 . kline(j1:min(jmax,j1+4))/='THICK' .AND.
939 . kline(j1:min(jmax,j1+7))/='ORTH_LOC'.AND.
940 . kline(j1:min(jmax,j1+5))/='STRESS' .AND.
941 . kline(j1:min(jmax,j1+9))/='SCALE_YLD'.AND.
942 . kline(j1:min(jmax,j1+4))/='FAIL' .AND.
943 . kline(j1:min(jmax,j1+4))/='FILL' .AND.
944 . kline(j1:min(jmax,j1+4))/='FULL' .AND.
945 . kline(j1:min(jmax,j1+3))/='DENS' .AND.
946 . kline(j1:min(jmax,j1+3))/='EREF' .AND.
947 . kline(j1:min(jmax,j1+3))/='ENER' ) THEN
948 READ(mot1,err=999,fmt=fmt_i)uid
949 IF (uid > id_limit%GLOBAL .OR. uid < 0) THEN
950 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,i1=uid,c1=kline)
951 RETURN
952 ENDIF
953 RETURN
954 ENDIF
955 ENDIF
956 IF (kline(j1:min(jmax,j1+2))=='AUX') THEN
957 j2=j1+3
958 ENDIF
959 IF (kline(j1:min(jmax,j1+3))=='EPSP') THEN
960 j2=j1+4
961 ENDIF
962 IF (kline(j1:min(jmax,j1+5))=='EPSP_F') THEN
963 j2=j1+6
964 ENDIF
965 IF (kline(j1:min(jmax,j1+4))=='ORTHO') THEN
966 j2=j1+5
967 ENDIF
968 IF (kline(j1:min(jmax,j1+8))=='STRA_FGLO') THEN
969 j2=j1+6
970 ELSEIF (kline(j1:min(jmax,j1+5))=='STRA_F') THEN
971 j2=j1+6
972 ENDIF
973 IF (kline(j1:min(jmax,j1+8))=='STRS_FGLO') THEN
974 j2=j1+9
975 ELSEIF (kline(j1:min(jmax,j1+5))=='STRS_F') THEN
976 j2=j1+6
977 ENDIF
978 IF (kline(j1:min(jmax,j1+4))=='THICK') THEN
979 j2=j1+5
980 ENDIF
981 IF (kline(j1:min(jmax,j1+7))=='ORTH_LOC') THEN
982 j2=j1+8
983 ENDIF
984 IF (kline(j1:min(jmax,j1+5))=='STRESS') THEN
985 j2=j1+6
986 ENDIF
987 IF (kline(j1:min(jmax,j1+9))=='SCALE_YLD') THEN
988 j2=j1+9
989 ENDIF
990 IF (kline(j1:min(jmax,j1+5))=='FAIL') THEN
991 j2=j1+4
992 ENDIF
993 IF (kline(j1:min(jmax,j1+5))=='FILL') THEN
994 j2=j1+4
995 ENDIF
996 IF (kline(j1:min(jmax,j1+5))=='FULL') THEN
997 j2=j1+4
998 ENDIF
999 IF (kline(j1:min(jmax,j1+3))=='DENS') THEN
1000 j2=j1+4
1001 ENDIF
1002 IF (kline(j1:min(jmax,j1+3))=='ENER') THEN
1003 j2=j1+4
1004 ENDIF
1005 IF (kline(j1:min(jmax,j1+3))=='EREF') THEN
1006 j2=j1+4
1007 ENDIF
1008 key2=kline(j1:min(jmax,j2-1))
1009C Read KEY3
1010 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
1011 i=i+1
1012 ENDDO
1013 j2 = i+1
1014 j2 = min(jmax,j2)
1015 IF (i>=ncharline) THEN
1016 mot1=kline(j2:i)
1017 IF (kline(j2:min(jmax,j2+5))/='STRA_F'.AND.
1018 . kline(j2:min(jmax,j2+5))/='STRS_F') THEN
1019 READ(mot1,err=999,fmt=fmt_i)uid
1020 IF (uid > id_limit%GLOBAL .OR. uid < 0) THEN
1021 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,
1022 . i1=uid,c1=kline)
1023 RETURN
1024 ENDIF
1025 RETURN
1026 ENDIF
1027 ENDIF
1028 IF (kline(j2:min(jmax,j2+3))=='GLOB') THEN
1029 j3=j2+3
1030 j3 = min(jmax,j3)
1031 i = j3
1032 key3=kline(j2:j3)
1033 DO WHILE(kline(i:i)/='/' .AND. i<ncharline)
1034 i=i+1
1035 ENDDO
1036 i=i+1
1037 i=min(ncharline,i)
1038 ELSEIF (kline(j2:min(jmax,j2+8))=='STRA_FGLO' .OR.
1039 . kline(j2:min(jmax,j2+8))=='STRS_FGLO' ) THEN
1040 j3=j2+8
1041 j3 = min(jmax,j3)
1042 i = j3
1043 key3=kline(j2:j3)
1044 DO WHILE(kline(i:i)/='/' .AND. i<ncharline)
1045 i=i+1
1046 ENDDO
1047 i=i+1
1048 i=min(jmax,i)
1049 ELSEIF (kline(j2:min(jmax,j2+5))=='STRA_F' .OR.
1050 . kline(j2:min(jmax,j2+5))=='STRS_F' ) THEN
1051 j3=j2+5
1052 j3 = min(jmax,j3)
1053 i = j3
1054 key3=kline(j2:j3)
1055 DO WHILE(kline(i:i)/='/' .AND. i<ncharline)
1056 i=i+1
1057 ENDDO
1058 i=i+1
1059 i = min(jmax,i)
1060 ELSE
1061 j3=j2
1062 i=i+1
1063 i = min(jmax,i)
1064 key3=' '
1065 ENDIF
1066C--- read UID
1067 j1=i
1068 DO WHILE(kline(i:i)/='/' .AND. i<ncharline)
1069 i=i+1
1070 ENDDO
1071 mot1=kline(j1:i-1)
1072 READ(mot1,err=999,fmt=fmt_i)uid
1073 IF (uid > id_limit%GLOBAL .OR. uid < 0) THEN
1074 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,
1075 . i1=uid,c1=kline)
1076 ENDIF
1077C--- read SUB_ID
1078 i=i+1
1079 i = min(jmax,i)
1080 j1=i
1081 DO WHILE(kline(i:i)/='/' .AND. i<ncharline)
1082 i=i+1
1083 ENDDO
1084 mot1=kline(j1:i-1)
1085 READ(mot1,err=999,fmt=fmt_i)sub_id
1086C---
1087 RETURN
1088 999 CALL freerr(0)
1089 CALL my_exit(2)
1090 END
1091!||====================================================================
1092!|| fredec_2key_4id_t ../starter/source/starter/freform.F
1093!||--- called by ------------------------------------------------------
1094!|| nbadigemesh ../starter/source/elements/ige3d/nbadigemesh.F
1095!||--- calls -----------------------------------------------------
1096!|| ancmsg ../starter/source/output/message/message.F
1097!|| freerr ../starter/source/starter/freform.F
1098!|| my_exit ../starter/source/output/analyse/analyse.c
1099!||--- uses -----------------------------------------------------
1100!|| format_mod ../starter/share/modules1/format_mod.f90
1101!|| message_mod ../starter/share/message_module/message_mod.F
1102!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
1103!||====================================================================
1104 SUBROUTINE fredec_2key_4id_t(KEY2,ID,UID,VERS,SUB_ID,TITR)
1105C-----------------------------------------------
1106C M o d u l e s
1107C-----------------------------------------------
1108 USE reader_old_mod , ONLY : kline, irec
1109 USE message_mod
1110 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
1111 USE format_mod , ONLY : fmt_i
1112 USE user_id_mod , ONLY : id_limit
1113C-----------------------------------------------
1114C I m p l i c i t T y p e s
1115C-----------------------------------------------
1116#include "implicit_f.inc"
1117C-----------------------------------------------
1118C C o m m o n B l o c k s
1119C-----------------------------------------------
1120#include "scr17_c.inc"
1121#include "units_c.inc"
1122C-----------------------------------------------
1123 INTEGER ID,UID,VERS,SUB_ID
1124 CHARACTER(LEN=NCHARTITLE) :: TITR
1125 CHARACTER(LEN=NCHARKEY) :: KEY2
1126C-----------------------------------------------
1127 INTEGER I,J1,J2,J
1128 CHARACTER(LEN=NCHARFIELD) :: MOT1
1129C-----------------------------------------------
1130C /KEYW/KEY2/int_id/u_id/VERS
1131C + char_title
1132C-----------------------------------------------
1133C Pass KEY1
1134 i=2
1135 DO WHILE(kline(i:i)/='/')
1136 i=i+1
1137 IF(i>ncharline)CALL freerr(0)
1138 ENDDO
1139 i=i+1
1140C Read KEY2
1141 j1=i
1142 DO WHILE(kline(i:i)/='/')
1143 i=i+1
1144 IF(i>ncharline)CALL freerr(0)
1145 ENDDO
1146 j2=i-1
1147 key2=kline(j1:j2)
1148 i=i+1
1149C--- read ID
1150 j1=i
1151 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1152 i=i+1
1153 ENDDO
1154 IF (i > ncharline) CALL freerr(0)
1155 j2 = i-1
1156 mot1=kline(j1:j2)
1157 READ(mot1,err=999,fmt=fmt_i)id
1158 IF (id > id_limit%GLOBAL .OR. id <= 0) THEN
1159 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,i1=id,c1=kline)
1160 ENDIF
1161 i =i+1
1162C--- read UID
1163 j1=i
1164 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1165 i=i+1
1166 ENDDO
1167 IF (i > ncharline) CALL freerr(0)
1168 j2 = i-1
1169 mot1=kline(j1:j2)
1170 READ(mot1,err=999,fmt=fmt_i)uid
1171 IF (uid > id_limit%GLOBAL .OR. uid < 0) THEN
1172 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,i1=uid,c1=kline)
1173 ENDIF
1174 i =i+1
1175C--- read VERS
1176 j1=i
1177 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1178 i=i+1
1179 ENDDO
1180 j2 = i-1
1181 mot1=kline(j1:j2)
1182 READ(mot1,err=999,fmt=fmt_i)vers
1183C--- read SUB_ID
1184 i =i+1
1185 j1=i
1186 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1187 i=i+1
1188 ENDDO
1189 j2 = i-1
1190 mot1=kline(j1:j2)
1191 READ(mot1,err=999,fmt=fmt_i)sub_id
1192C--- read TITR
1193 irec=irec+1
1194 READ(iin,rec=irec,err=999,fmt='(A)') titr
1195C---
1196 RETURN
1197 999 CALL freerr(0)
1198 CALL my_exit(2)
1199 END
1200!||====================================================================
1201!|| fredec_key_3id_t ../starter/source/starter/freform.F
1202!||--- called by ------------------------------------------------------
1203!|| nbadigemesh ../starter/source/elements/ige3d/nbadigemesh.F
1204!||--- calls -----------------------------------------------------
1205!|| ancmsg ../starter/source/output/message/message.F
1206!|| freerr ../starter/source/starter/freform.F
1207!|| my_exit ../starter/source/output/analyse/analyse.c
1208!||--- uses -----------------------------------------------------
1209!|| format_mod ../starter/share/modules1/format_mod.F90
1210!|| message_mod ../starter/share/message_module/message_mod.F
1211!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
1212!||====================================================================
1213 SUBROUTINE fredec_key_3id_t(ID,UID,VERS,TITR)
1214C-----------------------------------------------
1215C M o d u l e s
1216C-----------------------------------------------
1217 USE message_mod
1218 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
1219 USE format_mod , ONLY : fmt_i
1220 USE reader_old_mod , ONLY : kline, irec
1221 USE user_id_mod , ONLY : id_limit
1222C-----------------------------------------------
1223C I m p l i c i t T y p e s
1224C-----------------------------------------------
1225#include "implicit_f.inc"
1226C-----------------------------------------------
1227C C o m m o n B l o c k s
1228C-----------------------------------------------
1229#include "scr17_c.inc"
1230#include "units_c.inc"
1231C-----------------------------------------------
1232 INTEGER IOP,ID,UID,VERS
1233 CHARACTER(LEN=NCHARFIELD) :: MOT1
1234 CHARACTER(LEN=NCHARTITLE) :: TITR
1235 INTEGER I,J1,J2
1236C-----------------------------------------------
1237C /KEYW/int_id/uid/VERS
1238C-----------------------------------------------
1239 i=2
1240 DO WHILE(kline(i:i)/='/')
1241 i=i+1
1242 IF (i > ncharline)CALL freerr(0)
1243 ENDDO
1244 i=i+1
1245 IF (i > ncharline)CALL freerr(0)
1246C--- read ID
1247 j1=i
1248 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1249 i=i+1
1250 ENDDO
1251 IF (i > ncharline) CALL freerr(0)
1252 j2 = i-1
1253 mot1=kline(j1:j2)
1254 READ(mot1,err=999,fmt=fmt_i)id
1255 IF (id > id_limit%GLOBAL .OR. id <= 0) THEN
1256 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,i1=id,c1=kline)
1257 ENDIF
1258 i =i+1
1259C--- read UID
1260 j1=i
1261 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1262 i=i+1
1263 ENDDO
1264 IF (i > ncharline) CALL freerr(0)
1265 j2 = i-1
1266 mot1=kline(j1:j2)
1267 READ(mot1,err=999,fmt=fmt_i)uid
1268 IF (uid > id_limit%GLOBAL .OR. uid < 0) THEN
1269 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,i1=uid,c1=kline)
1270 ENDIF
1271 i =i+1
1272C--- read VERS
1273 j1=i
1274 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1275 i=i+1
1276 ENDDO
1277 j2 = i-1
1278 mot1=kline(j1:j2)
1279 READ(mot1,err=999,fmt=fmt_i)vers
1280C--- read TITR
1281 irec=irec+1
1282 READ(iin,rec=irec,err=999,fmt='(A)') titr
1283C---
1284 RETURN
1285 999 CALL freerr(0)
1286 CALL my_exit(2)
1287 END
1288!||====================================================================
1289!|| fredec_2key_4id ../starter/source/starter/freform.F
1290!||--- calls -----------------------------------------------------
1291!|| ancmsg ../starter/source/output/message/message.F
1292!|| freerr ../starter/source/starter/freform.F
1293!|| my_exit ../starter/source/output/analyse/analyse.c
1294!||--- uses -----------------------------------------------------
1295!|| format_mod ../starter/share/modules1/format_mod.F90
1296!|| message_mod ../starter/share/message_module/message_mod.F
1297!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
1298!||====================================================================
1299 SUBROUTINE fredec_2key_4id(KEY2,ID,UID,VERS,SUB_ID)
1300C-----------------------------------------------
1301C M o d u l e s
1302C-----------------------------------------------
1303 USE message_mod
1304 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
1305 USE format_mod , ONLY : fmt_i
1306 USE reader_old_mod , ONLY : kline
1307 USE user_id_mod , ONLY : id_limit
1308C-----------------------------------------------
1309C I m p l i c i t T y p e s
1310C-----------------------------------------------
1311#include "implicit_f.inc"
1312C-----------------------------------------------
1313C C o m m o n B l o c k s
1314C-----------------------------------------------
1315#include "scr17_c.inc"
1316C-----------------------------------------------
1317 INTEGER ID,UID,VERS,SUB_ID
1318 CHARACTER(LEN=NCHARTITLE) :: TITR
1319 CHARACTER(LEN=NCHARKEY) :: KEY2
1320C-----------------------------------------------
1321 INTEGER I,J1,J2,J
1322 CHARACTER(LEN=NCHARFIELD) :: MOT1
1323C-----------------------------------------------
1324C /KEYW/KEY2/int_id/u_id/VERS
1325C-----------------------------------------------
1326C Pass KEY1
1327 i=2
1328 DO WHILE(kline(i:i)/='/')
1329 i=i+1
1330 IF(i>ncharline)CALL freerr(0)
1331 ENDDO
1332 i=i+1
1333C Read KEY2
1334 j1=i
1335 DO WHILE(kline(i:i)/='/')
1336 i=i+1
1337 IF(i>ncharline)CALL freerr(0)
1338 ENDDO
1339 j2=i-1
1340 key2=kline(j1:j2)
1341 i=i+1
1342C--- read ID
1343 j1=i
1344 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1345 i=i+1
1346 ENDDO
1347 IF (i > ncharline) CALL freerr(0)
1348 j2 = i-1
1349 mot1=kline(j1:j2)
1350 READ(mot1,err=999,fmt=fmt_i)id
1351 IF (id > id_limit%GLOBAL .OR. id <= 0) THEN
1352 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,
1353 . i1=id,c1=kline)
1354 ENDIF
1355 i =i+1
1356C--- read UID
1357 j1=i
1358 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1359 i=i+1
1360 ENDDO
1361 IF (i > ncharline) CALL freerr(0)
1362 j2 = i-1
1363 mot1=kline(j1:j2)
1364 READ(mot1,err=999,fmt=fmt_i)uid
1365 IF (uid > id_limit%GLOBAL .OR. uid < 0) THEN
1366 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,
1367 . i1=uid,c1=kline)
1368 ENDIF
1369C--- read VERS
1370 i=i+1
1371 j1=i
1372 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1373 i=i+1
1374 ENDDO
1375 j2=i-1
1376 mot1=kline(j1:j2)
1377 READ(mot1,err=999,fmt=fmt_i) vers
1378C--- read SUB_ID
1379 i=i+1
1380 j1=i
1381 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1382 i=i+1
1383 ENDDO
1384 j2=i-1
1385 mot1=kline(j1:j2)
1386 READ(mot1,err=999,fmt=fmt_i) sub_id
1387C---
1388 RETURN
1389 999 CALL freerr(0)
1390 CALL my_exit(2)
1391 END
my_exit
void my_exit(int *i)
Definition analyse.c:1038
hm_read_cload
subroutine hm_read_cload(ibcl, forc, num, itab, itabm1, igrnod, nwork, unitab, iskn, lsubmodel, loads)
Definition hm_read_cload.F:46
min
#define min(a, b)
Definition macros.h:20
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:668
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1010
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1006
prelecsec4bolt
subroutine prelecsec4bolt(snstrf, ssecbuf, igrnod, itabm1, flag_r2r, nom_opt, igrbric, lsubmodel)
Definition prelecsec4bolt.F:44
rcheckmass
subroutine rcheckmass(ixr, geo, pm, msr, inr, ms, in, itab, igeo, ipm, uparam, ipart, ipartr, npby, lpby)
Definition rcheckmass.F:37
read_dfs_detline
subroutine read_dfs_detline(detonators, x, ipm, itabm1, unitab, lsubmodel)
Definition read_dfs_detline.F:45
read_dfs_wave_shaper
subroutine read_dfs_wave_shaper(detonators, igrnod, ipm, itabm1, unitab, lsubmodel, itab)
Definition read_dfs_wave_shaper.F:47
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:895
fredec_key_3id_t
subroutine fredec_key_3id_t(id, uid, vers, titr)
Definition freform.F:1214
fredec4
subroutine fredec4(copt)
Definition freform.F:90
fredec_2key_4id_t
subroutine fredec_2key_4id_t(key2, id, uid, vers, sub_id, titr)
Definition freform.F:1105
fredec_2key_id_or_key_id
subroutine fredec_2key_id_or_key_id(key2, key3, uid, sub_id)
Definition freform.F:883
nextsla
subroutine nextsla
Definition freform.F:841
freerr
subroutine freerr(it)
Definition freform.F:501
nodgrnr5
integer function nodgrnr5(igu, igs, ibuf, igrnod, itabm1, mess)
Definition freform.F:298
nodgrnr6
integer function nodgrnr6(m, igu, igs, ibuf, igrnod, itabm1, mess, id)
Definition freform.F:359
fredec6
subroutine fredec6(copt, copt2)
Definition freform.F:216
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:615
fredec_2key_4id
subroutine fredec_2key_4id(key2, id, uid, vers, sub_id)
Definition freform.F:1300
fredec0
subroutine fredec0(id)
Definition freform.F:39
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
grfind
integer function grfind(igu, igrnod, mess)
Definition freform.F:432
fredec5
subroutine fredec5(copt, id)
Definition freform.F:141
starter
program starter
Definition starter.F:39
groupdef_mod::group_
Definition groupdef_mod.F:706