MODULES.f90

Go to the documentation of this file.

!    Copyright (C) 2012 The SPEED FOUNDATION
!    Author: Ilario Mazzieri
!
!    This file is part of SPEED.
!
!    SPEED is free software; you can redistribute it and/or modify it
!    under the terms of the GNU Affero General Public License as
!    published by the Free Software Foundation, either version 3 of the
!    License, or (at your option) any later version.
!
!    SPEED is distributed in the hope that it will be useful, but
!    WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
!    Affero General Public License for more details.
!
!    You should have received a copy of the GNU Affero General Public License
!    along with SPEED.  If not, see <http://www.gnu.org/licenses/>.
 
 
module speed_exit_codes
 
implicit none
 
integer, parameter :: exit_normal         = 0
integer, parameter :: exit_cfl            = 1
integer, parameter :: exit_instab         = 2
integer, parameter :: exit_anelastic      = 3
integer, parameter :: exit_setup          = 4
integer, parameter :: exit_singularmtx    = 5
integer, parameter :: exit_surf_notfound  = 6
integer, parameter :: exit_energy_error   = 7
integer, parameter :: exit_syntax_error   = 8
integer, parameter :: exit_missing_file   = 9
integer, parameter :: exit_root           = 10
integer, parameter :: exit_elem_orient    = 11
integer, parameter :: exit_no_nodes       = 12
integer, parameter :: exit_no_elements    = 13
integer, parameter :: exit_damping_peak   = 14
integer, parameter :: exit_no_materials   = 15
integer, parameter :: exit_function_error = 16
 
end module speed_exit_codes
 
 
module max_var
        integer, parameter :: max_dim           = 3
        integer, parameter :: max_el_conf       = 200
        integer, parameter :: nofqp             = 8
        integer, parameter :: nofinr            = 500
        integer, parameter :: max_quad_points   = 8000
end module max_var
 
 
module str_mesh_scratch
 
  use max_var , only: nofqp !<max number of 1-d quadrature point per element
 
  type scratch_element 
     real*8, dimension(nofqp**2) :: x_nq 
     real*8, dimension(nofqp**2) :: y_nq 
     real*8, dimension(nofqp**2) :: z_nq 
  end type scratch_element
 
end module str_mesh_scratch
 
 
module str_mesh
 
 use max_var
 
 type element  
   
   integer*4:: mat
   integer*4:: ind_el
   integer*4:: face_el
   integer*4:: spct_deg
   integer*4:: quad_rule
   integer*4:: nofne
   integer*4:: proj_yn
   integer*4:: link         ! link two surfaces to speedup the dg setup
   real*8   :: nx,ny,nz     
   integer*4::frac_yn
 
   real*8, dimension(nofqp**2) :: wx_pl  
   real*8, dimension(nofqp**2) :: wy_pl  
   real*8, dimension(nofqp**2) :: wz_pl  
   real*8 :: zn,zt
   
 end type element
 
END MODULE str_mesh
 
 
module str_mesh_after
 
 use max_var,  only : max_quad_points, max_el_conf
 
 type element_after
   
   integer*4:: mat
   integer*4:: ind_el
   integer*4:: face_el
   integer*4:: spct_deg
   integer*4:: quad_rule
   integer*4:: nofne
   real*8   :: nx,ny,nz     
 
   real*8, dimension(max_quad_points) :: x_pl  
   real*8, dimension(max_quad_points) :: y_pl  
   real*8, dimension(max_quad_points) :: z_pl  
   real*8, dimension(max_quad_points) :: x_mn  
   real*8, dimension(max_quad_points) :: y_mn  
   real*8, dimension(max_quad_points) :: z_mn  
 
   real*8, dimension(max_quad_points) :: wx_pl 
   real*8, dimension(max_quad_points) :: wy_pl 
   real*8, dimension(max_quad_points) :: wz_pl 
 
   integer*4, dimension(max_quad_points,0:3) :: omega_minus
   integer*4, dimension(max_el_conf,0:2) :: conf
 
 
 end type element_after
 
 
