OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inintr_thkvar.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "param_c.inc"
#include "vect01_c.inc"
#include "units_c.inc"
#include "scr15_c.inc"
#include "scr17_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine thickvar (elbuf_tab, iparg, thksh4_var, thksh3_var, thknod, ixc, ixtg)
subroutine inintr_thkvar (elbuf_tab, ipari, intbuf_tab, inscr, x, ixs, ixc, pm, geo, itab, mwa, rwa, ixtg, ikine, iparg, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, intstamp, skew, ms, in, v, vr, rby, npby, lpby, iparts, ipartc, ipartg, thk_part, nom_opt, ptr_nopt_inter)

Function/Subroutine Documentation

◆ inintr_thkvar()

subroutine inintr_thkvar ( type(elbuf_struct_), dimension(ngroup) elbuf_tab,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
type(scratch_struct_), dimension(*) inscr,
x,
integer, dimension(*) ixs,
integer, dimension(*) ixc,
pm,
geo,
integer, dimension(*) itab,
integer, dimension(*) mwa,
rwa,
integer, dimension(*) ixtg,
integer, dimension(*) ikine,
integer, dimension(nparg,*) iparg,
integer, dimension(*) knod2els,
integer, dimension(*) knod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(*) nod2els,
integer, dimension(*) nod2elc,
integer, dimension(*) nod2eltg,
type(intstamp_data), dimension(*), target intstamp,
skew,
ms,
in,
v,
vr,
rby,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer, dimension(*) iparts,
integer, dimension(*) ipartc,
integer, dimension(*) ipartg,
thk_part,
integer, dimension(lnopt1,*) nom_opt,
integer ptr_nopt_inter )

Definition at line 99 of file inintr_thkvar.F.

108C-----------------------------------------------
109C M o d u l e s
110C-----------------------------------------------
111 USE intstamp_mod
112 USE message_mod
113 USE elbufdef_mod
114 USE intbufdef_mod
115 USE intbufscratch_mod
116 USE inoutfile_mod
117 USE names_and_titles_mod , ONLY : nchartitle
118C-----------------------------------------------
119C I m p l i c i t T y p e s
120C-----------------------------------------------
121#include "implicit_f.inc"
122C-----------------------------------------------
123C C o m m o n B l o c k s
124C-----------------------------------------------
125#include "units_c.inc"
126#include "param_c.inc"
127#include "scr15_c.inc"
128#include "scr17_c.inc"
129#include "com01_c.inc"
130#include "com04_c.inc"
131C-----------------------------------------------
132C D u m m y A r g u m e n t s
133C-----------------------------------------------
134 INTEGER IPARI(NPARI,*), IXS(*),
135 . IXC(*), ITAB(*), MWA(*), IXTG(*), IKINE(*),
136 . IPARG(NPARG,*),
137 . KNOD2ELS(*), KNOD2ELC(*), KNOD2ELTG(*),
138 . NOD2ELS(*), NOD2ELC(*), NOD2ELTG(*),
139 . NPBY(NNPBY,*), LPBY(*), IPARTS(*), IPARTC(*), IPARTG(*)
140 TYPE(INTSTAMP_DATA), TARGET :: INTSTAMP(*)
141 TYPE(INTSTAMP_DATA),POINTER :: pINTSTAMP
142 my_real
143 . x(3,*), pm(*), geo(*), rwa(6,*),
144 . ms(*), in(*), v(3,*), vr(3,*), rby(nrby,*), skew(lskew,*),
145 . thk_part(*)
146 INTEGER NOM_OPT(LNOPT1,*),PTR_NOPT_INTER
147 TYPE(ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
148 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
149 TYPE(SCRATCH_STRUCT_) INSCR(*)
150
151
152C-----------------------------------------------
153C L o c a l V a r i a b l e s
154C-----------------------------------------------
155 INTEGER N, JINSCR, NINTI, IWRN, I, I_MEM,
156 . RESORT
157 INTEGER NTY, STAT, ISTAMP, MULTIMP,LEN_FILNAM
158 my_real,
159 . DIMENSION(:),ALLOCATABLE:: thksh4_var,thksh3_var,thknod
160 CHARACTER*2148 FILNAM
161 INTEGER ID
162 CHARACTER(LEN=NCHARTITLE) :: TITR
163C-----------------------------------------------
164 i_mem = 0
165 resort = 0
166C----
167 ALLOCATE (thksh4_var(numelc) ,stat=stat)
168 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
169 . msgtype=msgerror,
170 . c1='THKSH4_VAR')
171 ALLOCATE (thksh3_var(numeltg) ,stat=stat)
172 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
173 . msgtype=msgerror,
174 . c1='THKSH3_VAR')
175 ALLOCATE (thknod(numnod) ,stat=stat)
176 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
177 . msgtype=msgerror,
178 . c1='THKNOD')
179 thksh4_var=zero
180 thksh3_var=zero
181 thknod =zero
182C
183 CALL thickvar(elbuf_tab,iparg,thksh4_var,thksh3_var,thknod,
184 . ixc ,ixtg )
185C
186 iwrn = 0
187 istamp=0
188 DO 100 n=1,ninter
189 resort = 0
190 nty=ipari(7,n)
191 IF (nty /= 21 .AND. nty /=23) GOTO 100
192C
193 IF(nty==21) istamp=istamp+1
194C
195 200 CONTINUE
196C
197
198 IF (i_mem == 2)THEN
199 multimp = max(ipari(23,n)+8,nint(ipari(23,n)*1.5))
200 CALL upgrade_multimp(n,multimp,intbuf_tab(n))
201 i_mem = 0
202 ENDIF
203
204
205
206 jinscr=ipari(10,n)
207 ninti=n
208 id=nom_opt(1,ptr_nopt_inter+ninti)
209 CALL fretitl2(titr,
210 . nom_opt(lnopt1-ltitr+1,ptr_nopt_inter+ninti),ltitr)
211
212 IF(istamp > 0)THEN
213 pintstamp => intstamp(istamp)
214 ELSE
215 NULLIFY(pintstamp)
216 ENDIF
217
218 CALL inint3_thkvar(
219 1 intbuf_tab(n),inscr(ninti)%WA ,x ,ixs ,
220 2 ixc ,ixtg ,pm ,geo ,ipari(1,n),
221 3 ninti ,itab ,mwa ,rwa ,iwrn ,
222 4 ikine ,knod2els ,knod2elc ,knod2eltg ,nod2els ,
223 5 nod2elc ,nod2eltg ,
224 6 thksh4_var,thksh3_var ,thknod ,pintstamp ,skew ,
225 7 ms ,in ,v ,vr ,rby ,
226 8 npby ,lpby ,i_mem ,resort ,iparts ,
227 9 ipartc ,ipartg ,thk_part ,id ,titr,
228 a nom_opt)
229 IF (i_mem /= 0) GOTO 200
230 100 CONTINUE
231C
232 IF(iwrn/=0) THEN
233 len_filnam = outfile_name_len + rootlen + 6
234 filnam = outfile_name(1:outfile_name_len)//rootnam(1:rootlen)//'.coord'
235 OPEN(unit=iou2,file=filnam(1:len_filnam),status='UNKNOWN',
236 . form='FORMATTED')
237 WRITE(iou2,'(2A)')'#--1---|---2---|---3---|---4---|',
238 . '---5---|---6---|---7---|---8---|'
239 WRITE(iou2,'(A)')'# NEW NODES COORDINATES'
240 WRITE(iou2,'(2A)')'#--1---|---2---|---3---|---4---|',
241 . '---5---|---6---|---7---|---8---|'
242 WRITE(iou2,'(I10,1P3G20.13)')
243 . (itab(i),x(1,i),x(2,i),x(3,i),i=1,numnod)
244 WRITE(iou2,'(2A)')'#--1---|---2---|---3---|---4---|',
245 . '---5---|---6---|---7---|---8---|'
246 WRITE(iou2,'(A)')'# END OF NEW NODES COORDINATES'
247 WRITE(iou2,'(2A)')'#--1---|---2---|---3---|---4---|',
248 . '---5---|---6---|---7---|---8---|'
249 CLOSE(unit=iou2)
250 ENDIF
251C
252 DEALLOCATE (thksh4_var,thksh3_var)
253C-----------
254 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
inint3_thkvar
subroutine inint3_thkvar(intbuf_tab, inscr, x, ixs, ixc, ixtg, pm, geo, ipari, numint, itab, mwa, rwa, iwrn, ikine, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, thksh4_var, thksh3_var, thknod, intstamp, skew, ms, in, v, vr, rby, npby, lpby, i_mem, resort, iparts, ipartc, ipartg, thk_part, id, titr, nom_opt)
Definition inint3_thkvar.F:52
thickvar
subroutine thickvar(elbuf_tab, iparg, thksh4_var, thksh3_var, thknod, ixc, ixtg)
Definition inintr_thkvar.F:31
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
inoutfile_mod
Definition inoutfile_mod.F:96
inoutfile_mod::outfile_name
character(len=outfile_char_len) outfile_name
Definition inoutfile_mod.F:111
inoutfile_mod::outfile_name_len
integer outfile_name_len
Definition inoutfile_mod.F:109
intbufscratch_mod
Definition intbufscratch_mod.F:33
intstamp_mod
Definition intstamp_mod.F:38
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
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
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
upgrade_multimp
subroutine upgrade_multimp(ni, multimp_parameter, intbuf_tab)
Definition upgrade_multimp.F:48

