OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
layini.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "drape_c.inc"
#include "com20_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine layini (elbuf_str, jft, jlt, geo, igeo, mat, pid, thkly, matly, posly, igtyp, ixfem, ixlay, nlay, npt, isubstack, stack, drape, nft, thk, nel, ratio_thkly, indx_drape, sedrape, numel_drape)

Function/Subroutine Documentation

◆ layini()

subroutine layini ( type(elbuf_struct_), target elbuf_str,
integer jft,
integer jlt,
geo,
integer, dimension(npropgi,*) igeo,
integer, dimension(*) mat,
integer, dimension(*) pid,
thkly,
integer, dimension(*) matly,
posly,
integer igtyp,
integer ixfem,
integer ixlay,
integer nlay,
integer npt,
integer isubstack,
type (stack_ply) stack,
type (drape_), dimension(numel_drape), target drape,
integer nft,
thk,
integer nel,
ratio_thkly,
integer, dimension(sedrape) indx_drape,
integer, intent(in) sedrape,
integer, intent(in) numel_drape )

Definition at line 41 of file layini.F.

47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE elbufdef_mod
51 USE stack_mod
52 USE drape_mod
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C G l o b a l P a r a m e t e r s
59C-----------------------------------------------
60#include "mvsiz_p.inc"
61#include "param_c.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "drape_c.inc"
66#include "com20_c.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 INTEGER JFT,JLT,NPT,NEL,IGTYP,ISUBSTACK,NLAY,IXLAY,IXFEM,NFT
71 INTEGER , INTENT(IN) :: SEDRAPE,NUMEL_DRAPE
72 INTEGER MAT(*), PID(*), MATLY(*), IGEO(NPROPGI,*)
73 my_real geo(npropg,*),posly(mvsiz,*),thkly(*),ratio_thkly(nel,*),
74 . thk(*)
75 INTEGER, DIMENSION(SEDRAPE) :: INDX_DRAPE
76 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
77 TYPE (STACK_PLY) :: STACK
78 TYPE (DRAPE_), DIMENSION(NUMEL_DRAPE), TARGET :: DRAPE
79C-----------------------------------------------
80C L o c a l V a r i a b l e s
81C-----------------------------------------------
82 INTEGER I, J, N, IADR, IPTHK, IPMAT, IPPOS ,IPPID, IPID,
83 . IPANG,MAT_LY(MVSIZ),IT,ITL,ILAY,NPTT,MAX_NPTT,IPT,JMLY,IINT,
84 . IPID_LY,IPT_ALL,MAT_LAY,IDX,IE,NSLICE,IP,IDRAPE,IPOS
85 my_real
86 . zshift,thk_nptt,thickt_drape,
87 . thkl,pos_nptt,pos_0,thickt,thinning,thk_ly(mvsiz),pos_ly(mvsiz)
88 my_real , DIMENSION(:,:),ALLOCATABLE :: thk_it
89C-----------------------------------------------
90 TYPE (DRAPE_PLY_), POINTER :: DRAPE_PLY
91 TYPE(L_BUFEL_) ,POINTER :: LBUF
92
93 my_real
94 . a_gauss(9,9),w_gauss(9,9)
95C-----------------------------------------------
96 DATA a_gauss /
97 1 0. ,0. ,0. ,
98 1 0. ,0. ,0. ,
99 1 0. ,0. ,0. ,
100 2 -.577350269189626,0.577350269189626,0. ,
101 2 0. ,0. ,0. ,
102 2 0. ,0. ,0. ,
103 3 -.774596669241483,0. ,0.774596669241483,
104 3 0. ,0. ,0. ,
105 3 0. ,0. ,0. ,
106 4 -.861136311594053,-.339981043584856,0.339981043584856,
107 4 0.861136311594053,0. ,0. ,
108 4 0. ,0. ,0. ,
109 5 -.906179845938664,-.538469310105683,0. ,
110 5 0.538469310105683,0.906179845938664,0. ,
111 5 0. ,0. ,0. ,
112 6 -.932469514203152,-.661209386466265,-.238619186083197,
113 6 0.238619186083197,0.661209386466265,0.932469514203152,
114 6 0. ,0. ,0. ,
115 7 -.949107912342759,-.741531185599394,-.405845151377397,
116 7 0. ,0.405845151377397,0.741531185599394,
117 7 0.949107912342759,0. ,0. ,
118 8 -.960289856497536,-.796666477413627,-.525532409916329,
119 8 -.183434642495650,0.183434642495650,0.525532409916329,
120 8 0.796666477413627,0.960289856497536,0. ,
121 9 -.968160239507626,-.836031107326636,-.613371432700590,
122 9 -.324253423403809,0. ,0.324253423403809,
123 9 0.613371432700590,0.836031107326636,0.968160239507626/
124 DATA w_gauss /
125 1 2. ,0. ,0. ,
126 1 0. ,0. ,0. ,
127 1 0. ,0. ,0. ,
128 2 1. ,1. ,0. ,
129 2 0. ,0. ,0. ,
130 2 0. ,0. ,0. ,
131 3 0.555555555555556,0.888888888888889,0.555555555555556,
132 3 0. ,0. ,0. ,
133 3 0. ,0. ,0. ,
134 4 0.347854845137454,0.652145154862546,0.652145154862546,
135 4 0.347854845137454,0. ,0. ,
136 4 0. ,0. ,0. ,
137 5 0.236926885056189,0.478628670499366,0.568888888888889,
138 5 0.478628670499366,0.236926885056189,0. ,
139 5 0. ,0. ,0. ,
140 6 0.171324492379170,0.360761573048139,0.467913934572691,
141 6 0.467913934572691,0.360761573048139,0.171324492379170,
142 6 0. ,0. ,0. ,
143 7 0.129484966168870,0.279705391489277,0.381830050505119,
144 7 0.417959183673469,0.381830050505119,0.279705391489277,
145 7 0.129484966168870,0. ,0. ,
146 8 0.101228536290376,0.222381034453374,0.313706645877887,
147 8 0.362683783378362,0.362683783378362,0.313706645877887,
148 8 0.222381034453374,0.101228536290376,0. ,
149 9 0.081274388361574,0.180648160694857,0.260610696402935,
150 9 0.312347077040003,0.330239355001260,0.312347077040003,
151 9 0.260610696402935,0.180648160694857,0.081274388361574/
152C=======================================================================
153 ipthk = 300
154 ippos = 400
155 ipmat = 100
156 idrape = elbuf_str%IDRAPE
157 max_nptt = 0
158 IF(igtyp == 51 .OR. igtyp == 52) THEN
159 DO ilay=1,nlay
160 max_nptt = max_nptt + elbuf_str%BUFLY(ilay)%NPTT
161 ENDDO
162 ENDIF
163 IF(max_nptt > 0 ) THEN
164 ALLOCATE(thk_it(max_nptt,mvsiz))
165 ELSE
166 ALLOCATE(thk_it(0,0))
167 ENDIF
168c
169c---------------------------------------------------------
170 IF (ixfem == 1 .and. ixlay > 0) THEN ! traitement des elements fantomes
171c ! layer = ixlay
172c---------------------------------------------------------
173 SELECT CASE (igtyp)
174c----
175 CASE (11)
176c----
177 DO ilay=1,elbuf_str%NLAY
178 iadr = (ilay-1)*jlt
179 DO i=jft,jlt
180 j = iadr + i
181 thkly(j) = one
182c POSLY(I,ILAY) = GEO(IPPOS+IXLAY,PID(1))
183 posly(i,ilay) = zero
184 matly(j) = igeo(ipmat+ixlay,pid(1))
185 ENDDO
186 ENDDO
187c
188c----
189 CASE (51,52)
190c----
191 ipang = 1
192 ippid = 2
193 ipmat = ippid + elbuf_str%NLAY ! layer material address
194 ipthk = ipang + elbuf_str%NLAY ! layer thickness address
195 ippos = ipthk + elbuf_str%NLAY ! layer position address
196c
197 nptt = elbuf_str%BUFLY(ixlay)%NPTT
198 iint = igeo(47,pid(1))
199C---
200 IF(iint == 1 ) THEN
201 DO i=jft,jlt
202 thk_ly(i) = stack%GEO(ipthk + ixlay,isubstack) ! layer thickness ratio
203 pos_ly(i) = stack%GEO(ippos + ixlay,isubstack) ! layer position ratio
204 mat_ly(i) = stack%IGEO(ipmat + ixlay,isubstack) ! layer material
205 ratio_thkly(i,ixlay) = thk_ly(i)
206 jmly = (ixlay - 1)*jlt + i
207 DO it=1,nptt
208 j = (it-1)*jlt + i
209 thk_it(it,i) = one/nptt ! THK_LY = ONE
210 thkly(j) = thk_it(it,i)
211 matly(jmly) = mat_ly(i) ! layer defined
212 posly(i,it) = zero
213 ENDDO
214 ENDDO
215 ELSEIF(iint == 2)THEN
216 DO i=jft,jlt
217 thk_ly(i) = stack%GEO(ipthk + ixlay,isubstack) ! layer thickness ratio
218 pos_ly(i) = stack%GEO(ippos + ixlay,isubstack) ! layer position ratio
219 mat_ly(i) = stack%IGEO(ipmat + ixlay,isubstack) ! layer material
220 ratio_thkly(i,ixlay) = thk_ly(i)
221 jmly = (ixlay - 1)*jlt + i
222 DO it=1,nptt
223 j = (it-1)*jlt + i
224 thk_it(it,i) = half*w_gauss(it,nptt) ! THK_LY = ONE
225 thkly(j) = thk_it(it,i)
226 matly(jmly) = mat_ly(i) ! layer defined
227 posly(i,it) = zero
228 ENDDO
229 ENDDO
230 ENDIF
231c-----------
232 END SELECT
233c---------------------------------------------------------
234c
235 ELSE ! (IXFEM = 0)
236c
237c---------------------------------------------------------
238 SELECT CASE (igtyp)
239c----
240 CASE (1,9)
241c----
242 zshift = geo(199, pid(1))
243 DO n=1,npt
244 iadr = (n-1)*jlt
245 DO i = jft,jlt
246 j = iadr+i
247 thkly(j) = wf(n,npt)
248 posly(i,n) = z0(n,npt)+zshift
249 matly(j) = mat(1)
250 ENDDO
251 ENDDO
252c----
253 CASE (10)
254c----
255 DO n=1,npt
256 iadr = (n-1)*jlt
257 pos_0 = geo(ippos+n,pid(1))
258 thk_nptt = geo(ipthk+n,pid(1))
259 DO i = jft,jlt
260 j = iadr+i
261 thkly(j) = thk_nptt
262 posly(i,n) = pos_0
263 matly(j) = mat(1)
264 ENDDO
265 ENDDO
266c----
267 CASE (11, 16)
268c----
269 DO n=1,npt
270 iadr = (n-1)*jlt
271 thk_nptt = geo(ipthk+n,pid(1))
272 pos_0 = geo(ippos+n,pid(1))
273 mat_lay = igeo(ipmat+n,pid(1))
274 DO i=jft,jlt
275 j = iadr+i
276 thkly(j) = thk_nptt
277 posly(i,n) = pos_0
278 matly(j) = mat_lay
279 ENDDO
280 ENDDO
281c----
282 CASE (17)
283c----
284 ippid = 2
285 ipmat = ippid + npt
286 ipang = 1
287 ipthk = ipang + npt
288 ippos = ipthk + npt
289 ipos = igeo(99,pid(1))
290 thickt = stack%GEO(1,isubstack)
291 zshift = geo(199, pid(1))
292 IF (ipos == 2 ) zshift = zshift /max(thickt,em20)
293 IF(idrape == 0) THEN
294 DO n=1,npt
295 iadr = (n-1)*jlt
296 DO i=jft,jlt
297 j = iadr+i
298 matly(j) = stack%IGEO(ipmat + n ,isubstack)
299 thkly(j) = stack%GEO (ipthk + n ,isubstack)
300 posly(i,n) = stack%GEO (ippos + n ,isubstack)
301 ENDDO
302 ENDDO
303 ELSE ! IDRAPE > 0
304 thickt = stack%GEO(1,isubstack)
305 DO n=1,npt
306 iadr = (n-1)*jlt
307 DO i=jft,jlt
308 j = iadr+i
309 matly(j) = stack%IGEO(ipmat + n ,isubstack)
310 ie = indx_drape(nft + i)
311 IF (ie == 0) THEN
312 thkly(j) = stack%GEO (ipthk + n ,isubstack)
313 posly(i,n) = stack%GEO (ippos + n ,isubstack)
314 ELSE
315 thickt_drape = drape(ie)%THICK
316 ip = drape(ie)%INDX_PLY(n)
317 IF (ip == 0) THEN
318 thkly(j) = stack%GEO (ipthk + n ,isubstack)*thickt
319 ratio_thkly(i,n) = thkly(j)/thickt_drape
320 IF (n == 1) THEN
321 posly(i,n) = zshift + half*ratio_thkly(i,n)
322 ELSE
323 posly(i,n) = posly(i,n-1)
324 . + half*(ratio_thkly(i,n)+ratio_thkly(i,n-1))
325 ENDIF ! IF (N == 1)
326 pos_ly(i) = posly(i,n)
327 ELSE ! draped ply
328 drape_ply => drape(ie)%DRAPE_PLY(ip)
329 thinning = drape_ply%RDRAPE(1,1)
330 thkly(j) = stack%GEO(ipthk + n,isubstack)*thickt ! initial THKLY
331 thkly(j) = thkly(j)*thinning ! new thkly(/drape thinning)
332 thkly(j) = thkly(j)/thickt_drape ! layer thickness ratio
333 ratio_thkly(i,n) = thkly(j)
334 IF (n == 1) THEN
335 posly(i,n) = zshift + half*ratio_thkly(i,n)
336 ELSE
337 posly(i,n) = posly(i,n-1)
338 . + half*(ratio_thkly(i,n)+ratio_thkly(i,n-1))
339 ENDIF ! IF (N == 1)
340 ENDIF ! IP
341 ENDIF ! IF (IDRAPE == 0)
342 ENDDO
343 ENDDO
344
345 ENDIF
346c----
347 CASE (51, 52)
348c----
349 ipt_all = 0
350c stack addresses
351 ipang = 1
352 ippid = 2
353 ipmat = ippid + nlay ! layer material address ( NLAY = NPT )
354 ipthk = ipang + nlay ! layer thickness address ( NLAY = NPT )
355 ippos = ipthk + nlay ! layer position address ( NLAY = NPT )
356c
357 ipos = igeo(99,pid(1))
358 thickt = stack%GEO(1,isubstack)
359 zshift = geo(199, pid(1))
360 IF (ipos == 2 ) zshift = zshift /max(thickt,em20)
361 IF(idrape == 0) THEN
362 ipt_all = 0
363 DO ilay=1,nlay
364 nptt = elbuf_str%BUFLY(ilay)%NPTT
365 iint = igeo(47,pid(1))
366 IF(iint == 1) THEN
367 DO i=jft,jlt
368 mat_ly(i) = stack%IGEO(ipmat + ilay,isubstack) ! layer material
369 thickt = stack%GEO(1,isubstack)
370 thk_ly(i) = stack%GEO(ipthk + ilay,isubstack) ! layer thickness ratio
371 pos_ly(i) = stack%GEO(ippos + ilay,isubstack) ! layer position ratio
372 ratio_thkly(i,ilay) = thk_ly(i)
373 jmly = (ilay-1)*jlt + i
374 DO it=1,nptt
375 ipt = ipt_all + it
376 j = (ipt-1)*jlt + i
377 thk_it(ipt,i) = thk_ly(i)/nptt ! uniform distribution of NPTT through layer
378 IF (ipt == 1) THEN
379 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
380 ELSE
381 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
382 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
383 ENDIF ! IF (ILAY == 1)
384 thkly(j) = thk_it(ipt,i)
385 ENDDO
386 matly(jmly) = mat_ly(i) ! layer defined
387 ENDDO ! DO I=JFT,JLT
388 ipt_all = ipt_all + nptt
389 ELSEIF (iint == 2) THEN ! Gauss distribution
390 DO i=jft,jlt
391 mat_ly(i) = stack%IGEO(ipmat + ilay,isubstack) ! layer material
392 thk_ly(i) = stack%GEO(ipthk + ilay,isubstack) ! layer thickness ratio
393 pos_ly(i) = stack%GEO(ippos + ilay,isubstack) ! layer position ratio
394 ratio_thkly(i,ilay) = thk_ly(i)
395 jmly = (ilay-1)*jlt + i
396 DO it=1,nptt
397 ipt = ipt_all + it
398 j = (ipt-1)*jlt + i
399 thk_it(ipt,i) = half*thk_ly(i)*w_gauss(it,nptt) ! uniform distribution of NPTT through layer
400 IF (ipt == 1) THEN
401 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
402 ELSE
403 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
404 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
405 ENDIF ! IF (ILAY == 1)
406 thkly(j) = thk_it(ipt,i)
407 ENDDO
408 matly(jmly) = mat_ly(i) ! layer defined
409 ENDDO ! DO I=JFT,JLT
410 ipt_all = ipt_all + nptt
411 ENDIF ! IINT
412 ENDDO ! DO ilay=1,nlay
413 ELSE ! idrape > 0
414 ipt_all = 0
415 DO ilay=1,nlay
416 nptt = elbuf_str%BUFLY(ilay)%NPTT
417cc IPID_LY = STACK%IGEO(IPPID + ILAY,ISUBSTACK) ! layer PID (igtyp = 19)
418 iint = igeo(47,pid(1))
419 IF(iint == 1) THEN
420 DO i=jft,jlt
421 mat_ly(i) = stack%IGEO(ipmat + ilay,isubstack) ! layer material
422 thickt = stack%GEO(1,isubstack)
423 thk_ly(i) = stack%GEO(ipthk + ilay,isubstack)*thickt ! layer thickness ratio
424 pos_ly(i) = stack%GEO(ippos + ilay,isubstack)*thickt ! layer position ratio
425 ratio_thkly(i,ilay) = thk_ly(i)/thickt
426 jmly = (ilay-1)*jlt + i
427 ie = indx_drape(nft + i)
428 IF(ie == 0) THEN
429 DO it=1,nptt
430 ipt = ipt_all + it
431 j = (ipt-1)*jlt + i
432 thk_it(ipt,i) = thk_ly(i)/thickt/nptt ! uniform distribution of NPTT through layer
433 IF (ipt == 1) THEN
434 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
435 ELSE
436 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
437 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
438 ENDIF ! IF (ILAY == 1)
439 thkly(j) = thk_it(ipt,i)
440 ENDDO
441 ELSE
442 ip = drape(ie)%INDX_PLY(ilay)
443 thickt_drape = drape(ie)%THICK
444 IF(ip > 0) THEN
445 drape_ply => drape(ie)%DRAPE_PLY(ip)
446 nslice = drape_ply%NSLICE ! = NPTT
447 DO it=1,nptt
448 ipt = ipt_all + it
449 j = (ipt-1)*jlt + i
450 thinning = drape_ply%RDRAPE(it,1)
451 thk_it(ipt,i) = thinning*thk_ly(i)/nptt
452 thk_it(ipt,i) = thk_it(ipt,i)/thickt_drape ! uniform distribution of NPTT through layer
453 IF (ipt == 1) THEN
454 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
455 ELSE
456 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
457 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
458 ENDIF ! IF (ILAY == 1)
459 thkly(j) = thk_it(ipt,i)
460 ENDDO
461 ELSE
462 DO it=1,nptt
463 ipt = ipt_all + it
464 j = (ipt-1)*jlt + i
465 thk_it(ipt,i) = thk_ly(i)/thickt_drape/nptt ! uniform distribution of NPTT through layer
466 IF (ipt == 1) THEN
467 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
468 ELSE
469 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
470 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
471 ENDIF ! IF (ILAY == 1)
472 thkly(j) = thk_it(ipt,i)
473 ENDDO
474 ENDIF ! IP
475 ENDIF ! IE
476 matly(jmly) = mat_ly(i) ! layer defined
477 ENDDO ! DO I=JFT,JLT
478 ipt_all = ipt_all + nptt
479 ELSEIF (iint == 2) THEN ! Gauss distribution
480 DO i=jft,jlt
481 mat_ly(i) = stack%IGEO(ipmat + ilay,isubstack) ! layer material
482 thickt = stack%GEO(1,isubstack)
483 thk_ly(i) = stack%GEO(ipthk + ilay,isubstack)*thickt ! layer thickness ratio
484 pos_ly(i) = stack%GEO(ippos + ilay,isubstack)*thickt ! layer position ratio
485 ratio_thkly(i,ilay) = thk_ly(i)/thickt_drape
486 jmly = (ilay-1)*jlt + i
487 ie = indx_drape(nft + i)
488 IF(ie == 0) THEN
489 DO it=1,nptt
490 ipt = ipt_all + it
491 j = (ipt-1)*jlt + i
492 thk_it(ipt,i) = half*thk_ly(i)*w_gauss(it,nptt)/thk(i) ! uniform distribution of NPTT through layer
493 IF (ipt == 1) THEN
494 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
495 ELSE
496 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
497 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
498 ENDIF ! IF (ILAY == 1)
499 thkly(j) = thk_it(ipt,i)
500 ENDDO
501 ELSE
502 ip = drape(ie)%INDX_PLY(ilay)
503 IF(ip > 0) THEN
504 drape_ply => drape(ie)%DRAPE_PLY(ip)
505 nslice = drape_ply%NSLICE ! = NPTT
506 DO it=1,nptt
507 ipt = ipt_all + it
508 j = (ipt-1)*jlt + i
509 thinning = drape_ply%RDRAPE(it,1)
510 thk_it(ipt,i) = thinning*half*thk_ly(i)*w_gauss(it,nptt) ! uniform distribution of NPTT through layer
511 thk_it(ipt,i) = thk_it(ipt,i)/thickt_drape
512 IF (ipt == 1) THEN
513 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
514 ELSE
515 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
516 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
517 ENDIF ! IF (ILAY == 1)
518 thkly(j) = thk_it(ipt,i)
519 ENDDO
520 ELSE
521 DO it=1,nptt
522 ipt = ipt_all + it
523 j = (ipt-1)*jlt + i
524 thk_it(ipt,i) = half*thk_ly(i)*w_gauss(it,nptt) ! uniform distribution of NPTT through layer
525 thk_it(ipt,i) = thk_it(ipt,i)/thickt_drape
526 IF (ipt == 1) THEN
527 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
528 ELSE
529 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
530 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
531 ENDIF ! IF (ILAY == 1)
532 thkly(j) = thk_it(ipt,i)
533 ENDDO
534 ENDIF ! IP
535 ENDIF ! IE
536 matly(jmly) = mat_ly(i) ! layer defined
537 ENDDO ! DO I=JFT,JLT
538 ipt_all = ipt_all + nptt
539 ENDIF ! IINT
540 ENDDO ! DO ILAY=1,NLAY
541 ENDIF ! idrape
542c----
543 CASE DEFAULT
544c----
545 DO n=1,npt
546 iadr = (n-1)*jlt
547 pos_0 = geo(ippos+n,pid(1))
548 thk_nptt = geo(ipthk+n,pid(1))
549 DO i = jft,jlt
550 j = iadr+i
551 thkly(j) = thk_nptt
552 posly(i,n) = pos_0
553 matly(j) = mat(1)
554 ENDDO
555 ENDDO
556c----
557 END SELECT
558c-----------
559 END IF ! IXFEM
560 DEALLOCATE(thk_it)
561c-----------
562 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
drape_mod
Definition drape_mod.F:54
stack_mod
Definition stack_mod.F:72