END MODULE str_mesh_after
 
 
 
module dgjump
 
use max_var , only: max_el_conf
 
type matrix 
 
   real*8, dimension(:,:), pointer :: mjump 
   real*8, dimension(:,:), pointer :: mjump_only_uv  
 
end type matrix
 
 
type el4loop   
 
   integer*4:: ind
   integer*4:: face
   integer*4:: deg
   integer*4:: mate
   integer*4:: num_of_ne
   integer*4:: nnz_plus
   integer*4:: nnz_minus
   integer*4:: nnz_col
   integer*4:: nnz_plus_only_uv
   integer*4:: nnz_minus_only_uv
   integer*4:: nnz_col_only_uv
   
   integer*4, dimension(:), pointer :: iplus, jplus
   integer*4, dimension(:), pointer :: imin, jmin
   integer*4, dimension(max_el_conf,0:2) :: el_conf
   real*8, dimension(:), pointer :: matplus, matmin  
   real*8, dimension(:,:), pointer :: matp           
   type(matrix), dimension(:), pointer :: matm
 
   integer*4, dimension(:), pointer :: iplus_only_uv, jplus_only_uv
   integer*4, dimension(:), pointer :: imin_only_uv, jmin_only_uv
   real*8, dimension(:), pointer :: matplus_only_uv, matmin_only_uv  
   real*8, dimension(:,:), pointer :: matp_only_uv                   
   type(matrix), dimension(:), pointer :: matm_only_uv
 
 
end type 
 
end module
 
 
module speed_par
 
! EXIT CODES
      use speed_exit_codes
 
!************************************************************************************
!                                    LOGICAL
!************************************************************************************
 
!'TRUE' OR 'FALSE'
      logical :: filefound  
 
      ! if .TRUE., fails on negative anelastic coefficients (see: damping 2)
      logical :: b_failoncoeffs
 
      ! if .TRUE., do not start the TIME_LOOP
      ! only setup mesh, parameters, CFL, etc. then quit
      logical :: b_setuponly
 
      ! if .TRUE:, quit if CFL does not hold
      logical :: b_failcfl
 
      ! if .TRUE., quit if simulation becomes unstable
      logical :: b_instabilitycontrol
 
      ! Default values
      logical, parameter :: b_failoncoeffs_default = .false.
      logical, parameter :: b_setuponly_default = .false.
      logical, parameter :: b_failcfl_default = .false.
      logical, parameter :: b_instabilitycontrol_default = .false.
      
!************************************************************************************
!                                    CHARACTERS
!************************************************************************************
 
! FILENAMES
      character*70 :: file_pg, file_mpgm, file_ls, file_mlst, file_sys, file_syslst, &   !!SSI -AH
                      head_file, grid_file, mat_file, bkp_file, head_file_frc, &
                      monitor_file, monitor_file_new, file_face, file_part, & 
                      file_mpi, mpi_file, file_mpi_new, &
                      filename, sdof_file, sys_filename 
 
! 'YES' OR 'NOT'
      character*3  :: deltat_fixed   
 
! RUNGE-KUTTA
      character*10 :: rk_scheme
 
! SLIP DISTRIBUTION 'STD' = HERRERO, 'ARC' = ARCHULETA, 'GAL' = GALLOVIC  
      character*3  :: slip_type
 
!************************************************************************************
!                                    INTEGERS
!************************************************************************************
 
! COUNTERS
      integer*4 :: im_pgm, im_lst, &
                   im, ie, i, j, k, h, in, ic, id, &
                   ip, ielem, i4t, im_nle
 
 
