m_common_struct.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
! Copyright (c) 2019 FrontISTR Commons
! This software is released under the MIT License, see LICENSE.txt
!-------------------------------------------------------------------------------
module m_common_struct
  implicit none
  integer, parameter, private :: kreal = kind(0.0d0)
 
  type tlocalcoordsys
    character(len=128) :: sys_name
    integer            :: sys_type
    integer            :: node_id(3)
    real(kind=kreal)   :: coordsys(3, 3) 
  end type tlocalcoordsys
 
  type(tlocalcoordsys), pointer, save :: g_localcoordsys(:) => null()
 
  type trotinfo
    integer :: n_rot
    type(trotcond), pointer :: conds(:)
  end type
 
  type trotcond
    logical :: active
    integer :: center_ngrp_id
    integer :: torque_ngrp_id
    real(kind=kreal) :: vec(3)
  end type
 
contains
 
  subroutine fstr_localcoordsys_init()
    integer :: i
 
    if( .not. associated(g_localcoordsys) ) return
    do i=1,size(g_localcoordsys)
      g_localcoordsys(i)%sys_name      = ""
      g_localcoordsys(i)%sys_type      = 10
      g_localcoordsys(i)%node_ID(:)    = -1
      g_localcoordsys(i)%CoordSys(:,:) = 0.d0
    enddo
  end subroutine
 
  subroutine print_localcoordsys(nfile, coordsys)
    integer, intent(in)              :: nfile
    type(tlocalcoordsys), intent(in) :: coordsys
 
    write(nfile, *) coordsys%sys_type, coordsys%sys_name
    write(nfile, *) coordsys%node_ID(:)
    write(nfile, *) coordsys%CoordSys(1,:)
    write(nfile, *) coordsys%CoordSys(2,:)
    write(nfile, *) coordsys%CoordSys(3,:)
  end subroutine
 
  logical function iscoordneeds( coordsys )
    type(tlocalcoordsys), intent(in) :: coordsys
 
    integer stype
    iscoordneeds = .false.
    stype = mod( coordsys%sys_type, 10 )
    if( stype==0 ) iscoordneeds = .true.
  end function
 
  subroutine set_localcoordsys(coords, coordsys, outsys, ierr)
    use m_utilities, only: cross_product
    real(kind=kreal), intent(inout)  :: coords(:, :) ! coord needs to define local coord sys
    type(tlocalcoordsys), intent(in) :: coordsys
    real(kind=kreal), intent(out)    :: outsys(3, 3)
    integer, intent(out)             :: ierr
 
    real(kind=kreal) :: f, xyza(3), xyzb(3), xyzc(3)
    integer :: stype
 
    ierr = 0
    stype = mod( coordsys%sys_type, 10 )
 
    if( stype==0 ) then  ! given coordinates
      outsys = coordsys%CoordSys
    elseif( stype==1 ) then    ! given nodes id
      xyza = coords(1,:)-coords(3,:)
      xyzb = coords(2,:)-coords(3,:)
      call cross_product(xyza,xyzb,xyzc)
      f = dsqrt( dot_product( xyza, xyza ) )
      outsys(1,:) = xyza/f
      f = dsqrt( dot_product( xyzc, xyzc ) )
      outsys(3,:) = xyzc/f
      call cross_product(outsys(3,:), outsys(1,:), outsys(2,:) )
    endif
  end subroutine
 
  subroutine fstr_rotinfo_init(n, rinfo)
    integer, intent(in) :: n
    type(trotinfo), intent(inout) :: rinfo
 
    integer :: i
 
    if( n < 1 ) return
 
    rinfo%n_rot = n
    allocate(rinfo%conds(n))
    do i=1,n
      rinfo%conds(i)%active = .false.
      rinfo%conds(i)%center_ngrp_id = -1
      rinfo%conds(i)%torque_ngrp_id = -1
      rinfo%conds(i)%vec(1:3) = 0.d0
    enddo
  end subroutine
 
  subroutine fstr_rotinfo_finalize(rinfo)
    type(trotinfo), intent(inout) :: rinfo
 
    rinfo%n_rot = 0
    if( associated(rinfo%conds)) deallocate(rinfo%conds)
  end subroutine
 
end module