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 )
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
60C-----------------------------------------------
61C I m p l i c i t T y p e s
62C-----------------------------------------------
63#include "implicit_f.inc"
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67#include "com04_c.inc"
68#include "units_c.inc"
69#include "scr17_c.inc"
70#include "param_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
75 INTEGER IFI,MFI,IDDLEVEL
76 INTEGER NPRW(*), LPRW(*), ITAB(*), ITABM1(*),IXS(NIXS,*),
77 . IXQ(NIXQ,*), NPC(*), IKINE(*),
78 . IMERGE(*),
79 . ikine1lag(*),itagnd(*)
80 TYPE(submodel_data) LSUBMODEL(*)
81C REAL
82 my_real
83 . rwl(nrwlp,*), ms(*), v(3,*), x(3,*),
84 . rtrans(ntransf,*)
85 INTEGER NOM_OPT(LNOPT1,*)
86C-----------------------------------------------
87 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
88C-----------------------------------------------
89C L o c a l V a r i a b l e s
90C-----------------------------------------------
91 INTEGER,DIMENSION(:),ALLOCATABLE :: IKINE1
92 INTEGER K,I,NCHPLAN,NCHCYL,NCHSPHER,NCHPARAL,
93 . OFFS,NCHLAGM,NCHTHERM
94 my_real
95 . BID
96 CHARACTER MESS*40
97C-----------------------------------------------
98C E x t e r n a l F u n c t i o n s
99C-----------------------------------------------
100 DATA mess/'STANDARD RIGID WALL DEFINITION '/
101C=======================================================================
102C-----------------------------------------------
103C B e g i n n i n g o f s o u r c e
104C-----------------------------------------------
105 CALL my_alloc(ikine1,3*numnod)
106C Beginning of RWALL cards in the IIN file
107 WRITE(iout,1000)
108C
109C Initialization of variable
110 k = 0
111 ! Offset
112 offs = 0
113 ! Flag for therm rigid wall
114 DO i=1,3*numnod
115 ikine1(i) = 0
116 ENDDO
117C
118C-----------------------------------------------
119! ************************** !
120! RWALL read with hm reader !
121! ************************** !
122C-----------------------------------------------
123C Counting RWALL type
124 CALL hm_option_count('/RWALL/PLANE' ,nchplan )
125 CALL hm_option_count('/RWALL/CYL' ,nchcyl )
126 CALL hm_option_count('/RWALL/SPHER' ,nchspher )
127 CALL hm_option_count('/RWALL/PARAL' ,nchparal )
128 CALL hm_option_count('/RWALL/LAGMUL',nchlagm )
129 CALL hm_option_count('/RWALL/THERM' ,nchtherm )
130C
131C /RWALL/PLANE
132 IF (nchplan > 0) THEN
133 CALL hm_read_rwall_plane(rwl ,nprw ,lprw ,ifi ,ms ,
134 . v ,itab ,itabm1 ,x ,ikine ,
135 . igrnod ,mfi ,imerge ,unitab ,iddlevel,
136 . lsubmodel,rtrans ,nom_opt ,itagnd ,nchplan ,
137 . k ,offs ,ikine1 )
138 ENDIF
139C
140C /RWALL/CYL
141 IF (nchcyl > 0) THEN
142 CALL hm_read_rwall_cyl(rwl ,nprw ,lprw ,ifi ,ms ,
143 . v ,itab ,itabm1 ,x ,ikine ,
144 . igrnod ,mfi ,imerge ,unitab ,iddlevel,
145 . lsubmodel,rtrans ,nom_opt ,itagnd ,nchcyl ,
146 . k ,offs ,ikine1 )
147 ENDIF
148C
149C /RWALL/SPHER
150 IF (nchspher > 0) THEN
151 CALL hm_read_rwall_spher(rwl ,nprw ,lprw ,ifi ,ms ,
152 . v ,itab ,itabm1 ,x ,ikine ,
153 . igrnod ,mfi ,imerge ,unitab ,iddlevel,
154 . lsubmodel,rtrans ,nom_opt ,itagnd ,nchspher,
155 . k ,offs ,ikine1 )
156 ENDIF
157C
158C /RWALL/PARAL
159 IF (nchparal > 0) THEN
160 CALL hm_read_rwall_paral(rwl ,nprw ,lprw ,ifi ,ms ,
161 . v ,itab ,itabm1 ,x ,ikine ,
162 . igrnod ,mfi ,imerge ,unitab ,iddlevel,
163 . lsubmodel,rtrans ,nom_opt ,itagnd ,nchparal,
164 . k ,offs ,ikine1 )
165 ENDIF
166C
167C /RWALL/LAGMUL
168 IF (nchlagm > 0) THEN
169 CALL hm_read_rwall_lagmul(rwl ,nprw ,lprw ,ifi ,ms ,
170 . v ,itab ,itabm1 ,x ,ikine ,
171 . igrnod ,mfi ,imerge ,unitab ,iddlevel,
172 . lsubmodel,rtrans ,nom_opt ,itagnd ,nchlagm ,
173 . k ,offs ,ikine1lag)
174 ENDIF
175C
176C /RWALL/THERM
177 IF (nchtherm > 0) THEN
178 CALL hm_read_rwall_therm(rwl ,nprw ,lprw ,ifi ,ms ,
179 . v ,itab ,itabm1 ,x ,ikine ,
180 . igrnod ,mfi ,imerge ,unitab ,iddlevel,
181 . lsubmodel,rtrans ,nom_opt ,itagnd ,nchtherm,
182 . k ,offs ,ikine1 ,ixs ,ixq ,
183 . npc )
184 ENDIF
185C
186C-------------------------------------
187C Recherche des ID doubles
188C-------------------------------------
189 CALL udouble(nom_opt,lnopt1,nrwall,mess,0,bid)
190 DEALLOCATE(ikine1)
191 RETURN
192 1000 FORMAT(
193 . ' RIGID WALL DEFINITIONS '/
194 . ' ---------------------- '/)
195 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:52
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
message_mod
Definition message_mod.F:1249
r2r_mod
Definition r2r_mod.F:125
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
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)
Definition read_rwall.F:48
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:589
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723