! MAX RANGE NUMBER  
      integer*4 :: nnod_macro, nnod, nelem, con_nnz, con_nnz_bc, &
                   con_nnz_loc, con_nnz_bc_loc, con_nnz_dg, &
                   nnz_node_weight, nface, nmat, n_case, & 
                   nload_dirx_el, nload_neux_el, nload_poix_el, nload_forx_el, &
                   nload_diry_el, nload_neuy_el, nload_poiy_el, nload_fory_el, &
                   nload_dirz_el, nload_neuz_el, nload_poiz_el, nload_forz_el, &
                   nload_neun_el, nload_sism_el, nload_expl_el, & 
                   nload_plax_el, nload_play_el, nload_plaz_el, &
                   nload_pres_el, nload_shea_el, nload_forc_el, &
                   nload_trax_el, nload_tray_el, nload_traz_el, &
                   nload_abc_el, nload_dg_el, &
                   nfunc, nfunc_data, &
                   nmonitors_pgm, nmonitors_lst, &
                   num_pgm, num_lst, nsystem_lst, sys_lst, &  !!SSI - AH
                   nts, restart, trestart, &
                   ns, nn, nn2, nn3, &
                   nnode_dirx,nnode_diry,nnode_dirz, &
                   nnode_abc, nelem_abc, nnode_dg, nelem_dg, nelem_dg_glo, &
                   nnod_loc, nelem_loc, nface_loc, &
                   dime_js, dime_jr, &
                   szsism, max_num_node_sism, length_check_node_sism, &                
                   max_num_node_expl, length_check_node_expl, &
                   nsend,nrecv, nsend_jump, nrecv_jump, &
                   nnode_dom, nelem_dom, edgecut, &
                   nmat_nle, total_els, nvec, &
                   nargs, ntime_err, n_test, n_frac, &
                   num_testcase, label_testcase, nmat_rnd, nmat_nhe
                   
! 0/1 INTERGERS
      integer*4 :: file_mon_pgm, file_mon_lst, file_sys_lst, &  !!SSI-AH
                   find, torf, trof, make_damping_yes_or_not, &
                   mpi_ierr, srcmodflag, sdofflag
      
! DAMPING
      integer*4 :: damping_type
      integer*4, parameter :: n_sls = 3
          
            
! OTHER       
      integer*4 :: trash, &
                   opt_out_form, opt_out_data, &  
                   unit_mpi, unit_part, &
                   initial_snap, &
                   mpi_id, mpi_np, mpi_comm, &
                   ncase, ndt_mon_lst, ndt_mon_pgm, &
                   iargc, &
                   rk_order, rk_stages, testmode, debug
                   
! FIXED DIMENSION VECTORS
      integer*4, dimension(3)  :: clock  !CLOCK (OBSOLTE)
      integer*4, dimension (6) :: opt_out_var ! SELECT OUTPUT VARIABLES   
 
! CONNECTIVIY VECTORS
      integer*4, dimension (:), allocatable :: con_spx, con_spx_dg, con_spx_bc, &
                                               node_weight, node_pointer, &
                                               con_spx_loc, con_spx_bc_loc, &
                                               local_el_num, local_node_num, local_node_num_dg, &
                                               n_glo, el_glo, &
                                               n_system_glo, el_system_glo, system_label, &  !!SSI-AH
                                               node_domain, elem_domain, &
                                               node_domain_loc, elem_domain_loc, &
                                               count_faces, &
                                               elem_index, node_index_seq, & !OBSOLETE
                                               inode_dirx, inode_diry, inode_dirz
 
