OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i10sms2.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!|| i10sms2 ../engine/source/interfaces/int10/i10sms2.F
25!||--- called by ------------------------------------------------------
26!|| i10for3 ../engine/source/interfaces/int10/i10for3.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.f
29!|| arret ../engine/source/system/arret.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../engine/share/message_module/message_mod.F
32!|| tri7box ../engine/share/modules/tri7box.F
33!||====================================================================
34 SUBROUTINE i10sms2(JLT ,IX1 ,IX2 ,IX3 ,IX4 ,
35 2 NSVG ,H1 ,H2 ,H3 ,H4 ,STIF ,
36 3 NIN ,NOINT ,MSKYI_SMS ,ISKYI_SMS,NSMS ,
37 4 KT ,C ,DTI )
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE tri7box
42 USE message_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47#include "comlock.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "mvsiz_p.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "parit_c.inc"
56#include "task_c.inc"
57#include "sms_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER JLT,NIN,NOINT,
62 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),NSVG(MVSIZ),
63 . NSMS(*), ISKYI_SMS(LSKYI_SMS,*)
65 . h1(mvsiz),h2(mvsiz),h3(mvsiz),h4(mvsiz),stif(mvsiz),
66 . mskyi_sms(*), kt(mvsiz), c(mvsiz), dti
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER I, IG, NISKYL1, NISKYL, NN
71 my_real
72 . MAS, DTS
73C
74C
75 niskyl1 = 0
76 DO i=1,jlt
77 IF(nsms(i)==0.OR.stif(i)==zero) cycle
78 IF (h1(i)/=zero) niskyl1 = niskyl1 + 1
79 IF (h2(i)/=zero) niskyl1 = niskyl1 + 1
80 IF (h3(i)/=zero) niskyl1 = niskyl1 + 1
81 IF (h4(i)/=zero) niskyl1 = niskyl1 + 1
82 ENDDO
83#include "lockon.inc"
84 niskyl = nisky_sms
85 nisky_sms = nisky_sms + niskyl1
86#include "lockoff.inc"
87C
88 IF (niskyl+niskyl1 > lskyi_sms) THEN
89 CALL ancmsg(msgid=26,anmode=aninfo_blind)
90 CALL arret(2)
91 ENDIF
92C
93 DO i=1,jlt
94 IF(nsms(i)==0.OR.stif(i)==zero) cycle
95C
96 IF(nsms(i)>0)THEN
97 dts = dtmins/dtfacs
98 dti=min(dti,dtmins)
99 ELSE
100 dts = dtmins_int/dtfacs_int
101 dti=min(dti,dtmins_int)
102 END IF
103C
104 mas= half * dts * ( dts * kt(i) + c(i) )
105C
106 ig =nsvg(i)
107 IF(ig > 0)THEN
108 IF(h1(i)/=zero)THEN
109 niskyl=niskyl+1
110 mskyi_sms(niskyl)=abs(h1(i))*mas
111 iskyi_sms(niskyl,1)=ig
112 iskyi_sms(niskyl,2)=ix1(i)
113 iskyi_sms(niskyl,3)=ispmd+1
114 END IF
115 IF(h2(i)/=zero)THEN
116 niskyl=niskyl+1
117 mskyi_sms(niskyl)=abs(h2(i))*mas
118 iskyi_sms(niskyl,1)=ig
119 iskyi_sms(niskyl,2)=ix2(i)
120 iskyi_sms(niskyl,3)=ispmd+1
121 END IF
122 IF(h3(i)/=zero)THEN
123 niskyl=niskyl+1
124 mskyi_sms(niskyl)=abs(h3(i))*mas
125 iskyi_sms(niskyl,1)=ig
126 iskyi_sms(niskyl,2)=ix3(i)
127 iskyi_sms(niskyl,3)=ispmd+1
128 END IF
129 IF(h4(i)/=zero)THEN
130 niskyl=niskyl+1
131 mskyi_sms(niskyl)=abs(h4(i))*mas
132 iskyi_sms(niskyl,1)=ig
133 iskyi_sms(niskyl,2)=ix4(i)
134 iskyi_sms(niskyl,3)=ispmd+1
135 END IF
136 ELSE
137 nn = -ig
138 IF(h1(i)/=zero)THEN
139 niskyl=niskyl+1
140 mskyi_sms(niskyl)=abs(h1(i))*mas
141 iskyi_sms(niskyl,1)=nodamsfi(nin)%P(nn)
142 iskyi_sms(niskyl,2)=ix1(i)
143 iskyi_sms(niskyl,3)=procamsfi(nin)%P(nn)
144 END IF
145 IF(h2(i)/=zero)THEN
146 niskyl=niskyl+1
147 mskyi_sms(niskyl)=abs(h2(i))*mas
148 iskyi_sms(niskyl,1)=nodamsfi(nin)%P(nn)
149 iskyi_sms(niskyl,2)=ix2(i)
150 iskyi_sms(niskyl,3)=procamsfi(nin)%P(nn)
151 END IF
152 IF(h3(i)/=zero)THEN
153 niskyl=niskyl+1
154 mskyi_sms(niskyl)=abs(h3(i))*mas
155 iskyi_sms(niskyl,1)=nodamsfi(nin)%P(nn)
156 iskyi_sms(niskyl,2)=ix3(i)
157 iskyi_sms(niskyl,3)=procamsfi(nin)%P(nn)
158 END IF
159 IF(h4(i)/=zero)THEN
160 niskyl=niskyl+1
161 mskyi_sms(niskyl)=abs(h4(i))*mas
162 iskyi_sms(niskyl,1)=nodamsfi(nin)%P(nn)
163 iskyi_sms(niskyl,2)=ix4(i)
164 iskyi_sms(niskyl,3)=procamsfi(nin)%P(nn)
165 END IF
166 END IF
167 ENDDO
168C
169 RETURN
170 END
171C
#define my_real
Definition cppsort.cpp:32
subroutine i10sms2(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, nin, noint, mskyi_sms, iskyi_sms, nsms, kt, c, dti)
Definition i10sms2.F:38
#define min(a, b)
Definition macros.h:20
type(int_pointer), dimension(:), allocatable nodamsfi
Definition tri7box.F:440
type(int_pointer), dimension(:), allocatable procamsfi
Definition tri7box.F:440
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
subroutine arret(nn)
Definition arret.F:87