OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lecdamp.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!|| lecdamp ../engine/source/input/lecdamp.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../engine/source/input/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| ngr2usr ../engine/source/input/freform.F
31!||--- uses -----------------------------------------------------
32!|| groupdef_mod ../common_source/modules/groupdef_mod.F
33!|| message_mod ../engine/share/message_module/message_mod.F
34!||====================================================================
35 SUBROUTINE lecdamp(ND, DAMPR, IGRNOD)
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE message_mod
40 USE groupdef_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "scr07_c.inc"
49#include "stati_c.inc"
50#include "statr_c.inc"
51#include "units_c.inc"
52#include "com04_c.inc"
53#include "warn_c.inc"
54#include "param_c.inc"
55#include "task_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER ND
60 my_real dampr(nrdamp,*)
61 TYPE(group_) ,DIMENSION(NGRNOD) :: IGRNOD
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER K, L, ID, IDNEW, NGR, OK, KORTH
66C REAL
67 my_real
68 . dampa,dampb,dampay,dampby,dampaz,dampbz,factb,
69 . damparx,dampbrx,dampary,dampbry,damparz,dampbrz
70c . TSTART,TSTOP
71C-----------------------------------------------
72C E x t e r n a l F u n c t i o n s
73C-----------------------------------------------
74 INTEGER NGR2USR
75 EXTERNAL ngr2usr
76C-----------------------------------------------
77 IF (nd>0) THEN
78 IF (idamp0 == 1) THEN
79 IF (nd>1) THEN
80 IF (ispmd==0)THEN
81 WRITE(istdo,*)' ** ERROR: INPUT ERROR IN OPTION DAMP'
82 WRITE(iout,* )' ** ERROR: INPUT ERROR IN OPTION DAMP'
83 WRITE(iout,*) ' V41 FORMAT ALLOWS ONLY ONE /DAMP OPTION'
84 END IF
85 CALL arret(2)
86 ENDIF
87 dampa0 = 0.
88 dampb0 = 0.
89 READ (iin,'(I10,2E16.9,I8)') idnew,dampa0,dampb0,ngr
90 IF (mcheck==0) THEN
91 idampg = ngr2usr(ngr,igrnod,ngrnod)
92 IF (idampg==0) ngr = 0
93 dampa = dampa0
94 dampb = dampb0
95 IF (ispmd==0) WRITE(iout,2241) ngr,dampa,dampb
96 ENDIF
97 ELSEIF (ndamp>0) THEN
98 IF (ispmd==0) WRITE (iout,2000) nd
99 DO k=1,nd
100 READ (iin,'(I10,2E20.0,2I10,E20.0)') idnew,dampa,dampb,ngr,
101 . korth,factb
102c READ (IIN,'(I10,2E20.0,2I10,2E20.0)') IDNEW,DAMPA,DAMPB,NGR,
103c . KORTH,TSTART,TSTOP
104c FACTB = ZERO
105c IF(TSTOP == ZERO) TSTOP = EP30
106 IF (ngr/=0) THEN
107 IF (ispmd==0) THEN
108 WRITE(istdo,*)' ** ERROR: INPUT ERROR IN OPTION DAMP'
109 WRITE(iout,* )' ** ERROR: INPUT ERROR IN OPTION DAMP'
110 WRITE(iout,*) ' NOT A V44 FORMAT '
111 END IF
112 CALL arret(2)
113 ENDIF
114 IF (factb == zero) factb = one
115 IF(korth==0)THEN
116 IF (ispmd==0) WRITE (iout,2200) idnew,dampa,dampb,factb
117c IF (ISPMD==0) WRITE (IOUT,2200) IDNEW,DAMPA,DAMPB,FACTB,
118c . TSTART,TSTOP
119 ok=0
120 IF (ndamp == 1 .AND. idnew == 0) THEN
121 id = dampr(1,1)
122 dampr(3,1) = dampa
123 dampr(4,1) = dampb
124 dampr(16,1)= factb
125 ok=1
126 ELSE
127 DO l=1,ndamp
128 id = dampr(1,l)
129 IF(id==idnew) THEN
130 dampr(3,l) = dampa
131 dampr(4,l) = dampb
132 dampr(5,l) = dampa
133 dampr(6,l) = dampb
134 dampr(7,l) = dampa
135 dampr(8,l) = dampb
136 dampr(9,l) = dampa
137 dampr(10,l) = dampb
138 dampr(11,l) = dampa
139 dampr(12,l) = dampb
140 dampr(13,l) = dampa
141 dampr(14,l) = dampb
142 dampr(16,l) = factb
143c DAMPR(17,L) = TSTART
144c DAMPR(18,L) = TSTOP
145 ok=1
146 ENDIF
147 ENDDO
148 ENDIF
149 ELSE
150 IF(nrdamp<15)THEN
151 ierr=ierr+1
152 IF (ispmd==0) THEN
153 CALL ancmsg(msgid=203,anmode=aninfo,
154 . i1=idnew)
155 END IF
156 CALL arret(2)
157 END IF
158 READ (iin,'(2E20.0)') dampay,dampby
159 READ (iin,'(2E20.0)') dampaz,dampbz
160 READ (iin,'(2E20.0)') damparx,dampbrx
161 READ (iin,'(2E20.0)') dampary,dampbry
162 READ (iin,'(2E20.0)') damparz,dampbrz
163 IF (ispmd==0) WRITE (iout,2250) idnew,
164 . dampa,dampb,dampay,dampby,dampaz,dampbz,
165 . damparx,dampbrx,dampary,dampbry,damparz,dampbrz
166c IF (ISPMD==0) WRITE (IOUT,2250) IDNEW,
167c . DAMPA,DAMPB,DAMPAY,DAMPBY,DAMPAZ,DAMPBZ,
168c . DAMPARX,DAMPBRX,DAMPARY,DAMPBRY,DAMPARZ,DAMPBRZ,
169c . TSTART,TSTOP
170 ok=0
171 DO l=1,ndamp
172 id = dampr(1,l)
173 IF(id==idnew) THEN
174 dampr(3,l) = dampa
175 dampr(4,l) = dampb
176 dampr(5,l) = dampay
177 dampr(6,l) = dampby
178 dampr(7,l) = dampaz
179 dampr(8,l) = dampbz
180 dampr(9,l) = damparx
181 dampr(10,l) = dampbrx
182 dampr(11,l) = dampary
183 dampr(12,l) = dampbry
184 dampr(13,l) = damparz
185 dampr(14,l) = dampbrz
186 dampr(16,l) = factb
187c DAMPR(17,L) = TSTART
188c DAMPR(18,L) = TSTOP
189 ok=1
190 ENDIF
191 ENDDO
192 END IF
193 IF(ok==0)THEN
194 ierr=ierr+1
195 IF (ispmd==0) THEN
196 CALL ancmsg(msgid=203,anmode=aninfo,
197 . i1=idnew)
198 END IF
199 CALL arret(2)
200 ENDIF
201 ENDDO
202 ELSE
203 IF (ispmd==0) THEN
204 CALL ancmsg(msgid=204,anmode=aninfo)
205 END IF
206 CALL arret(2)
207 ENDIF
208 ENDIF
209C
210 RETURN
211C
212 2000 FORMAT(' RAYLEIGH DAMPING' /
213 . ' NUMBER OF NEW DAMPING PARAMETERS. . . . . . =' ,i8 /)
214 2050 FORMAT(' ** ERROR: INPUT ERROR IN OPTION DAMP',/
215 .' WRONG NUMBER OF DAMPING PARAMETERS FOR /DAMP/ID NUMBER:',
216 . i10/)
217 2100 FORMAT(' ** ERROR: INPUT ERROR IN OPTION DAMP',/
218 . ' /DAMP/ID NUMBER:',i10,' NOT FOUND'/)
219 2200 FORMAT('DAMPING ID . . . . . . . . . . . . .',i10
220 . /5x,'ALPHA. . . . . . . . . . . . . .',1pg20.13
221 . /5x,'BETA . . . . . . . . . . . . . .',1pg20.13
222 . /5x,'MAX TIME STEP FACTOR . . . . . .',1pg20.13/)
223c . /5X,'START TIME . . . . . . . . . . .',1PG20.13
224c . /5X,'STOP TIME . . . . . . . . . . .',1PG20.13/)
225 2250 FORMAT('DAMPING ID . . . . . . . . . . . . .',i10
226 . /5x,'ALPHAX . . . . . . . . . . . . .',1pg20.13
227 . /5x,'BETAX. . . . . . . . . . . . . .',1pg20.13
228 . /5x,'ALPHAY . . . . . . . . . . . . .',1pg20.13
229 . /5x,'BETAY. . . . . . . . . . . . . .',1pg20.13
230 . /5x,'ALPHAZ . . . . . . . . . . . . .',1pg20.13
231 . /5x,'BETAZ. . . . . . . . . . . . . .',1pg20.13
232 . /5x,'ALPHARX. . . . . . . . . . . . .',1pg20.13
233 . /5x,'BETARX . . . . . . . . . . . . .',1pg20.13
234 . /5x,'ALPHARY. . . . . . . . . . . . .',1pg20.13
235 . /5x,'BETARY . . . . . . . . . . . . .',1pg20.13
236 . /5x,'ALPHARZ. . . . . . . . . . . . .',1pg20.13
237 . /5x,'BETARZ . . . . . . . . . . . . .',1pg20.13/)
238c . /5X,'START TIME . . . . . . . . . . .',1PG20.13
239c . /5X,'STOP TIME . . . . . . . . . . .',1PG20.13/)
240 2241 FORMAT(/
241 . ' RAYLEIGH DAMPING '/
242 . ' NODE GROUP ID (=0 ALL NODES) . . . . . . . . . . ',i5/
243 . ' ALPHA . . . . . . . . . . . . . . . . . . . . . ',g14.7/
244 . ' BETA . . . . . . . . . . . . . . . . . . . . . . ',g14.7/)
245 END
my_real
#define my_real
Definition cppsort.cpp:32
lecdamp
subroutine lecdamp(nd, dampr, igrnod)
Definition lecdamp.F:36
groupdef_mod
Definition groupdef_mod.F:662
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
groupdef_mod::group_
Definition groupdef_mod.F:700