57
58
59
60 USE elbufdef_mod
61 USE matparam_def_mod
67 use element_mod , only : nixc,nixtg
68
69
70
71#include "implicit_f.inc"
72
73
74
75#include "com01_c.inc"
76#include "com04_c.inc"
77#include "param_c.inc"
78#include "units_c.inc"
79#include "scr17_c.inc"
80#include "chara_c.inc"
81#include "task_c.inc"
82
83
84
85 INTEGER IPARG(*),
86 . IXC(NIXC,*),IXTG(NIXTG,*),IPM(*),IGEO(*),
87 . ITAB(*) ,IPART(LIPART1,*) ,IPARTC(*) ,IPARTTG(*),
88 . WEIGHT(*), NODGLOB(*), NPBY(NNPBY,*), LPBY(*)
89 INTEGER LENG,LENGC,LENGTG
91 . x(*), bufel(*),
92 . pm(npropm,*), geo(npropg,*) ,thke(*)
93 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
94 TYPE (STACK_PLY) :: STACK
95 TYPE (DRAPE_) :: DRAPE_SH4N(NUMELC_DRAPE),DRAPE_SH3N(NUMELTG_DRAPE)
96 TYPE (DRAPEG_) :: DRAPEG
97 TYPE (DYNAIN_DATABASE), INTENT(INOUT) :: DYNAIN_DATA
98 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
99
100
101
102 CHARACTER CHSTAT*4, FILNAM*100, T10*10, MES*40
103 INTEGER FILEN, I, IERR, J, N
104 INTEGER SIZLOC, SIZP0
105 INTEGER , DIMENSION(:),ALLOCATABLE :: ITABG, NODTAG ,DYNAIN_INDXC ,
106 . DYNAIN_INDXTG
107 INTEGER CTEXT(2149)
108 double precision
109 . , DIMENSION(:),ALLOCATABLE :: wa,wap0
110
111 INTEGER :: LEN_TMP_NAME
112 CHARACTER(len=2148) :: TMP_NAME
113
114 CHARACTER*100 LINE
115
116
117
118
119
120
121 IF(dynain_data%IDYNAINF>=10000)dynain_data%IDYNAINF=1
122 WRITE(chstat,'(I4.4)')dynain_data%IDYNAINF
123 IF(dynain_data%ZIPDYNAIN==0) THEN
124 filnam=rootnam(1:rootlen)//'_'//chstat//'.dynain'
125 filen = rootlen + 12
128 IF(ispmd == 0) THEN
129 OPEN(unit=iudynain,file=tmp_name(1:len_tmp_name),access='SEQUENTIAL',form='FORMATTED',status='UNKNOWN')
130 WRITE(iudynain,'(2A)')'$RADIOSS DYNAIN FILE ',filnam(1:filen)
131 END IF
132 ELSE
133 filnam=rootnam(1:rootlen)//'_'//chstat//'.dynain'
134 filen = rootlen + 12
137 DO i=1,len_tmp_name
138 ctext(i)=ichar(tmp_name(i:i))
140 ENDDO
141 IF(ispmd == 0) THEN
142 CALL open_c(ctext,len_tmp_name,6)
143 WRITE(line,'(2A)') '$RADIOSS DYNAIN FILE ',filnam(1:filen)
145 ENDIF
146 ENDIF
147
148
149
150
151
152
153 ALLOCATE(nodtag(numnod),stat=ierr)
154 ALLOCATE(itabg(leng),stat=ierr)
155 ALLOCATE(dynain_indxc(2*lengc),stat=ierr)
156 ALLOCATE(dynain_indxtg(2*lengtg),stat=ierr)
157
158
159
160
162
163 nodtag=0
164
165 dynain_data%DYNAIN_NUMELC =0
166 dynain_data%DYNAIN_NUMELTG =0
167
168 IF(nspmd == 1)THEN
169
171 . ixtg ,ipartc ,iparttg ,dynain_data ,
172 . nodtag ,dynain_indxc,dynain_indxtg,iparg ,
173 . elbuf_tab,thke ,ipart )
174 dynain_data%DYNAIN_NUMELC_G =dynain_data%DYNAIN_NUMELC
175 dynain_data%DYNAIN_NUMELTG_G =dynain_data%DYNAIN_NUMELTG
176 ELSE
177
179 . ixtg ,ipartc ,iparttg ,dynain_data ,
180 . nodtag ,dynain_indxc,dynain_indxtg,iparg ,
181 . elbuf_tab,thke ,lengc ,lengtg ,ipart )
182 END IF
183
184
185
186
187
188 DO i=1,nrbody
189 DO j=1,npby(2,i)
190 n=lpby(npby(11,i)+j)
191 IF (nodtag(n)/=0) THEN
192 nodtag(npby(1,i)) = 1
193 EXIT
194 END IF
195 ENDDO
196 ENDDO
197
198 CALL dynain_node(x,numnod,itab,itabg,leng,nodglob,weight,nodtag,dynain_data)
199
200
201 CALL dynain_size_c(iparg ,elbuf_tab, sizp0 ,sizloc ,dynain_data )
202
203
204
205
206 ierr = 0
207 IF(sizloc >= 1) THEN
208 ALLOCATE(wa(sizloc),stat=ierr)
209 ELSE
210 ALLOCATE(wa(1))
211 ENDIF
212 IF(ierr/=0)THEN
213 CALL ancmsg(msgid=252,anmode=aninfo,
214 . i1=ierr)
216 END IF
217
218 ierr = 0
220 ALLOCATE(wap0(sizp0),stat=ierr)
221 IF(ierr/=0)THEN
222 CALL ancmsg(msgid=252,anmode=aninfo,
223 . i1=ierr)
225 END IF
226
227
228
229
230
231 IF(dynain_data%DYNAIN_C(4)==1) THEN
233 1 elbuf_tab ,iparg ,igeo ,ixc ,
234 2 ixtg ,wa ,wap0 ,ipartc,iparttg,
235 3 dynain_data,dynain_indxc,dynain_indxtg,sizp0 ,
236 4 geo ,stack ,drape_sh4n ,drape_sh3n,x ,
237 5 thke , drapeg ,nummat ,mat_param )
238 ENDIF
239
240
241 IF(dynain_data%DYNAIN_C(5)==1) THEN
243 1 elbuf_tab ,iparg ,ipm ,igeo ,ixc ,
244 2 ixtg ,wa ,wap0 ,ipartc,iparttg,
245 3 dynain_data,dynain_indxc,dynain_indxtg,sizp0 ,
246 4 geo ,stack ,drape_sh4n ,drape_sh3n,x ,
247 5 thke ,drapeg)
248 ENDIF
249
250
251
252 IF(sizloc >= 1) DEALLOCATE(wa)
253 IF(sizp0 >= 1) DEALLOCATE(wap0)
254
255
256
257 DEALLOCATE(nodtag,itabg,dynain_indxc,dynain_indxtg)
258
259
260
261 IF(ispmd==0) THEN
262 IF(dynain_data%ZIPDYNAIN==0) THEN
263 WRITE(iudynain,'(A)')'*END '
264 CLOSE(unit=iudynain)
265 ELSE
268 ENDIF
269
270 WRITE (iout,1000) filnam(1:filen)
271 WRITE (istdo,1000) filnam(1:filen)
272 ENDIF
273
274
275 1000 FORMAT (4x,' DYNAIN FILE:',1x,a,' WRITTEN')
276
277 RETURN
subroutine dynain_c_strag(elbuf_tab, iparg, ipm, igeo, ixc, ixtg, wa, wap0, ipartc, iparttg, dynain_data, dynain_indxc, dynain_indxtg, sizp0, geo, stack, drape_sh4n, drape_sh3n, x, thke, drapeg)
subroutine dynain_c_strsg(elbuf_tab, iparg, igeo, ixc, ixtg, wa, wap0, ipartc, iparttg, dynain_data, dynain_indxc, dynain_indxtg, sizp0, geo, stack, drape_sh4n, drape_sh3n, x, thke, drapeg, nummat, mat_param)
subroutine dynain_node(x, numnod, itab, itabg, leng, nodglob, weight, nodtag, dynain_data)
subroutine dynain_shel_mp(itab, itabg, leng, igeo, ixc, ixtg, ipartc, iparttg, dynain_data, nodtag, dynain_indxc, dynain_indxtg, iparg, elbuf_tab, thke, ipart)
subroutine dynain_shel_spmd(itab, itabg, leng, igeo, ixc, ixtg, ipartc, iparttg, dynain_data, nodtag, dynain_indxc, dynain_indxtg, iparg, elbuf_tab, thke, lengc, lengtg, ipart)
subroutine dynain_size_c(iparg, elbuf_tab, p0ars, wasz, dynain_data)
character(len=outfile_char_len) outfile_name
subroutine spmd_outpitab(v, weight, nodglob, vglob)
subroutine strs_txt50(text, length)
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)
void open_c(int *ifil, int *len, int *mod)