FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
hecmw_mat_id.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!-------------------------------------------------------------------------------
5
7 use hecmw_util
8
9 private
10
11 public:: hecmw_mat_id_set
12 public:: hecmw_mat_id_get
13 public:: hecmw_mat_id_clear
14
15 type mat_mesh
16 logical :: used = .false.
17 type(hecmwST_matrix), pointer :: mat
18 type(hecmwST_local_mesh), pointer :: mesh
19 end type mat_mesh
20
21 integer(kind=kint), parameter :: max_mm = 8
22
23 type(mat_mesh), save :: mm(max_mm)
24
25contains
26
27 subroutine hecmw_mat_id_set(hecMAT, hecMESH, id)
28 implicit none
29 type(hecmwst_matrix), intent(in), target :: hecmat
30 type(hecmwst_local_mesh), intent(in), target :: hecmesh
31 integer(kind=kint), intent(out) :: id
32 integer(kind=kint) :: i
33 id = 0
34 do i = 1, max_mm
35 if (.not. mm(i)%used) then
36 id = i
37 exit
38 endif
39 end do
40 if (id == 0) then
41 stop 'ERROR: hecmw_mat_id_set: too many matrices set'
42 endif
43 mm(id)%mat => hecmat
44 mm(id)%mesh => hecmesh
45 mm(id)%used = .true.
46 end subroutine hecmw_mat_id_set
47
48 subroutine hecmw_mat_id_get(id, hecMAT, hecMESH)
49 implicit none
50 integer(kind=kint), intent(in) :: id
51 type(hecmwst_matrix), pointer :: hecmat
52 type(hecmwst_local_mesh), pointer :: hecmesh
53 if (id <= 0 .or. max_mm < id) then
54 stop 'ERROR: hecmw_mat_id_get: id out of range'
55 endif
56 if (.not. mm(id)%used) then
57 stop 'ERROR: hecmw_mat_id_get: invalid id'
58 endif
59 hecmat => mm(id)%mat
60 hecmesh => mm(id)%mesh
61 end subroutine hecmw_mat_id_get
62
63 subroutine hecmw_mat_id_clear(id)
64 implicit none
65 integer(kind=kint), intent(in) :: id
66 if (.not. mm(id)%used) then
67 stop 'ERROR: hecmw_mat_id_clear: invalid id'
68 endif
69 mm(id)%mat => null()
70 mm(id)%mesh => null()
71 mm(id)%used = .false.
72 end subroutine hecmw_mat_id_clear
73
74end module hecmw_mat_id
integer(kind=kint), parameter max_mm
subroutine, public hecmw_mat_id_set(hecmat, hecmesh, id)
subroutine, public hecmw_mat_id_get(id, hecmat, hecmesh)
subroutine, public hecmw_mat_id_clear(id)
I/O and Utility.
Definition: hecmw_util_f.F90:7