FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
hecmw_couple_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
8
9 use hecmw_util
12
13 implicit none
14 private
15 public :: hecmw_couple_copy_c2f
16
17contains
18
19subroutine hecmw_couple_copy_c2f(couple_value, ierr)
20
21 type(hecmw_couple_value), intent(inout) :: couple_value
22 integer(kind=kint), intent(inout) :: ierr
23 integer(kind=kint) :: ista, is_allocated
24 character(len=HECMW_NAME_LEN) :: sname, vname
25
26 sname = "hecmw_couple_value"
27
28 vname = "n"
29 call hecmw_cpl_copy_c2f_set_if(sname, vname, couple_value%n, ierr)
30 if(ierr /= 0) return
31
32 vname = "item_type"
33 call hecmw_cpl_copy_c2f_set_if(sname, vname, couple_value%item_type, ierr)
34 if(ierr /= 0) return
35
36 vname = "n_dof"
37 call hecmw_cpl_copy_c2f_set_if(sname, vname, couple_value%n_dof, ierr)
38 if(ierr /= 0) return
39
40 if(couple_value%n > 0) then
41 vname = "item"
42 call hecmw_cpl_copy_c2f_isalloc_if(sname, vname, is_allocated, ierr)
43 if(is_allocated == 1) then
44 if(couple_value%item_type == hecmw_couple_node_group) then
45 allocate(couple_value%item(couple_value%n), stat=ista)
46 if(ista > 0) return
47 call hecmw_cpl_copy_c2f_set_if(sname, vname, couple_value%item, ierr)
48 if(ierr /= 0) return
49 else if(couple_value%item_type == hecmw_couple_element_group) then
50 allocate(couple_value%item(couple_value%n), stat=ista)
51 if(ista > 0) return
52 call hecmw_cpl_copy_c2f_set_if(sname, vname, couple_value%item, ierr)
53 if(ierr /= 0) return
54 else if(couple_value%item_type == hecmw_couple_surface_group) then
55 allocate(couple_value%item(couple_value%n*2), stat=ista)
56 if(ista > 0) return
57 call hecmw_cpl_copy_c2f_set_if(sname, vname, couple_value%item, ierr)
58 if(ierr /= 0) return
59 else
60 return
61 endif
62 endif
63 endif
64
65 if(couple_value%n > 0 .AND. couple_value%n_dof > 0) then
66 vname = "value"
67 call hecmw_cpl_copy_c2f_isalloc_if(sname, vname, is_allocated, ierr)
68 if(is_allocated == 1) then
69 allocate(couple_value%value(couple_value%n*couple_value%n_dof), stat=ista)
70 if(ista > 0) return
71 call hecmw_cpl_copy_c2f_set_if(sname, vname, couple_value%value, ierr)
72 if(ierr /= 0) return
73 endif
74 endif
75
76end subroutine hecmw_couple_copy_c2f
77
void hecmw_cpl_copy_c2f_isalloc_if(char *struct_name, char *var_name, int *is_allocated, int *err, int slen, int vlen)
void hecmw_cpl_copy_c2f_set_if(char *struct_name, char *var_name, void *dst, int *err, int slen, int vlen)
subroutine, public hecmw_couple_copy_c2f(couple_value, ierr)
integer(kind=kint), parameter, public hecmw_couple_surface_group
integer(kind=kint), parameter, public hecmw_couple_node_group
integer(kind=kint), parameter, public hecmw_couple_element_group
I/O and Utility.
Definition: hecmw_util_f.F90:7