MAKE_LOAD_MATRIX.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/>.
 
 
      subroutine make_load_matrix()
      
      use max_var
      use speed_par
      
     
      implicit none
 
      include 'SPEED.MPI'      
 
 
     
      if (nfunc.le.0) nfunc = 1
      
 
      allocate (fel(nfunc,3*nnod_loc))
 
 
      call make_extint_forces(nnod_loc,xx_spx_loc,yy_spx_loc,zz_spx_loc,local_node_num,con_nnz_loc,con_spx_loc,&
                    nmat,tag_mat,type_mat,sdeg_mat,tref_mat,prop_mat,&
                    nelem_loc,local_el_num, &
                    alfa11,alfa12,alfa13,alfa21,alfa22,alfa23,&
                    alfa31,alfa32,alfa33,beta11,beta12,beta13,&
                    beta21,beta22,beta23,beta31,beta32,beta33,&
                    gamma1,gamma2,gamma3,delta1,delta2,delta3,&
                    con_nnz_bc_loc,con_spx_bc_loc,&
                    nload_dirx_el,val_dirx_el,fun_dirx_el,tag_dirx_el,&
                    nload_diry_el,val_diry_el,fun_diry_el,tag_diry_el,&
                    nload_dirz_el,val_dirz_el,fun_dirz_el,tag_dirz_el,&
                    nload_neux_el,val_neux_el,fun_neux_el,tag_neux_el,&
                    nload_neuy_el,val_neuy_el,fun_neuy_el,tag_neuy_el,&
                    nload_neuz_el,val_neuz_el,fun_neuz_el,tag_neuz_el,&
                    nload_neun_el,val_neun_el,fun_neun_el,tag_neun_el,&
                    nload_poix_el,val_poix_el,fun_poix_el,&
                    nload_poiy_el,val_poiy_el,fun_poiy_el,&
                    nload_poiz_el,val_poiz_el,fun_poiz_el,&
                    nload_trax_el,val_trax_el,fun_trax_el,&
                    nload_tray_el,val_tray_el,fun_tray_el,&
                    nload_traz_el,val_traz_el,fun_traz_el,&
                    nload_plax_el,val_plax_el,fun_plax_el,tag_plax_el,&
                    nload_play_el,val_play_el,fun_play_el,tag_play_el,&
                    nload_plaz_el,val_plaz_el,fun_plaz_el,tag_plaz_el,&
                    srcmodflag, szsism, &
                    nload_sism_el,val_sism_el,fun_sism_el,tag_sism_el,&
                    nload_expl_el,val_expl_el,fun_expl_el,tag_expl_el,&
                    nload_forx_el,val_forx_el,fun_forx_el,&
                    nload_fory_el,val_fory_el,fun_fory_el,&
                    nload_forz_el,val_forz_el,fun_forz_el,&
                    nload_forc_el,val_forc_el,fun_forc_el,&
                    nload_pres_el,val_pres_el,fun_pres_el,&
                    nload_shea_el,val_shea_el,fun_shea_el,&
                    n_test,fun_test,  & !val_fun_test, &
                    nfunc,tag_func,func_type,func_indx,func_data,nfunc_data,&
                    fel,&  
                    con,nelem,& 
                    length_check_node_sism,&                                 
                    sour_node_sism,max_num_node_sism,num_node_sism,&         
                    factor_seismic_moment,node_index_seq,&                  
                    tau_seismic_moment,&                                
                    length_check_node_expl,&                                 
                    sour_node_expl,max_num_node_expl,num_node_expl,&         
                    factor_explosive_source,&                                  
                    mpi_comm, mpi_np, mpi_id, testmode, &
                    nmat_nhe, rho_nhe, lambda_nhe, mu_nhe)
 
          
          
                ! length_check_node_sism = total number of seismic nodes for each processors 
                
          if (mpi_id.eq.0) write(*,'(A)')'Load matrix built.'
          if (mpi_id.eq.0) write(*,'(A)')
          deallocate(con) 
          
!          do i = 1, nfunc
!             do j = 1, 3*nnod_loc
!                if (Fel(i,j) .ne. 0) then 
!                  print*, i,j, Fel(i,j)
!                endif
!              enddo
!           enddo 
!           read(*,*)
 
!**********************************************************************************************************
!                                  SEISMIC MOMENT                           
!**********************************************************************************************************
!  check_node_sism, check_dist_node_sism are local vector
!  check_node_sism(i,1) = global node index
!  check_node_sism(i,2) = time function number
!  check_node_sism(i,3) = fault number
!  check_node_sism(i,4) = global element index
!  check_dist_node_sism(i,1) = distance from hypocenter
 
      if (nload_sism_el.gt.0) then        
         
      
