OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
outp_c_t.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "task_c.inc"
#include "scr16_c.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine outp_c_t (itens, key, text, elbuf_tab, iparg, epsdot, dd_iad, sizloc, sizp0, siz_wr)
subroutine outp_c_tf (itens, key, text, elbuf_tab, iparg, dd_iad, sizloc, sizp0, thke, geo, igeo, stack, drape_sh4n, drape_sh3n, ixc, ixtg, siz_wr, drapeg)
subroutine count_arsz_ct (iparg, dd_iad, wasz, siz_write, elbuf_tab)

Function/Subroutine Documentation

◆ count_arsz_ct()

subroutine count_arsz_ct ( integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer, dimension(3) wasz,
integer, dimension(3*nspgroup+3) siz_write,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab )

Definition at line 957 of file outp_c_t.F.

958C-----------------------------------------------
959C M o d u l e s
960C-----------------------------------------------
961 USE elbufdef_mod
962C-----------------------------------------------
963C I m p l i c i t T y p e s
964C-----------------------------------------------
965#include "implicit_f.inc"
966C-----------------------------------------------
967C C o m m o n B l o c k s
968C-----------------------------------------------
969#include "param_c.inc"
970#include "task_c.inc"
971#include "com01_c.inc"
972#include "scr16_c.inc"
973C-----------------------------------------------
974C D u m m y A r g u m e n t s
975C-----------------------------------------------
976 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ(3),SIZ_WRITE(3*NSPGROUP+3)
977 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
978C-----------------------------------------------
979C L o c a l V a r i a b l e s
980C-----------------------------------------------
981 INTEGER NGF,NGL,NN,ITY,MLW,NEL,NPT,IHBE,NPG,MPT,NG,JJ,COUNT,I,
982 . WASZ1,WASZ2,WASZ3,WASZ_95,WASZ4,
983 . IL,NLAY,IGTYP,NPT_ALL,
984 . NPTR,NPTS,SIZ_WRITE_LOC(4*NSPGROUP)
985C-----------------------------------------------
986 siz_write_loc = 0
987 wasz1 = 0
988
989 count = 0
990 DO i=1,30
991 count = count + outp_ct(10+i)+outp_ct(50+i)+outp_ct(100+i)
992 ENDDO
993
994 IF ( outp_ct( 1) == 1.OR.outp_ct( 2) == 1.OR.outp_ct( 3) == 1
995 . .OR.outp_ct( 4) == 1.OR.outp_ct( 5) == 1.OR.outp_ct( 6) == 1
996 . .OR.outp_ct( 7) == 1.OR.outp_ct( 8) == 1.OR.outp_ct(91) == 1
997 . .OR.outp_ct(92) == 1.OR.outp_ct(93) == 1.OR.outp_ct(94) == 1
998 . .OR.count>0 ) THEN
999
1000 ngf = 1
1001 ngl = 0
1002 DO nn=1,nspgroup
1003 jj = 0
1004 ngl = ngl + dd_iad(ispmd+1,nn)
1005 DO ng = ngf, ngl
1006 ity =iparg(5,ng)
1007 IF(ity == 3.OR.ity == 7) THEN
1008 nel = iparg(2,ng)
1009 jj = jj + 3 * nel
1010 ENDIF
1011 ENDDO
1012 ngf = ngl + 1
1013 wasz1 = wasz1+jj
1014 siz_write_loc(nn) = jj
1015 ENDDO
1016 ENDIF
1017
1018
1019 wasz2 = 0
1020C--------
1021
1022 IF (outp_ct(95) == 1) THEN
1023 ngf = 1
1024 ngl = 0
1025 DO nn=1,nspgroup
1026 jj = 0
1027 ngl = ngl + dd_iad(ispmd+1,nn)
1028 DO ng = ngf, ngl
1029 ity =iparg(5,ng)
1030 IF (ity == 3.OR.ity == 7) THEN
1031 mlw = iparg(1,ng)
1032 nel = iparg(2,ng)
1033 npt = iparg(6,ng)
1034 ihbe = iparg(23,ng)
1035 igtyp = iparg(38,ng)
1036 jj=jj+nel
1037 nlay = elbuf_tab(ng)%NLAY
1038 nptr = elbuf_tab(ng)%NPTR
1039 npts = elbuf_tab(ng)%NPTS
1040 npg = nptr*npts
1041 mpt=iabs(npt)
1042 IF (igtyp == 51 .OR. igtyp == 52) THEN
1043 npt_all = 0
1044 DO il=1,nlay
1045 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
1046 ENDDO
1047 mpt = max(1,npt_all)
1048 ENDIF
1049C
1050 IF (ihbe >= 11) THEN
1051C------------------------
1052C STRESS
1053C------------------------
1054 IF (mlw == 1.OR.mlw == 3.OR.mlw == 23) mpt=0
1055C---QEPH:------
1056 IF (ihbe == 23) THEN
1057 npg=4
1058C---Transfer to QBAT------
1059 IF (mpt == 0) THEN
1060 jj = jj + ((9*npg)+5)*nel
1061 ELSE
1062 jj = jj + (6*npg*mpt+5)*nel
1063 ENDIF
1064 ELSEIF (ihbe == 11) THEN
1065C-------QBAT,DKT18-----
1066 IF (mpt == 0) THEN
1067 jj = jj + ((9*npg)+5)*nel
1068 ELSE
1069 jj = jj + ((6*npg*mpt)+5)*nel
1070 ENDIF
1071 ENDIF ! IF (IHBE == 23)
1072 ELSE
1073 IF (mlw == 1.OR.mlw == 3.OR.mlw == 23) THEN
1074 jj = jj + 16*nel
1075 ELSE
1076 IF (mpt == 0) THEN
1077 jj = jj + 16*nel
1078 ELSE
1079 jj = jj + (6*mpt+7)*nel
1080 ENDIF
1081 ENDIF
1082 ENDIF ! IF (IHBE >= 11)
1083 ELSE
1084C----error message------
1085 ENDIF ! IF (ITY == 3.OR.ITY == 7)
1086 ENDDO ! DO NG = NGF, NGL
1087
1088 wasz2 = wasz2+jj
1089 ngf = ngl + 1
1090 siz_write_loc(nspgroup+nn) = jj
1091 ENDDO ! DO NN=1,NSPGROUP
1092 ENDIF !IF (OUTP_CT(95) == 1)
1093
1094C--------
1095
1096 wasz3 = 0
1097 IF (outp_ct(95) == 1) THEN
1098 ngf = 1
1099 ngl = 0
1100 DO nn=1,nspgroup
1101 jj = 0
1102 ngl = ngl + dd_iad(ispmd+1,nn)
1103 DO ng = ngf, ngl
1104 ity =iparg(5,ng)
1105 nel =iparg(2,ng)
1106 IF(ity == 3.OR.ity == 7) THEN
1107 jj = jj + 9*nel
1108 ENDIF
1109 ENDDO
1110 wasz3 = wasz3+jj
1111 ngf = ngl + 1
1112 siz_write_loc(2*nspgroup+nn) = jj
1113 ENDDO
1114 END IF
1115
1116
1117 wasz4 = 0
1118 IF (outp_ct(96) == 1) THEN
1119 ngf = 1
1120 ngl = 0
1121 DO nn=1,nspgroup
1122 jj = 0
1123 ngl = ngl + dd_iad(ispmd+1,nn)
1124 DO ng = ngf, ngl
1125 nel =iparg(2,ng)
1126 jj = jj + 9*nel
1127 ENDDO
1128 wasz4 = wasz4+jj
1129 ngf = ngl + 1
1130 siz_write_loc(3*nspgroup+nn) = jj
1131 ENDDO
1132 END IF
1133 wasz_95 = max(wasz2,wasz3)
1134 wasz(1) = wasz1
1135 wasz(2) = wasz_95
1136 wasz(3) = wasz4
1137 DO nn=1,nspgroup
1138 siz_write(nn) = siz_write_loc(nn)
1139 siz_write(nspgroup+nn) = max(siz_write_loc(nspgroup+nn),siz_write_loc(2*nspgroup+nn))
1140 siz_write(2*nspgroup+nn) = siz_write_loc(3*nspgroup+nn)
1141 ENDDO
1142 DO nn=1,3
1143 siz_write(3*nspgroup+nn) = wasz(nn)
1144 ENDDO
1145c-----------
1146 RETURN
max
#define max(a, b)
Definition macros.h:21