! VARIABLES DEFINED IN FILENAME.MATE                                
      integer*4, dimension (:), allocatable :: &
                 sub_tag_all, val_case, tag_case, &    !FOR MULTI-NOTHONORING
                 sdeg_mat, type_mat, tag_mat, &
                 fun_dirx_el, fun_neux_el, fun_diry_el, fun_neuy_el, fun_dirz_el, fun_neuz_el, &
                 fun_neun_el, & 
                 fun_poix_el, fun_forx_el, fun_poiy_el, fun_fory_el, fun_poiz_el, fun_forz_el, &
                 fun_plax_el, fun_play_el, fun_plaz_el, &
                 fun_pres_el, fun_shea_el, fun_forc_el, &
                 fun_sism_el, fun_expl_el, &
                 fun_trax_el, fun_tray_el, fun_traz_el, &
                 fun_test, &
                 tag_dirx_el, tag_neux_el, tag_diry_el, tag_neuy_el, tag_dirz_el, tag_neuz_el, &
                 tag_neun_el, &
                 tag_play_el, tag_plax_el, tag_plaz_el, &
                 tag_abc_el, tag_dg_el, tag_dg_yn, tag_dg_frc, tag_dg_link, &
                 tag_sism_el, tag_expl_el, &           
                 tag_func, func_type, func_indx
! SSI           
      integer*4, dimension (:,:), allocatable :: locnode_buildid_map
 
      integer*4, dimension (:), allocatable :: node_counter_sdof
      
! OTHER  (MONITOR)
      integer*4, dimension (:), allocatable :: n_monitor_pgm, el_monitor_pgm, &
                                               n_monitor_lst, el_monitor_lst, monit_files, & 
                                               n_system_lst, el_system_lst, system_files  !!SSI-AH
 
! OTHER (SEISMIC MOMENT OR EXPLOSIVE SOURCE)
      integer*4, dimension (:), allocatable :: num_node_sism, num_node_expl, &
                                               sism_el_glo, expl_el_glo
                                               
         
! OTHER (MPI SETUP)      
      integer*4, dimension (:), allocatable :: mpi_stat, &
                                               node_send, node_recv, proc_send, proc_recv, &
                                               node_send_jump, node_recv_jump, &
                                               proc_send_jump, proc_recv_jump, &
                                               proc_sys_send, proc_sys_recv   !!SSI-AH
 
! OTHER
      integer*4, dimension (:), allocatable :: itersnap, vec, i4count, &
                                               type_mat_nle, tag_mat_nle, rand_mat
 
! Not-Honoring Enhanced
      integer*4, dimension(:), allocatable :: val_nhe, tol_nhe
 
 
! MATRICES
      integer*4, dimension (:,:), allocatable :: con, con_bc, & !val_case         
                                                 ielem_abc, faces, &        
                                                 sour_node_sism, check_node_sism, &                
                                                 sour_node_expl, check_node_expl, & 
                                                 prop_mat_nle 
 
!************************************************************************************
!                                    REALS
!************************************************************************************
 
     real*8 :: &  
               deltat, deltat_cfl, tstart, tstop, time_in_seconds, start1, start2, &
               start, finish, &                        ! TIME VARIABLES
               fmax, fpeak, &                          ! FREQUENCY                      
               xx_macro, yy_macro, zz_macro, &         ! NODES
               depth_search_mon_pgm, rotation_angle_mon_pgm, depth_search_mon_lst, depth_search_sys_lst, &        ! MONITORS
               dg_c, pen_c, &                          ! DG CONSTANTS
               dist, eps, r8t                ! OTHER 
               
               
! VECTOR WITH FIXED DIMENSION                
      real*8, dimension(5) :: prova, sum_prova    ! OBSOLTE
     
     
! SPECTRAL NODES & MAPPING TRANFORMATION      
      real*8, dimension (:), allocatable ::  & 
              zs_elev, zs_all, vs_tria, thick, tol_case ,&        !NOT HONORING                                          
              xx_spx, yy_spx, zz_spx, & !SPECTRAL NODES
              xx_spx_loc, yy_spx_loc, zz_spx_loc, &   !SPECTRAL NODES    
              alfa11, alfa12, alfa13, alfa21, alfa22, alfa23, alfa31, alfa32, alfa33, & !MAP
              beta11, beta12, beta13, beta21, beta22, beta23, beta31, beta32, beta33, & !MAP
              gamma1, gamma2, gamma3, delta1, delta2, delta3 !MAP
 
