OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
w_drape.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| w_drape ../starter/source/restart/ddsplit/w_drape.F
25!||--- called by ------------------------------------------------------
26!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| drape_mod ../starter/share/modules1/drape_mod.F
30!||====================================================================
31 SUBROUTINE w_drape(DRAPE,INDX, CEP,P,NUMEL,NUMEL_L,NELDRP_L,LEN_IA,LEN_AM)
32 USE drape_mod
33C---------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37#include "mvsiz_p.inc"
38#include "com04_c.inc"
39C-----------------------------------------------
40C C o m m o n B l o c k s
41C-----------------------------------------------
42C-----------------------------------------------
43C D u m m y A r g u m e n t s
44C-----------------------------------------------
45 INTEGER CEP(*), P, NUMEL, NUMEL_L, LEN_AM,LEN_IA
46 TYPE(drape_), DIMENSION(NUMELC_DRAPE + NUMELTG_DRAPE):: DRAPE
47 INTEGER, DIMENSION(NUMEL) :: INDX
48C-----------------------------------------------
49C F u n c t i o n
50C-----------------------------------------------
51C-----------------------------------------------
52C L o c a l V a r i a b l e s
53C-----------------------------------------------
54 INTEGER I, EL, J,NPT,NDIM,IDX,NUMELDRP_L,NDIM_SLICE,
55 . NDIM_INDX_PLY,K,II,IS,NEL,NSLICE,NELDRP_L,NPT_DRP
56 my_real, DIMENSION(:,:), ALLOCATABLE :: rtmp
57 my_real, DIMENSION(:) , ALLOCATABLE :: thk
58 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITMP
59 INTEGER, DIMENSION(:) , ALLOCATABLE :: NPTDRP_ELT,ISLICE,INDX_PLY,
60 . NPT_ELT,INDEX
61C-----------------------------------------------
62! allocate 2d array
63! --------------------------------------
64C
65 ALLOCATE(npt_elt(numel_l),nptdrp_elt(numel_l), index(numel_l),thk(numel_l))
66C
67 index = 0
68 nptdrp_elt =0
69 npt_elt =0
70 thk = zero
71 !
72 ndim = 0
73 nel = 0
74 ndim_slice = 0
75 ndim_indx_ply = 0
76 ndim = 0
77 neldrp_l = 0
78 DO i = 1, numel
79 IF(cep(i)== p) THEN
80 ii = indx(i)
81 nel = nel + 1
82 IF(ii > 0) THEN
83 neldrp_l = neldrp_l + 1
84 index(nel) = neldrp_l
85 npt_drp = drape(ii)%NPLY_DRAPE
86 npt = drape(ii)%NPLY
87 nptdrp_elt(neldrp_l) = npt_drp
88 npt_elt(neldrp_l ) = npt
89 thk(neldrp_l) = drape(ii)%THICK
90 DO j = 1,npt_drp
91 nslice = drape(ii)%DRAPE_PLY(j)%NSLICE
92 ndim = ndim + nslice
93 ENDDO
94 ndim_slice = ndim_slice + npt_drp
95 ndim_indx_ply = ndim_indx_ply + npt
96 ENDIF
97 ENDIF
98 ENDDO
99 IF(neldrp_l > 0) THEN
100C
101 ALLOCATE(itmp(ndim,2),rtmp(ndim,2),islice(ndim_slice),indx_ply(ndim_indx_ply))
102C
103 ndim_slice = 0
104 ndim_indx_ply = 0
105 ndim = 0
106 neldrp_l = 0
107 nel = 0
108 DO i = 1, numel
109 IF(cep(i)== p) THEN
110 ii = indx(i)
111 nel = nel + 1
112 IF(ii > 0) THEN
113 neldrp_l = neldrp_l + 1
114 npt_drp = drape(ii)%NPLY_DRAPE
115 npt = drape(ii)%NPLY
116 DO j = 1,npt_drp
117 nslice = drape(ii)%DRAPE_PLY(j)%NSLICE
118 islice(ndim_slice + j) = nslice
119 DO is = 1,nslice
120 itmp(ndim + is,1) = drape(ii)%DRAPE_PLY(j)%IDRAPE(is,1)
121 itmp(ndim + is,2) = drape(ii)%DRAPE_PLY(j)%IDRAPE(is,2)
122 rtmp(ndim + is,1) = drape(ii)%DRAPE_PLY(j)%RDRAPE(is,1)
123 rtmp(ndim + is,2) = drape(ii)%DRAPE_PLY(j)%RDRAPE(is,2)
124 ENDDO
125 ndim = ndim + nslice
126 ENDDO
127 ndim_slice = ndim_slice + npt_drp
128 DO j = 1,npt
129 indx_ply(ndim_indx_ply + j) = drape(ii)%INDX_PLY(j)
130 ENDDO
131 ndim_indx_ply = ndim_indx_ply + npt
132 ENDIF
133 ENDIF
134 ENDDO
135C
136 CALL write_i_c(ndim, 1)
137 CALL write_i_c(ndim_slice,1)
138 Call write_i_c(ndim_indx_ply,1)
139 CALL write_i_c(index,numel_l)
140 CALL write_i_c(nptdrp_elt,neldrp_l)
141 CALL write_i_c(npt_elt,neldrp_l)
142 CALL write_i_c(islice,ndim_slice)
143 CALL write_i_c(indx_ply,ndim_indx_ply)
144 CALL write_i_c(itmp,2*ndim)
145 CALL write_db(rtmp,2*ndim)
146 CALL write_db(thk,neldrp_l)
147 len_am = len_am + 2*ndim + neldrp_l
148 len_ia = len_ia + 2*ndim + numel_l + 2*neldrp_l
149 . + ndim_slice + ndim_indx_ply + 3
150 DEALLOCATE(itmp,rtmp,islice,indx_ply,npt_elt,nptdrp_elt, index,thk)
151 ENDIF
152! --------------------------------------
153 RETURN
154 END
my_real
#define my_real
Definition cppsort.cpp:32
drape_mod
Definition drape_mod.F:54
drape_mod::drape_
Definition drape_mod.F:71
w_drape
subroutine w_drape(drape, indx, cep, p, numel, numel_l, neldrp_l, len_ia, len_am)
Definition w_drape.F:32
write_db
subroutine write_db(a, n)
Definition write_db.F:140
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645