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