! MONITORS
      real*8, dimension (:), allocatable :: &
              x_monitor_pgm, y_monitor_pgm, z_monitor_pgm, &         
              x_monitor_lst, y_monitor_lst, z_monitor_lst, &
              x_monitor_real, y_monitor_real, z_monitor_real, &
              xr_monitor_pgm, yr_monitor_pgm, zr_monitor_pgm, &
              xr_monitor_lst, yr_monitor_lst, zr_monitor_lst, & 
              dist_monitor_lst, dist_monitor_pgm, &
              xr_glo, yr_glo, zr_glo, dist_glo, &
              x_glo_real, y_glo_real, z_glo_real, &
              highest_pgm, highest_pgm_loc, &
              highest_lst, highest_lst_loc, & 
              dist_el_glo, posx_el_glo, posy_el_glo, posz_el_glo, &
              x_system_lst, y_system_lst, z_system_lst, &  !!SSI-AH
              x_system_real, y_system_real, z_system_real, &
              xr_system_lst, yr_system_lst, zr_system_lst, dist_system_lst, &
              xr_system_glo, yr_system_glo, zr_system_glo, dist_system_glo, &
              x_system_glo_real, y_system_glo_real, z_system_glo_real , &
              highest_sys_lst_loc
 
! DAMPING
      real*8, dimension(:), allocatable :: qs, qp, frequency_range
      real*8, dimension(:,:), allocatable:: y_lambda,y_mu
      real*8, dimension(:), allocatable :: a0_ray, a1_ray
 
 
! RANDOM 
      real*8, dimension (:), allocatable :: lambda_rnd, rho_rnd, mu_rnd
 
! Not-Honoring Enhanced
      real*8, dimension(:), allocatable :: rho_nhe, lambda_nhe, mu_nhe    !size = nnodes in partition
      real*4, dimension(:), allocatable :: qs_nhe_el, qp_nhe_el !Gamma_nhe_el !size = nelem in partition
 
 
! OTHER 
      real*8, dimension (:), allocatable :: tref_mat, & !tol_case
                                            func_data, tsnap, set_initial_snap, &      
                                            cel,kcel, &
                                            time_error
 
! LOAD VECTOR
      real*8, dimension (:,:), allocatable :: fel
 
!!! AH (3D tensor instead of 2D)
!      real*8, dimension (:,:,:), allocatable :: Fel
 
! (MATRICES OF) VALUES DEFINED IN FILENAME.MATE
      real*8, dimension (:,:), allocatable :: &
              val_dirx_el, val_neux_el, val_diry_el, val_neuy_el, &
              val_dirz_el, val_neuz_el, val_neun_el, &
              val_poix_el, val_forx_el, val_poiy_el, val_fory_el, &
              val_poiz_el, val_forz_el, val_plax_el, val_play_el, val_plaz_el, &
              val_pres_el, val_shea_el, val_forc_el, val_sism_el, val_expl_el, &
              val_trax_el, val_tray_el, val_traz_el, &
              val_mat_nle, prop_mat, val_dg_frc
 
              
! (MATRICES FOR) SEISMIC MOMENT OR EXPLOSIVE SOURCE                       
      real*8, dimension (:,:), allocatable :: &
              factor_seismic_moment, tau_seismic_moment, dist_sour_node_sism, check_dist_node_sism, &        
              factor_explosive_source, dist_sour_node_expl, check_dist_node_expl, &
              pos_sour_node_x, pos_sour_node_y, pos_sour_node_z, check_pos_sism                
 
! AREA DG FACES
      real*8, dimension (:,:), allocatable :: area_nodes
 
! OTHER
      real*8, dimension (:,:), allocatable :: max_u, max_v, max_a, max_o                                    
 
! INSTABILITY CONTROL
      real*8 :: instability_maxval
      ! default value
      real*8, parameter :: instability_maxval_default = 1e20
 
