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