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
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
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
integer, parameter ncharline100
subroutine arret(nn)
Definition arret.F:86