end module speed_par
 
 
 
module speed_par_dg
 
      use max_var
      use str_mesh 
      use str_mesh_scratch                   
      use dgjump
      use speed_par, only: nelem_dg
      use speed_exit_codes
 
      type(el4loop), dimension(:), allocatable :: el_new                        
      type(element), dimension(:), allocatable :: dg_els
      type(scratch_element), dimension(:), allocatable :: scratch_dg_els
 
end module speed_par_dg
 
 
 
module speed_timeloop
 
 
  use speed_par, only:  &
                        !SLIP DISTRIBUTION
                         slip_type, srcmodflag, szsism,&
  
                        !CONNECTIVITY 
                         nnod, nnode_dom,  nnod_loc, local_node_num, xx_spx_loc, yy_spx_loc, zz_spx_loc, &
                         nelem, nelem_loc, local_el_num, con_nnz_loc, con_spx_loc,&
                         nelem_dg, nelem_dg_glo, con_spx_dg, con_nnz_dg, local_node_num_dg, &                      
                        
                        !(NLE) MATERIALS
                         nmat, tag_mat, type_mat, sdeg_mat, tref_mat, prop_mat, &
                         nmat_nle,  tag_mat_nle, type_mat_nle, prop_mat_nle, val_mat_nle, fpeak, &
                         
                        !RAND MATERIALS
                        nmat_rnd, rand_mat, lambda_rnd, mu_rnd, rho_rnd, &
 
                        ! Not-Honoring Enhanced
                        nmat_nhe, rho_nhe, lambda_nhe, mu_nhe, qs_nhe_el, qp_nhe_el, &
                        
                        !EXTERNAL LOADS
                         nload_trax_el, nload_tray_el, nload_traz_el, &                  
                         val_trax_el, val_tray_el, val_traz_el, &
                         fun_trax_el, fun_tray_el, fun_traz_el, &          
                         nfunc, tag_func, func_type, func_indx, func_data, nfunc_data, fel, &
                         sdofflag, locnode_buildid_map, node_counter_sdof, & ! SSI
                        
                         !COORDINATE TRANFORMATION                       
                         alfa11, alfa12, alfa13, alfa21, alfa22, alfa23, &
                         alfa31, alfa32, alfa33, beta11, beta12, beta13, &
                         beta21, beta22, beta23, beta31, beta32, beta33, &
                         gamma1, gamma2, gamma3, delta1, delta2, delta3, &
                        
                         !BOUNDARY CONDITIONS   
                         nnode_dirx, inode_dirx, nnode_diry, inode_diry, &
                         nnode_dirz, inode_dirz, nelem_abc, ielem_abc, &          
                        
                         !TIME INTEGRATION
                         nts, deltat, tstart, tstop, &
                         restart, trestart, initial_snap, &
                         rk_scheme, rk_order, rk_stages, & 
                        
                         !MPI
                         mpi_np, mpi_id, mpi_comm, mpi_stat, mpi_ierr, &
                         nsend, node_send, nrecv, node_recv, proc_send, proc_recv, &
                         nsend_jump, node_send_jump, nrecv_jump, node_recv_jump, &
                         proc_send_jump, proc_recv_jump, &
                         proc_sys_send, proc_sys_recv, & !!SSI-AH
                         
                         !SEISMIC MOMENT
                         check_node_sism, check_dist_node_sism, &                                                  
                         length_check_node_sism, nload_sism_el, factor_seismic_moment, tau_seismic_moment, &
                         check_node_expl, check_dist_node_expl, &        
                         length_check_node_expl,nload_expl_el,factor_explosive_source, &
                         
                         !DAMPING
                          make_damping_yes_or_not, y_lambda,y_mu, n_sls, damping_type, frequency_range, &
                          a0_ray, a1_ray,fmax, &
                        
                         !CASE
                         n_case,tag_case,val_case, & 
                         zs_elev, zs_all, vs_tria, thick, sub_tag_all, &
                        
                         !MONITOR & MAP 
                         ndt_mon_pgm, rotation_angle_mon_pgm, &                                                
                         nmonitors_pgm, n_monitor_pgm, el_monitor_pgm, &                                        
                         xr_monitor_pgm, yr_monitor_pgm, zr_monitor_pgm, &                                        
                         ndt_mon_lst, nmonitors_lst, n_monitor_lst, el_monitor_lst, &                                        
                         xr_monitor_lst, yr_monitor_lst, zr_monitor_lst, &                                        
                         opt_out_var, monitor_file, bkp_file, &
                         sdof_file, nsystem_lst, el_system_lst, & !!SSI-AH
                         xr_system_lst, yr_system_lst, zr_system_lst, & 
                            
                         !TESTMODE
                         testmode, ntime_err, time_error, debug, &
                         
                         !INSTABILITY CONTROL
                         b_instabilitycontrol, instability_maxval, &
                         
                         !TEST NOT-HONORING
                         num_testcase, label_testcase
 
  use speed_exit_codes                         
