OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lecdamp.F File Reference
#include "implicit_f.inc"
#include "scr07_c.inc"
#include "stati_c.inc"
#include "statr_c.inc"
#include "units_c.inc"
#include "com04_c.inc"
#include "warn_c.inc"
#include "param_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine lecdamp (nd, dampr, igrnod)

Function/Subroutine Documentation

◆ lecdamp()

subroutine lecdamp ( integer nd,
dampr,
type(group_), dimension(ngrnod) igrnod )

Definition at line 35 of file lecdamp.F.

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 2200 FORMAT('DAMPING ID . . . . . . . . . . . . .',i10
215 . /5x,'ALPHA. . . . . . . . . . . . . .',1pg20.13
216 . /5x,'BETA . . . . . . . . . . . . . .',1pg20.13
217 . /5x,'MAX TIME STEP FACTOR . . . . . .',1pg20.13/)
218c . /5X,'START TIME . . . . . . . . . . .',1PG20.13
219c . /5X,'STOP TIME . . . . . . . . . . .',1PG20.13/)
220 2250 FORMAT('DAMPING ID . . . . . . . . . . . . .',i10
221 . /5x,'ALPHAX . . . . . . . . . . . . .',1pg20.13
222 . /5x,'BETAX. . . . . . . . . . . . . .',1pg20.13
223 . /5x,'ALPHAY . . . . . . . . . . . . .',1pg20.13
224 . /5x,'BETAY. . . . . . . . . . . . . .',1pg20.13
225 . /5x,'ALPHAZ . . . . . . . . . . . . .',1pg20.13
226 . /5x,'BETAZ. . . . . . . . . . . . . .',1pg20.13
227 . /5x,'ALPHARX. . . . . . . . . . . . .',1pg20.13
228 . /5x,'BETARX . . . . . . . . . . . . .',1pg20.13
229 . /5x,'ALPHARY. . . . . . . . . . . . .',1pg20.13
230 . /5x,'BETARY . . . . . . . . . . . . .',1pg20.13
231 . /5x,'ALPHARZ. . . . . . . . . . . . .',1pg20.13
232 . /5x,'BETARZ . . . . . . . . . . . . .',1pg20.13/)
233c . /5X,'START TIME . . . . . . . . . . .',1PG20.13
234c . /5X,'STOP TIME . . . . . . . . . . .',1PG20.13/)
235 2241 FORMAT(/
236 . ' RAYLEIGH DAMPING '/
237 . ' NODE GROUP ID (=0 ALL NODES) . . . . . . . . . . ',i5/
238 . ' ALPHA . . . . . . . . . . . . . . . . . . . . . ',g14.7/
239 . ' BETA . . . . . . . . . . . . . . . . . . . . . . ',g14.7/)
my_real
#define my_real
Definition cppsort.cpp:32
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:668
message_mod
Definition message_mod.F:1257
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:323
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:895
arret
subroutine arret(nn)
Definition arret.F:86