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

Go to the source code of this file.

Functions/Subroutines

subroutine fredec2im (line1, id)

Function/Subroutine Documentation

◆ fredec2im()

subroutine fredec2im ( character(len=ncharline) line1,
integer id )

Definition at line 31 of file fredec2im.F.

32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40#include "units_c.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 CHARACTER(LEN=NCHARLINE) :: LINE1
48 INTEGER ID
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 CHARACTER(LEN=NCHARLINE) :: MOT
53 INTEGER I,J1,J2,J
54 mot=' '
55 i=2
56 DO WHILE(line1(i:i)/='/')
57 i=i+1
58 IF(i>ncharline) GOTO 900
59 ENDDO
60 i=i+1
61 IF(i>ncharline) GOTO 900
62 j1=i
63 DO WHILE(line1(i:i)/='/')
64 i=i+1
65 IF(i>ncharline) GOTO 900
66 ENDDO
67 j2=i-1
68C
69 mot=line1(j1:j2)
70 READ(mot,'(I10)',err=910)id
71 RETURN
72C
73C cannot use ANCMSG : used to build message structure
74 900 CONTINUE
75 WRITE(istdo,*)
76 . ' ** ERROR IN FREDEC2IM WHILE GETTING KEY',
77 . ' ** LINE=',line1
78 WRITE(iout,*)
79 . ' ** ERROR IN FREDEC2IM WHILE GETTING KEY',
80 . ' ** LINE=',line1
81 CALL arret(2)
82 RETURN
83 910 CONTINUE
84 WRITE(istdo,*)
85 . ' ** ERROR IN FREDEC2IM WHILE GETTING ID',
86 . ' ** LINE=',line1,
87 . ' ** KEY=',mot,' IS NOT AN INTEGER'
88 WRITE(iout,*)
89 . ' ** ERROR IN FREDEC2IM WHILE GETTING ID',
90 . ' ** LINE=',line1,
91 . ' ** KEY=',mot,' IS NOT AN INTEGER'
92 CALL arret(2)
93 RETURN
initmumps id
integer, parameter ncharline
subroutine arret(nn)
Definition arret.F:87