------- Comment #5 from rlnaff at usgs dot gov 2008-11-05 16:08 ------- Subject: Re: compiler Segmentation fault
Compiled with gfortran 4.3.2 (bash) stoch.pts/10% export LAMHF77=/z/stoch/home/rlnaff/usr/local/bin/gfortran4.3.2 (bash) stoch.pts/10% mpif77 -c -fopenmp reorder_parent.f90 reorder_parent.f90:470: internal compiler error: Segmentation fault Please submit a full bug report, with preprocessed source if appropriate. See <http://gcc.gnu.org/bugs.html> for instructions. kargl at gcc dot gnu dot org wrote: > ------- Comment #3 from kargl at gcc dot gnu dot org 2008-11-05 04:10 ------- > Can you attach the code instead of embedded in a message? > > It's a PITA to strip out HTML from your code when I save it as a file. > > > module common_parameters implicit none ! OMPI? include '/usr/include/mpif.h' ! include 'mpif.h' ! ... kv: precision of variables used in assembly integer, parameter :: kv=selected_real_kind(p=10) ! ... common numbers real(kind=kv), parameter :: n0=0.0_kv, n1=1.0_kv, n2=2.0_kv, n3=3.0_kv, & n4=4.0_kv, n5=5.0_kv, n6=6.0_kv, n7=7.0_kv, n8=8.0_kv, n9=9.0_kv, & n10=10.0_kv, n100=100.0_kv ! ... common fractions real(kind=kv), parameter :: f2=0.5_kv, f3=n1/n3, f4=0.25_kv, f5=0.2_kv, & f6=n1/n6, f7=n1/n7, f8=0.125_kv, f9=n1/n9, f10=0.1_kv ! ... machine smallest number real(kind=kv), parameter :: machine_epsilon=epsilon(n0) real(kind=kv), parameter :: small=n100*machine_epsilon real(kind=kv), save :: MZ=tiny(n0) ! ... interim print character(len=32) :: file_name integer :: interim_print, data_print end module common_parameters ! ... File shared_common_parent.f90 ! ... ! ... Version last modified: R.L. Naff, 07/06 ! ... Purpose: Allow for the transfer of information between modules ! ... and subroutines of "parent" type. ! ... ! ... Utilization: use "module name" ! ... ! ... Modules herein: ! ... common_input_types_parent ! ... common_partition_types_parent ! ... common_MPI_types_parent ! ... module common_input_types_parent use common_parameters implicit none integer :: n_x, n_y, n_z end module common_input_types_parent module common_partition_types_parent use common_parameters implicit none integer, save :: max_part, npx, npy, npz integer, save :: ind_rot_rn, dim, no_rows integer, save :: tot_variables integer, save :: no_partitions, red_count, max_C integer, save :: red_part_count, red_node_count, black_node_count integer, save :: max_nodes_A, max_nx, max_ny, max_nz ! ... arrays integer, dimension(:), allocatable :: perm_p, inv_perm_p integer, dimension(:), allocatable :: part_end integer, dimension(:), allocatable :: perm end module common_partition_types_parent module common_reorder_types_parent use common_parameters implicit none integer, dimension(:), allocatable, target :: ii_1, ii_2, ii_3 real(kind=kv), dimension(:), allocatable, target :: C1, C2, C3, & CC_1, CC_2, CC_3, coef end module common_reorder_types_parent module common_MPI_types_parent integer :: pc_intracomm, pc_intra_root end module common_MPI_types_parent module reorder_parent ! ... Version last modified: R.L. Naff, 02/07 ! ... Purpose: reorder stiffness coefficients into partitions and ! ... send coefficients to children (slaves). ! ... ! ... Subroutines herein: ! ... subroutine AC_reorder ! ... Called from subroutine MS_PCG_solve, module MS_PCG_parent ! ... Sends or BCasts to Child: coef, C1, C2, C3, ! ... CC_1, CC_2, CC_3 (surrogates for hcoef, C_x, C_y, C_z ! ... and part_con arrays). ! ... ! ... use omp_lib use common_parameters use common_input_types_parent ! ... n_x, n_y, n_z use common_partition_types_parent use common_reorder_types_parent use common_MPI_types_parent !tmp use utilities_parent !tmp use error_handler ! ... pointer arrays holding incoming coefficients real, save, pointer, dimension(:) :: Cii, Cjj, Ckk, hcoef ! ... Arrays pointed in MS_PCG_solve ! ... contains subroutine AC_reorder(i_bound, ib0_count) ! ... Based on domain partitioning, rearrange coefficients and ! ... assign to a process. ! ... ! ... Argument list ! ... integer, intent(out) :: ib0_count integer, dimension(:), intent(in) :: i_bound ! ... ! ... local variables ! ... integer :: p, i, j, k, ii, jj, kk, i_org, xyz_loc integer :: i_1, i_2, i_3, np1, np2, np3 integer :: d_1s, d_2s, d_3s, i_range=range(n1) integer :: n_1, n_2, n_3, d_1, d_2, d_3 integer :: node, row_ct, level_ct, A_nodes integer :: pn_count, ls1, ls2, ls3, e_1, e_2, e_3 integer :: ierr, error, tag_out, a_size integer :: i11, i22, i33, int_real_type integer, dimension(1:3) :: C_count integer, pointer, dimension(:) :: I_point real(kind=kv) :: C11, C22, C33, t_num real :: one=1.0, neg_one=-1.0 real(kind=kv), pointer, dimension(:) :: R_point character(len=64) :: err_loc_message ! ........................................................................ ! ... allocate work space error=0; t_num=n10**(-i_range/2) nullify (R_point) ! ... call rot_rn(1, n_x, n_x*n_y, e_1, e_2, e_3) ! ... call rot_rn(n_x, n_y, n_z, n_1, n_2, n_3) call rot_rn(npx, npy, npz, np1, np2, np3) d_1s=nint(real(n_1)/np1) d_2s=nint(real(n_2)/np2) d_3s=nint(real(n_3)/np3) ! ... ! ... main partitions ! ... pn_count=0; ib0_count=0 call OMP_SET_NUM_THREADS(4) !$OMP PARALLEL DEFAULT(private) SHARED(no_partitions, ind_rot_rn) & !$OMP SHARED(npx, npy, npz, np1, np2, np3) & !$OMP SHARED(n_1, n_2, n_3, e_1, e_2, e_3, d_1s, d_2s, d_3s) & !$OMP SHARED(inv_perm_p, perm, i_bound, Cii, Cjj, Ckk, hcoef) !$OMP DO do p=1, no_partitions C_count=0 ! ... (ii, jj, kk): regular, x first z last, partition numbering xyz_loc=inv_perm_p(p) kk=(xyz_loc-1)/(npx*npy)+1 jj=(xyz_loc-(kk-1)*npx*npy-1)/npx+1 ii=xyz_loc-(kk-1)*npx*npy-(jj-1)*npx call rot_rn(ii, jj, kk, i_1, i_2, i_3) ! ... d_1=d_1s if (i_1==np1) then d_1=n_1-d_1s*(np1-1) C_count(1)=-1 endif d_2=d_2s if (i_2==np2) then d_2=n_2-d_2s*(np2-1) C_count(2)=-1 endif d_3=d_3s if (i_3==np3) then d_3=n_3-d_3s*(np3-1) C_count(3)=-1 endif ! ... do k=1, d_3 level_ct=d_1*d_2*(k-1) ls3=1 if (k==d_3)then if (i_3==np3) then ! ... external boundary ls3=0 else ! ... internal boundary ls3=2 endif endif do j=1, d_2 row_ct=d_1*(j-1) ls2=1 if (j==d_2) then if (i_2==np2) then ! ... external boundary ls2=0 else ! ... internal boundary ls2=2 endif endif do i=1, d_1 ls1=1 if (i==d_1) then if (i_1==np1) then ! ... external boundary ls1=0 else ! ... internal boundary ls1=2 endif endif node=level_ct+row_ct+i i_org=perm(node+pn_count) ! ... Assign higher precision to coef coef(node)=hcoef(i_org) C11=n0; C22=n0; C33=n0 ! ... Assign higher precision to C11, C22 and C33 ! ... Note: all coefficients on external boundies ! ... assigned null value. if (i_bound(i_org)>0) then if (ls1>0) then if (i_bound(i_org+e_1)/=0) C11=sign(Cii(i_org),one) endif if (ls2>0) then if (i_bound(i_org+e_2)/=0) C22=sign(Cjj(i_org),one) endif if (ls3>0) then if (i_bound(i_org+e_3)/=0) C33=sign(Ckk(i_org),one) endif elseif (i_bound(i_org)==0) then ib0_count=ib0_count+1 else ! ... assign constant-value cells a negative value if (ls1>0) then if (i_bound(i_org+e_1)/=0) C11=sign(Cii(i_org),neg_one) endif if (ls2>0) then if (i_bound(i_org+e_2)/=0) C22=sign(Cjj(i_org),neg_one) endif if (ls3>0) then if (i_bound(i_org+e_3)/=0) C33=sign(Ckk(i_org),neg_one) endif if (C11==n0.and.C22==n0.and.C33==n0) then ! ... If no nonzero coefficients present, then assign ! ... C11 a very small negative number. C11=-t_num; ls1=1 endif endif ! ... Assign values to internal-boundary indicator array. ! ... Value assigned indicates node type across boundary. i11=1; i22=1; i33=1 if (ls1==2) then if (i_bound(i_org+e_1)==0) then i11=0 elseif (i_bound(i_org+e_1)<0) then i11=-1 endif endif if (ls2==2) then if (i_bound(i_org+e_2)==0) then i22=0 elseif (i_bound(i_org+e_2)<0) then i22=-1 endif endif if (ls3==2) then if (i_bound(i_org+e_3)==0) then i33=0 elseif (i_bound(i_org+e_3)<0) then i33=-1 endif endif ! ... Insert final coefficients into C1, C2 and C_ arrays ! ... or into connector coefficient arrays (lsx=2). call insert_coef(C11, C22, C33, i11, i22, i33, node) ! ... enddo enddo enddo ! ... A_nodes=d_1*d_2*d_3 pn_count=pn_count+A_nodes ! xxx if (C_count(1)/=d_2*d_3) print*,'C_count(1)=',C_count(1), & ! xxx ' face value=',d_2*d_3 ! xxx if (C_count(2)/=d_1*d_3) print*,'C_count(2)=',C_count(2), & ! xxx ' face value=',d_1*d_3 ! xxx if (C_count(3)/=d_1*d_2) print*,'C_count(3)=',C_count(3), & ! xxx ' face value=',d_1*d_2 ! ... ! ... Send A partitions to spawned processes ! ... Received in subroutine coef_recv, module PCG_solve_child ! ... tag_out=1211 R_point=>coef(1:A_nodes) call MPI_SSEND(R_point, A_nodes, MPI_DOUBLE_PRECISION, p, & tag_out, pc_intracomm, ierr) call error_class(pc_intracomm, ierr) tag_out=1212 R_point=>C1(1:A_nodes) call MPI_SSEND(R_point, A_nodes, MPI_DOUBLE_PRECISION, p, & tag_out, pc_intracomm, ierr) call error_class(pc_intracomm, ierr) C1=n0 if (dim>1) then tag_out=1213 R_point=>C2(1:A_nodes) call MPI_SSEND(R_point, A_nodes, MPI_DOUBLE_PRECISION, p, & tag_out, pc_intracomm, ierr) call error_class(pc_intracomm, ierr) C2=n0 if (dim>2) then tag_out=1214 R_point=>C3(1:A_nodes) call MPI_SSEND(R_point, A_nodes, MPI_DOUBLE_PRECISION, p, & tag_out, pc_intracomm, ierr) call error_class(pc_intracomm, ierr) C3=n0 endif endif ! ... ! ... Send connectors to partitions ! ... Received in subroutine coef_recv, module PCG_solve_child ! ... if (C_count(1)>0) then err_loc_message='reorder_parent AC_reorder MPI_SEND 1' R_point=>CC_1(1:C_count(1)) I_point=>ii_1(1:C_count(1)) ! ... ! ??? 02/14/07 ! ??? The following MPI structure is malfunctioning for unknown ! ??? reasons; using MPI sends 12150 and 12151 instead. ! ??? 04/04/07 now functioning tag_out=1215 int_real_type=MPI_struct_int_real_array(I_point,R_point) call MPI_SSEND(I_point, 1, int_real_type, p, & tag_out, pc_intracomm, ierr) call error_class(pc_intracomm, ierr, err_loc_message) call MPI_TYPE_FREE(int_real_type,ierr) ! ... ! xxx tag_out=12150 ! xxx call MPI_SEND(I_point, C_count(1), MPI_INTEGER, p, & ! xxx tag_out, pc_intracomm, ierr) ! xxx call error_class(pc_intracomm, ierr, err_loc_message) ! xxx tag_out=12151 ! xxx call MPI_SEND(R_point, C_count(1), MPI_DOUBLE_PRECISION, p, & ! xxx tag_out, pc_intracomm, ierr) ! xxx call error_class(pc_intracomm, ierr, err_loc_message) ! ... CC_1=n0; II_1=0 endif ! ... if (C_count(2)>0) then err_loc_message='reorder_parent AC_reorder MPI_SEND 2' R_point=>CC_2(1:C_count(2)) I_point=>ii_2(1:C_count(2)) ! ... ! ??? 02/14/07 ! ??? The following MPI structure is malfunctioning for unknown ! ??? reasons; using MPI sends 12160 and 12161 instead. ! ??? 04/04/07 now functioning int_real_type=MPI_struct_int_real_array(I_point,R_point) tag_out=1216 call MPI_SSEND(I_point, 1, int_real_type, & p, tag_out, pc_intracomm, ierr) call error_class(pc_intracomm, ierr, err_loc_message) call MPI_TYPE_FREE(int_real_type,ierr) ! ... ! xxx tag_out=12160 ! xxx call MPI_SEND(I_point, C_count(2), MPI_INTEGER, p, & ! xxx tag_out, pc_intracomm, ierr) ! xxx call error_class(pc_intracomm, ierr, err_loc_message) ! xxx tag_out=12161 ! xxx call MPI_SEND(R_point, C_count(2), MPI_DOUBLE_PRECISION, p, & ! xxx tag_out, pc_intracomm, ierr) ! xxx call error_class(pc_intracomm, ierr, err_loc_message) ! ... CC_2=n0; II_2=0 endif ! ... if (C_count(3)>0) then err_loc_message='reorder_parent AC_reorder MPI_SEND 3' R_point=>CC_3(1:C_count(3)) I_point=>ii_3(1:C_count(3)) ! ... ! ??? 02/14/07 ! ??? The following MPI structure is malfunctioning for unknown ! ??? reasons; using MPI sends 12170 and 12171 instead. ! ??? 04/04/07 now functioning tag_out=1217 int_real_type=MPI_struct_int_real_array(I_point,R_point) call MPI_SSEND(I_point, 1, int_real_type, p, & tag_out, pc_intracomm, ierr) call error_class(pc_intracomm, ierr, err_loc_message) call MPI_TYPE_FREE(int_real_type,ierr) ! ... ! xxx tag_out=12170 ! xxx call MPI_SEND(I_point, C_count(3), MPI_INTEGER, p, & ! xxx tag_out, pc_intracomm, ierr) ! xxx call error_class(pc_intracomm, ierr, err_loc_message) ! xxx tag_out=12171 ! xxx call MPI_SEND(R_point, C_count(3), MPI_DOUBLE_PRECISION, p, & ! xxx tag_out, pc_intracomm, ierr) ! xxx call error_class(pc_intracomm, ierr, err_loc_message) ! ... CC_3=n0; II_3=0 endif nullify (I_point, R_point) ! ... if (p<no_partitions) then C1=n0; C2=n0; C3=n0 ! xxx ii_1=1; ii_2=1; ii_1=1; CC_1=n0; CC_2=n0; CC_3=n0 endif enddo ! end outer partition loop !$OMP END DO !$OMP END PARALLEL nullify (R_point) ! ... contains ! ... subroutine insert_coef(C11,C22,C33,i11,i22,i33,node) ! ... ! ... Argument list ! ... real(kind=kv), intent(in) :: C11,C22,C33 integer, intent(in) :: i11,i22,i33 integer, intent(in) :: node ! ...................................................... ! ... if (dim>2) then ! ... 3-D if (ls1==1) then C1(node)=C11 elseif (ls1==2) then C_count(1)=C_count(1)+1 CC_1(C_count(1))=C11 ii_1(C_count(1))=i11 endif if (ls2==1) then C2(node)=C22 elseif (ls2==2) then C_count(2)=C_count(2)+1 CC_2(C_count(2))=C22 ii_2(C_count(2))=i22 endif if (ls3==1) then C3(node)=C33 elseif (ls3==2) then C_count(3)=C_count(3)+1 CC_3(C_count(3))=C33 ii_3(C_count(3))=i33 endif elseif (dim>1) then ! ... 2-D slice if (ls1==1) then C1(node)=C11 elseif (ls1==2) then C_count(1)=C_count(1)+1 CC_1(C_count(1))=C11 ii_1(C_count(1))=i11 endif if (ls2==1) then C2(node)=C22 elseif (ls2==2) then C_count(2)=C_count(2)+1 CC_2(C_count(2))=C22 ii_2(C_count(2))=i22 endif else ! ... 1-D if (ls1==1) then C1(node)=C11 elseif (ls1==2) then C_count(1)=C_count(1)+1 CC_1(C_count(1))=C11 ii_1(C_count(1))=i11 endif endif ! ... end subroutine insert_coef ! ... end subroutine AC_reorder function MPI_struct_int_real_array(indx,value) result(type_int_real) ! ... Purpose: Build an MPI structure consisting of an integer array and ! ... a double precision real array. ! ... Explicit interface required: assumed-shape arrays INDX and VALUE. ! ... ! ... argument list ! ... integer, dimension(:) :: indx real(kind=kv), dimension(:) :: value ! ... ! ... result ! ... integer :: type_int_real ! ... ! ... local variables ! ... integer, dimension(1:2) :: blks, types, displs integer :: ierr, i_size, v_size, start_address, address character(len=64) :: err_loc_message= & 'PCG_solve_child MPI_struct_int_real_array MPI_TYPE_COMMIT 1' ! ....................................................................... type_int_real=0 i_size=size(indx); v_size=size(value) blks=(/i_size, v_size/) types=(/MPI_INTEGER, MPI_DOUBLE_PRECISION/) displs(1)=0 call MPI_ADDRESS(indx(1), start_address, ierr) call MPI_ADDRESS(value(1), address, ierr) displs(2)=address-start_address call MPI_TYPE_STRUCT(2, blks, displs, types, type_int_real, ierr) call MPI_TYPE_COMMIT(type_int_real,ierr) call error_class(pc_intracomm, ierr, err_loc_message) ! ... end function MPI_struct_int_real_array end module reorder_parent -- http://gcc.gnu.org/bugzilla/show_bug.cgi?id=37644