!         if (mpi_id.eq.0) then
!            write(*,'(A)')'------------------Make Seismic Moment------------------'
!            write(*,*) 'Seismic moment tensor for each sub fault'          
!            do i = 1, nload_sism_el
!               write(*,*) 'Subfault :', i
!              ! write(*,*)'Mxx : ', factor_seismic_moment(i,1)
!               write(*,*) 'Myy : ', factor_seismic_moment(i,2)
!               write(*,*) 'Mzz : ', factor_seismic_moment(i,3)
!               write(*,*) 'Myz : ', factor_seismic_moment(i,4)
!               write(*,*) 'Mzx : ', factor_seismic_moment(i,5)
!               write(*,*) 'Mxy : ', factor_seismic_moment(i,6)
!               write(*,*) 'Target seismic moment : ', val_sism_el(i,20)
!               write(*,*) 'Assigned seismic moment : ', sum(factor_seismic_moment(i,1:6)) 
!               write(*,*) '(Target - Assigned) seismic moment : ', &
!                           val_sism_el(i,20)-sum(factor_seismic_moment(i,1:6))  
!            write(*,*) '----------------------------------------------------------'
!            enddo         
!         endif
    
         allocate (check_node_sism(length_check_node_sism,4))
         allocate (check_dist_node_sism(length_check_node_sism,1))
         allocate (check_pos_sism(length_check_node_sism,3))
      
      
         call check_sism(con_nnz_loc, con_spx_loc,&                        
                         nmat, tag_mat, sdeg_mat, &                          
                         nload_sism_el,&
                         num_node_sism, max_num_node_sism,&        
                         sour_node_sism, dist_sour_node_sism, &  
                         pos_sour_node_x,pos_sour_node_y,pos_sour_node_z,&      
                         check_node_sism, check_dist_node_sism, &        
                         length_check_node_sism,& 
                         check_pos_sism, &               
                         fun_sism_el, nfunc, tag_func, val_sism_el, &
                         nnod_loc, local_node_num, srcmodflag, szsism)
 
! uncomment this to check kinematic source parameters
!          filename = 'SISM00000.dat';
!           if (mpi_id .lt. 10) then                                        
!              write(filename(9:9),'(i1)') mpi_id;
!           else if (mpi_id .lt. 100) then                                
!              write(filename(8:9),'(i2)') mpi_id;                                
!           else if (mpi_id .lt. 1000) then                                
!              write(filename(7:9),'(i3)') mpi_id;                
!           else if (mpi_id .lt. 10000) then                                
!               write(filename(6:9),'(i4)') mpi_id;               
!           endif
 
 
          !write(*,*) mpi_id, filename
!          open(1000+mpi_id, file=filename,position='APPEND')        
            
!          do i = 1, length_check_node_sism
!              ! fault num - node index - coordinates xyz - rise time - rupture time - 
!              write(1000+mpi_id,*) check_node_sism(i,3), check_node_sism(i,1), check_pos_sism(i,1), &
!              check_pos_sism(i,2), check_pos_sism(i,3) , &
!              tau_seismic_moment(check_node_sism(i,3),1), check_dist_node_sism(i,1)
!          enddo
!          
!          close(1000+mpi_id)      
                 
        
         deallocate (sour_node_sism)                                
         deallocate (dist_sour_node_sism)     
         deallocate (pos_sour_node_x,pos_sour_node_y,pos_sour_node_z)                   
 
      endif                                                        
 
!**********************************************************************************************************
!                                  EXPLOSIVE SOURCE                           
!**********************************************************************************************************
!  check_node_expl, check_dist_node_expl are local vector
!  check_node_expl(i,1) = global node index
!  check_node_expl(i,2) = time function number
!  check_node_expl(i,3) = fault number
!  check_node_expl(i,4) = global element index
!  check_dist_node_expl(i,1) = distance from hypocenter
        
      if (nload_expl_el.gt.0) then      
         if (mpi_id.eq.0) write(*,'(A)')'-----------------Make explosive source-----------------'                  
         allocate (check_node_expl(length_check_node_expl,4))                
         allocate (check_dist_node_expl(length_check_node_expl,1))        
      
         call check_expl(con_nnz,con_spx,&                        
                         nmat,tag_mat,sdeg_mat,&                  
                         nload_expl_el,&                        
                         num_node_expl,max_num_node_expl,&        
                         sour_node_expl,dist_sour_node_expl,&        
                         check_node_expl,check_dist_node_expl,&        
                         length_check_node_expl,&                
                         fun_expl_el,nfunc,tag_func,val_expl_el, &
                         nnod_loc, local_node_num)
        
         deallocate (sour_node_expl)                                
         deallocate (dist_sour_node_expl)                        
 
      endif                                                        
 
 
      
      
      end subroutine make_load_matrix