◆ outp_c_t()

subroutine outp_c_t ( integer itens,
character*10 key,
character*40 text,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
epsdot,
integer, dimension(nspmd+1,*) dd_iad,
integer sizloc,
integer sizp0,
integer siz_wr )

Definition at line 32 of file outp_c_t.F.

34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE elbufdef_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com01_c.inc"
46#include "com04_c.inc"
47#include "param_c.inc"
48#include "units_c.inc"
49#include "task_c.inc"
50#include "scr16_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 CHARACTER*10 KEY
55 CHARACTER*40 TEXT
56 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*)
57 INTEGER ITENS,SIZLOC,SIZP0,SIZ_WR
58 my_real
59 . epsdot(6,*)
60 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I,J,JJ
65 INTEGER NG,NEL,NFT,ITY,LFT,NPT,IPT,N0,
66 . LLT,MLW,ISTRAIN,N,NS1,NS2,
67 . ISTRE,IHBE,JJ_OLD,NGF,NGL,NN,
68 . NLAY,MPT,NPT_ALL,IGTYP,II(8)
69 INTEGER RESP0,WRTLEN,RES,COMPTEUR,L,K
70 INTEGER, DIMENSION(NSPGROUP) :: JJ_LOC
71 INTEGER, DIMENSION(NSPGROUP+1,NSPMD) :: ADRESS
72 my_real
73 . wa(sizloc),wap0(siz_wr),wap0_loc(sizp0)
74 my_real a1,a2,thk
75C
76 TYPE(G_BUFEL_) , POINTER :: GBUF
77C-----------------------------------------------
78 IF (ispmd == 0) THEN
79 WRITE(iugeo,'(2A)')'/SHELL /TENSOR /',key
80 WRITE(iugeo,'(A)')text
81 IF (outyy_fmt == 2) THEN
82 WRITE(iugeo,'(A)')
83 . '#FORMAT: (1P6E12.5) (TX(I),TY(I),TXY(I),I=1,NUMSHL)'
84 ELSE
85 WRITE(iugeo,'(A)')
86 . '#FORMAT: (1P6E20.13) (TX(I),TY(I),TXY(I),I=1,NUMSHL)'
87 ENDIF
88 ENDIF
89C
90 jj_old = 1
91 resp0 = 1
92 ngf = 1
93 ngl = 0
94 jj = 0
95 compteur = 0
96 DO nn=1,nspgroup
97 ngl = ngl + dd_iad(ispmd+1,nn)
98 DO ng = ngf,ngl
99 ity = iparg(5,ng)
100 IF (ity == 3 .OR. ity == 7) THEN
101 mlw = iparg(1,ng)
102 nel = iparg(2,ng)
103 nft = iparg(3,ng)
104 lft = 1
105 llt = nel
106 npt = iparg(6,ng)
107 mpt = max(1,npt)
108 istrain = iparg(44,ng)
109 ihbe = iparg(23,ng)
110 igtyp = iparg(38,ng)
111 nlay = elbuf_tab(ng)%NLAY
112 gbuf =>elbuf_tab(ng)%GBUF
113!
114 DO i=1,8 ! length max of GBUF%G_STRA = 8
115 ii(i) = nel*(i-1)
116 ENDDO
117
118!
119 IF (mlw == 0 .OR. mlw == 13) cycle
120 IF (mlw == 27 .OR. mlw == 25 .OR.
121 . mlw == 32 .OR. mlw == 15) istrain=1
122C
123 a1 = zero
124 a2 = zero
125 istre = 1
126C
127 IF (igtyp == 51 .OR. igtyp == 52) THEN
128 npt_all = 0
129 DO ipt=1,nlay
130 npt_all = npt_all + elbuf_tab(ng)%BUFLY(ipt)%NPTT
131 ENDDO
132 IF (nlay == 1) mpt = max(1,npt_all)
133 ENDIF
134C------------------------
135C STRESS
136C------------------------
137 IF (itens == 1) THEN
138 ns1 = 5
139 ns2 = 3
140 a1 = one
141 a2 = zero
142 ELSEIF (itens == 2) THEN
143 ns1 = 5
144 ns2 = 3
145 a1 = zero
146 a2 = one
147 ELSEIF (itens == 3) THEN
148 ns1 = 5
149 ns2 = 3
150 IF (mlw == 1) THEN
151 a1 = one
152 a2 = six
153 ELSEIF (mlw == 3 .OR. mlw == 23) THEN
154 a1 = one
155 a2 = zero
156 ELSE
157 a1 = one
158 a2 = zero
159 ENDIF
160 ELSEIF (itens == 4) THEN
161 ns1 = 5
162 ns2 = 3
163 IF (mlw == 1) THEN
164 a1 = one
165 a2 = -six
166 ELSEIF (mlw == 3 .OR. mlw == 23) THEN
167 a1 = one
168 a2 = zero
169 ELSE
170 a1 = one
171 a2 = zero
172 ENDIF
173 ELSEIF (itens >= 11 .and. itens <= 40) THEN
174 ns1 = 5
175 ns2 = 3
176 IF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) THEN
177 a1 = one
178 a2 = zero
179 ELSE
180 ipt = min(mpt,itens-10)
181 a1 = one
182 a2 = zero
183 ENDIF
184C------------------------
185C STRAIN
186C------------------------
187 ELSEIF (itens == 5) THEN
188 istre = 0
189 ns1 = 8
190 ns2 = 8
191 IF (istrain == 1) THEN
192 a1 = one
193 a2 = zero
194 ELSE
195 a1 = zero
196 a2 = zero
197 ENDIF
198 ELSEIF (itens == 6) THEN
199 istre = 0
200 ns1 = 8
201 ns2 = 8
202 IF (istrain == 1) THEN
203 a1 = zero
204 a2 = one
205 ELSE
206 a1 = zero
207 a2 = zero
208 ENDIF
209 ELSEIF (itens == 7) THEN
210 istre = 0
211 ns1 = 8
212 ns2 = 8
213 IF (istrain == 1) THEN
214 a1 = one
215 a2 = half
216 ELSE
217 a1 = zero
218 a2 = zero
219 ENDIF
220 ELSEIF (itens == 8) THEN
221 istre = 0
222 ns1 = 8
223 ns2 = 8
224 IF (istrain == 1) THEN
225 a1 = one
226 a2 = -half
227 ELSE
228 a1 = zero
229 a2 = zero
230 ENDIF
231 ELSEIF (itens >= 51 .and. itens <= 80) THEN
232 istre = 0
233 ns1 = 8
234 ns2 = 8
235 IF (istrain == 1 .and. mpt /= 0) THEN
236 ipt = min(mpt,itens-50)
237 a1 = one
238 a2 = half*(((2*ipt-one)/mpt)- one)
239 ELSE
240 a1 = zero
241 a2 = zero
242 ENDIF
243C------------------------
244C STRAIN RATE
245C------------------------
246 ELSEIF (itens == 91) THEN
247 istre = 2
248 a1 = one
249 a2 = zero
250 ELSEIF (itens == 92) THEN
251 istre = 2
252 a1 = zero
253 a2 = one
254 ELSEIF (itens == 93) THEN
255 istre = 2
256 a1 = one
257 a2 = half
258 ELSEIF (itens == 94) THEN
259 istre = 2
260 a1 = one
261 a2 = -half
262 ELSEIF (itens >= 101 .and. itens <= 130) THEN
263 istre = 2
264 ipt = min(mpt,itens-100)
265 a1 = one
266 a2 = half*(((2*ipt-one)/mpt)-one)
267 ENDIF
268C
269 IF (istre == 1) THEN
270C------------------------
271C STRESS
272C------------------------
273 DO i=lft,llt
274 DO j=1,3
275 jj = jj + 1
276 wa(jj) = a1 * gbuf%FOR(ii(j)+i) + a2 * gbuf%MOM(ii(j)+i)
277 ENDDO
278 ENDDO
279 ELSEIF (istre == 0 .and. gbuf%G_STRA > 0) THEN
280C------------------------
281C STRAIN
282C------------------------
283 DO i=lft,llt
284 n = i + nft
285 thk = gbuf%THK(i)
286 jj = jj + 3
287 wa(jj-2)= a1*gbuf%STRA(ii(1)+i)+ a2*gbuf%STRA(ii(1)+i)*thk
288 wa(jj-1)= a1*gbuf%STRA(ii(2)+i)+ a2*gbuf%STRA(ii(2)+i)*thk
289 wa(jj) = half*(gbuf%STRA(ii(3)+i)+ a2*gbuf%STRA(ii(3)+i)*thk)
290 ENDDO
291 ELSEIF (istre == 2) THEN
292C------------------------
293C STRAIN RATE
294C------------------------
295 IF (ity == 3) THEN
296 n0 = 0
297 ELSE
298 n0 = numelc
299 ENDIF
300 DO i=lft,llt
301 thk = gbuf%THK(i)
302 n = i + nft
303 jj = jj + 3
304 wa(jj-2)= a1 * epsdot(1,n+n0) + a2 * epsdot(4,n+n0)*thk
305 wa(jj-1)= a1 * epsdot(2,n+n0) + a2 * epsdot(5,n+n0)*thk
306 wa(jj)= half*(a1*epsdot(3,n+n0)+a2*epsdot(6,n+n0)*thk)
307 ENDDO
308 ENDIF ! IF (ISTRE == 1)
309 ENDIF ! IF (ITY == 3 .OR. ITY == 7)
310 ENDDO ! DO NG = NGF,NGL
311 ngf = ngl + 1
312 jj_loc(nn) = jj - compteur ! size of each group
313 compteur = jj
314 ENDDO
315! ++++++++++
316 IF( nspmd>1 ) THEN
317 CALL spmd_rgather9_1comm(wa,jj,jj_loc,wap0_loc,sizp0,adress)
318 ELSE
319 wap0_loc(1:jj) = wa(1:jj)
320 adress(1,1) = 1
321 DO nn = 2,nspgroup+1
322 adress(nn,1) = jj_loc(nn-1) + adress(nn-1,1)
323 ENDDO
324 ENDIF
325! ++++++++++
326 IF(ispmd==0) THEN
327 resp0 = 0
328 DO nn=1,nspgroup
329 compteur = 0
330 DO k = 1,nspmd
331 IF((adress(nn+1,k)-1-adress(nn,k))>=0) THEN
332 DO l = adress(nn,k),adress(nn+1,k)-1
333 compteur = compteur + 1
334 wap0(compteur+resp0) = wap0_loc(l)
335 ENDDO ! l=... , ...
336 ENDIF !if(size_loc>0)
337 ENDDO ! k=1,nspmd
338
339 jj_old = compteur+resp0
340 IF(jj_old>0) THEN
341 res=mod(jj_old,6)
342 wrtlen=jj_old-res
343 IF (wrtlen > 0) THEN
344 IF (outyy_fmt == 2) THEN
345 WRITE(iugeo,'(1P6E12.5)')(wap0(j),j=1,wrtlen)
346 ELSE
347 WRITE(iugeo,'(1P6E20.13)')(wap0(j),j=1,wrtlen)
348 ENDIF
349 ENDIF
350 DO i=1,res
351 wap0(i)=wap0(wrtlen+i)
352 ENDDO
353 resp0=res
354 ENDIF
355 ENDDO ! DO NN=1,NSPGROUP
356C
357 IF (resp0 > 0) THEN
358 IF (outyy_fmt == 2) THEN
359 WRITE(iugeo,'(1P6E12.5)')(wap0(j),j=1,resp0)
360 ELSE
361 WRITE(iugeo,'(1P6E20.13)')(wap0(j),j=1,resp0)
362 ENDIF
363 ENDIF
364 ENDIF ! IF (NSPMD == 1)
365C---
366 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
spmd_rgather9_1comm
subroutine spmd_rgather9_1comm(v, sizv, len, vp0, sizv0, adress)
Definition spmd_outp.F:1181

