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