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

Go to the source code of this file.

Functions/Subroutines

subroutine fredec3 (line, key)

Function/Subroutine Documentation

◆ fredec3()

subroutine fredec3 ( character(len=ncharline100) line,
character(len=ncharline100) key )

Definition at line 32 of file fredec3.F.

33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41#include "units_c.inc"
42C-----------------------------------------------
43C D u m m y A r g u m e n t s
44C-----------------------------------------------
45 CHARACTER(LEN=NCHARLINE100)::LINE,KEY
46C-----------------------------------------------
47C L o c a l V a r i a b l e s
48C-----------------------------------------------
49 INTEGER I,J1,J2,J
50 key=' '
51 i=2
52 DO WHILE(line(i:i)/='/')
53 i=i+1
54 IF(i>ncharline100) GOTO 900
55 ENDDO
56 i=i+1
57 DO WHILE(line(i:i)/='/')
58 I=I+1
59 IF(I>NCHARLINE100) GOTO 900
60 ENDDO
61 I=I+1
62 IF(I>NCHARLINE100) GOTO 900
63 J1=I
64 DO WHILE(LINE(I:I)/='/')
65 I=I+1
66 IF(I>NCHARLINE100) THEN
67 J2=NCHARLINE100
68 GOTO 10
69 END IF
70 ENDDO
71 J2=I-1
72 10 CONTINUE
73C
74 KEY=TRIM(LINE(J1:J2))
75 RETURN
76C
77C cannot use ANCMSG : used to build message structure
78 900 CONTINUE
79 WRITE(ISTDO,*)
80 . ' ** error in fredec3 WHILE getting key',
81 . ' ** line=',LINE
82 WRITE(IOUT,*)
83 . ' ** error in fredec3 WHILE getting key',
84 . ' ** line=',LINE
85 CALL ARRET(2)
86 RETURN
subroutine fredec3(line, key)
Definition fredec3.F:33
integer, parameter ncharline100