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 955 of file outp_c_t.F.

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

◆ 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 381 of file outp_c_t.F.

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