◆ thickvar()

subroutine thickvar ( type(elbuf_struct_), dimension(ngroup) elbuf_tab,
integer, dimension(nparg,*) iparg,
thksh4_var,
thksh3_var,
thknod,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg )

Definition at line 29 of file inintr_thkvar.F.

31C-----------------------------------------------
32C M o d u l e s
33C-----------------------------------------------
34 USE elbufdef_mod
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C C o m m o n B l o c k s
41C-----------------------------------------------
42#include "com01_c.inc"
43#include "param_c.inc"
44#include "vect01_c.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER IPARG(NPARG,*), IXC(NIXC,*), IXTG(NIXTG,*)
49C REAL
50 my_real
51 . thksh4_var(*), thksh3_var(*), thknod(*)
52 TYPE(ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER NG, I, J, N, NEL
57C-----------------------------------------------
58 DO ng=1,ngroup
59 mtn=iparg(1,ng)
60 IF (mtn==0 .OR. mtn==13) cycle
61 nel=iparg(2,ng)
62 nft=iparg(3,ng)
63 ity=iparg(5,ng)
64 IF (ity == 3) THEN
65 DO i=1,nel
66 n=nft+i
67 thksh4_var(n)=elbuf_tab(ng)%GBUF%THK(i)
68 DO j=2,5
69 thknod(ixc(j,n))=max(thknod(ixc(j,n)),thksh4_var(n))
70 END DO
71 END DO
72 ELSEIF(ity == 7)THEN
73 DO i=1,nel
74 n=nft+i
75 thksh3_var(n)=elbuf_tab(ng)%GBUF%THK(i)
76 DO j=2,4
77 thknod(ixtg(j,n))=max(thknod(ixtg(j,n)),thksh3_var(n))
78 END DO
79 END DO
80 END IF
81 END DO
82C
83 RETURN