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