OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
redsqr.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/.
23!||====================================================================
24!|| redsqr ../engine/source/output/tools/redsqr.F
25!||--- called by ------------------------------------------------------
26!|| convrrest ../engine/source/output/restart/rdresb.F
27!|| dsrrest ../engine/source/output/restart/rdresb.F
28!|| eigrrest ../engine/source/output/restart/rdresb.f
29!|| fxbresb ../engine/source/output/restart/rdresb.F
30!|| fxfluxrrest ../engine/source/constraints/thermic/fxfluxrrest.F
31!|| fxtemprrest ../engine/source/output/restart/rdresb.F
32!|| nfrrest ../engine/source/output/restart/rdresb.F
33!|| nitscherrest ../engine/source/output/restart/rdresb.F
34!|| radiarrest ../engine/source/output/restart/rdresb.F
35!|| rmatrrest ../engine/source/output/restart/rdresb.F
36!|| thcrrest ../engine/source/output/restart/rdresb.F
37!||====================================================================
38 SUBROUTINE redsqr(A,L,IFORM)
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER L, IFORM
47C REAL
48 my_real
49 . a(*)
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "scr13_c.inc"
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER LREC, L1, L2, I
58 CHARACTER*8 STR(10),OneSTR
59C-----------------------------------------------
60C E x t e r n a l F u n c t i o n s
61C-----------------------------------------------
62 INTEGER IC
63C REAL
64 my_real
65 . rstr
66 EXTERNAL rstr
67C-----------------------------------------------
68 IF (l==0)RETURN
69 IF (mod(iform,5)==1)THEN
70 lrec=10
71 ELSE
72 lrec=2000
73 ENDIF
74C
75 l1=1
76 l2=lrec
77 1 l2=min(l,l2)
78
79 IF (mod(iform,5)==1)THEN
80 READ(iunit,'(10A8)') (str(i),i=1,10)
81 DO i=l1,l2
82 onestr=str(i-l1+1)
83 a(i)=rstr(onestr)
84 ENDDO
85 ELSE
86 READ(iunit) (a(i),i=l1,l2)
87 ENDIF
88
89 IF(l2==l)RETURN
90 l1=l2+1
91 l2=l1+lrec-1
92 GOTO 1
93 END
94!||====================================================================
95!|| redsqrdp ../engine/source/output/tools/redsqr.F
96!||====================================================================
97 SUBROUTINE redsqrdp(A,L,IFORM)
98C-----------------------------------------------
99C I m p l i c i t T y p e s
100C-----------------------------------------------
101#include "implicit_f.inc"
102C-----------------------------------------------
103C D u m m y A r g u m e n t s
104C-----------------------------------------------
105 INTEGER L, IFORM
106C REAL
107 double precision
108 . a(*)
109C-----------------------------------------------
110C C o m m o n B l o c k s
111C-----------------------------------------------
112#include "scr13_c.inc"
113C-----------------------------------------------
114C L o c a l V a r i a b l e s
115C-----------------------------------------------
116 INTEGER LREC, L1, L2, I
117 CHARACTER*8 STR(10),OneSTR
118C-----------------------------------------------
119C E x t e r n a l F u n c t i o n s
120C-----------------------------------------------
121C REAL
122 my_real
123 . rstr
124 my_real
125 . val
126C-----------------------------------------------
127 EXTERNAL rstr
128 IF (l==0)RETURN
129 IF (mod(iform,5)==1)THEN
130 lrec=10
131 ELSE
132 lrec=2000
133 ENDIF
134C
135 l1=1
136 l2=lrec
137 1 l2=min(l,l2)
138 IF (mod(iform,5)==1)THEN
139 READ(iunit,'(10A8)') (str(i),i=1,10)
140 DO i=l1,l2
141 onestr=str(i-l1+1)
142 val=rstr(onestr)
143 a(i)=val
144 ENDDO
145 ELSE
146 READ(iunit) (a(i),i=l1,l2)
147 ENDIF
148 IF(l2==l)RETURN
149 l1=l2+1
150 l2=l1+lrec-1
151 GOTO 1
152 END
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
rdresb
subroutine rdresb(af, iaf, lvarrea, irunn, multi_fvm, h3d_data, pinch_data, ale_connectivity, t_monvol, sensors, ebcs_tab, dynain_data, user_windows, output, interfaces, loads, mat_elem, python, iflow, skews, rflow, liflow, lrflow, impl_s0, forneqs, unitab, stack, drape_sh4n, drape_sh3n, drapeg, ndrape, glob_therm, pblast, element, nodes, rbe3)
Definition rdresb.F:159
eigrrest
subroutine eigrrest()
Definition rdresb.F:1808
redsqr
subroutine redsqr(a, l, iform)
Definition redsqr.F:39
redsqrdp
subroutine redsqrdp(a, l, iform)
Definition redsqr.F:98