FrontISTR  5.7.0
Large-scale structural analysis program with finit element method
hecmw_dist_copy_f2c_f.f90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
2 ! Copyright (c) 2019 FrontISTR Commons
3 ! This software is released under the MIT License, see LICENSE.txt
4 !-------------------------------------------------------------------------------
11 
12 module hecmw_dist_copy_f2c_f
13  use hecmw_util
14  implicit none
15 
16  private
17  character(len=100) :: sname,vname
18 
19  public :: hecmw_dist_copy_f2c
20 
21 contains
22 
23  subroutine hecmw_dist_copy_f2c(mesh, ierr)
24  integer(kind=kint) :: ierr
25  type(hecmwst_local_mesh) :: mesh
26 
27  call put_flags(mesh, ierr)
28  if(ierr /= 0) return
29 
30  call put_etc(mesh, ierr)
31  if(ierr /= 0) return
32 
33  call put_node(mesh, ierr)
34  if(ierr /= 0) return
35 
36  call put_elem(mesh, ierr)
37  if(ierr /= 0) return
38 
39  call put_comm(mesh, ierr)
40  if(ierr /= 0) return
41 
42  call put_adapt(mesh, ierr)
43  if(ierr /= 0) return
44 
45  call put_refine(mesh, ierr)
46  if(ierr /= 0) return
47 
48  call put_sect(mesh%section, ierr)
49  if(ierr /= 0) return
50 
51  call put_mat(mesh%material, ierr)
52  if(ierr /= 0) return
53 
54  call put_mpc(mesh%mpc, ierr)
55  if(ierr /= 0) return
56 
57  call put_amp(mesh%amp, ierr)
58  if(ierr /= 0) return
59 
60  call put_ngrp(mesh%node_group, ierr)
61  if(ierr /= 0) return
62 
63  call put_egrp(mesh%elem_group, ierr)
64  if(ierr /= 0) return
65 
66  call put_sgrp(mesh%surf_group, ierr)
67  if(ierr /= 0) return
68 
69  call put_contact_pair(mesh%contact_pair, ierr)
70  if(ierr /= 0) return
71  end subroutine hecmw_dist_copy_f2c
72 
73 
74  subroutine put_flags(mesh, ierr)
75  integer(kind=kint) :: ierr
76  type(hecmwst_local_mesh) :: mesh
77 
78  sname = 'hecmwST_local_mesh'
79 
80  vname = 'hecmw_flag_adapt'
81  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%hecmw_flag_adapt, ierr)
82  if(ierr /= 0) return
83 
84  vname = 'hecmw_flag_initcon'
85  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%hecmw_flag_initcon, ierr)
86  if(ierr /= 0) return
87 
88  vname = 'hecmw_flag_parttype'
89  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%hecmw_flag_parttype, ierr)
90  if(ierr /= 0) return
91 
92  vname = 'hecmw_flag_partdepth'
93  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%hecmw_flag_partdepth, ierr)
94  if(ierr /= 0) return
95 
96  vname = 'hecmw_flag_version'
97  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%hecmw_flag_version, ierr)
98  if(ierr /= 0) return
99 
100  vname = 'hecmw_flag_partcontact'
101  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%hecmw_flag_partcontact, ierr)
102  if(ierr /= 0) return
103  end subroutine put_flags
104 
105 
106  subroutine put_etc(mesh, ierr)
107  integer(kind=kint) :: ierr
108  type(hecmwst_local_mesh) :: mesh
109 
110  sname = 'hecmwST_local_mesh'
111 
112  vname = 'gridfile'
113  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%gridfile, ierr)
114  if(ierr /= 0) return
115 
116  vname = 'hecmw_n_file'
117  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%hecmw_n_file, ierr)
118  if(ierr /= 0) return
119 
120  if(mesh%hecmw_n_file > 0) then
121  vname = 'files'
122  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%files, ierr)
123  if(ierr /= 0) return
124  endif
125 
126  vname = 'header'
127  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%header, ierr)
128  if(ierr /= 0) return
129 
130  vname = 'zero_temp'
131  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%zero_temp, ierr)
132  if(ierr /= 0) return
133  end subroutine put_etc
134 
135 
136  subroutine put_node(mesh, ierr)
137  integer(kind=kint) :: ierr
138  type(hecmwst_local_mesh) :: mesh
139 
140  sname = 'hecmwST_local_mesh'
141  vname = 'n_node'
142  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%n_node, ierr)
143  if(ierr /= 0) return
144 
145  vname = 'n_node_gross'
146  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%n_node_gross, ierr)
147  if(ierr /= 0) return
148 
149  vname = 'nn_middle'
150  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%nn_middle, ierr)
151  if(ierr /= 0) return
152 
153  vname = 'nn_internal'
154  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%nn_internal, ierr)
155  if(ierr /= 0) return
156 
157  if((mesh%hecmw_flag_parttype == 0 .OR. mesh%hecmw_flag_parttype == 2) .AND. mesh%nn_internal > 0) then
158  vname = 'node_internal_list'
159  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%node_internal_list, ierr)
160  if(ierr /= 0) return
161  endif
162 
163  if(mesh%n_node_gross > 0) then
164  vname = 'node_ID'
165  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%node_ID, ierr)
166  if(ierr /= 0) return
167 
168  vname = 'global_node_ID'
169  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%global_node_ID, ierr)
170  if(ierr /= 0) return
171 
172  vname = 'node'
173  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%node, ierr)
174  if(ierr /= 0) return
175  endif
176 
177  vname = 'n_dof'
178  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%n_dof, ierr)
179  if(ierr /= 0) return
180 
181  vname = 'n_dof_grp'
182  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%n_dof_grp, ierr)
183  if(ierr /= 0) return
184 
185  vname = 'n_dof_tot'
186  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%n_dof_tot, ierr)
187  if(ierr /= 0) return
188 
189  if(mesh%n_dof_grp > 0) then
190  vname = 'node_dof_index'
191  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%node_dof_index, ierr)
192  if(ierr /= 0) return
193 
194  vname = 'node_dof_item'
195  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%node_dof_item, ierr)
196  if(ierr /= 0) return
197  endif
198 
199  if(mesh%n_node_gross > 0) then
200  vname = 'node_val_index'
201  if(associated(mesh%node_val_index)) then
202  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%node_val_index, ierr)
203  if(ierr /= 0) return
204  endif
205 
206  vname = 'node_val_item'
207  if(associated(mesh%node_val_item)) then
208  if(mesh%node_val_index(mesh%n_node_gross) > 0) then
209  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%node_val_item, ierr)
210  if(ierr /= 0) return
211  endif
212  endif
213 
214  vname = 'node_init_val_index'
215  if(associated(mesh%node_init_val_index)) then
216  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%node_init_val_index, ierr)
217  if(ierr /= 0) return
218  endif
219 
220  vname = 'node_init_val_item'
221  if(associated(mesh%node_init_val_item)) then
222  if(mesh%node_init_val_index(mesh%n_node_gross) > 0) then
223  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%node_init_val_item, ierr)
224  if(ierr /= 0) return
225  endif
226  endif
227  endif
228  end subroutine put_node
229 
230 
231  subroutine put_elem(mesh, ierr)
232  integer(kind=kint) :: ierr
233  type(hecmwst_local_mesh) :: mesh
234 
235  sname = 'hecmwST_local_mesh'
236 
237  vname = 'n_elem'
238  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%n_elem, ierr)
239  if(ierr /= 0) return
240 
241  vname = 'n_elem_gross'
242  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%n_elem_gross, ierr)
243  if(ierr /= 0) return
244 
245  vname = 'ne_internal'
246  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%ne_internal, ierr)
247  if(ierr /= 0) return
248 
249  if((mesh%hecmw_flag_parttype == 0 .OR. mesh%hecmw_flag_parttype == 1) .AND. mesh%ne_internal > 0) then
250  vname = 'elem_internal_list'
251  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%elem_internal_list, ierr)
252  if(ierr /= 0) return
253  endif
254 
255  if(mesh%n_elem_gross > 0) then
256  vname = 'elem_ID'
257  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%elem_ID, ierr)
258  if(ierr /= 0) return
259 
260  vname = 'global_elem_ID'
261  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%global_elem_ID, ierr)
262  if(ierr /= 0) return
263 
264  vname = 'elem_type'
265  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%elem_type, ierr)
266  if(ierr /= 0) return
267  endif
268 
269  vname = 'n_elem_type'
270  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%n_elem_type, ierr)
271  if(ierr /= 0) return
272 
273  if(mesh%n_elem_type > 0) then
274  vname = 'elem_type_index'
275  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%elem_type_index, ierr)
276  if(ierr /= 0) return
277 
278  vname = 'elem_type_item'
279  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%elem_type_item, ierr)
280  if(ierr /= 0) return
281  endif
282 
283  if(mesh%n_elem_gross > 0) then
284  vname = 'elem_node_index'
285  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%elem_node_index, ierr)
286  if(ierr /= 0) return
287 
288  vname = 'elem_node_item'
289  if(mesh%elem_node_index(mesh%n_elem_gross) > 0) then
290  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%elem_node_item, ierr)
291  if(ierr /= 0) return
292  endif
293 
294  vname = 'section_ID'
295  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%section_ID, ierr)
296  if(ierr /= 0) return
297  endif
298 
299  if(mesh%n_elem_gross > 0) then
300  vname = 'elem_mat_ID_index'
301  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%elem_mat_ID_index, ierr)
302  if(ierr /= 0) return
303 
304  if(mesh%elem_mat_ID_index(mesh%n_elem_gross) > 0) then
305  vname = 'elem_mat_ID_item'
306  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%elem_mat_ID_item, ierr)
307  if(ierr /= 0) return
308  endif
309  endif
310 
311  vname = 'n_elem_mat_ID'
312  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%n_elem_mat_ID, ierr)
313  if(ierr /= 0) return
314 
315  if(mesh%n_elem_gross > 0) then
316  vname = 'elem_mat_int_index'
317  if(associated(mesh%elem_mat_int_index)) then
318  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%elem_mat_int_index, ierr)
319  if(ierr /= 0) return
320  endif
321 
322  vname = 'elem_mat_int_val'
323  if(associated(mesh%elem_mat_int_val)) then
324  if(mesh%elem_mat_int_index(mesh%n_elem_gross) > 0) then
325  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%elem_mat_int_val, ierr)
326  if(ierr /= 0) return
327  endif
328  endif
329  endif
330 
331  if(mesh%n_elem_gross > 0) then
332  vname = 'elem_val_index'
333  if(associated(mesh%elem_val_index)) then
334  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%elem_val_index, ierr)
335  if(ierr /= 0) return
336  endif
337 
338  vname = 'elem_val_item'
339  if(associated(mesh%elem_val_item)) then
340  if(mesh%elem_val_index(mesh%n_elem_gross) > 0) then
341  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%elem_val_item, ierr)
342  if(ierr /= 0) return
343  endif
344  endif
345  endif
346  end subroutine put_elem
347 
348 
349  subroutine put_comm(mesh, ierr)
350  integer(kind=kint) :: ierr
351  type(hecmwst_local_mesh) :: mesh
352 
353 
354  sname = 'hecmwST_local_mesh'
355 
356  vname = 'zero'
357  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%zero, ierr)
358  if(ierr /= 0) return
359 
360  vname = 'HECMW_COMM'
361  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%MPI_COMM, ierr)
362  if(ierr /= 0) return
363 
364  vname = 'PETOT'
365  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%PETOT, ierr)
366  if(ierr /= 0) return
367 
368  vname = 'PEsmpTOT'
369  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%PEsmpTOT, ierr)
370  if(ierr /= 0) return
371 
372  vname = 'my_rank'
373  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%my_rank, ierr)
374  if(ierr /= 0) return
375 
376  vname = 'errnof'
377  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%errnof, ierr)
378  if(ierr /= 0) return
379 
380  vname = 'n_subdomain'
381  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%n_subdomain, ierr)
382  if(ierr /= 0) return
383 
384  vname = 'n_neighbor_pe'
385  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%n_neighbor_pe, ierr)
386  if(ierr /= 0) return
387 
388  if(mesh%n_neighbor_pe > 0) then
389  vname = 'neighbor_pe'
390  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%neighbor_pe, ierr)
391  if(ierr /= 0) return
392 
393  vname = 'import_index'
394  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%import_index, ierr)
395  if(ierr /= 0) return
396 
397  if(mesh%import_index(mesh%n_neighbor_pe) > 0) then
398  vname = 'import_item'
399  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%import_item, ierr)
400  if(ierr /= 0) return
401  endif
402 
403  vname = 'export_index'
404  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%export_index, ierr)
405  if(ierr /= 0) return
406 
407  if(mesh%export_index(mesh%n_neighbor_pe) > 0) then
408  vname = 'export_item'
409  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%export_item, ierr)
410  if(ierr /= 0) return
411  endif
412 
413  vname = 'shared_index'
414  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%shared_index, ierr)
415  if(ierr /= 0) return
416 
417  if(mesh%shared_index(mesh%n_neighbor_pe) > 0) then
418  vname = 'shared_item'
419  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%shared_item, ierr)
420  if(ierr /= 0) return
421  endif
422  endif
423  end subroutine put_comm
424 
425 
426  subroutine put_adapt(mesh, ierr)
427  integer(kind=kint) :: ierr
428  type(hecmwst_local_mesh) :: mesh
429 
430  if(mesh%hecmw_flag_adapt == 0) return;
431 
432  sname = 'hecmwST_local_mesh'
433 
434  vname = 'coarse_grid_level'
435  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%coarse_grid_level, ierr)
436  if(ierr /= 0) return
437 
438  vname = 'n_adapt'
439  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%n_adapt, ierr)
440  if(ierr /= 0) return
441 
442  if(mesh%n_node_gross > 0) then
443  vname = 'when_i_was_refined_node'
444  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%when_i_was_refined_node, ierr)
445  if(ierr /= 0) return
446  endif
447 
448  if(mesh%n_elem_gross > 0) then
449  vname = 'when_i_was_refined_elem'
450  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%when_i_was_refined_elem, ierr)
451  if(ierr /= 0) return
452 
453  vname = 'adapt_parent_type'
454  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%adapt_parent_type, ierr)
455  if(ierr /= 0) return
456 
457  vname = 'adapt_type'
458  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%adapt_type, ierr)
459  if(ierr /= 0) return
460 
461  vname = 'adapt_level'
462  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%adapt_level, ierr)
463  if(ierr /= 0) return
464 
465  vname = 'adapt_parent'
466  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%adapt_parent, ierr)
467  if(ierr /= 0) return
468 
469  vname = 'adapt_children_index'
470  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%adapt_children_index, ierr)
471  if(ierr /= 0) return
472 
473  vname = 'adapt_children_item'
474  if(mesh%adapt_children_index(mesh%n_elem_gross) > 0) then
475  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%adapt_children_item, ierr)
476  if(ierr /= 0) return
477  endif
478  endif
479  end subroutine put_adapt
480 
481 
482  subroutine put_refine(mesh, ierr)
483  integer(kind=kint) :: ierr
484  type(hecmwst_local_mesh) :: mesh
485 
486  sname = 'hecmwST_local_mesh'
487 
488  vname = 'n_refine'
489  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%n_refine, ierr)
490  if(ierr /= 0) return
491 
492  if(mesh%n_refine == 0) return;
493 
494  if(mesh%n_node_gross > 0) then
495  vname = 'node_old2new'
496  if(associated(mesh%node_old2new)) then
497  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%node_old2new, ierr)
498  if(ierr /= 0) return
499  endif
500 
501  vname = 'node_new2old'
502  if(associated(mesh%node_new2old)) then
503  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%node_new2old, ierr)
504  if(ierr /= 0) return
505  endif
506  endif
507 
508  if(mesh%n_elem_gross > 0) then
509  vname = 'elem_old2new'
510  if(associated(mesh%elem_old2new)) then
511  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%elem_old2new, ierr)
512  if(ierr /= 0) return
513  endif
514 
515  vname = 'elem_new2old'
516  if(associated(mesh%elem_new2old)) then
517  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%elem_new2old, ierr)
518  if(ierr /= 0) return
519  endif
520  endif
521 
522  if(mesh%n_refine > 0) then
523  vname = 'n_node_refine_hist'
524  if(associated(mesh%n_node_refine_hist)) then
525  call hecmw_dist_copy_f2c_set_if(sname, vname, mesh%n_node_refine_hist, ierr)
526  if(ierr /= 0) return
527  endif
528  endif
529  end subroutine put_refine
530 
531 
532  subroutine put_sect(sect, ierr)
533  integer(kind=kint) :: ierr
534  type(hecmwst_section) :: sect
535 
536  sname = 'hecmwST_section'
537 
538  vname = 'n_sect'
539  call hecmw_dist_copy_f2c_set_if(sname, vname, sect%n_sect, ierr)
540  if(ierr /= 0) return
541 
542  if(sect%n_sect > 0) then
543  vname = 'sect_type'
544  call hecmw_dist_copy_f2c_set_if(sname, vname, sect%sect_type, ierr)
545  if(ierr /= 0) return
546 
547  vname = 'sect_opt'
548  call hecmw_dist_copy_f2c_set_if(sname, vname, sect%sect_opt, ierr)
549  if(ierr /= 0) return
550 
551  vname = 'sect_mat_ID_index'
552  call hecmw_dist_copy_f2c_set_if(sname, vname, sect%sect_mat_ID_index, ierr)
553  if(ierr /= 0) return
554 
555  if(sect%sect_mat_ID_index(sect%n_sect) > 0) then
556  vname = 'sect_mat_ID_item'
557  call hecmw_dist_copy_f2c_set_if(sname, vname, sect%sect_mat_ID_item, ierr)
558  if(ierr /= 0) return
559  endif
560 
561  vname = 'sect_I_index'
562  call hecmw_dist_copy_f2c_set_if(sname, vname, sect%sect_I_index, ierr)
563  if(ierr /= 0) return
564 
565  if(sect%sect_I_index(sect%n_sect) > 0) then
566  vname = 'sect_I_item'
567  call hecmw_dist_copy_f2c_set_if(sname, vname, sect%sect_I_item, ierr)
568  if(ierr /= 0) return
569  endif
570 
571  vname = 'sect_R_index'
572  call hecmw_dist_copy_f2c_set_if(sname, vname, sect%sect_R_index, ierr)
573  if(ierr /= 0) return
574 
575  if(sect%sect_R_index(sect%n_sect) > 0) then
576  vname = 'sect_R_item'
577  call hecmw_dist_copy_f2c_set_if(sname, vname, sect%sect_R_item, ierr)
578  if(ierr /= 0) return
579  endif
580  endif
581  end subroutine put_sect
582 
583 
584  subroutine put_mat(mat, ierr)
585  integer(kind=kint) :: ierr
586  type(hecmwst_material),target :: mat
587  character(len=HECMW_NAME_LEN),pointer :: name_p
588 
589  sname = 'hecmwST_material'
590 
591  vname = 'n_mat'
592  call hecmw_dist_copy_f2c_set_if(sname, vname, mat%n_mat, ierr)
593  if(ierr /= 0) return
594 
595  vname = 'n_mat_item'
596  call hecmw_dist_copy_f2c_set_if(sname, vname, mat%n_mat_item, ierr)
597  if(ierr /= 0) return
598 
599  vname = 'n_mat_subitem'
600  call hecmw_dist_copy_f2c_set_if(sname, vname, mat%n_mat_subitem, ierr)
601  if(ierr /= 0) return
602 
603  vname = 'n_mat_table'
604  call hecmw_dist_copy_f2c_set_if(sname, vname, mat%n_mat_table, ierr)
605  if(ierr /= 0) return
606 
607  if(mat%n_mat > 0) then
608  vname = 'mat_name'
609  name_p => mat%mat_name(1)
610  call hecmw_dist_copy_f2c_set_if(sname, vname, name_p, ierr)
611  if(ierr /= 0) return
612  endif
613 
614  if(mat%n_mat > 0) then
615  vname = 'mat_item_index'
616  call hecmw_dist_copy_f2c_set_if(sname, vname, mat%mat_item_index, ierr)
617  if(ierr /= 0) return
618  endif
619 
620  if(mat%n_mat_item > 0) then
621  vname = 'mat_subitem_index'
622  call hecmw_dist_copy_f2c_set_if(sname, vname, mat%mat_subitem_index, ierr)
623  if(ierr /= 0) return
624  endif
625 
626  if(mat%n_mat_subitem > 0) then
627  vname = 'mat_table_index'
628  call hecmw_dist_copy_f2c_set_if(sname, vname, mat%mat_table_index, ierr)
629  if(ierr /= 0) return
630  endif
631 
632  if(mat%n_mat_table > 0) then
633  vname = 'mat_val'
634  call hecmw_dist_copy_f2c_set_if(sname, vname, mat%mat_val, ierr)
635  if(ierr /= 0) return
636 
637  vname = 'mat_temp'
638  call hecmw_dist_copy_f2c_set_if(sname, vname, mat%mat_temp, ierr)
639  if(ierr /= 0) return
640  endif
641  end subroutine put_mat
642 
643 
644  subroutine put_mpc(mpc, ierr)
645  integer(kind=kint) :: ierr
646  type(hecmwst_mpc) :: mpc
647 
648  sname = 'hecmwST_mpc'
649 
650  vname = 'n_mpc'
651  call hecmw_dist_copy_f2c_set_if(sname, vname, mpc%n_mpc, ierr)
652  if(ierr /= 0) return
653 
654  if(mpc%n_mpc > 0) then
655  vname = 'mpc_index'
656  call hecmw_dist_copy_f2c_set_if(sname, vname, mpc%mpc_index, ierr)
657  if(ierr /= 0) return
658 
659  if(mpc%mpc_index(mpc%n_mpc) > 0) then
660  vname = 'mpc_item'
661  call hecmw_dist_copy_f2c_set_if(sname, vname, mpc%mpc_item, ierr)
662  if(ierr /= 0) return
663 
664  vname = 'mpc_dof'
665  call hecmw_dist_copy_f2c_set_if(sname, vname, mpc%mpc_dof, ierr)
666  if(ierr /= 0) return
667 
668  vname = 'mpc_val'
669  call hecmw_dist_copy_f2c_set_if(sname, vname, mpc%mpc_val, ierr)
670  if(ierr /= 0) return
671 
672  vname = 'mpc_const'
673  call hecmw_dist_copy_f2c_set_if(sname, vname, mpc%mpc_const, ierr)
674  if(ierr /= 0) return
675  endif
676  endif
677  end subroutine put_mpc
678 
679 
680  subroutine put_amp(amp, ierr)
681  integer(kind=kint) :: ierr
682  type(hecmwst_amplitude) :: amp
683  character(len=HECMW_NAME_LEN),pointer :: name_p
684 
685  sname = 'hecmwST_amplitude'
686 
687  vname = 'n_amp'
688  call hecmw_dist_copy_f2c_set_if(sname, vname, amp%n_amp, ierr)
689  if(ierr /= 0) return
690 
691  if(amp%n_amp > 0) then
692  vname = 'amp_name'
693  name_p => amp%amp_name(1)
694  call hecmw_dist_copy_f2c_set_if(sname, vname, name_p, ierr)
695  if(ierr /= 0) return
696 
697  vname = 'amp_type_definition'
698  call hecmw_dist_copy_f2c_set_if(sname, vname, amp%amp_type_definition, ierr)
699  if(ierr /= 0) return
700 
701  vname = 'amp_type_time'
702  call hecmw_dist_copy_f2c_set_if(sname, vname, amp%amp_type_time, ierr)
703  if(ierr /= 0) return
704 
705  vname = 'amp_type_value'
706  call hecmw_dist_copy_f2c_set_if(sname, vname, amp%amp_type_value, ierr)
707  if(ierr /= 0) return
708 
709  vname = 'amp_index'
710  call hecmw_dist_copy_f2c_set_if(sname, vname, amp%amp_index, ierr)
711  if(ierr /= 0) return
712 
713  if(amp%amp_index(amp%n_amp) > 0) then
714  vname = 'amp_val'
715  call hecmw_dist_copy_f2c_set_if(sname, vname, amp%amp_val, ierr)
716  if(ierr /= 0) return
717 
718  vname = 'amp_table'
719  call hecmw_dist_copy_f2c_set_if(sname, vname, amp%amp_table, ierr)
720  if(ierr /= 0) return
721  endif
722  endif
723  end subroutine put_amp
724 
725 
726  subroutine put_ngrp(grp, ierr)
727  integer(kind=kint) :: ierr
728  type(hecmwst_node_grp) :: grp
729  character(len=HECMW_NAME_LEN),pointer :: name_p
730 
731  sname = 'hecmwST_node_grp'
732 
733  vname = 'n_grp'
734  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%n_grp, ierr)
735  if(ierr /= 0) return
736 
737  if(grp%n_grp > 0) then
738  vname = 'grp_name'
739  name_p => grp%grp_name(1)
740  call hecmw_dist_copy_f2c_set_if(sname, vname, name_p, ierr)
741  if(ierr /= 0) return
742 
743  vname = 'grp_index'
744  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%grp_index, ierr)
745  if(ierr /= 0) return
746 
747  vname = 'grp_item'
748  if(grp%grp_index(grp%n_grp) > 0) then
749  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%grp_item, ierr)
750  if(ierr /= 0) return
751  endif
752  endif
753 
754  vname = 'n_bc'
755  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%n_bc, ierr)
756  if(ierr /= 0) return
757 
758  if(grp%n_bc > 0) then
759  vname = 'bc_grp_ID'
760  if(associated(grp%bc_grp_ID)) then
761  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%bc_grp_ID, ierr)
762  if(ierr /= 0) return
763  endif
764 
765  vname = 'bc_grp_type'
766  if(associated(grp%bc_grp_type)) then
767  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%bc_grp_type, ierr)
768  if(ierr /= 0) return
769  endif
770 
771  vname = 'bc_grp_index'
772  if(associated(grp%bc_grp_index)) then
773  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%bc_grp_index, ierr)
774  if(ierr /= 0) return
775  endif
776 
777  vname = 'bc_grp_dof'
778  if(associated(grp%bc_grp_dof)) then
779  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%bc_grp_dof, ierr)
780  if(ierr /= 0) return
781  endif
782 
783  vname = 'bc_grp_val'
784  if(associated(grp%bc_grp_val)) then
785  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%bc_grp_val, ierr)
786  if(ierr /= 0) return
787  endif
788  endif
789  end subroutine put_ngrp
790 
791 
792  subroutine put_egrp(grp, ierr)
793  integer(kind=kint) :: ierr
794  type(hecmwst_elem_grp) :: grp
795  character(len=HECMW_NAME_LEN),pointer :: name_p
796 
797  sname = 'hecmwST_elem_grp'
798 
799  vname = 'n_grp'
800  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%n_grp, ierr)
801  if(ierr /= 0) return
802 
803  if(grp%n_grp > 0) then
804  vname = 'grp_name'
805  name_p => grp%grp_name(1)
806  call hecmw_dist_copy_f2c_set_if(sname, vname, name_p, ierr)
807  if(ierr /= 0) return
808 
809  vname = 'grp_index'
810  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%grp_index, ierr)
811  if(ierr /= 0) return
812 
813  vname = 'grp_item'
814  if(grp%grp_index(grp%n_grp) > 0) then
815  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%grp_item, ierr)
816  if(ierr /= 0) return
817  endif
818  endif
819 
820  vname = 'n_bc'
821  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%n_bc, ierr)
822  if(ierr /= 0) return
823 
824  if(grp%n_bc > 0) then
825  vname = 'bc_grp_ID'
826  if(associated(grp%bc_grp_ID)) then
827  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%bc_grp_ID, ierr)
828  if(ierr /= 0) return
829  endif
830 
831  vname = 'bc_grp_type'
832  if(associated(grp%bc_grp_type)) then
833  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%bc_grp_type, ierr)
834  if(ierr /= 0) return
835  endif
836 
837  vname = 'bc_grp_index'
838  if(associated(grp%bc_grp_index)) then
839  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%bc_grp_index, ierr)
840  if(ierr /= 0) return
841  endif
842 
843  vname = 'bc_grp_val'
844  if(associated(grp%bc_grp_val)) then
845  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%bc_grp_val, ierr)
846  if(ierr /= 0) return
847  endif
848  endif
849  end subroutine put_egrp
850 
851 
852  subroutine put_sgrp(grp, ierr)
853  integer(kind=kint) :: ierr
854  type(hecmwst_surf_grp) :: grp
855  character(len=HECMW_NAME_LEN),pointer :: name_p
856 
857  sname = 'hecmwST_surf_grp'
858 
859  vname = 'n_grp'
860  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%n_grp, ierr)
861  if(ierr /= 0) return
862 
863  if(grp%n_grp > 0) then
864  vname = 'grp_name'
865  name_p => grp%grp_name(1)
866  call hecmw_dist_copy_f2c_set_if(sname, vname, name_p, ierr)
867  if(ierr /= 0) return
868 
869  vname = 'grp_index'
870  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%grp_index, ierr)
871  if(ierr /= 0) return
872 
873  vname = 'grp_item'
874  if(grp%grp_index(grp%n_grp) > 0) then
875  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%grp_item, ierr)
876  if(ierr /= 0) return
877  endif
878  endif
879 
880  vname = 'n_bc'
881  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%n_bc, ierr)
882  if(ierr /= 0) return
883 
884  if(grp%n_bc > 0) then
885  vname = 'bc_grp_ID'
886  if(associated(grp%bc_grp_ID)) then
887  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%bc_grp_ID, ierr)
888  if(ierr /= 0) return
889  endif
890 
891  vname = 'bc_grp_type'
892  if(associated(grp%bc_grp_type)) then
893  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%bc_grp_type, ierr)
894  if(ierr /= 0) return
895  endif
896 
897  vname = 'bc_grp_index'
898  if(associated(grp%bc_grp_index)) then
899  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%bc_grp_index, ierr)
900  if(ierr /= 0) return
901  endif
902 
903  vname = 'bc_grp_val'
904  if(associated(grp%bc_grp_val)) then
905  call hecmw_dist_copy_f2c_set_if(sname, vname, grp%bc_grp_val, ierr)
906  if(ierr /= 0) return
907  endif
908  endif
909  end subroutine put_sgrp
910 
911 
912  subroutine put_contact_pair(cpair, ierr)
913  integer(kind=kint) :: ierr
914  type(hecmwst_contact_pair) :: cpair
915  character(len=HECMW_NAME_LEN),pointer :: name_p
916 
917  sname = 'hecmwST_contact_pair'
918 
919  vname = 'n_pair'
920  call hecmw_dist_copy_f2c_set_if(sname, vname, cpair%n_pair, ierr)
921  if(ierr /= 0) return
922 
923  if(cpair%n_pair > 0) then
924  vname = 'name'
925  name_p => cpair%name(1)
926  call hecmw_dist_copy_f2c_set_if(sname, vname, name_p, ierr)
927  if(ierr /= 0) return
928 
929  vname = 'type'
930  call hecmw_dist_copy_f2c_set_if(sname, vname, cpair%type, ierr)
931  if(ierr /= 0) return
932 
933  vname = 'slave_grp_id'
934  call hecmw_dist_copy_f2c_set_if(sname, vname, cpair%slave_grp_id, ierr)
935  if(ierr /= 0) return
936 
937  vname = 'slave_orisgrp_id'
938  call hecmw_dist_copy_f2c_set_if(sname, vname, cpair%slave_orisgrp_id, ierr)
939  if(ierr /= 0) return
940 
941  vname = 'master_grp_id'
942  call hecmw_dist_copy_f2c_set_if(sname, vname, cpair%master_grp_id, ierr)
943  if(ierr /= 0) return
944  endif
945  end subroutine put_contact_pair
946 
947 end module hecmw_dist_copy_f2c_f
948 
hecmw_dist_copy_f2c_set_if
void hecmw_dist_copy_f2c_set_if(char *struct_name, char *var_name, void *src, int *err, int slen, int vlen)
Definition: hecmw_dist_copy_f2c.c:2040
hecmw_util::hecmwst_amplitude
Definition: hecmw_util_f.F90:110
hecmw_util::hecmwst_material
Definition: hecmw_util_f.F90:76
hecmw_util::hecmwst_contact_pair
Definition: hecmw_util_f.F90:202
hecmw_util::hecmwst_mpc
Definition: hecmw_util_f.F90:95
hecmw_util
I/O and Utility.
Definition: hecmw_util_f.F90:7
hecmw_util::hecmwst_local_mesh
Definition: hecmw_util_f.F90:234
hecmw_util::hecmwst_elem_grp
Definition: hecmw_util_f.F90:158
hecmw_util::hecmwst_section
Definition: hecmw_util_f.F90:44
hecmw_dist_copy_f2c_f
I/O and Utility memo) Intel 9 compiler generates codes to waste stack memory when an array of string ...
Definition: hecmw_dist_copy_f2c_f.f90:12
hecmw_util::hecmwst_node_grp
Definition: hecmw_util_f.F90:135
hecmw_dist_copy_f2c_f::hecmw_dist_copy_f2c
subroutine, public hecmw_dist_copy_f2c(mesh, ierr)
Definition: hecmw_dist_copy_f2c_f.f90:24
hecmw_util::hecmwst_surf_grp
Definition: hecmw_util_f.F90:180