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 100 of file inintr_thkvar.F.

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