OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rstr.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 REAL
24#include "my_real.inc"
26 . FUNCTION rstr(STR)
27C-----------------------------------------------
28C I m p l i c i t T y p e s
29C-----------------------------------------------
30#include "implicit_f.inc"
31C-----------------------------------------------
32C D u m m y A r g u m e n t s
33C-----------------------------------------------
34 CHARACTER str*8
35C-----------------------------------------------
36C C o m m o n B l o c k s
37C-----------------------------------------------
38#include "ascchr_c.inc"
39C-----------------------------------------------
40C L o c a l V a r i a b l e s
41C-----------------------------------------------
42 INTEGER is, iexp, mant11, mant12, mant21, mant22, mant31, mant32,
43 . ism, ise, mant1, mant2, mant3
44C-----------------------------------------------
45 is=iascod(ichar(str(1:1)))-1
46 iexp=iascod(ichar(str(2:2)))
47 mant11=iascod(ichar(str(3:3)))
48 mant12=iascod(ichar(str(4:4)))
49 mant21=iascod(ichar(str(5:5)))
50 mant22=iascod(ichar(str(6:6)))
51 mant31=iascod(ichar(str(7:7)))
52 mant32=iascod(ichar(str(8:8)))
53C
54 ism=is/2
55 ise=is-2*ism
56 mant1=mant11*32+mant12
57 mant2=mant21*32+mant22
58 mant3=mant31*32+mant32
59C
60 IF(ise==1)iexp=-iexp
61 rstr=mant3+mant2*1000+mant1*1000000
62 rstr=rstr/ep9
63 rstr=rstr*ten**iexp
64 IF(ism==1)rstr=-rstr
65C
66 RETURN
67 END
#define my_real
Definition cppsort.cpp:32