◆ outp_c_tf()

subroutine outp_c_tf ( integer itens,
character*10 key,
character*40 text,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer sizloc,
integer sizp0,
thke,
geo,
integer, dimension(npropgi,*) igeo,
type (stack_ply) stack,
type(drape_), dimension(numelc_drape) drape_sh4n,
type(drape_), dimension(numeltg_drape) drape_sh3n,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer siz_wr,
type(drapeg_) drapeg )

Definition at line 382 of file outp_c_t.F.

386C-----------------------------------------------
387C M o d u l e s
388C-----------------------------------------------
389 USE elbufdef_mod
390 USE stack_mod
391 USE drape_mod
392 use element_mod , only : nixc,nixtg
393C-----------------------------------------------
394C I m p l i c i t T y p e s
395C-----------------------------------------------
396#include "implicit_f.inc"
397C-----------------------------------------------
398C C o m m o n B l o c k s
399C-----------------------------------------------
400#include "param_c.inc"
401#include "units_c.inc"
402#include "task_c.inc"
403#include "com01_c.inc"
404#include "scr16_c.inc"
405#include "mvsiz_p.inc"
406C-----------------------------------------------
407C D u m m y A r g u m e n t s
408C-----------------------------------------------
409 CHARACTER*10 KEY
410 CHARACTER*40 TEXT
411 INTEGER ITENS
412 INTEGER IPARG(NPARG,*), DD_IAD(NSPMD+1,*),SIZLOC,SIZP0,
413 . IGEO(NPROPGI,*),IXC(NIXC,*),IXTG(NIXTG,*),
414 . SIZ_WR
415 my_real
416 . thke(*),geo(npropg,*)
417 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
418 TYPE (STACK_PLY) :: STACK
419C-----------------------------------------------
420C L o c a l V a r i a b l e s
421C-----------------------------------------------
422 INTEGER NG,NEL,NFT,ITY,LFT,NPT,
423 . LLT,MLW,ISTRAIN,
424 . I1,I3,IHBE,I,J,JJ,
425 . JJ_OLD,NGF,NGL,NN,K,NPG,IPG,NLAY,NPTS,NPTR,IL,ITHK,NPTT,IT,
426 . IGTYP,IXFEM,ISUBSTACK,NPT_ALL,MPT,COMPTEUR,L,II(8)
427 INTEGER, DIMENSION(NSPGROUP) :: JJ_LOC
428 INTEGER, DIMENSION(NSPGROUP+1,NSPMD) :: ADRESS
429 my_real
430 . wa(sizloc),wap0(siz_wr),wap0_loc(sizp0)
431
432 my_real
433 . func(6),hourg(5)
434C
435 TYPE(BUF_LAY_) ,POINTER :: BUFLY
436 TYPE(G_BUFEL_) ,POINTER :: GBUF
437 TYPE(L_BUFEL_) ,POINTER :: LBUF
438 TYPE(DRAPE_) :: DRAPE_SH4N(NUMELC_DRAPE), DRAPE_SH3N(NUMELTG_DRAPE)
439 TYPE(DRAPEG_) :: DRAPEG
440C-----------------------------------------------
441 IF (ispmd == 0) THEN
442 WRITE(iugeo,'(2A)')'/SHELL /TENSOR /',key
443 WRITE(iugeo,'(A)')text
444 IF (itens == 95) THEN
445 WRITE(iugeo,'(A)')
446 . '#(NPG=Surface Quadratue Points; For QEPH,QBAT,DKT18: NPG>1) '
447 IF (outyy_fmt == 2) THEN
448 WRITE(iugeo,'(A)')
449 . .GT.'#FORMAT: (IF NPT0) (2I8/1P6E12.5/6E12.5) '
450 WRITE(iugeo,'(A)')
451 . '#NPT,NPG,THICK,EM,EB,H1,H2,H3'
452 WRITE(iugeo,'(2A)')
453 . '#(TX,TY,TXY,TXZ,TYZ,EPSP(K,J,I)',
454 . 'K=1,NPG),J=1,NPT),I=1,NUMSHL)'
455 WRITE(iugeo,'(A)')
456 . '#FORMAT: (IF NPT == 0) ((2I8/1P6E12.5/6E12.5/3E12.5)) '
457 WRITE(iugeo,'(A)')
458 . '#0,NPG,THICK,EM,EB,H1,H2,H3'
459 WRITE(iugeo,'(2A)')
460 . '#(NX,NY,NXY,NXZ,NYZ,EPSP,MX,MY,MXY(K,I)',
461 . 'K=1,NPG),I=1,NUMSHL)'
462 ELSE
463 WRITE(iugeo,'(A)')
464 . .GT.'#FORMAT: (IF NPT0) (2I10/1P6E20.13/6E20.13) '
465 WRITE(iugeo,'(A)')
466 . '#NPT,NPG,THICK,EM,EB,H1,H2,H3'
467 WRITE(iugeo,'(2A)')
468 . '#(TX,TY,TXY,TXZ,TYZ,EPSP(K,J,I)',
469 . 'K=1,NPG),J=1,NPT),I=1,NUMSHL)'
470 WRITE(iugeo,'(A)')
471 . '#FORMAT: (IF NPT == 0) ((2I10/1P6E20.13/6E20.13/3E20.13)) '
472 WRITE(iugeo,'(A)')
473 . '#0,NPG,THICK,EM,EB,H1,H2,H3'
474 WRITE(iugeo,'(2A)')
475 . '#(NX,NY,NXY,NXZ,NYZ,EPSP,MX,MY,MXY(K,I)',
476 . 'K=1,NPG),I=1,NUMSHL)'
477 ENDIF
478 ELSEIF (itens == 96) THEN
479 IF (outyy_fmt == 2) THEN
480 WRITE(iugeo,'(A)')
481 . '#FORMAT: (1P6E12.5/3E12.5) '
482 WRITE(iugeo,'(2A)')
483 . '#(EX(I),EY(I),EXY(I),EXZ(I),EYZ(I),',
484 . 'EPSP(I),KX(I),KY(I),KXY(I),I=1,NUMSHL)'
485 ELSE
486 WRITE(iugeo,'(A)')
487 . '#FORMAT: (1P6E20.13/3E20.13) '
488 WRITE(iugeo,'(2A)')
489 . '#(EX(I),EY(I),EXY(I),EXZ(I),EYZ(I),',
490 . 'EPSP(I),KX(I),KY(I),KXY(I),I=1,NUMSHL)'
491 ENDIF
492 ENDIF ! IF (ITENS == 95)
493 ENDIF ! IF (ISPMD == 0)
494C
495 jj_old = 1
496 ngf = 1
497 ngl = 0
498 jj = 0
499 compteur = 0
500 DO nn=1,nspgroup
501 ngl = ngl + dd_iad(ispmd+1,nn)
502 DO ng = ngf, ngl
503 ity = iparg(5,ng)
504 IF (ity == 3 .OR. ity == 7) THEN
505 mlw = iparg(1,ng)
506 nel = iparg(2,ng)
507 nft = iparg(3,ng)
508 lft = 1
509 llt = nel
510 npt = iparg(6,ng)
511 istrain= iparg(44,ng)
512 ihbe = iparg(23,ng)
513 ithk = iparg(28,ng)
514 igtyp = iparg(38,ng)
515 ixfem = iparg(54,ng)
516 isubstack=iparg(71,ng)
517C---
518 gbuf => elbuf_tab(ng)%GBUF
519 nlay = elbuf_tab(ng)%NLAY
520 nptr = elbuf_tab(ng)%NPTR
521 npts = elbuf_tab(ng)%NPTS
522 npg = nptr*npts
523!
524 DO i=1,8 ! length max of GBUF%G_STRA = 8
525 ii(i) = nel*(i-1)
526 ENDDO
527!
528C
529C pre counting of all NPTT (especially for PID_51)
530C
531 mpt = iabs(npt)
532 IF (igtyp == 51 .OR. igtyp == 52 ) THEN
533 npt_all = 0
534 DO il=1,nlay
535 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
536 ENDDO
537 mpt = max(1,npt_all)
538 ENDIF
539C---
540 IF (mlw == 27 .OR. mlw == 25 .OR.
541 . mlw == 32 .OR. mlw == 15) istrain=1
542C------------------------
543C STRESS
544C------------------------
545 IF (itens == 95) THEN
546 IF (ihbe == 0) THEN
547 DO i=lft,llt
548 wa(jj+1) = ihbe
549 jj=jj+1
550 ENDDO
551 ELSEIF (ihbe >= 11) THEN
552 CALL c_tf_ne(elbuf_tab(ng),ihbe ,nel ,npt ,mlw ,
553 . ity ,istrain ,jj ,wa ,1 ,
554 . nlay ,nptr ,npts ,ithk ,nft ,
555 . thke ,npg ,igtyp,geo ,igeo ,
556 . ixfem ,isubstack,stack,drape_sh4n, drape_sh3n,
557 . ixc ,ixtg ,mpt ,drapeg )
558 ELSE
559 IF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) THEN
560 DO i=lft,llt
561 IF (gbuf%G_HOURG == 0) THEN
562 hourg(1) = zero
563 hourg(2) = zero
564 hourg(3) = zero
565 ELSE
566 hourg(1) = gbuf%HOURG(ii(1)+i)
567 hourg(2) = gbuf%HOURG(ii(2)+i)
568 hourg(3) = gbuf%HOURG(ii(3)+i)
569 ENDIF
570 wa(jj+1) = ihbe
571 jj=jj+1
572 wa(jj+1) = 0
573 IF (ithk >0 ) THEN
574 wa(jj+2) = gbuf%THK(i)
575 ELSE
576 wa(jj+2) = thke(i+nft)
577 END IF
578c WA(JJ+2) = GBUF%THK(I)
579 wa(jj+3) = gbuf%EINT(i)
580 wa(jj+4) = gbuf%EINT(i+llt)
581 wa(jj+5) = hourg(1)
582 wa(jj+6) = hourg(2)
583 wa(jj+7) = hourg(3)
584 wa(jj+8) = gbuf%FORPG(ii(1)+i)
585 wa(jj+9) = gbuf%FORPG(ii(2)+i)
586 wa(jj+10) = gbuf%FORPG(ii(3)+i)
587 wa(jj+11) = gbuf%FORPG(ii(4)+i)
588 wa(jj+12) = gbuf%FORPG(ii(5)+i)
589 IF (gbuf%G_PLA > 0) THEN
590 wa(jj+13) = gbuf%PLA(i)
591 ELSE
592 wa(jj+13)=zero
593 ENDIF
594 wa(jj+14) = gbuf%MOMPG(ii(1)+i)
595 wa(jj+15) = gbuf%MOMPG(ii(2)+i)
596 wa(jj+16) = gbuf%MOMPG(ii(3)+i)
597 jj = jj + 16
598 ENDDO
599 ELSE ! MLW
600 DO i=lft,llt
601 IF (gbuf%G_HOURG == 0) THEN
602 hourg(1) = zero
603 hourg(2) = zero
604 hourg(3) = zero
605 ELSE
606 hourg(1) = gbuf%HOURG(ii(1)+i)
607 hourg(2) = gbuf%HOURG(ii(2)+i)
608 hourg(3) = gbuf%HOURG(ii(3)+i)
609 ENDIF
610 wa(jj+1) = ihbe
611 jj=jj+1
612 wa(jj+1) = mpt
613 IF (ithk > 0) THEN
614 wa(jj+2) = gbuf%THK(i)
615 ELSE
616 wa(jj+2) = thke(i+nft)
617 END IF
618 wa(jj+3) = gbuf%EINT(i)
619 wa(jj+4) = gbuf%EINT(i+llt)
620 wa(jj+5) = hourg(1)
621 wa(jj+6) = hourg(2)
622 wa(jj+7) = hourg(3)
623 jj = jj+7
624C
625 IF (npt == 0) THEN
626C
627 wa(jj+1) = gbuf%FORPG(ii(1)+i)
628 wa(jj+2) = gbuf%FORPG(ii(2)+i)
629 wa(jj+3) = gbuf%FORPG(ii(3)+i)
630 wa(jj+4) = gbuf%FORPG(ii(4)+i)
631 wa(jj+5) = gbuf%FORPG(ii(5)+i)
632 IF (gbuf%G_PLA > 0) THEN
633 wa(jj+6) = gbuf%PLA(i)
634 ELSE
635 wa(jj+6)=zero
636 ENDIF
637 wa(jj+7) = gbuf%MOMPG(ii(1)+i)
638 wa(jj+8) = gbuf%MOMPG(ii(2)+i)
639 wa(jj+9) = gbuf%MOMPG(ii(3)+i)
640 jj = jj+9
641C
642 ELSE ! NPT > 0
643C
644 IF (nlay == 1) THEN
645 bufly => elbuf_tab(ng)%BUFLY(1)
646 nptt = bufly%NPTT
647 DO it = 1,nptt
648 lbuf => bufly%LBUF(1,1,it)
649 wa(jj+1) = lbuf%SIG(ii(1)+i)
650 wa(jj+2) = lbuf%SIG(ii(2)+i)
651 wa(jj+3) = lbuf%SIG(ii(3)+i)
652 wa(jj+4) = lbuf%SIG(ii(4)+i)
653 wa(jj+5) = lbuf%SIG(ii(5)+i)
654 IF (bufly%L_PLA > 0) THEN
655 wa(jj+6) = lbuf%PLA(i)
656 ELSE
657 wa(jj+6) = zero
658 ENDIF
659 jj = jj+6
660 ENDDO
661 ELSEIF (nlay > 1) THEN
662 DO il = 1,nlay
663 bufly => elbuf_tab(ng)%BUFLY(il)
664 nptt = bufly%NPTT ! need for PID51 (new shell prop)
665 DO it=1,nptt
666 lbuf => bufly%LBUF(1,1,it)
667 wa(jj+1) = lbuf%SIG(ii(1)+i)
668 wa(jj+2) = lbuf%SIG(ii(2)+i)
669 wa(jj+3) = lbuf%SIG(ii(3)+i)
670 wa(jj+4) = lbuf%SIG(ii(4)+i)
671 wa(jj+5) = lbuf%SIG(ii(5)+i)
672 IF (bufly%L_PLA > 0) THEN
673 wa(jj+6) = lbuf%PLA(i)
674 ELSE
675 wa(jj+6) = zero
676 ENDIF
677 jj = jj+6
678 ENDDO ! DO IT=1,NPTT
679 ENDDO ! DO IL = 1,NLAY
680 ENDIF ! IF (NLAY ==1) THEN
681 ENDIF ! NPT > 0
682 ENDDO ! DO i=lft,llt
683 ENDIF ! MLW
684 ENDIF ! IF (IHBE == 0)
685C------------------------
686C STRAIN
687C------------------------
688 ELSEIF (itens == 96) THEN
689cc IF (ISTRAIN > 0) THEN
690 IF (gbuf%G_STRA > 0) THEN
691 DO i=lft,llt
692 wa(jj+1) = gbuf%STRA(ii(1)+i)
693 wa(jj+2) = gbuf%STRA(ii(2)+i)
694 wa(jj+3) = gbuf%STRA(ii(3)+i)
695 wa(jj+4) = gbuf%STRA(ii(4)+i)
696 wa(jj+5) = gbuf%STRA(ii(5)+i)
697C--------------
698 ! plastic strain (mid layer : npt/2 + 1)
699C--------------
700 IF (gbuf%G_PLA > 0) THEN
701 IF (nlay > 1) THEN
702 il = iabs(nlay)/2 + 1
703 bufly => elbuf_tab(ng)%BUFLY(il)
704 IF (bufly%L_PLA > 0) THEN
705 nptt = bufly%NPTT
706 IF (ihbe /= 11) THEN
707 func(6) = zero
708 DO it=1,nptt
709 lbuf => bufly%LBUF(1,1,it)
710 func(6) = func(6) + lbuf%PLA(i)/nptt
711 ENDDO
712 wa(jj+6) = func(6)
713 ELSE
714 wa(jj+6) = bufly%PLAPT(i)
715 ENDIF
716 ENDIF
717 ELSE
718 bufly => elbuf_tab(ng)%BUFLY(1)
719 IF (bufly%L_PLA > 0) THEN
720 nptt = bufly%NPTT
721 il = iabs(nptt)/2 + 1
722 IF (ihbe /= 11) THEN
723 wa(jj+6) = bufly%LBUF(1,1,il)%PLA(i)
724 ELSE
725 i3 = (il-1)*nel
726 wa(jj+6) = bufly%PLAPT(i3+i)
727 ENDIF
728 ENDIF
729 ENDIF
730 ELSE
731 wa(jj+6) = zero
732 ENDIF
733 wa(jj+7) = gbuf%STRA(ii(6)+i)
734 wa(jj+8) = gbuf%STRA(ii(7)+i)
735 wa(jj+9) = gbuf%STRA(ii(8)+i)
736 jj = jj+9
737 ENDDO
738 ELSE ! (GBUF%G_STRA = 0)
739 DO i=lft,llt
740 i1 = 8*(i-1)
741 wa(jj+1) = zero
742 wa(jj+2) = zero
743 wa(jj+3) = zero
744 wa(jj+4) = zero
745 wa(jj+5) = zero
746C--------------
747 ! plastic strain (mid layer : npt/2 + 1)
748C--------------
749 IF (gbuf%G_PLA > 0) THEN
750 IF (nlay > 1) THEN
751 il = iabs(nlay)/2 + 1
752 bufly => elbuf_tab(ng)%BUFLY(il)
753 IF (bufly%L_PLA > 0) THEN
754 nptt = bufly%NPTT
755 IF (ihbe /= 11) THEN
756 func(6) = zero
757 DO it=1,nptt
758 lbuf => bufly%LBUF(1,1,it)
759 func(6) = func(6) + lbuf%PLA(i)/nptt
760 ENDDO
761 wa(jj+6) = func(6)
762 ELSE
763 wa(jj+6) = bufly%PLAPT(i)
764 ENDIF
765 ENDIF
766 ELSE
767 bufly => elbuf_tab(ng)%BUFLY(1)
768 IF (bufly%L_PLA > 0) THEN
769 nptt = bufly%NPTT
770 il = iabs(nptt)/2 + 1
771 IF (ihbe /= 11) THEN
772 wa(jj+6) = bufly%LBUF(1,1,il)%PLA(i)
773 ELSE
774 i3 = (il-1)*nel
775 wa(jj+6) = bufly%PLAPT(i3+i)
776 ENDIF
777 ENDIF
778 ENDIF
779 ELSE
780 wa(jj+6) = zero
781 ENDIF
782 wa(jj+7) = zero
783 wa(jj+8) = zero
784 wa(jj+9) = zero
785 jj = jj+9
786 ENDDO
787 ENDIF ! IF (GBUF%G_STRA > 0)
788C
789 ENDIF ! IF (ITENS == 95)
790 ENDIF ! IF (ITY == 3 .OR. ITY == 7)
791 ENDDO ! DO NG = NGF, NGL
792C-----------------------------------------------------------------------
793 ngf = ngl + 1
794 jj_loc(nn) = jj - compteur ! size of each group
795 compteur = jj
796 ENDDO
797! ++++++++++
798 IF( nspmd>1 ) THEN
799 CALL spmd_rgather9_1comm(wa,jj,jj_loc,wap0_loc,sizp0,adress)
800 ELSE
801 wap0_loc(1:jj) = wa(1:jj)
802 adress(1,1) = 1
803 DO nn = 2,nspgroup+1
804 adress(nn,1) = jj_loc(nn-1) + adress(nn-1,1)
805 ENDDO
806 ENDIF
807! ++++++++++
808 IF(ispmd==0) THEN
809 DO nn=1,nspgroup
810 compteur = 0
811 DO k = 1,nspmd
812 IF((adress(nn+1,k)-1-adress(nn,k))>=0) THEN
813 DO l = adress(nn,k),adress(nn+1,k)-1
814 compteur = compteur + 1
815 wap0(compteur) = wap0_loc(l)
816 ENDDO ! l=... , ...
817 ENDIF !if(size_loc>0)
818 ENDDO ! k=1,nspmd
819
820
821 jj_old = compteur
822 IF(jj_old>0) THEN
823
824 IF (itens == 95) THEN
825 j = 1
826 DO WHILE (j < jj_old+1)
827 ihbe=nint(wap0(j))
828 j=j+1
829 IF (ihbe == 0) THEN
830 IF (outyy_fmt == 2) THEN
831 npt = 0
832 npg = 0
833 WRITE(iugeo,'(2I8/,1P6E12.5)')
834 . npt,npg,zero,zero,zero,
835 . zero,zero,zero
836 WRITE(iugeo,'(1P6E12.5)')
837 . zero,zero,zero,
838 . zero,zero,zero
839 WRITE(iugeo,'(1P3E12.5)')
840 . zero,zero,zero
841 ELSE
842 npt = 0
843 npg = 0
844 WRITE(iugeo,'(2I10/,1P6E20.13)')
845 . npt,npg,zero,zero,zero,
846 . zero,zero,zero
847 WRITE(iugeo,'(1P6E20.13)')
848 . zero,zero,zero,
849 . zero,zero,zero
850 WRITE(iugeo,'(1P3E20.13)')
851 . zero,zero,zero
852 ENDIF
853 ELSEIF (ihbe >= 11) THEN
854 IF (outyy_fmt == 2) THEN
855 npt = nint(wap0(j))
856 npg = nint(wap0(j+1))
857 WRITE(iugeo,'(2I8/,1P3E12.5)')npt,npg,
858 . (wap0(j+k),k=2,4)
859 j = j + 5
860 IF (npt == 0) THEN
861 DO ipg=1,npg
862 WRITE(iugeo,'(1P6E12.5/1P3E12.5)')
863 . (wap0(j+k),k=0,8)
864 j = j + 9
865 ENDDO
866 ELSE
867 DO i=1,npt
868 DO ipg=1,npg
869 WRITE(iugeo,'(1P6E12.5)')(wap0(j+k),k=0,5)
870 j = j + 6
871 ENDDO
872 ENDDO
873 ENDIF
874 ELSE
875 npt = nint(wap0(j))
876 npg = nint(wap0(j+1))
877 WRITE(iugeo,'(2I10/,1P3E20.13)')npt,npg,
878 . (wap0(j+k),k=2,4)
879 j = j + 5
880 IF (npt == 0) THEN
881 DO ipg=1,npg
882 WRITE(iugeo,'(1P6E20.13/1P3E20.13)')
883 . (wap0(j+k),k=0,8)
884 j = j + 9
885 ENDDO
886 ELSE
887 DO i=1,npt
888 DO ipg=1,npg
889 WRITE(iugeo,'(1P6E20.13)')(wap0(j+k),k=0,5)
890 j = j + 6
891 ENDDO
892 ENDDO
893 ENDIF
894 ENDIF
895 ELSE
896 npt = nint(wap0(j))
897 IF (npt == 0) THEN
898 IF (outyy_fmt == 2) THEN
899 WRITE(iugeo,'(I8/,1P6E12.5)')npt,(wap0(j+k),k=1,6)
900 WRITE(iugeo,'(1P6E12.5/1P3E12.5)')(wap0(j+k),k=7,15)
901 ELSE
902 WRITE(iugeo,'(I10/,1P6E20.13)')npt,(wap0(j+k),k=1,6)
903 WRITE(iugeo,'(1P6E20.13/1P3E20.13)')(wap0(j+k),k=7,15)
904 ENDIF
905 j = j + 16
906 ELSE
907 IF (outyy_fmt == 2) THEN
908 WRITE(iugeo,'(I8/,1P6E12.5)')npt,(wap0(j+k),k=1,6)
909 ELSE
910 WRITE(iugeo,'(I10/,1P6E20.13)')npt,(wap0(j+k),k=1,6)
911 ENDIF
912 j = j + 7
913 IF (outyy_fmt == 2) THEN
914 DO i=1,npt
915 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
916 j = j + 6
917 ENDDO
918 ELSE
919 DO i=1,npt
920 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
921 j = j + 6
922 ENDDO
923 ENDIF
924 ENDIF
925 ENDIF ! IF (IHBE == 0)
926 ENDDO ! DO WHILE (J < JJ_OLD)
927 ELSEIF (itens == 96) THEN
928 j = 1
929 IF (outyy_fmt == 2) THEN
930 DO WHILE (j < jj_old)
931 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
932 WRITE(iugeo,'(1P3E12.5)')(wap0(j-1+k),k=7,9)
933 j = j + 9
934 ENDDO
935 ELSE
936 DO WHILE (j < jj_old)
937 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
938 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=7,9)
939 j = j + 9
940 ENDDO
941 ENDIF
942 ENDIF ! IF (ITENS == 95)
943 ENDIF ! IF (JJ_OLD > 0)
944 ENDDO ! DO NN=1,NSPGROUP
945 ENDIF ! IF(ISPMD == 0)THEN
946C---
947 RETURN
c_tf_ne
subroutine c_tf_ne(elbuf_str, ihbe, nel, npt, mlw, ity, istrain, jj, wa, iw, nlay, nptr, npts, ithk, nft, thke, npg, igtyp, geo, igeo, ixfem, isubstack, stack, drape_sh4n, drape_sh3n, ixc, ixtg, mpt, drapeg)
Definition c_tf_ne.F:41
drape_mod
Definition drape_mod.F:54
stack_mod
Definition stack_mod.F:75