FrontISTR  6.0.0
Large-scale structural analysis program with finit element method
hecmw_util_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_util
8 #ifndef HECMW_SERIAL
9  use mpi
10 #endif
11  implicit none
12  private :: hecmw_petot,hecmw_rank,hecmw_comm,hecmw_group
13  public
14 
15  integer(kind=4),parameter:: kint = 4
16  integer(kind=4),parameter:: kreal = 8
17 
18  integer(kind=kint),parameter :: hecmw_name_len = 63
19  integer(kind=kint),parameter :: hecmw_header_len = 127
20  integer(kind=kint),parameter :: hecmw_msg_len = 255
21  integer(kind=kint),parameter :: hecmw_filename_len = 1023
22 
24  integer(kind=kint),parameter :: hecmw_exit_success = 0
25  integer(kind=kint),parameter :: hecmw_exit_usage = 1
26  integer(kind=kint),parameter :: hecmw_exit_input = 2
27  integer(kind=kint),parameter :: hecmw_exit_model = 3
28  integer(kind=kint),parameter :: hecmw_exit_solver_setup = 4
29  integer(kind=kint),parameter :: hecmw_exit_noconv = 10
30  integer(kind=kint),parameter :: hecmw_exit_internal = 20
31 
32  integer(kind=kint),parameter :: hecmw_sum = 46801
33  integer(kind=kint),parameter :: hecmw_prod = 46802
34  integer(kind=kint),parameter :: hecmw_max = 46803
35  integer(kind=kint),parameter :: hecmw_min = 46804
36  integer(kind=kint),parameter :: hecmw_lor = 46805
37  integer(kind=kint),parameter :: hecmw_land = 46806
38  integer(kind=kint),parameter :: hecmw_integer = 53951
39  integer(kind=kint),parameter :: hecmw_single_precision = 53952
40  integer(kind=kint),parameter :: hecmw_double_precision = 53953
41  integer(kind=kint),parameter :: hecmw_character = 53954
42 
43 #ifndef HECMW_SERIAL
44  integer(kind=kint),parameter :: hecmw_status_size = mpi_status_size
45 #else
46  integer(kind=kint),parameter :: hecmw_status_size = 1
47 #endif
48 
49  integer(kind=kint) :: hecmw_petot,hecmw_rank,hecmw_comm,hecmw_group
50  !C
51  !C +---------------+
52  !C | SECTION info. |
53  !C +---------------+
54  !C===
56  integer(kind=kint) :: n_sect=0
57  integer(kind=kint),pointer :: sect_type(:)=>null()
58  integer(kind=kint),pointer :: sect_opt(:)=>null()
59  integer(kind=kint),pointer :: sect_mat_id_index(:)=>null()
60  integer(kind=kint),pointer :: sect_mat_id_item(:)=>null()
61  integer(kind=kint),pointer :: sect_i_index(:)=>null()
62  integer(kind=kint),pointer :: sect_i_item(:)=>null()
63  integer(kind=kint),pointer :: sect_r_index(:)=>null()
64  real(kind=kreal),pointer :: sect_r_item(:)=>null()
65  integer(kind=kint),pointer :: sect_orien_id(:)=>null()
66  end type hecmwst_section
67 
68  !C for hecmwST_section%sect_type
69  integer(kind=kint),parameter :: hecmw_sect_type_solid = 1
70  integer(kind=kint),parameter :: hecmw_sect_type_shell = 2
71  integer(kind=kint),parameter :: hecmw_sect_type_beam = 3
72  integer(kind=kint),parameter :: hecmw_sect_type_interface = 4
73  !C for hecmwST_section%sect_opt
74  integer(kind=kint),parameter :: hecmw_sect_opt_pstress = 0
75  integer(kind=kint),parameter :: hecmw_sect_opt_pstrain = 1
76  integer(kind=kint),parameter :: hecmw_sect_opt_asymmetry = 2
77  integer(kind=kint),parameter :: hecmw_sect_opt_pstress_ri = 10
78  integer(kind=kint),parameter :: hecmw_sect_opt_pstrain_ri = 11
79  integer(kind=kint),parameter :: hecmw_sect_opt_asymmetry_ri = 12
80  !C===
81 
82  !C
83  !C +----------------+
84  !C | MATERIAL info. |
85  !C +----------------+
86  !C===
88  integer(kind=kint) :: n_mat=0
89  integer(kind=kint) :: n_mat_item=0
90  integer(kind=kint) :: n_mat_subitem=0
91  integer(kind=kint) :: n_mat_table=0
92  character(HECMW_NAME_LEN),pointer :: mat_name(:)=>null()
93  integer(kind=kint),pointer :: mat_item_index(:)=>null()
94  integer(kind=kint),pointer :: mat_subitem_index(:)=>null()
95  integer(kind=kint),pointer :: mat_table_index(:)=>null()
96  real(kind=kreal),pointer :: mat_val(:)=>null()
97  real(kind=kreal),pointer :: mat_temp(:)=>null()
98  end type hecmwst_material
99  !C===
100 
101  !C
102  !C +-----------+
103  !C | MPC info. |
104  !C +-----------+
105  !C===
107  integer(kind=kint) :: n_mpc=0
108  integer(kind=kint),pointer :: mpc_index(:)=>null()
109  integer(kind=kint),pointer :: mpc_item(:)=>null()
110  integer(kind=kint),pointer :: mpc_dof(:)=>null()
111  real(kind=kreal),pointer :: mpc_val(:)=>null()
112  real(kind=kreal),pointer :: mpc_const(:)=>null()
113  end type hecmwst_mpc
114  !C===
115 
116  !C
117  !C +-----------+
118  !C | AMPLITUDE |
119  !C +-----------+
120  !C===
122  integer(kind=kint) :: n_amp=0
123  character(len=HECMW_NAME_LEN),pointer :: amp_name(:)=>null()
124  integer(kind=kint),pointer :: amp_type_definition(:)=>null()
125  integer(kind=kint),pointer :: amp_type_time(:)=>null()
126  integer(kind=kint),pointer :: amp_type_value(:)=>null()
127  integer(kind=kint),pointer :: amp_index(:)=>null()
128  real(kind=kreal),pointer :: amp_val(:)=>null()
129  real(kind=kreal),pointer :: amp_table(:)=>null()
130  end type hecmwst_amplitude
131 
132  !C for hecmwST_amplitude%amp_type_definition
133  integer(kind=kint),parameter :: hecmw_amp_typedef_tabular = 1
134  !C for hecmwST_amplitude%amp_type_time
135  integer(kind=kint),parameter :: hecmw_amp_typetime_step = 1
136  integer(kind=kint),parameter :: hecmw_amp_typetime_total = 2
137  !C for hecmwST_amplitude%amp_type_value
138  integer(kind=kint),parameter :: hecmw_amp_typeval_relative = 1
139  integer(kind=kint),parameter :: hecmw_amp_typeval_absolute = 2
140  !C===
141 
142  !C
143  !C +-----------+
144  !C | NODE grp. |
145  !C +-----------+
146  !C===
148  integer(kind=kint) :: n_grp=0
149  integer(kind=kint) :: n_bc=0
150  character(HECMW_NAME_LEN),pointer :: grp_name(:)=>null()
151  integer(kind=kint),pointer :: grp_index(:)=>null()
152  integer(kind=kint),pointer :: grp_item(:)=>null()
153  integer(kind=kint),pointer :: bc_grp_id(:)=>null()
154  integer(kind=kint),pointer :: bc_grp_type(:)=>null()
155  integer(kind=kint),pointer :: bc_grp_index(:)=>null()
156  integer(kind=kint),pointer :: bc_grp_dof(:)=>null()
157  real(kind=kreal),pointer :: bc_grp_val(:)=>null()
158  end type hecmwst_node_grp
159 
160  !C for hecmwST_node_grp%bc_grp_type
161  integer(kind=kint),parameter :: hecmw_bcgrptype_desplacement = 1
162  integer(kind=kint),parameter :: hecmw_bcgrptype_flux = 2
163  !C===
164 
165  !C
166  !C +-----------+
167  !C | ELEM grp. |
168  !C +-----------+
169  !C===
171  integer(kind=kint) :: n_grp=0
172  integer(kind=kint) :: n_bc=0
173  character(HECMW_NAME_LEN),pointer :: grp_name(:)=>null()
174  integer(kind=kint),pointer :: grp_index(:)=>null()
175  integer(kind=kint),pointer :: grp_item(:)=>null()
176  integer(kind=kint),pointer :: bc_grp_id(:)=>null()
177  integer(kind=kint),pointer :: bc_grp_type(:)=>null()
178  integer(kind=kint),pointer :: bc_grp_index(:)=>null()
179  real(kind=kreal),pointer :: bc_grp_val(:)=>null()
180  end type hecmwst_elem_grp
181 
182  !C for hecmwST_elem_grp%bc_grp_type
183  !C integer(kind=kint),parameter :: HECMW_BCGRPTYPE_DESPLACEMENT = 1
184  !C integer(kind=kint),parameter :: HECMW_BCGRPTYPE_FLUX = 2
185  !C===
186 
187  !C
188  !C +-----------+
189  !C | SURF grp. |
190  !C +-----------+
191  !C===
193  integer(kind=kint) :: n_grp=0
194  integer(kind=kint) :: n_bc=0
195  character(HECMW_NAME_LEN),pointer:: grp_name(:)=>null()
196  integer(kind=kint),pointer :: grp_index(:)=>null()
197  integer(kind=kint),pointer :: grp_item(:)=>null()
198  integer(kind=kint),pointer :: bc_grp_id(:)=>null()
199  integer(kind=kint),pointer :: bc_grp_type(:)=>null()
200  integer(kind=kint),pointer :: bc_grp_index(:)=>null()
201  real(kind=kreal),pointer :: bc_grp_val(:)=>null()
202  end type hecmwst_surf_grp
203 
204  !C for hecmwST_surf_grp%bc_grp_type
205  !C integer(kind=kint),parameter :: HECMW_BCGRPTYPE_DESPLACEMENT = 1
206  !C integer(kind=kint),parameter :: HECMW_BCGRPTYPE_FLUX = 2
207  !C
208 
209  !C
210  !C +---------+
211  !C | CONTACT |
212  !C +---------+
213  !C===
215  integer(kind=kint) :: n_pair=0
216  character(HECMW_NAME_LEN),pointer:: name(:)=>null()
217  integer(kind=kint),pointer :: type(:)=>null()
218  integer(kind=kint),pointer :: slave_grp_id(:)=>null()
219  integer(kind=kint),pointer :: master_grp_id(:)=>null()
220  integer(kind=kint),pointer :: slave_orisgrp_id(:)=>null()
221  end type hecmwst_contact_pair
222 
223  !C for hecmwST_contact_pair%type
224  integer(kind=kint),parameter :: hecmw_contact_type_node_surf = 1
225  integer(kind=kint),parameter :: hecmw_contact_type_surf_surf = 2
226  integer(kind=kint),parameter :: hecmw_contact_type_node_elem = 3
227  !C===
228 
229  !C
230  !C +----------------+
231  !C | REFINE Origin. |
232  !C +----------------+
233  !C===
235  integer(kind=kint),pointer :: index(:)=>null()
236  integer(kind=kint),pointer :: item_index(:)=>null()
237  integer(kind=kint),pointer :: item_item(:)=>null()
238  end type hecmwst_refine_origin
239  !C===
240 
241  !C
242  !C +------------------+
243  !C | LOCAL MESH info. |
244  !C +------------------+
245  !C===
247 
248  !C
249  !C-- FILES, GENERAL
250  !C
251  character(HECMW_FILENAME_LEN) :: gridfile=achar(0)
252  character(HECMW_FILENAME_LEN),pointer :: files(:)=>null()
253  character(HECMW_HEADER_LEN) :: header=achar(0)
254  integer(kind=kint) :: hecmw_flag_adapt=0
255  integer(kind=kint) :: hecmw_flag_initcon=0
256  integer(kind=kint) :: hecmw_n_file=0
257  integer(kind=kint) :: hecmw_flag_parttype=0
258  integer(kind=kint) :: hecmw_flag_partdepth=0
259  integer(kind=kint) :: hecmw_flag_version=0
260  integer(kind=kint) :: hecmw_flag_partcontact=0
261  real(kind=kreal) :: zero_temp=0.0d0
262 
263  !C
264  !C-- NODE
265  integer(kind=kint) :: n_node=0
266  integer(kind=kint) :: n_node_gross=0
267  ! For parallel contact with hanging slave nodes
268  integer(kind=kint) :: nn_middle=0
269  integer(kind=kint) :: nn_internal=0
270  integer(kind=kint) :: n_dof=0
271  integer(kind=kint) :: n_dof_grp=0
272  integer(kind=kint) :: n_dof_tot=0
273  real(kind=kreal),pointer :: node(:)=>null()
274  integer(kind=kint),pointer :: node_id(:)=>null()
275  integer(kind=kint),pointer :: global_node_id(:)=>null()
276  integer(kind=kint),pointer :: node_val_index(:)=>null()
277  real(kind=kreal),pointer :: node_val_item(:)=>null()
278  integer(kind=kint),pointer :: node_dof_index(:)=>null()
279  integer(kind=kint),pointer :: node_dof_item(:)=>null()
280  integer(kind=kint),pointer :: node_init_val_index(:)=>null()
281  real(kind=kreal),pointer :: node_init_val_item(:)=>null()
282  integer(kind=kint),pointer :: node_internal_list(:)=>null()
283  !C
284  !C-- ELEMENT
285  !C
286  integer(kind=kint) :: n_elem=0
287  integer(kind=kint) :: n_elem_gross=0
288  integer(kind=kint) :: ne_internal=0
289  integer(kind=kint) :: n_elem_type=0
290  integer(kind=kint) :: n_elem_mat_id=0
291  integer(kind=kint),pointer :: elem_type_index(:)=>null()
292  integer(kind=kint),pointer :: elem_type_item(:)=>null()
293  integer(kind=kint),pointer :: elem_type(:)=>null()
294  integer(kind=kint),pointer :: section_id(:)=>null()
295  integer(kind=kint),pointer :: elem_mat_id_index(:)=>null()
296  integer(kind=kint),pointer :: elem_mat_id_item(:)=>null()
297  integer(kind=kint),pointer :: elem_node_index(:)=>null()
298  integer(kind=kint),pointer :: elem_node_item(:)=>null()
299  integer(kind=kint),pointer :: elem_id(:)=>null()
300  integer(kind=kint),pointer :: global_elem_id(:)=>null()
301  integer(kind=kint),pointer :: elem_internal_list(:)=>null()
302  integer(kind=kint),pointer :: elem_mat_int_index(:)=>null()
303  real(kind=kreal),pointer :: elem_mat_int_val(:)=>null()
304  integer(kind=kint),pointer :: elem_val_index(:)=>null()
305  real(kind=kreal),pointer :: elem_val_item(:)=>null()
306  !integer(kind=kint) :: is_33shell
307  !integer(kind=kint) :: is_33beam
308  !integer(kind=kint) :: is_heat
309  !C
310  !C-- COMMUNICATION
311  !C
312  integer(kind=kint) :: zero=0
313  integer(kind=kint) :: mpi_comm=0
314  integer(kind=kint) :: petot=0
315  integer(kind=kint) :: pesmptot=0
316  integer(kind=kint) :: my_rank=0
317  integer(kind=kint) :: errnof=0
318  integer(kind=kint) :: n_subdomain=0
319  integer(kind=kint) :: n_neighbor_pe=0
320  integer(kind=kint),pointer :: neighbor_pe(:)=>null()
321  integer(kind=kint),pointer :: import_index(:)=>null()
322  integer(kind=kint),pointer :: import_item(:)=>null()
323  integer(kind=kint),pointer :: export_index(:)=>null()
324  integer(kind=kint),pointer :: export_item(:)=>null()
325  integer(kind=kint),pointer :: shared_index(:)=>null()
326  integer(kind=kint),pointer :: shared_item(:)=>null()
327 
328  !C
329  !C-- ADAPTATION
330  !C
331  integer(kind=kint) :: coarse_grid_level=0
332  integer(kind=kint) :: n_adapt=0
333  integer(kind=kint),pointer :: when_i_was_refined_node(:)=>null()
334  integer(kind=kint),pointer :: when_i_was_refined_elem(:)=>null()
335  integer(kind=kint),pointer :: adapt_parent_type(:)=>null()
336  integer(kind=kint),pointer :: adapt_type(:)=>null()
337  integer(kind=kint),pointer :: adapt_level(:)=>null()
338  integer(kind=kint),pointer :: adapt_parent(:)=>null()
339  integer(kind=kint),pointer :: adapt_children_index(:)=>null()
340  integer(kind=kint),pointer :: adapt_children_item(:)=>null()
341 
342  integer(kind=kint) :: nn_array=0, ne_array=0, nx_array=0
343  integer(kind=kint) :: n_adapt_edge=0, n_adapt_edge_global=0
344  integer(kind=kint) :: n_adapt_act_node=0, n_adapt_act_edge=0
345  integer(kind=kint) :: n_adapt_act_elem=0, n_adapt_act_elem_cur=0
346  integer(kind=kint) :: n_adapt_elem_341=0, n_adapt_elem_351=0
347  integer(kind=kint) :: n_adapt_elem_341_cur=0, n_adapt_elem_351_cur=0
348  integer(kind=kint) :: n_adapt_act_elem_341=0, n_adapt_act_elem_351=0
349 
350  integer(kind=kint) :: n_adapt_node_cur=0, nn_adapt_internal_cur=0
351  integer(kind=kint) :: n_adapt_node_old=0, nn_adapt_internal_old=0
352  integer(kind=kint) :: n_adapt_elem_cur=0, n_adapt_elem_old=0
353 
354  integer(kind=kint), pointer :: adapt_edge_node(:)=>null(), adapt_mid_edge(:)=>null()
355  integer(kind=kint), pointer :: adapt_iemb (:)=>null(), adapt_edge_home(:)=>null()
356  integer(kind=kint), pointer :: adapt_act_edge (:)=>null()
357 
358  integer(kind=kint), pointer :: &
359  & adapt_import_edge_index(:)=>null(), adapt_import_edge_item(:)=>null(),&
360  & adapt_export_edge_index(:)=>null(), adapt_export_edge_item(:)=>null(),&
361  & adapt_import_elem_index(:)=>null(), adapt_import_elem_item(:)=>null(),&
362  & adapt_export_elem_index(:)=>null(), adapt_export_elem_item(:)=>null(),&
363  & adapt_import_new_index (:)=>null(), adapt_import_new_item (:)=>null(),&
364  & adapt_export_new_index (:)=>null(), adapt_export_new_item (:)=>null()
365  integer(kind=kint), pointer :: rev_neighbor_pe(:)=>null()
366  integer(kind=kint), pointer :: adapt_act_elem_341(:)=>null()
367  integer(kind=kint), pointer :: adapt_act_elem_351(:)=>null()
368  integer(kind=kint), pointer :: adapt_oldtonew_node(:)=>null(), adapt_newtoold_node(:)=>null()
369  integer(kind=kint), pointer :: adapt_oldtonew_elem(:)=>null(), adapt_newtoold_elem(:)=>null()
370  integer(kind=kint), pointer :: adapt_iwk(:)=>null(), adapt_children_local(:)=>null()
371 
372  !C
373  !C-- REFINEMENT
374  !C
375  integer(kind=kint) :: n_refine=0
376  integer(kind=kint),pointer :: node_old2new(:)=>null()
377  integer(kind=kint),pointer :: node_new2old(:)=>null()
378  integer(kind=kint),pointer :: elem_old2new(:)=>null()
379  integer(kind=kint),pointer :: elem_new2old(:)=>null()
380  integer(kind=kint),pointer :: n_node_refine_hist(:)=>null()
381 
382  !C
383  !C-- ETC.
384  !C
385  type (hecmwst_section) :: section
386  type (hecmwst_material) :: material
387  type (hecmwst_mpc) :: mpc
388  type (hecmwst_amplitude) :: amp
389  type (hecmwst_node_grp) :: node_group
390  type (hecmwst_elem_grp) :: elem_group
391  type (hecmwst_surf_grp) :: surf_group
392  type (hecmwst_contact_pair):: contact_pair
393  type (hecmwst_refine_origin):: refine_origin
394 
395  end type hecmwst_local_mesh
396 
397  !C for hecmwST_local_mesh%hecmw_flag_parttype
398  integer(kind=kint),parameter :: hecmw_flag_parttype_unknown = 0
399  integer(kind=kint),parameter :: hecmw_flag_parttype_nodebased = 1
400  integer(kind=kint),parameter :: hecmw_flag_parttype_elembased = 2
401 
402  !C for hecmwST_local_mesh%hecmw_flag_partcontact
403  integer(kind=kint),parameter :: hecmw_flag_partcontact_unknown = 0
404  integer(kind=kint),parameter :: hecmw_flag_partcontact_aggregate = 1
405  integer(kind=kint),parameter :: hecmw_flag_partcontact_distribute = 2
406  integer(kind=kint),parameter :: hecmw_flag_partcontact_simple = 3
407 
408  !C the mode above occupies bits 0-7, the ownership scheme bit 8. OWNER_MASTER must stay zero so that a
409  !C distributed mesh holding a bare mode value reads back as the master-owner scheme. Test with
410  !C hecmw_partcontact_get_mode()/_get_owner(), never for equality against the whole flag.
411  integer(kind=kint),parameter :: hecmw_flag_partcontact_mode_mask = 255
412  integer(kind=kint),parameter :: hecmw_flag_partcontact_owner_mask = 256
413  integer(kind=kint),parameter :: hecmw_flag_partcontact_owner_master = 0
414  integer(kind=kint),parameter :: hecmw_flag_partcontact_owner_slave = 256
415 
416  !C
417  !C +--------+
418  !C | MATRIX |
419  !C +--------+
420  !C===
422  integer(kind=kint) :: zero
423  integer(kind=kint) :: hecmw_comm
424  integer(kind=kint) :: petot
425  integer(kind=kint) :: pesmptot
426  integer(kind=kint) :: my_rank
427  integer(kind=kint) :: errnof
428  integer(kind=kint) :: n_subdomain
429  integer(kind=kint) :: n_neighbor_pe
430  integer(kind=kint), dimension(:), pointer :: neighbor_pe
431  integer(kind=kint), dimension(:), pointer :: import_index
432  integer(kind=kint), dimension(:), pointer :: import_item
433  integer(kind=kint), dimension(:), pointer :: export_index
434  integer(kind=kint), dimension(:), pointer :: export_item
435  integer(kind=kint), dimension(:), pointer :: shared_index
436  integer(kind=kint), dimension(:), pointer :: shared_item
437  end type hecmwst_matrix_comm
438 
440  integer(kind=kint) :: i
441  integer(kind=kint) :: j
442  real(kind=kreal), dimension(3,3) :: val
443  end type hecmwst_index_value_pair
444 
448  integer(kind=kint) :: num_lagrange = 0
449  integer(kind=kint) :: numl_lagrange = 0
450  integer(kind=kint) :: numu_lagrange = 0
451 
452  integer(kind=kint), pointer :: indexl_lagrange(:) => null()
453  integer(kind=kint), pointer :: indexu_lagrange(:) => null()
454 
455  integer(kind=kint), pointer :: iteml_lagrange(:) => null()
456  integer(kind=kint), pointer :: itemu_lagrange(:) => null()
457 
458  real(kind=kreal), pointer :: al_lagrange(:) => null()
459  real(kind=kreal), pointer :: au_lagrange(:) => null()
460  real(kind=kreal), pointer :: d_lagrange(:) => null()
461 
462  real(kind=kreal), pointer :: lagrange(:) => null()
463  end type hecmwst_matrix_lagrange
464 
466  integer(kind=kint) :: n=0, np=0, npl=0, npu=0, npa=0, ndof=0
467  real(kind=kreal), pointer :: d(:)=>null(), b(:)=>null(), x(:)=>null()
468  real(kind=kreal), pointer :: al(:)=>null(), au(:)=>null()
469  real(kind=kreal), pointer :: a(:)=>null()
470  integer(kind=kint), pointer :: indexl(:)=>null(), indexu(:)=>null()
471  integer(kind=kint), pointer :: indexa(:)=>null()
472  integer(kind=kint), pointer :: iteml(:)=>null(), itemu(:)=>null()
473  integer(kind=kint), pointer :: itema(:)=>null()
474  integer(kind=kint ), dimension(100) :: iarray=0
475  real (kind=kreal), dimension(100) :: rarray=0.0d0
476  logical :: symmetric = .true.
477  end type hecmwst_matrix
478 contains
479 
480  !C
481  !C***
482  !C*** HECMW_PARTCONTACT_GET_MODE / HECMW_PARTCONTACT_GET_OWNER
483  !C***
484  !C
485  !C UNPACK hecmw_flag_partcontact, so that its bit layout stays internal to HEC-MW
486  !C
487  pure integer(kind=kint) function hecmw_partcontact_get_mode( flag_partcontact )
488  integer(kind=kint), intent(in) :: flag_partcontact
490  end function hecmw_partcontact_get_mode
491 
492  pure integer(kind=kint) function hecmw_partcontact_get_owner( flag_partcontact )
493  integer(kind=kint), intent(in) :: flag_partcontact
495  end function hecmw_partcontact_get_owner
496 
497  !C
498  !C***
499  !C*** HECMW_HAS_INTERNAL_NODE
500  !C***
501  !C
502  !C TEST WHETHER AN ELEMENT TOUCHES AN INTERNAL NODE OF THIS RANK
503  !C
504  !C Local node numbering places the internal nodes first, so a local node id
505  !C greater than nn_internal belongs to another rank.
506  !C
507  pure logical function hecmw_has_internal_node( hecMESH, nn, nodLOCAL )
508  type(hecmwst_local_mesh), intent(in) :: hecmesh
509  integer(kind=kint), intent(in) :: nn
510  integer(kind=kint), intent(in) :: nodlocal(:)
511  integer(kind=kint) :: j
512 
513  hecmw_has_internal_node = .true.
514  do j = 1, nn
515  if( nodlocal(j) <= hecmesh%nn_internal ) return
516  enddo
517  hecmw_has_internal_node = .false.
518  end function hecmw_has_internal_node
519 
520  !C
521  !C***
522  !C*** HECMW_INIT
523  !C***
524  !C
525  !C INIT. HECMW-FEM process's
526  !C
527  subroutine hecmw_init
528  character(len=HECMW_FILENAME_LEN):: ctrlfile = "hecmw_ctrl.dat"
529  call hecmw_init_ex(ctrlfile)
530  end subroutine hecmw_init
531 
532  subroutine hecmw_comm_init
533  integer(kind=kint) :: ierr
534 #ifndef HECMW_SERIAL
535  !call MPI_INIT (ierr)
536  call mpi_comm_size (mpi_comm_world, hecmw_petot, ierr)
537  call mpi_comm_rank (mpi_comm_world, hecmw_rank, ierr)
538  call mpi_comm_dup (mpi_comm_world, hecmw_comm, ierr)
539  call mpi_comm_group(mpi_comm_world, hecmw_group, ierr)
540 #else
541  hecmw_petot=1
542  hecmw_rank=0
543  hecmw_comm=0
544  hecmw_group=0
545  ierr=0
546 #endif
547  if(ierr /= 0) then
549  endif
550  end subroutine hecmw_comm_init
551 
552  subroutine hecmw_init_nocontrol()
553  call hecmw_comm_init()
554  call hecmw_comm_init_if(hecmw_comm, hecmw_petot, hecmw_rank, hecmw_group)
555  end subroutine
556 
557  !C
558  !C***
559  !C*** HECMW_INIT_EX
560  !C***
561  !C
562  !C INIT. HECMW-FEM process's
563  !C
564  subroutine hecmw_init_ex(ctrlfile)
565  character(len=HECMW_FILENAME_LEN):: ctrlfile
566  integer(kind=kint) :: ierr
567 
568  call hecmw_comm_init()
569  call hecmw_comm_init_if(hecmw_comm, hecmw_petot, hecmw_rank, hecmw_group)
570 
571  call hecmw_ctrl_init_ex_if(ctrlfile, ierr)
572  if(ierr /= 0) then
574  endif
575  ! call hecmw_couple_comm_init_if(ierr)
576  ! if(ierr /= 0) then
577  ! call hecmw_abort( hecmw_comm_get_comm( ) )
578  ! endif
579 
580  end subroutine hecmw_init_ex
581 
582 
583  !C
584  !C***
585  !C*** HECMW_FINALIZE
586  !C***
587  !C
588  !C FINALIZE. HECMW-FEM process's
589  !C
590  subroutine hecmw_finalize
591  integer(kind=kint) :: ierr
592 
594 
595 #ifndef HECMW_SERIAL
596  call mpi_finalize(ierr)
597 #endif
598 
599  end subroutine hecmw_finalize
600 
601 
602  !C******************** MPI WRAPPER SUBROUTINES ************************
603  !C
604  !C***
605  !C*** HECMW_ABORT
606  !C***
607  !C
608  subroutine hecmw_abort(comm, code)
609  integer(kind=kint) :: comm
610  integer(kind=kint), intent(in), optional :: code
611  integer(kind=kint) :: errorcode, ierror
612 
613  errorcode = hecmw_exit_internal
614  if( present(code) ) errorcode = code
615 
616  ! MPI_ABORT does not flush the Fortran unit buffers; do it here so that
617  ! the message written just before the abort survives.
618  !$omp critical
619  flush(6)
620  !$omp end critical
621 
622 #ifndef HECMW_SERIAL
623  call mpi_abort(comm, errorcode, ierror)
624 #else
625  stop errorcode
626 #endif
627  end subroutine hecmw_abort
628 
629  !C
630  !C***
631  !C*** HECMW_WTIME
632  !C***
633  !C
634  function hecmw_wtime()
635  real(kind=kreal) hecmw_wtime
636  external hecmw_wtime_fi
637  real(kind=kreal) hecmw_wtime_fi
639  end function hecmw_wtime
640  !C
641  !C***
642  !C*** HECMW_WTICK
643  !C***
644  !C
645  function hecmw_wtick()
646  real(kind=kreal) hecmw_wtick
647  external hecmw_wtick_fi
648  real(kind=kreal) hecmw_wtick_fi
650  end function hecmw_wtick
651  !C
652  !C***
653  !C*** HECMW_COMM_GET_COMM
654  !C***
655  !C
656  function hecmw_comm_get_comm() result(comm)
657  integer(kind=kint) :: comm
658 
659  comm = hecmw_comm
660  end function hecmw_comm_get_comm
661 
662  !C
663  !C***
664  !C*** HECMW_COMM_GET_RANK
665  !C***
666  !C
667  function hecmw_comm_get_rank() result(rank)
668  integer(kind=kint) :: rank
669 
670  rank = hecmw_rank
671  end function hecmw_comm_get_rank
672 
673  !C
674  !C***
675  !C*** HECMW_COMM_GET_SIZE
676  !C***
677  !C
678  function hecmw_comm_get_size() result(comm_size)
679  integer(kind=kint) :: comm_size
680 
681  comm_size = hecmw_petot
682  end function hecmw_comm_get_size
683 
684 
685  !C*************** NULL POINTER SETTING UTILITY ****************
686 
687  subroutine hecmw_nullify_section( P )
688  type( hecmwst_section ) :: P
689  nullify( p%sect_type )
690  nullify( p%sect_opt )
691  nullify( p%sect_mat_ID_index )
692  nullify( p%sect_mat_ID_item )
693  nullify( p%sect_I_index )
694  nullify( p%sect_I_item )
695  nullify( p%sect_R_index )
696  nullify( p%sect_R_item )
697  nullify( p%sect_orien_ID )
698  end subroutine hecmw_nullify_section
699 
700  subroutine hecmw_nullify_material( P )
701  type( hecmwst_material ) :: P
702  nullify( p%mat_name )
703  nullify( p%mat_item_index )
704  nullify( p%mat_subitem_index )
705  nullify( p%mat_table_index )
706  nullify( p%mat_val )
707  nullify( p%mat_temp )
708  end subroutine hecmw_nullify_material
709 
710  subroutine hecmw_nullify_mpc( P )
711  type( hecmwst_mpc ) :: P
712  nullify( p%mpc_index )
713  nullify( p%mpc_item )
714  nullify( p%mpc_dof )
715  nullify( p%mpc_val )
716  nullify( p%mpc_const )
717  end subroutine hecmw_nullify_mpc
718 
719  subroutine hecmw_initialize_mpc( mpc, n_mpc, n_item )
720  type( hecmwst_mpc ), intent(inout) :: mpc
721  integer(kind=kint), intent(in) :: n_mpc
722  integer(kind=kint), intent(in) :: n_item
723 
724  mpc%n_mpc = n_mpc
725  allocate( mpc%mpc_index(0:n_mpc) )
726  allocate( mpc%mpc_item(n_item) )
727  allocate( mpc%mpc_dof(n_item) )
728  allocate( mpc%mpc_val(n_item) )
729  end subroutine
730 
731  subroutine hecmw_finalize_mpc( P )
732  type( hecmwst_mpc ) :: P
733  if( associated(p%mpc_index) ) deallocate( p%mpc_index )
734  if( associated(p%mpc_item) ) deallocate( p%mpc_item )
735  if( associated(p%mpc_dof) ) deallocate( p%mpc_dof )
736  if( associated(p%mpc_val) ) deallocate( p%mpc_val )
737  end subroutine hecmw_finalize_mpc
738 
739  subroutine hecmw_nullify_amplitude( P )
740  type( hecmwst_amplitude ) :: P
741  nullify( p%amp_name )
742  nullify( p%amp_type_definition )
743  nullify( p%amp_type_time )
744  nullify( p%amp_type_value )
745  nullify( p%amp_index )
746  nullify( p%amp_val )
747  nullify( p%amp_table )
748  end subroutine hecmw_nullify_amplitude
749 
750  subroutine hecmw_nullify_node_grp( P )
751  type( hecmwst_node_grp ) :: P
752  nullify( p%grp_name )
753  nullify( p%grp_index )
754  nullify( p%grp_item )
755  nullify( p%bc_grp_ID )
756  nullify( p%bc_grp_type )
757  nullify( p%bc_grp_index )
758  nullify( p%bc_grp_dof )
759  nullify( p%bc_grp_val )
760  end subroutine hecmw_nullify_node_grp
761 
762  subroutine hecmw_nullify_elem_grp( P )
763  type( hecmwst_elem_grp ) :: P
764  nullify( p%grp_name )
765  nullify( p%grp_index )
766  nullify( p%grp_item )
767  nullify( p%bc_grp_ID )
768  nullify( p%bc_grp_type )
769  nullify( p%bc_grp_index )
770  nullify( p%bc_grp_val )
771  end subroutine hecmw_nullify_elem_grp
772 
773  subroutine hecmw_nullify_surf_grp( P )
774  type( hecmwst_surf_grp ) :: P
775  nullify( p%grp_name )
776  nullify( p%grp_index )
777  nullify( p%grp_item )
778  nullify( p%bc_grp_ID )
779  nullify( p%bc_grp_type )
780  nullify( p%bc_grp_index )
781  nullify( p%bc_grp_val )
782  end subroutine hecmw_nullify_surf_grp
783 
785  type( hecmwst_contact_pair ) :: P
786  nullify( p%name )
787  nullify( p%type )
788  nullify( p%slave_grp_id )
789  nullify( p%master_grp_id )
790  nullify( p%slave_orisgrp_id )
791  end subroutine hecmw_nullify_contact_pair
792 
794  type( hecmwst_refine_origin ) :: P
795  nullify( p%index )
796  nullify( p%item_index )
797  nullify( p%item_item )
798  end subroutine hecmw_nullify_refine_origin
799 
800  subroutine hecmw_nullify_mesh( P )
801  type( hecmwst_local_mesh ) :: P
802  nullify( p%files )
803  nullify( p%node )
804  nullify( p%node_ID )
805  nullify( p%global_node_ID )
806  nullify( p%node_val_index )
807  nullify( p%node_val_item )
808  nullify( p%node_dof_index )
809  nullify( p%node_dof_item )
810  nullify( p%node_init_val_index )
811  nullify( p%node_init_val_item )
812  nullify( p%node_internal_list )
813  nullify( p%elem_type_index )
814  nullify( p%elem_type_item )
815  nullify( p%elem_type )
816  nullify( p%section_ID )
817  nullify( p%elem_mat_ID_index )
818  nullify( p%elem_mat_ID_item )
819  nullify( p%elem_node_index )
820  nullify( p%elem_node_item )
821  nullify( p%elem_ID )
822  nullify( p%global_elem_ID )
823  nullify( p%elem_internal_list )
824  nullify( p%elem_mat_int_index )
825  nullify( p%elem_mat_int_val )
826  nullify( p%elem_val_index )
827  nullify( p%elem_val_item )
828  nullify( p%neighbor_pe )
829  nullify( p%import_index )
830  nullify( p%import_item )
831  nullify( p%export_index )
832  nullify( p%export_item )
833  nullify( p%shared_index )
834  nullify( p%shared_item )
835  nullify( p%when_i_was_refined_node )
836  nullify( p%when_i_was_refined_elem )
837  nullify( p%adapt_parent_type )
838  nullify( p%adapt_type )
839  nullify( p%adapt_level )
840  nullify( p%adapt_parent )
841  nullify( p%adapt_children_index )
842  nullify( p%adapt_children_item )
843  nullify( p%adapt_edge_node )
844  nullify( p%adapt_mid_edge )
845  nullify( p%adapt_iemb )
846  nullify( p%adapt_edge_home )
847  nullify( p%adapt_act_edge )
848  nullify( p%adapt_import_edge_index )
849  nullify( p%adapt_import_edge_item )
850  nullify( p%adapt_export_edge_index )
851  nullify( p%adapt_export_edge_item )
852  nullify( p%adapt_import_elem_index )
853  nullify( p%adapt_import_elem_item )
854  nullify( p%adapt_export_elem_index )
855  nullify( p%adapt_export_elem_item )
856  nullify( p%adapt_import_new_index )
857  nullify( p%adapt_import_new_item )
858  nullify( p%adapt_export_new_index )
859  nullify( p%adapt_export_new_item )
860  nullify( p%rev_neighbor_pe )
861  nullify( p%adapt_act_elem_341 )
862  nullify( p%adapt_act_elem_351 )
863  nullify( p%adapt_OLDtoNEW_node )
864  nullify( p%adapt_NEWtoOLD_node )
865  nullify( p%adapt_OLDtoNEW_elem )
866  nullify( p%adapt_NEWtoOLD_elem )
867  nullify( p%adapt_IWK )
868  nullify( p%adapt_children_local )
869  nullify( p%node_old2new )
870  nullify( p%node_new2old )
871  nullify( p%elem_old2new )
872  nullify( p%elem_new2old )
873  nullify( p%n_node_refine_hist )
874 
875  call hecmw_nullify_section( p%section )
876  call hecmw_nullify_material( p%material )
877  call hecmw_nullify_mpc( p%mpc )
878  call hecmw_nullify_amplitude( p%amp )
879  call hecmw_nullify_node_grp( p%node_group )
880  call hecmw_nullify_elem_grp( p%elem_group )
881  call hecmw_nullify_surf_grp( p%surf_group )
882  call hecmw_nullify_contact_pair( p%contact_pair )
883  call hecmw_nullify_refine_origin( p%refine_origin )
884 
885  end subroutine hecmw_nullify_mesh
886 
887 
889  type( hecmwst_matrix_comm ) :: P
890  nullify( p%neighbor_pe )
891  nullify( p%import_index )
892  nullify( p%import_item )
893  nullify( p%export_index )
894  nullify( p%export_item )
895  nullify( p%shared_index )
896  nullify( p%shared_item )
897  end subroutine hecmw_nullify_matrix_comm
898 
899  subroutine hecmw_nullify_matrix( P )
900  type( hecmwst_matrix ) :: P
901  nullify( p%D )
902  nullify( p%B )
903  nullify( p%X )
904  nullify( p%AL )
905  nullify( p%AU )
906  nullify( p%A )
907  nullify( p%indexL )
908  nullify( p%indexU )
909  nullify( p%indexA )
910  nullify( p%itemL )
911  nullify( p%itemU )
912  nullify( p%itemA )
913  end subroutine hecmw_nullify_matrix
914 
915  subroutine hecmw_print_matrix( fname, P )
916  character(len=*), intent(in) :: fname
917  type( hecmwst_matrix ), intent(in) :: P
918 
919  integer :: i, nf, nBlock
920  integer :: io_stat
921  nf = 777
922  nblock = p%NDOF * p%NDOF
923  open( unit=nf, file=fname, iostat=io_stat)
924  if( io_stat /= 0 ) return
925  write( nf, * ) p%N,p%NP,p%NPL,p%NPU,p%NDOF
926  !---- index
927  do i=0, p%NP
928  write( nf,* ) p%indexL(i), p%indexU(i)
929  enddo
930  !---- itemL, AL
931  do i=1, p%NPL
932  write( nf,* ) p%itemL(i)
933  enddo
934  do i=1,nblock * p%NPL
935  write( nf,* ) p%AL(i)
936  enddo
937  !---- itemU, AU
938  do i=1,p%NPU
939  write( nf,* ) p%itemU(i)
940  enddo
941  do i=1,nblock * p%NPU
942  write( nf,* ) p%AU(i)
943  enddo
944  !---- D
945  do i=1,nblock * p%NP
946  write( nf, * ) p%D(i)
947  enddo
948  !---- B
949  do i=1,p%NDOF * p%NP
950  write( nf, * ) p%B(i)
951  enddo
952 
953  close( nf )
954  end subroutine
955 
956  subroutine hecmw_read_matrix( fname, P )
957  character(len=*), intent(in) :: fname
958  type( hecmwst_matrix ), intent(out) :: P
959 
960  integer :: i, nf, nBlock, istat
961  nf = 777
962  open( unit=nf, file=fname, status='old', iostat= istat)
963  if(istat /= 0) then
964  print *, "cannot open file ",fname
965  stop
966  endif
967  read( nf, * ) p%N,p%NP,p%NPL,p%NPU,p%NDOF
968  nblock = p%NDOF * p%NDOF
969 
970  !----It is supposing of array are not allocated yet
971  allocate( p%indexL(0:p%NP), p%indexU(0:p%NP) )
972  allocate( p%itemL(p%NPL), p%itemU(p%NPU) )
973  allocate( p%AL(p%NPL*nblock), p%AU(p%NPU*nblock) )
974  allocate( p%D(p%NP*nblock) )
975  allocate( p%B(p%NDOF*p%NP) )
976  !---- index
977  do i=0, p%NP
978  read( nf,* ) p%indexL(i), p%indexU(i)
979  enddo
980  !---- itemL, AL
981  do i=1, p%NPL
982  read( nf,* ) p%itemL(i)
983  enddo
984  do i=1,nblock * p%NPL
985  read( nf,* ) p%AL(i)
986  enddo
987  !---- itemU, AU
988  do i=1,p%NPU
989  read( nf,* ) p%itemU(i)
990  enddo
991  do i=1,nblock * p%NPU
992  read( nf,* ) p%AU(i)
993  enddo
994  !---- D
995  do i=1,nblock * p%NP
996  read( nf, * ) p%D(i)
997  enddo
998  !---- B
999  do i=1,p%NDOF * p%NP
1000  read( nf, * ) p%B(i)
1001  enddo
1002 
1003  close( nf )
1004  end subroutine
1005 
1006  subroutine hecmw_clone_matrix(hecMATorig,hecMAT)
1007  type (hecmwST_matrix ) :: hecMATorig
1008  type (hecmwST_matrix ),pointer :: hecMAT
1009  allocate(hecmat)
1010  call hecmw_nullify_matrix( hecmat )
1011 
1012  hecmat%B => hecmatorig%B
1013  hecmat%X => hecmatorig%X
1014  hecmat%D => hecmatorig%D
1015  hecmat%AL => hecmatorig%AL
1016  hecmat%AU => hecmatorig%AU
1017  hecmat%indexL => hecmatorig%indexL
1018  hecmat%indexU => hecmatorig%indexU
1019  hecmat%itemL => hecmatorig%itemL
1020  hecmat%itemU => hecmatorig%itemU
1021  hecmat%N = hecmatorig%N
1022  hecmat%NP = hecmatorig%NP
1023  hecmat%NPL = hecmatorig%NPL
1024  hecmat%NPU = hecmatorig%NPU
1025  hecmat%NDOF = hecmatorig%NDOF
1026  hecmat%Iarray = hecmatorig%Iarray
1027  hecmat%Rarray = hecmatorig%Rarray
1028  end subroutine hecmw_clone_matrix
1029 
1030  subroutine hecmw_copy_matrix(hecMATorig,hecMAT)
1031  type (hecmwST_matrix ) :: hecMATorig
1032  type (hecmwST_matrix ),pointer :: hecMAT
1033  integer(kind=kint) NDOF,NDOF2,N,NP,NPL,NPU
1034 
1035  allocate(hecmat)
1036  call hecmw_nullify_matrix( hecmat )
1037  n = hecmatorig%N
1038  ndof = hecmatorig%NDOF
1039  ndof2 = ndof*ndof
1040  np = hecmatorig%NP
1041  npl = hecmatorig%NPL
1042  npu = hecmatorig%NPU
1043  hecmat%N = n
1044  hecmat%NP = np
1045  hecmat%NPL = npl
1046  hecmat%NPU = npu
1047  hecmat%NDOF = ndof
1048  allocate(hecmat%B(ndof*np))
1049  allocate(hecmat%X(ndof*np))
1050  allocate(hecmat%D(ndof2*np))
1051  allocate(hecmat%AU(ndof2*npu))
1052  allocate(hecmat%AL(ndof2*npl))
1053  allocate(hecmat%indexL(0:np), hecmat%indexU(0:np), hecmat%itemL(npl), hecmat%itemU(npu))
1054  hecmat%B = hecmatorig%B
1055  hecmat%X = hecmatorig%X
1056  hecmat%D = hecmatorig%D
1057  hecmat%AU = hecmatorig%AU
1058  hecmat%AL = hecmatorig%AL
1059  hecmat%indexL = hecmatorig%indexL
1060  hecmat%indexU = hecmatorig%indexU
1061  hecmat%itemL = hecmatorig%itemL
1062  hecmat%itemU = hecmatorig%itemU
1063  hecmat%Iarray = hecmatorig%Iarray
1064  hecmat%Rarray = hecmatorig%Rarray
1065  end subroutine hecmw_copy_matrix
1066 
1067  subroutine hecmw_blockmatrix_expand(hecMATorig,hecMAT,NDOF)
1068  type (hecmwST_matrix ) :: hecMATorig
1069  type (hecmwST_matrix ),pointer :: hecMAT
1070  integer(kind=kint) NDOF,NDOF2,oNDOF,oNDOF2,i,j,k
1071 
1072  ndof2 = ndof*ndof
1073  ondof = hecmatorig%NDOF
1074  ondof2 = ondof*ondof
1075  allocate(hecmat)
1076  call hecmw_nullify_matrix( hecmat )
1077 
1078  allocate(hecmat%B(ndof*hecmatorig%NP))
1079  allocate(hecmat%X(ndof*hecmatorig%NP))
1080  allocate(hecmat%D(ndof2*hecmatorig%NP))
1081  allocate(hecmat%AL(ndof2*hecmatorig%NPL))
1082  allocate(hecmat%AU(ndof2*hecmatorig%NPU))
1083  hecmat%indexL => hecmatorig%indexL
1084  hecmat%indexU => hecmatorig%indexU
1085  hecmat%itemL => hecmatorig%itemL
1086  hecmat%itemU => hecmatorig%itemU
1087  hecmat%N = hecmatorig%N
1088  hecmat%NP = hecmatorig%NP
1089  hecmat%NPL = hecmatorig%NPL
1090  hecmat%NPU = hecmatorig%NPU
1091  hecmat%NDOF = ndof
1092  hecmat%Iarray = hecmatorig%Iarray
1093  hecmat%Rarray = hecmatorig%Rarray
1094  hecmat%X = 0.0d0
1095  do i = 1, hecmatorig%NP
1096  do j = 1, ndof
1097  do k = 1, ndof
1098  if (j<=ondof .and. k<=ondof) then
1099  hecmat%D(ndof2*(i-1) + (j-1)*ndof + k) = hecmatorig%D(ondof2*(i-1) + (j-1)*ondof + k)
1100  else
1101  if(j==k) then
1102  hecmat%D(ndof2*(i-1) + (j-1)*ndof + k)=1
1103  else
1104  hecmat%D(ndof2*(i-1) + (j-1)*ndof + k)=0
1105  end if
1106  end if
1107  end do
1108  if (j<=ondof) then
1109  hecmat%B(ndof*(i-1) + j) = hecmatorig%B(ondof*(i-1) + j)
1110  else
1111  hecmat%B(ndof*(i-1) + j)=0
1112  end if
1113  end do
1114  end do
1115  do i = 1, hecmatorig%NPL
1116  do j = 1, ndof
1117  do k = 1, ndof
1118  if (j<=ondof .and. k<=ondof) then
1119  hecmat%AL(ndof2*(i-1) + (j-1)*ndof + k) = hecmatorig%AL(ondof2*(i-1) + (j-1)*ondof + k)
1120  else
1121  hecmat%AL(ndof2*(i-1) + (j-1)*ndof + k) = 0
1122  end if
1123  end do
1124  end do
1125  end do
1126  do i = 1, hecmatorig%NPU
1127  do j = 1, ndof
1128  do k = 1, ndof
1129  if (j<=ondof .and. k<=ondof) then
1130  hecmat%AU(ndof2*(i-1) + (j-1)*ndof + k) = hecmatorig%AU(ondof2*(i-1) + (j-1)*ondof + k)
1131  else
1132  hecmat%AU(ndof2*(i-1) + (j-1)*ndof + k) = 0
1133  end if
1134  end do
1135  end do
1136  end do
1137  end subroutine hecmw_blockmatrix_expand
1138  subroutine hecmw_vector_contract(hecMATorig,hecMAT,NDOF)
1139  type (hecmwST_matrix ) :: hecMATorig
1140  type (hecmwST_matrix ),pointer :: hecMAT
1141  integer(kind=kint) NDOF,NDOF2,oNDOF,i,j
1142  ndof2 = ndof*ndof
1143  ondof = hecmatorig%NDOF
1144  do i = 1, hecmatorig%NP
1145  do j = 1, ondof
1146  hecmatorig%X(ondof*(i-1) + j) = hecmat%X(ndof*(i-1) + j)
1147  end do
1148  end do
1149  hecmatorig%Iarray = hecmat%Iarray
1150  hecmatorig%Rarray = hecmat%Rarray
1151  deallocate(hecmat%B)
1152  deallocate(hecmat%D)
1153  deallocate(hecmat%X)
1154  deallocate(hecmat%AL)
1155  deallocate(hecmat%AU)
1156  deallocate(hecmat)
1157  end subroutine hecmw_vector_contract
1158 end module hecmw_util
void hecmw_comm_init_if(HECMW_Fint *comm, int *size, int *rank, HECMW_Fint *group)
Definition: hecmw_comm.c:793
void hecmw_ctrl_finalize_if(void)
void hecmw_ctrl_init_ex_if(char *ctrlfile, int *err, int len)
double hecmw_wtime_fi(void)
Definition: hecmw_time.c:41
double hecmw_wtick_fi(void)
Definition: hecmw_time.c:48
I/O and Utility.
Definition: hecmw_util_f.F90:7
integer(kind=kint), parameter hecmw_flag_partcontact_owner_slave
integer(kind=kint), parameter hecmw_sect_type_interface
pure integer(kind=kint) function hecmw_partcontact_get_mode(flag_partcontact)
integer(kind=kint), parameter hecmw_contact_type_node_surf
integer(kind=kint), parameter hecmw_land
integer(kind=kint), parameter hecmw_sect_opt_pstrain
integer(kind=kint), parameter hecmw_sum
integer(kind=kint), parameter hecmw_sect_type_beam
subroutine hecmw_print_matrix(fname, P)
integer(kind=kint), parameter hecmw_amp_typetime_total
integer(kind=kint), parameter hecmw_flag_partcontact_distribute
subroutine hecmw_init_nocontrol()
integer(kind=kint), parameter hecmw_integer
integer(kind=kint), parameter hecmw_contact_type_surf_surf
subroutine hecmw_abort(comm, code)
integer(kind=kint), parameter hecmw_flag_partcontact_aggregate
subroutine hecmw_comm_init
integer(kind=kint), parameter hecmw_exit_usage
subroutine hecmw_nullify_material(P)
subroutine hecmw_copy_matrix(hecMATorig, hecMAT)
integer(kind=kint), parameter hecmw_sect_opt_pstress_ri
integer(kind=kint) function hecmw_comm_get_size()
integer(kind=kint), parameter hecmw_exit_input
subroutine hecmw_nullify_matrix_comm(P)
integer(kind=kint), parameter hecmw_exit_model
subroutine hecmw_nullify_mpc(P)
integer(kind=kint), parameter hecmw_sect_type_shell
integer(kind=kint), parameter hecmw_prod
integer(kind=4), parameter kint
integer(kind=kint), parameter hecmw_exit_internal
subroutine hecmw_init_ex(ctrlfile)
integer(kind=kint) function hecmw_comm_get_comm()
subroutine hecmw_nullify_contact_pair(P)
integer(kind=kint), parameter hecmw_single_precision
integer(kind=kint), parameter hecmw_max
integer(kind=kint), parameter hecmw_contact_type_node_elem
integer(kind=4), parameter kreal
subroutine hecmw_nullify_surf_grp(P)
integer(kind=kint), parameter hecmw_bcgrptype_flux
integer(kind=kint), parameter hecmw_sect_opt_pstress
pure logical function hecmw_has_internal_node(hecMESH, nn, nodLOCAL)
integer(kind=kint), parameter hecmw_flag_partcontact_owner_master
integer(kind=kint), parameter hecmw_lor
integer(kind=kint), parameter hecmw_header_len
subroutine hecmw_nullify_node_grp(P)
subroutine hecmw_finalize
integer(kind=kint), parameter hecmw_flag_partcontact_mode_mask
integer(kind=kint), parameter hecmw_sect_opt_asymmetry
integer(kind=kint), parameter hecmw_status_size
integer(kind=kint) function hecmw_comm_get_rank()
integer(kind=kint), parameter hecmw_flag_parttype_nodebased
integer(kind=kint), parameter hecmw_min
integer(kind=kint), parameter hecmw_amp_typeval_relative
subroutine hecmw_nullify_refine_origin(P)
integer(kind=kint), parameter hecmw_bcgrptype_desplacement
real(kind=kreal) function hecmw_wtick()
integer(kind=kint), parameter hecmw_flag_parttype_elembased
integer(kind=kint), parameter hecmw_flag_parttype_unknown
integer(kind=kint), parameter hecmw_msg_len
integer(kind=kint), parameter hecmw_amp_typeval_absolute
pure integer(kind=kint) function hecmw_partcontact_get_owner(flag_partcontact)
integer(kind=kint), parameter hecmw_exit_success
exit status returned to the OS (keep the values below 256)
integer(kind=kint), parameter hecmw_amp_typetime_step
subroutine hecmw_nullify_elem_grp(P)
subroutine hecmw_nullify_matrix(P)
subroutine hecmw_blockmatrix_expand(hecMATorig, hecMAT, NDOF)
integer(kind=kint), parameter hecmw_sect_opt_pstrain_ri
subroutine hecmw_nullify_section(P)
subroutine hecmw_clone_matrix(hecMATorig, hecMAT)
subroutine hecmw_initialize_mpc(mpc, n_mpc, n_item)
subroutine hecmw_nullify_mesh(P)
integer(kind=kint), parameter hecmw_filename_len
integer(kind=kint), parameter hecmw_sect_opt_asymmetry_ri
integer(kind=kint), parameter hecmw_flag_partcontact_owner_mask
integer(kind=kint), parameter hecmw_name_len
integer(kind=kint), parameter hecmw_character
subroutine hecmw_finalize_mpc(P)
subroutine hecmw_nullify_amplitude(P)
subroutine hecmw_init
integer(kind=kint), parameter hecmw_exit_solver_setup
integer(kind=kint), parameter hecmw_flag_partcontact_unknown
real(kind=kreal) function hecmw_wtime()
integer(kind=kint), parameter hecmw_amp_typedef_tabular
subroutine hecmw_vector_contract(hecMATorig, hecMAT, NDOF)
integer(kind=kint), parameter hecmw_double_precision
subroutine hecmw_read_matrix(fname, P)
integer(kind=kint), parameter hecmw_sect_type_solid
integer(kind=kint), parameter hecmw_exit_noconv
integer(kind=kint), parameter hecmw_flag_partcontact_simple
Structure for Lagrange multiplier-related part of stiffness matrix (Lagrange multiplier-related matri...