OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fredamp.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!|| fredamp ../engine/source/input/fredamp.F
25!||--- called by ------------------------------------------------------
26!|| freform ../engine/source/input/freform.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| wriusc2 ../engine/source/input/wriusc2.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../engine/share/message_module/message_mod.F
33!||====================================================================
34 SUBROUTINE fredamp(IKAD,KEY0,KDAMP,NDAMP)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE message_mod
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 IKAD(0:*),KDAMP,NDAMP
47 CHARACTER KEY0(*)*5
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "units_c.inc"
52C-----------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55 INTEGER K, NN, ID, IKEY, IDG, IGR, NBC, KORTH
56 my_real dampa, dampb
57
58C=======================================================================
59 k=0
60 ikey = kdamp
61 igr = 0
62 IF (ndamp == 1) THEN
63 READ(iusc1,rec=ikad(ikey)+k,fmt='(6X,I10,85X,I10)',err=9990)
64 . id,nbc
65
66 IF (id/=1.AND.nbc==1) THEN
67 korth=0
68 k=k+1
69 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
70 READ(iusc2,*,err=9990,END=9990) DAMPA,dampb
71 WRITE(iin,'(I10,1P2G20.13,2I10)') id,dampa,dampb,igr,korth
72 ELSEIF(id==1) THEN
73 IF(nbc==2) THEN
74 k=k+1
75 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
76 READ(iusc2,*,err=9990,END=9990) igr
77 ENDIF
78 IF(nbc/=6)THEN
79 korth=0
80 k=k+1
81 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
82 READ(iusc2,*,err=9990,END=9990) DAMPA,dampb
83 WRITE(iin,'(I10,1P2G20.13,2I10)') id,dampa,dampb,igr,korth
84 ELSE
85 korth=1
86C dampax, dampbx
87 k=k+1
88 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
89 READ(iusc2,*,err=9990,END=9990) DAMPA,dampb
90 WRITE(iin,'(I10,1P2G20.13,2I10)') id,dampa,dampb,igr,korth
91C dampay, dampby
92 k=k+1
93 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
94 READ(iusc2,*,err=9990,END=9990) DAMPA,dampb
95 WRITE(iin,'(1P2G20.13)') dampa,dampb
96C dampaz, dampbz
97 k=k+1
98 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
99 READ(iusc2,*,err=9990,END=9990) DAMPA,dampb
100 WRITE(iin,'(1P2G20.13)') dampa,dampb
101C damparx, dampbrx
102 k=k+1
103 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
104 READ(iusc2,*,err=9990,END=9990) DAMPA,dampb
105 WRITE(iin,'(1P2G20.13)') dampa,dampb
106C dampary, dampbry
107 k=k+1
108 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
109 READ(iusc2,*,err=9990,END=9990) DAMPA,dampb
110 WRITE(iin,'(1P2G20.13)') dampa,dampb
111C damparz, damprbz
112 k=k+1
113 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
114 READ(iusc2,*,err=9990,END=9990) DAMPA,dampb
115 WRITE(iin,'(1P2G20.13)') dampa,dampb
116 END IF
117 ELSE
118 GOTO 9990
119 ENDIF
120 ELSE
121 DO nn=1,ndamp
122 READ(iusc1,rec=ikad(ikey)+k,fmt='(6X,I10,85X,I10)',err=9990)
123 . id,nbc
124
125 IF(nbc/=6)THEN
126 korth=0
127 k=k+1
128 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
129 READ(iusc2,*,err=9990,END=9990) DAMPA,dampb
130 WRITE(iin,'(I10,1P2G20.13,10X,I10)') id,dampa,dampb,korth
131 ELSE
132 korth=1
133C dampax, dampbx
134 k=k+1
135 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
136 READ(iusc2,*,err=9990,END=9990) DAMPA,dampb
137 WRITE(iin,'(I10,1P2G20.13,10X,I10)') id,dampa,dampb,korth
138C dampay, dampby
139 k=k+1
140 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
141 READ(iusc2,*,err=9990,END=9990) DAMPA,dampb
142 WRITE(iin,'(1P2G20.13)') dampa,dampb
143C dampaz, dampbz
144 k=k+1
145 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
146 READ(iusc2,*,err=9990,END=9990) DAMPA,dampb
147 WRITE(iin,'(1P2G20.13)') dampa,dampb
148C damparx, dampbrx
149 k=k+1
150 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
151 READ(iusc2,*,err=9990,END=9990) DAMPA,dampb
152 WRITE(iin,'(1P2G20.13)') dampa,dampb
153C dampary, dampbry
154 k=k+1
155 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
156 READ(iusc2,*,err=9990,END=9990) DAMPA,dampb
157 WRITE(iin,'(1P2G20.13)') dampa,dampb
158C damparz, damprbz
159 k=k+1
160 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
161 READ(iusc2,*,err=9990,END=9990) DAMPA,dampb
162 WRITE(iin,'(1P2G20.13)') dampa,dampb
163 END IF
164 k=k+1
165 ENDDO
166 ENDIF
167C---
168 RETURN
169 9990 CONTINUE
170 CALL ancmsg(msgid=73,anmode=aninfo,
171 . c1=key0(ikey))
172 CALL arret(0)
173 END
my_real
#define my_real
Definition cppsort.cpp:32
fredamp
subroutine fredamp(ikad, key0, kdamp, ndamp)
Definition fredamp.F:35
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1249
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87
wriusc2
subroutine wriusc2(irec, nbc, key0)
Definition wriusc2.F:60