OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
read_rwall.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!|| read_rwall ../starter/source/constraints/general/rwall/read_rwall.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| hm_option_count ../starter/source/devtools/hm_reader/hm_option_count.F
29!|| hm_read_rwall_cyl ../starter/source/constraints/general/rwall/hm_read_rwall_cyl.F
30!|| hm_read_rwall_lagmul ../starter/source/constraints/general/rwall/hm_read_rwall_lagmul.F
31!|| hm_read_rwall_paral ../starter/source/constraints/general/rwall/hm_read_rwall_paral.F
32!|| hm_read_rwall_plane ../starter/source/constraints/general/rwall/hm_read_rwall_plane.F
33!|| hm_read_rwall_spher ../starter/source/constraints/general/rwall/hm_read_rwall_spher.F
34!|| hm_read_rwall_therm ../starter/source/constraints/general/rwall/hm_read_rwall_therm.F
35!|| udouble ../starter/source/system/sysfus.F
36!||--- uses -----------------------------------------------------
37!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
38!|| message_mod ../starter/share/message_module/message_mod.F
39!|| r2r_mod ../starter/share/modules1/r2r_mod.F
40!|| submodel_mod ../starter/share/modules1/submodel_mod.F
41!||====================================================================
42 SUBROUTINE read_rwall(RWL ,NPRW ,LPRW ,IFI ,MS ,
43 . V ,ITAB ,ITABM1 ,X ,IXS ,
44 . IXQ ,NPC ,IKINE ,IGRNOD ,
45 . MFI ,IMERGE ,UNITAB ,
46 . IKINE1LAG,IDDLEVEL,LSUBMODEL,RTRANS,NOM_OPT ,
47 . ITAGND ,LNSPEN )
48C-------------------------------------
49C LECTURE MUR RIGIDE
50C-----------------------------------------------
51C M o d u l e s
52C-----------------------------------------------
53 USE my_alloc_mod
54 USE unitab_mod
55 USE submodel_mod
56 USE message_mod
57 USE r2r_mod
58 USE groupdef_mod
59 USE hm_option_read_mod
60 use element_mod , only : nixs,nixq
61C-----------------------------------------------
62C I m p l i c i t T y p e s
63C-----------------------------------------------
64#include "implicit_f.inc"
65C-----------------------------------------------
66C C o m m o n B l o c k s
67C-----------------------------------------------
68#include "com04_c.inc"
69#include "units_c.inc"
70#include "scr17_c.inc"
71#include "param_c.inc"
72C-----------------------------------------------
73C D u m m y A r g u m e n t s
74C-----------------------------------------------
75 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
76 INTEGER IFI,MFI,IDDLEVEL
77 INTEGER NPRW(*), LPRW(*), ITAB(*), ITABM1(*),IXS(NIXS,*),
78 . IXQ(NIXQ,*), NPC(*), IKINE(*),
79 . IMERGE(*),
80 . ikine1lag(*),itagnd(*)
81 TYPE(submodel_data) LSUBMODEL(*)
82C REAL
83 my_real
84 . rwl(nrwlp,*), ms(*), v(3,*), x(3,*),
85 . rtrans(ntransf,*)
86 INTEGER NOM_OPT(LNOPT1,*)
87 INTEGER, INTENT (INOUT) :: LNSPEN
88C-----------------------------------------------
89 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
90C-----------------------------------------------
91C L o c a l V a r i a b l e s
92C-----------------------------------------------
93 INTEGER,DIMENSION(:),ALLOCATABLE :: IKINE1
94 INTEGER K,I,NCHPLAN,NCHCYL,NCHSPHER,NCHPARAL,
95 . OFFS,NCHLAGM,NCHTHERM,N,NSL,IPEN
96 my_real
97 . BID
98 CHARACTER MESS*40
99C-----------------------------------------------
100C E x t e r n a l F u n c t i o n s
101C-----------------------------------------------
102 DATA mess/'STANDARD RIGID WALL DEFINITION '/
103C=======================================================================
104C-----------------------------------------------
105C B e g i n n i n g o f s o u r c e
106C-----------------------------------------------
107 CALL my_alloc(ikine1,3*numnod)
108C Beginning of RWALL cards in the IIN file
109 WRITE(iout,1000)
110C
111C Initialization of variable
112 k = 0
113 ! Offset
114 offs = 0
115 ! Flag for therm rigid wall
116 DO i=1,3*numnod
117 ikine1(i) = 0
118 ENDDO
119C
120C-----------------------------------------------
121! ************************** !
122! RWALL read with hm reader !
123! ************************** !
124C-----------------------------------------------
125C Counting RWALL type
126 CALL hm_option_count('/RWALL/PLANE' ,nchplan )
127 CALL hm_option_count('/RWALL/CYL' ,nchcyl )
128 CALL hm_option_count('/RWALL/SPHER' ,nchspher )
129 CALL hm_option_count('/RWALL/PARAL' ,nchparal )
130 CALL hm_option_count('/RWALL/LAGMUL',nchlagm )
131 CALL hm_option_count('/RWALL/THERM' ,nchtherm )
132C
133C /RWALL/PLANE
134 IF (nchplan > 0) THEN
135 CALL hm_read_rwall_plane(rwl ,nprw ,lprw ,ifi ,ms ,
136 . v ,itab ,itabm1 ,x ,ikine ,
137 . igrnod ,mfi ,imerge ,unitab ,iddlevel,
138 . lsubmodel,rtrans ,nom_opt ,itagnd ,nchplan ,
139 . k ,offs ,ikine1 )
140 ENDIF
141C
142C /RWALL/CYL
143 IF (nchcyl > 0) THEN
144 CALL hm_read_rwall_cyl(rwl ,nprw ,lprw ,ifi ,ms ,
145 . v ,itab ,itabm1 ,x ,ikine ,
146 . igrnod ,mfi ,imerge ,unitab ,iddlevel,
147 . lsubmodel,rtrans ,nom_opt ,itagnd ,nchcyl ,
148 . k ,offs ,ikine1 )
149 ENDIF
150C
151C /RWALL/SPHER
152 IF (nchspher > 0) THEN
153 CALL hm_read_rwall_spher(rwl ,nprw ,lprw ,ifi ,ms ,
154 . v ,itab ,itabm1 ,x ,ikine ,
155 . igrnod ,mfi ,imerge ,unitab ,iddlevel,
156 . lsubmodel,rtrans ,nom_opt ,itagnd ,nchspher,
157 . k ,offs ,ikine1 )
158 ENDIF
159C
160C /RWALL/PARAL
161 IF (nchparal > 0) THEN
162 CALL hm_read_rwall_paral(rwl ,nprw ,lprw ,ifi ,ms ,
163 . v ,itab ,itabm1 ,x ,ikine ,
164 . igrnod ,mfi ,imerge ,unitab ,iddlevel,
165 . lsubmodel,rtrans ,nom_opt ,itagnd ,nchparal,
166 . k ,offs ,ikine1 )
167 ENDIF
168C
169C /RWALL/LAGMUL
170 IF (nchlagm > 0) THEN
171 CALL hm_read_rwall_lagmul(rwl ,nprw ,lprw ,ifi ,ms ,
172 . v ,itab ,itabm1 ,x ,ikine ,
173 . igrnod ,mfi ,imerge ,unitab ,iddlevel,
174 . lsubmodel,rtrans ,nom_opt ,itagnd ,nchlagm ,
175 . k ,offs ,ikine1lag)
176 ENDIF
177C
178C /RWALL/THERM
179 IF (nchtherm > 0) THEN
180 CALL hm_read_rwall_therm(rwl ,nprw ,lprw ,ifi ,ms ,
181 . v ,itab ,itabm1 ,x ,ikine ,
182 . igrnod ,mfi ,imerge ,unitab ,iddlevel,
183 . lsubmodel,rtrans ,nom_opt ,itagnd ,nchtherm,
184 . k ,offs ,ikine1 ,ixs ,ixq ,
185 . npc )
186 ENDIF
187C
188C-------------------------------------
189C Search for double IDs
190C-------------------------------------
191 CALL udouble(nom_opt,lnopt1,nrwall,mess,0,bid)
192 DO n=1,nrwall
193 nsl = nprw(n)
194 ipen = nprw(n+8*nrwall)
195 IF (ipen > 0) lnspen = lnspen + nsl + 1 ! stif+leng_m
196 END DO
197 DEALLOCATE(ikine1)
198 RETURN
199 1000 FORMAT(
200 . ' RIGID WALL DEFINITIONS '/
201 . ' ---------------------- '/)
202 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_option_count
subroutine hm_option_count(entity_type, hm_option_number)
Definition hm_option_count.F:105
hm_read_rwall_cyl
subroutine hm_read_rwall_cyl(rwl, nprw, lprw, ifi, ms, v, itab, itabm1, x, ikine, igrnod, mfi, imerge, unitab, iddlevel, lsubmodel, rtrans, nom_opt, itagnd, nchcyl, k, offs, ikine1)
Definition hm_read_rwall_cyl.F:52
hm_read_rwall_lagmul
subroutine hm_read_rwall_lagmul(rwl, nprw, lprw, ifi, ms, v, itab, itabm1, x, ikine, igrnod, mfi, imerge, unitab, iddlevel, lsubmodel, rtrans, nom_opt, itagnd, nchlagm, k, offs, ikine1lag)
Definition hm_read_rwall_lagmul.F:52
hm_read_rwall_paral
subroutine hm_read_rwall_paral(rwl, nprw, lprw, ifi, ms, v, itab, itabm1, x, ikine, igrnod, mfi, imerge, unitab, iddlevel, lsubmodel, rtrans, nom_opt, itagnd, nchparal, k, offs, ikine1)
Definition hm_read_rwall_paral.F:52
hm_read_rwall_plane
subroutine hm_read_rwall_plane(rwl, nprw, lprw, ifi, ms, v, itab, itabm1, x, ikine, igrnod, mfi, imerge, unitab, iddlevel, lsubmodel, rtrans, nom_opt, itagnd, nchplan, k, offs, ikine1)
Definition hm_read_rwall_plane.F:52
hm_read_rwall_spher
subroutine hm_read_rwall_spher(rwl, nprw, lprw, ifi, ms, v, itab, itabm1, x, ikine, igrnod, mfi, imerge, unitab, iddlevel, lsubmodel, rtrans, nom_opt, itagnd, nchspher, k, offs, ikine1)
Definition hm_read_rwall_spher.F:52
hm_read_rwall_therm
subroutine hm_read_rwall_therm(rwl, nprw, lprw, ifi, ms, v, itab, itabm1, x, ikine, igrnod, mfi, imerge, unitab, iddlevel, lsubmodel, rtrans, nom_opt, itagnd, nchtherm, k, offs, ikine1, ixs, ixq, npc)
Definition hm_read_rwall_therm.F:51
groupdef_mod
Definition groupdef_mod.F:668
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
r2r_mod
Definition r2r_mod.F:125
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
read_rwall
subroutine read_rwall(rwl, nprw, lprw, ifi, ms, v, itab, itabm1, x, ixs, ixq, npc, ikine, igrnod, mfi, imerge, unitab, ikine1lag, iddlevel, lsubmodel, rtrans, nom_opt, itagnd, lnspen)
Definition read_rwall.F:48
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:573
submodel_mod::submodel_data
Definition submodel_mod.F:728