end module speed_timeloop
 
 
 
module qsort_c_module    
 
implicit none
public :: qsortc
private :: partition
 
contains
 
recursive subroutine qsortc(A)
  integer, intent(in out), dimension(:) :: a
  integer :: iq
 
  if(size(a) > 1) then
     call partition(a, iq)
     call qsortc(a(:iq-1))
     call qsortc(a(iq:))
  endif
end subroutine qsortc
 
subroutine partition(A, marker)
  integer, intent(in out), dimension(:) :: a
  integer, intent(out) :: marker
  integer :: i, j
  integer :: temp
  integer :: x      ! pivot point
  x = a(1)
  i= 0
  j= size(a) + 1
 
  do
     j = j-1
     do
        if (a(j) <= x) exit
        j = j-1
     end do
     i = i+1
     do
        if (a(i) >= x) exit
        i = i+1
     end do
     if (i < j) then
        ! exchange A(i) and A(j)
        temp = a(i)
        a(i) = a(j)
        a(j) = temp
     elseif (i == j) then
        marker = i+1
        return
     else
        marker = i
        return
     endif
  end do
 
end subroutine partition
 
end module qsort_c_module
 
 
 
module binarysearch
 
implicit none
public :: binarysearch_real
 
contains
   pure recursive function binarysearch_real(vec, scal, min, max) result (idx)
    ! input parameters
    real*8, intent(in)              :: vec(:)
    real*8, intent(in)              :: scal
    integer, optional, intent(in) :: min
    integer, optional, intent(in) :: max
 
    ! result
    integer           :: idx
 
    !locals
    integer           :: i
    
    ! logic    
    if(.not.present(min)) then
       idx = binarysearch_real(vec,scal, 1, size(vec))
    else
 
       i = ishft(min+max, -1)
       
       !write(*,*) i, scal
       !read(*,*)
       !write(*,*) vec
       !read(*,*)
       
       
       if(scal >= vec(i) .and. scal < vec(i+1)) then
          idx = i
          
       else if( scal < vec(i) ) then
          idx = binarysearch_real(vec,scal, min, ishft(min+max, -1) - 1)
          
       elseif(scal > vec(i)) then
          idx = binarysearch_real(vec,scal, ishft(min+max, -1) + 1, max)
       end if
    end if
  end function binarysearch_real
 
 
end module binarysearch
 
 
 
