1!-------------------------------------------------------------------------------
2! Copyright (c) 2019 FrontISTR Commons
3! This software is released under the MIT License, see LICENSE.txt
4!-------------------------------------------------------------------------------
5!> This module provide a function to ECHO for IFSTR solver
6module m_static_echo
7contains
8  !C
9  !C***
10  !> ECHO for IFSTR solver
11  !C***
12  !C
13  subroutine FSTR_ECHO (hecMESH)
14    use m_fstr
15    use m_hecmw2fstr_mesh_conv
16    implicit none
17    type (hecmwST_local_mesh):: hecMESH
18
19    !** Local variables
20    integer(kind=kint) :: i,j,is,iE,nn,ic_type
21    integer(kind=kint) :: icel,isect,ig1,iS0,iE0,ik
22    integer(kind=kint) :: in,nid, itype
23    real(kind=kreal) :: x,y,z
24    integer(kind=kint):: nids(20)
25    !C====
26    !C +-------------------------------+
27    !C | NODE                          |
28    !C +-------------------------------+
29    !C===
30    !C** nodal coordinate
31    write(ILOG,*) '### Number of nodes',hecMESH%n_node
32    write(ILOG,*) 'ID X Y Z'
33    do i=1,hecMESH%n_node
34      nid = hecMESH%global_node_ID(i)
35      x = hecMESH%node(3*i-2)
36      y = hecMESH%node(3*i-1)
37      z = hecMESH%node(3*i)
38      write(ILOG,'(i8,e15.5,e15.5,e15.5)') nid,x,y,z
39    enddo
40    !C
41    !C +-------------------------------+
42    !C | ELEMENT                       |
43    !C +-------------------------------+
44    !C===
45    call fstr2hecmw_mesh_conv( hecMESH )
46    write(ILOG,*) '### Elements', hecMESH%n_elem
47    do itype= 1, hecMESH%n_elem_type
48      is= hecMESH%elem_type_index(itype-1) + 1
49      iE= hecMESH%elem_type_index(itype  )
50      ic_type= hecMESH%elem_type_item(itype)
51      !C** Set number of nodes
52      nn = hecmw_get_max_node(ic_type)
53      !C** element loop
54      do icel= is, iE
55        !C** node ID
56        is= hecMESH%elem_node_index(icel-1)
57        do j=1,nn
58          if( hecMESH%n_refine > 0 ) then
59            nids(j)= hecMESH%elem_node_item (is+j)
60          else
61            nids(j)= hecMESH%global_node_ID( hecMESH%elem_node_item (is+j))
62          endif
63        enddo
64        !C** section  ID
65        isect= hecMESH%section_ID(icel)
66        write(ILOG,*) '### Element ID=',ic_type,isect,hecMESH%global_elem_id(icel)
67        write(ILOG,*) (nids(j),j=1,nn)
68      enddo
69    enddo
70    call hecmw2fstr_mesh_conv( hecMESH )
71    !C +-------------------------------+
72    !C | NODE GROUP                    |
73    !C +-------------------------------+
74    write(ILOG,*) '### Ngroup'
75    do ig1= 1, hecMESH%node_group%n_grp
76      write(ILOG,*)
77      write(ILOG,'(a80)') hecMESH%node_group%grp_name(ig1)
78      iS0= hecMESH%node_group%grp_index(ig1-1) + 1
79      iE0= hecMESH%node_group%grp_index(ig1  )
80      do ik= iS0, iE0
81        in   = hecMESH%node_group%grp_item(ik)
82        write(ILOG,*) hecMESH%global_node_ID(in)
83      enddo
84    enddo
85    !C +-------------------------------+
86    !C | ELEMEN GROUP                  |
87    !C +-------------------------------+
88    write(ILOG,*) '### Egroup'
89    do ig1= 1, hecMESH%elem_group%n_grp
90      write(ILOG,*)
91      write(ILOG,'(a80)') hecMESH%elem_group%grp_name(ig1)
92      iS0= hecMESH%elem_group%grp_index(ig1-1) + 1
93      iE0= hecMESH%elem_group%grp_index(ig1  )
94      do ik= iS0, iE0
95        in   = hecMESH%elem_group%grp_item(ik)
96        write(ILOG,*) hecMESH%global_elem_ID(in)
97      enddo
98    enddo
99    write(ILOG,*) '### Reftemp',ref_temp
100    !C====
101  end subroutine FSTR_ECHO
102end module m_static_echo
103