module speed_sci      !!! AH, SS
 
      implicit none
    
      type system
        integer*4 :: id
 
        real*8 :: tn         
        integer*4 :: ndt, ndof
        real*8 :: dt, dt2    
 
        integer*4 :: structtype   ! 1. SDOF, 2. MDOF
        integer*4 :: const_law
        integer*4 :: sfs
        integer*4 :: forceapplicationtype  ! Apply reactions from Building onto Soil assuming : 1-PointForce, 2-ShearStress over an Area of ground surface
 
        real*8 :: height, floor_h, tend, t2, area, massparea       
        real*8 :: calpha, cbeta
        real*8, dimension (:,:), allocatable :: ms, ks, sysc, ms_inv    
        real*8, dimension(:,:,:), allocatable :: props
        real*8, dimension (:,:), allocatable :: dval
 
        real*8, dimension(4,4) :: mat_m, mat_ks, mat_ki, mat_c, mat_f, mat_mcinv      
        real*8 :: mf, j           ! Foundation Mass, Centroidal Moment of Inertia, Structural Height - For SFS system(?)
        real*8 :: k0, kr, kv      
        real*8 :: beta_newmark, gamma_newmark     
 
        real*8 :: hs, ss          
        real*8 :: csi, cs, c0, cr, cv     
        
        real*8, dimension(4,2) :: u, v, a, f     
        real*8, dimension(2) :: fs, fb  
        
        real*8, dimension(:,:), allocatable :: idr, variidr, intforce     
        real*8, dimension(:,:), allocatable :: maxidr
        real*8, dimension(:,:), allocatable :: mdofet, mdofspd
        real*8, dimension(:,:,:), allocatable :: mdofstatev
        real*8, dimension(:,:), allocatable :: mdofyield, mdofstate, mdofideath
        real*8, dimension(:,:), allocatable :: tempu0,tempu1,tempu,tempa1     
        real*8, dimension(:,:), allocatable :: tempra1     ! Relative Acceleration of lumped mass in SDOF
        
        real*8 :: fy, fh, fu, ey, eh, eu
        integer*4,dimension(3) :: branch, damage
        integer*4 :: flag_minv
      end type system
    
      type(system),allocatable:: sys(:)
      integer*4 :: bldinfo_fp, sdofnum ! SS - deleted common integers i, j; SDOFnum - related to oscillator numbers in SYS.input file
      integer*4:: n_bld                ! SS -  Number of structures - Seen in BLDInfo.txt file - Currently n_bld is non zero only in mpi_id = 0. 
                                       ! i.e. calculations for all the structures is being done only in one processor. Need to fing 
      integer*4 :: maxdof_glob, maxdof_loc
      integer*4, dimension(3) :: sdofout
      integer*4 :: flag_outatalldofs
      logical :: isconfigpresent
      real*8, dimension(:), allocatable :: gr_acc_rot, gr_intf
      real*8, dimension(:), allocatable :: rot_sin, rot_cos
      real*8, dimension(:), allocatable :: ug1, ug2, ug3
      real*8, dimension(:,:), allocatable :: sdofag, sdofgd    !!! ground acc and displ
      real*8,dimension(:), allocatable :: sdofinput, sdofinputd, sdofforceinput
      real*8,dimension(:), allocatable ::  sdofinputbuffer, sdofforceinputbuffer
    
      character*100 :: bldinfo
      character*100 :: sdofdisplx, sdofdisply, sdofdisplz
      character*100 :: sdofgrdisplx, sdofgrdisply, sdofgrdisplz
      character*100 :: sdofaccx, sdofaccy, sdofaccz
      character*100 :: sdofgraccx, sdofgraccy, sdofgraccz
      character*100 :: sdoffx, sdoffy, sdoffz
    
      character*100 :: strdisplx, strdisply
      character*100 :: grddisplx, grddisply, grddisplz
      character*100 :: fnddisplx, fnddisply, fnddisplrx, fnddisplry, fnddisplzx, fnddisplzy
      character*100 :: straccx, straccy
      character*100 :: grdaccx, grdaccy, grdaccz
      character*100 :: fndaccx, fndaccy, fndaccrx, fndaccry, fndacczx, fndacczy
      character*100 :: strfx, strfy, fndfx, fndfy
      character*100 :: intfx, intfy, intfz
    
    end module speed_sci