OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sana_reordertree.F File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine smumps_reorder_tree (n, frere, step, fils, na, lna, ne, nd, dad, ldad, use_dad, nsteps, perm, sym, info, lp, k215, k234, k55, k199, procnode, slavef, peak, sbtr_which_m)
subroutine smumps_build_load_mem_info (n, frere, step, fils, na, lna, ne, nd, dad, ldad, use_dad, nsteps, perm, sym, info, lp, k47, k81, k76, k215, k234, k55, keep199, procnode, mem_subtree, slavef, size_mem_sbtr, peak, sbtr_which_m, size_depth_first, size_cost_trav, depth_first_trav, depth_first_seq, cost_trav, my_first_leaf, my_nb_leaf, my_root_sbtr, sbtr_id)
recursive subroutine smumps_fusion_sort (tab, dim, tab1, tab2, perm, result, temp1, temp2)

Function/Subroutine Documentation

◆ smumps_build_load_mem_info()

subroutine smumps_build_load_mem_info ( integer n,
integer, dimension(nsteps) frere,
integer, dimension(n) step,
integer, dimension(n) fils,
integer, dimension(lna) na,
integer lna,
integer, dimension(nsteps) ne,
integer, dimension(nsteps) nd,
integer, dimension(ldad) dad,
integer ldad,
logical use_dad,
integer nsteps,
integer perm,
integer sym,
integer, dimension(80) info,
integer lp,
integer k47,
integer k81,
integer k76,
integer k215,
integer k234,
integer k55,
integer keep199,
integer, dimension(nsteps) procnode,
double precision, dimension(size_mem_sbtr,slavef), intent(out) mem_subtree,
integer slavef,
integer size_mem_sbtr,
real peak,
integer sbtr_which_m,
integer size_depth_first,
integer size_cost_trav,
integer, dimension(size_depth_first) depth_first_trav,
integer, dimension(size_depth_first) depth_first_seq,
real, dimension(size_cost_trav) cost_trav,
integer, dimension(size_mem_sbtr,slavef) my_first_leaf,
integer, dimension(size_mem_sbtr,slavef) my_nb_leaf,
integer, dimension(size_mem_sbtr,slavef) my_root_sbtr,
integer, dimension(size_depth_first) sbtr_id )

Definition at line 730 of file sana_reordertree.F.

738 IMPLICIT NONE
739 INTEGER N,PERM,SYM, NSTEPS, LNA, LP, SIZE_MEM_SBTR,LDAD
740 INTEGER FRERE(NSTEPS), FILS(N), STEP(N)
741 INTEGER NA(LNA), NE(NSTEPS), ND(NSTEPS)
742 INTEGER K47,K81,K76,K215,K234,K55,KEEP199
743 INTEGER DAD(LDAD)
744 LOGICAL USE_DAD
745 INTEGER INFO(80)
746 INTEGER SLAVEF,PROCNODE(NSTEPS)
747 DOUBLE PRECISION, intent(out) :: MEM_SUBTREE(SIZE_MEM_SBTR,SLAVEF)
748 INTEGER :: SBTR_WHICH_M
749 INTEGER MY_FIRST_LEAF(SIZE_MEM_SBTR,SLAVEF),
750 & MY_ROOT_SBTR(SIZE_MEM_SBTR,SLAVEF),
751 & MY_NB_LEAF(SIZE_MEM_SBTR,SLAVEF)
752 EXTERNAL mumps_rootssarbr,mumps_procnode
753 LOGICAL MUMPS_ROOTSSARBR
754 INTEGER MUMPS_PROCNODE
755 REAL PEAK
756 INTEGER SIZE_DEPTH_FIRST,DEPTH_FIRST_TRAV(SIZE_DEPTH_FIRST),
757 & DEPTH_FIRST_SEQ(SIZE_DEPTH_FIRST)
758 INTEGER SIZE_COST_TRAV
759 INTEGER SBTR_ID(SIZE_DEPTH_FIRST),OOC_CUR_SBTR
760 REAL COST_TRAV(SIZE_COST_TRAV)
761 INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH
762 INTEGER IFATH,IN,INODE,I,allocok,LOCAL_PERM
763 INTEGER(8) NELIM,NFR
764 INTEGER NFR4,NELIM4
765 INTEGER LEAF,NBLEAF,NBROOT, SIZE_TAB
766 INTEGER, DIMENSION (:), ALLOCATABLE :: IPOOL,TNSTK
767 INTEGER, DIMENSION (:), ALLOCATABLE,TARGET :: SON,TEMP
768 INTEGER(8), DIMENSION (:), ALLOCATABLE :: M,M_TOTAL, fact
769 INTEGER(8), DIMENSION (:), ALLOCATABLE :: TAB1,TAB2
770 INTEGER x,dernier,fin,RANK_TRAV
771 INTEGER II
772 INTEGER ROOT_OF_CUR_SBTR
773 INTEGER(8), DIMENSION (:), ALLOCATABLE :: T1,T2
774 INTEGER, DIMENSION (:), ALLOCATABLE :: RESULT
775 INTEGER(8) MEM_SIZE,FACT_SIZE,
776 & TOTAL_MEM_SIZE,
777 & SIZECB
778 LOGICAL SBTR_M
779 INTEGER,DIMENSION(:),ALLOCATABLE :: INDICE
780 INTEGER ID,FIRST_LEAF,SIZE_SBTR
781 EXTERNAL mumps_in_or_root_ssarbr,mumps_inssarbr
782 LOGICAL MUMPS_IN_OR_ROOT_SSARBR,MUMPS_INSSARBR
783 DOUBLE PRECISION COST_NODE
784 INTEGER CUR_DEPTH_FIRST_RANK
785 include 'mumps_headers.h'
786 total_mem_size=0_8
787 root_of_cur_sbtr=0
788 ALLOCATE(indice( slavef ), stat=allocok)
789 IF (allocok > 0) THEN
790 IF ( lp .GT. 0 )
791 & WRITE(lp,*)'Memory allocation error in
792 &SMUMPS_REORDER_TREE'
793 info(1)=-7
794 info(2)=slavef
795 RETURN
796 ENDIF
797 IF((perm.EQ.0).OR.(perm.EQ.1).OR.
798 & (perm.EQ.2).OR.(perm.EQ.3).OR.(perm.EQ.4).OR.
799 & (perm.EQ.5).OR.(perm.EQ.6))THEN
800 local_perm=0
801 ENDIF
802 IF (k47 == 4 .OR. ((k47.GE.2).AND.(k81.GE. 1))) THEN
803 DO i=1,slavef
804 indice(i)=1
805 ENDDO
806 DO i=1,slavef
807 DO x=1,size_mem_sbtr
808 mem_subtree(x,i)=-1.0d0
809 ENDDO
810 ENDDO
811 ENDIF
812 sbtr_m=((k47 == 4 .OR. ((k47.GE.2).AND.(k81 .GE. 1))))
813 mem_size=0_8
814 fact_size=0_8
815 IF ((perm.GT.7).AND.
816 & (.NOT.(k47 == 4 .OR. ((k47.GE.2).AND.(k81 .GE. 1))))) THEN
817 WRITE(*,*) "Internal Error in SMUMPS_REORDER_TREE",perm
818 CALL mumps_abort()
819 END IF
820 nbleaf = na(1)
821 nbroot = na(2)
822 cur_depth_first_rank=1
823 IF((perm.EQ.0).AND.(nbroot.EQ.nbleaf)) THEN
824 DEALLOCATE(indice)
825 RETURN
826 ENDIF
827 IF (sbtr_m.OR.(perm.EQ.2)) THEN
828 IF((sbtr_which_m.EQ.1).AND.(perm.NE.1))THEN
829 ALLOCATE(m_total(nsteps), stat=allocok )
830 IF (allocok > 0) THEN
831 IF ( lp .GT. 0 )
832 & WRITE(lp,*)'Memory allocation error in
833 & SMUMPS_REORDER_TREE'
834 info(1)=-7
835 info(2)=nsteps
836 RETURN
837 ENDIF
838 ENDIF
839 ENDIF
840 ALLOCATE( ipool(nbleaf), m(nsteps), fact(nsteps),
841 & tnstk(nsteps), stat=allocok )
842 IF (allocok > 0) THEN
843 IF ( lp .GT. 0 )
844 & WRITE(lp,*)'Memory allocation error in SMUMPS_REORDER_TREE'
845 info(1)=-7
846 info(2)=nsteps
847 RETURN
848 ENDIF
849 ii=0
850 DO i=1,nsteps
851 tnstk(i) = ne(i)
852 IF(ne(i).GE.ii) ii=ne(i)
853 ENDDO
854 size_tab=max(ii,nbroot)
855 ALLOCATE(son(ii), temp(ii),
856 & tab1(size_tab), tab2(size_tab), stat=allocok )
857 IF (allocok > 0) THEN
858 IF ( lp .GT. 0 )
859 & WRITE(lp,*)'Memory allocation error in SMUMPS_REORDER_TREE'
860 info(1)=-7
861 info(2)=nsteps
862 RETURN
863 ENDIF
864 ALLOCATE(t1(size_tab),t2(size_tab),
865 & result(size_tab),stat=allocok)
866 IF (allocok > 0) THEN
867 IF ( lp .GT. 0 )
868 & WRITE(lp,*)'Memory allocation error in SMUMPS_REORDER_TREE'
869 info(1)=-7
870 info(2)=size_tab
871 RETURN
872 ENDIF
873 IF(nbroot.EQ.nbleaf)THEN
874 IF((perm.NE.1).OR.(perm.EQ.4).OR.(perm.EQ.6))THEN
875 WRITE(*,*)'Internal Error in reordertree:'
876 WRITE(*,*)' problem with perm parameter in reordertree'
877 CALL mumps_abort()
878 ENDIF
879 DO i=1,nbroot
880 tab1(i)=int(nd(step(na(i+2+nbleaf))),8)
881 ipool(i)=na(i+2+nbleaf)
882 m(step(ipool(i)))=tab1(i)*tab1(i)
883 ENDDO
884 CALL smumps_fusion_sort(na(2+nbleaf+1),nbroot,tab1,tab2,4,
885 & result,t1,t2)
886 GOTO 789
887 ENDIF
888 IF((perm.EQ.3).OR.(perm.EQ.4))THEN
889 ALLOCATE(depth(nsteps),stat=allocok)
890 IF (allocok > 0) THEN
891 IF ( lp .GT. 0 )
892 & WRITE(lp,*)'Memory allocation error in
893 & SMUMPS_REORDER_TREE'
894 info(1)=-7
895 info(2)=nsteps
896 RETURN
897 ENDIF
898 depth=0
899 nbroot = na(2)
900 ipool(1:nbroot) = na(3+nbleaf:2+nbleaf+nbroot)
901 fin=nbroot
902 leaf=na(1)
903 499 CONTINUE
904 inode=ipool(fin)
905 IF(inode.LT.0)THEN
906 WRITE(*,*)'Internal Error in reordertree INODE < 0 !'
907 CALL mumps_abort()
908 ENDIF
909 in=inode
910 4602 in = fils(in)
911 IF (in .GT. 0 ) THEN
912 GOTO 4602
913 ENDIF
914 in=-in
915 DO i=1,ne(step(inode))
916 son(i)=in
917 in=frere(step(in))
918 ENDDO
919 DO i=1,ne(step(inode))
920 ipool(fin)=son(i)
921 depth(step(son(i)))=depth(step(inode))+1
922 son(i)=0
923 fin=fin+1
924 ENDDO
925 IF(ne(step(inode)).EQ.0)THEN
926 leaf=leaf-1
927 ELSE
928 fin=fin-1
929 GOTO 499
930 ENDIF
931 fin=fin-1
932 IF(fin.EQ.0) GOTO 489
933 GOTO 499
934 489 CONTINUE
935 ENDIF
936 IF(k76.EQ.4.OR.(k76.EQ.6))THEN
937 rank_trav=nsteps
938 depth_first_trav=0
939 depth_first_seq=0
940 ENDIF
941 IF((k76.EQ.5).OR.(perm.EQ.5).OR.(perm.EQ.6))THEN
942 cost_trav=0.0e0
943 cost_node=0.0d0
944 ENDIF
945 DO i=1,nsteps
946 m(i)=0_8
947 IF (sbtr_m.OR.(perm.EQ.2)) THEN
948 IF((sbtr_which_m.EQ.1).AND.(perm.NE.1))THEN
949 m_total(i)=0_8
950 ENDIF
951 ENDIF
952 ENDDO
953 DO i=1,nsteps
954 fact(i)=0_8
955 ENDDO
956 nbroot = na(2)
957 nbleaf = na(1)
958 ipool(1:nbroot) = na(3+nbleaf:2+nbleaf+nbroot)
959 CONTINUE
960 fin=nbroot
961 leaf=na(1)
962 first_leaf=-9999
963 size_sbtr=0
964 999 CONTINUE
965 inode=ipool(fin)
966 IF(inode.LT.0)THEN
967 WRITE(*,*)'Internal Error in reordertree INODE < 0 !'
968 CALL mumps_abort()
969 ENDIF
970 IF(size_sbtr.NE.0)THEN
971 IF(.NOT.mumps_inssarbr(procnode(step(inode)),keep199))THEN
972 IF ( k47 == 4 .OR. ((k81.GE.1).AND.(k47.GE.2))) THEN
973 IF((slavef.NE.1))THEN
974 my_first_leaf(indice(id+1)-1,id+1)=first_leaf
975 my_nb_leaf(indice(id+1)-1,id+1)=size_sbtr
976 first_leaf=-9999
977 size_sbtr=0
978 ENDIF
979 ENDIF
980 ENDIF
981 ENDIF
982 IF(mumps_rootssarbr(procnode(step(inode)),keep199))THEN
983 root_of_cur_sbtr=inode
984 ENDIF
985 IF (k76.EQ.4)THEN
986 IF(slavef.NE.1)THEN
987 WRITE(*,*)'INODE=',inode,'RANK',rank_trav
988 IF(mumps_inssarbr(procnode(step(inode)),keep199))THEN
989 depth_first_trav(step(inode))=depth_first_trav(step(
990 & root_of_cur_sbtr))
991 ELSE
992 depth_first_trav(step(inode))=rank_trav
993 ENDIF
994 rank_trav=rank_trav-1
995 ENDIF
996 ENDIF
997 IF (k76.EQ.5)THEN
998 IF(slavef.NE.1)THEN
999 IF (use_dad) THEN
1000 ifath=dad(inode)
1001 ELSE
1002 in = inode
1003 395 in = frere(in)
1004 IF (in.GT.0) GO TO 395
1005 ifath = -in
1006 ENDIF
1007 nfr4 = nd(step(inode))
1008 nfr = int(nfr4,8)
1009 nelim4 = 0
1010 in = inode
1011 396 nelim4 = nelim4 + 1
1012 in = fils(in)
1013 IF (in .GT. 0 ) GOTO 396
1014 nelim=int(nelim4,8)
1015 IF((sym.EQ.0).OR.(k215.NE.0))THEN
1016 sizecb=(nfr-nelim)*(nfr-nelim)
1017 ELSE
1018 sizecb=(nfr-nelim)*(nfr-nelim+1_8)/2_8
1019 ENDIF
1020 CALL mumps_get_flops_cost(nfr4,nelim4,nelim4,
1021 & sym,1,cost_node)
1022 IF(ifath.NE.0)THEN
1023 IF(mumps_inssarbr(procnode(step(inode)),keep199))THEN
1024 cost_trav(step(inode))=cost_trav(step(
1025 & root_of_cur_sbtr))
1026 ELSE
1027 cost_trav(step(inode))=real(cost_node)+
1028 & cost_trav(step(ifath))+
1029 & real(sizecb*18_8)
1030 ENDIF
1031 ELSE
1032 cost_trav(step(inode))=real(cost_node)
1033 ENDIF
1034 IF(k76.EQ.5)THEN
1035 WRITE(*,*)'INODE=',inode,'COST=',cost_trav(step(inode))
1036 ENDIF
1037 ENDIF
1038 ENDIF
1039 IF ( k47 == 4 .OR. ((k81.GE.1).AND.(k47.GE.2))) THEN
1040 IF((slavef.NE.1).AND.
1041 & mumps_rootssarbr(procnode(step(inode)),keep199))THEN
1042 IF (ne(step(inode)).NE.0) THEN
1043 id=mumps_procnode(procnode(step(inode)),keep199)
1044 IF((sbtr_which_m.EQ.1).AND.(perm.NE.1))THEN
1045 mem_subtree(indice(id+1),id+1)=
1046 & dble(m_total(step(inode)))
1047 ELSE
1048 mem_subtree(indice(id+1),id+1)=
1049 & dble(m(step(inode)))
1050 ENDIF
1051 my_root_sbtr(indice(id+1),id+1)=inode
1052 indice(id+1)=indice(id+1)+1
1053 ENDIF
1054 ENDIF
1055 IF((slavef.EQ.1).AND.frere(step(inode)).EQ.0)THEN
1056 id=mumps_procnode(procnode(step(inode)),keep199)
1057 IF((sbtr_which_m.EQ.1).AND.(perm.NE.1))THEN
1058 mem_subtree(indice(id+1),id+1)=
1059 & dble(m_total(step(inode)))
1060 ELSE
1061 mem_subtree(indice(id+1),id+1)=
1062 & dble(m(step(inode)))
1063 ENDIF
1064 indice(id+1)=indice(id+1)+1
1065 ENDIF
1066 ENDIF
1067 in=inode
1068 5602 in = fils(in)
1069 IF (in .GT. 0 ) THEN
1070 dernier=in
1071 GOTO 5602
1072 ENDIF
1073 in=-in
1074 DO i=1,ne(step(inode))
1075 ipool(fin)=in
1076 IF(in.GT.0) in=frere(step(in))
1077 fin=fin+1
1078 ENDDO
1079 IF(ne(step(inode)).EQ.0)THEN
1080 IF ( k47 == 4 .OR. ((k81.GE.1).AND.(k47.GE.2))) THEN
1081 IF(slavef.NE.1)THEN
1082 IF(mumps_inssarbr(procnode(step(inode)),keep199))THEN
1083 IF(first_leaf.EQ.-9999)THEN
1084 first_leaf=inode
1085 ENDIF
1086 size_sbtr=size_sbtr+1
1087 ENDIF
1088 ENDIF
1089 ENDIF
1090 IF(perm.NE.7)THEN
1091 na(leaf+2)=inode
1092 ENDIF
1093 leaf=leaf-1
1094 ELSE
1095 fin=fin-1
1096 GOTO 999
1097 ENDIF
1098 fin=fin-1
1099 IF(fin.EQ.0) THEN
1100 IF(size_sbtr.NE.0)THEN
1101 IF ( k47 == 4 .OR. ((k81.GE.1).AND.(k47.GE.2))) THEN
1102 IF((slavef.NE.1))THEN
1103 my_first_leaf(indice(id+1)-1,id+1)=first_leaf
1104 my_nb_leaf(indice(id+1)-1,id+1)=size_sbtr
1105 first_leaf=-9999
1106 size_sbtr=0
1107 ENDIF
1108 ENDIF
1109 ENDIF
1110 GOTO 789
1111 ENDIF
1112 GOTO 999
1113 789 CONTINUE
1114 IF(k76.EQ.6)THEN
1115 ooc_cur_sbtr=1
1116 DO i=1,nsteps
1117 tnstk(i) = ne(i)
1118 ENDDO
1119 nbroot=na(2)
1120 nbleaf=na(1)
1121 ipool(1:nbleaf)=na(3:2+nbleaf)
1122 leaf = nbleaf + 1
1123 9100 CONTINUE
1124 IF (leaf.NE.1) THEN
1125 leaf = leaf -1
1126 inode = ipool(leaf)
1127 ENDIF
1128 9600 CONTINUE
1129 IF(slavef.NE.1)THEN
1130 id=mumps_procnode(procnode(step(inode)),keep199)
1131 depth_first_trav(step(inode))=cur_depth_first_rank
1132 depth_first_seq(cur_depth_first_rank)=inode
1133 cur_depth_first_rank=cur_depth_first_rank+1
1134 IF(mumps_in_or_root_ssarbr(procnode(step(inode)),
1135 & keep199))THEN
1136 sbtr_id(step(inode))=ooc_cur_sbtr
1137 ELSE
1138 sbtr_id(step(inode))=-9999
1139 ENDIF
1140 IF(mumps_rootssarbr(procnode(step(inode)),
1141 & keep199))THEN
1142 ooc_cur_sbtr=ooc_cur_sbtr+1
1143 ENDIF
1144 ENDIF
1145 IF (use_dad) THEN
1146 ifath = dad( step(inode) )
1147 ELSE
1148 in = inode
1149 1133 in = frere(in)
1150 IF (in.GT.0) GO TO 1133
1151 ifath = -in
1152 ENDIF
1153 IF (ifath.EQ.0) THEN
1154 nbroot = nbroot - 1
1155 IF (nbroot.EQ.0) GOTO 1163
1156 GOTO 9100
1157 ENDIF
1158 tnstk(step(ifath))=tnstk(step(ifath))-1
1159 IF(tnstk(step(ifath)).EQ.0) THEN
1160 inode=ifath
1161 GOTO 9600
1162 ELSE
1163 GOTO 9100
1164 ENDIF
1165 1163 CONTINUE
1166 ENDIF
1167 peak=0.0e0
1168 fact_size=0_8
1169 DO i=1,nbroot
1170 peak=max(peak,real(m(step(na(2+nbleaf+i)))))
1171 fact_size=fact_size+fact(step(na(2+nbleaf+i)))
1172 ENDDO
1173 CONTINUE
1174 DEALLOCATE(ipool)
1175 DEALLOCATE(m)
1176 DEALLOCATE(fact)
1177 DEALLOCATE(tnstk)
1178 DEALLOCATE(son)
1179 DEALLOCATE(tab2)
1180 DEALLOCATE(tab1)
1181 DEALLOCATE(t1)
1182 DEALLOCATE(t2)
1183 DEALLOCATE(result)
1184 DEALLOCATE(temp)
1185 DEALLOCATE(indice)
1186 IF((perm.EQ.3).OR.(perm.EQ.4))THEN
1187 DEALLOCATE(depth)
1188 ENDIF
1189 IF (sbtr_m.OR.(perm.EQ.2)) THEN
1190 IF((sbtr_which_m.EQ.1).AND.(perm.NE.1).OR.(perm.EQ.2))THEN
1191 DEALLOCATE(m_total)
1192 ENDIF
1193 ENDIF
1194 RETURN
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
mumps_get_flops_cost
subroutine mumps_get_flops_cost(nfront, npiv, nass, keep50, level, cost)
Definition estim_flops.F:74
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
smumps_fusion_sort
recursive subroutine smumps_fusion_sort(tab, dim, tab1, tab2, perm, result, temp1, temp2)
Definition sana_reordertree.F:1198
mumps_in_or_root_ssarbr
logical function mumps_in_or_root_ssarbr(procinfo_inode, k199)
Definition tools_common.F:214
mumps_rootssarbr
logical function mumps_rootssarbr(procinfo_inode, k199)
Definition tools_common.F:189
mumps_inssarbr
logical function mumps_inssarbr(procinfo_inode, k199)
Definition tools_common.F:201
mumps_procnode
integer function mumps_procnode(procinfo_inode, k199)
Definition tools_common.F:151

◆ smumps_fusion_sort()

recursive subroutine smumps_fusion_sort ( integer, dimension(dim) tab,
integer dim,
integer(8), dimension(dim) tab1,
integer(8), dimension(dim) tab2,
integer perm,
integer, dimension(dim) result,
integer(8), dimension(dim) temp1,
integer(8), dimension(dim) temp2 )

Definition at line 1196 of file sana_reordertree.F.

1198 IMPLICIT NONE
1199 INTEGER DIM
1200 INTEGER(8) TAB1(DIM),TAB2(DIM)
1201 INTEGER(8) TEMP1(DIM),TEMP2(DIM)
1202 INTEGER TAB(DIM), PERM,RESULT(DIM)
1203 INTEGER I,J,I1,I2
1204 IF(dim.EQ.1) THEN
1205 result(1)=tab(1)
1206 temp1(1)=tab1(1)
1207 temp2(1)=tab2(1)
1208 RETURN
1209 ENDIF
1210 i=dim/2
1211 CALL smumps_fusion_sort(tab(1),i,tab1(1),tab2(1),perm,
1212 & result(1),temp1(1),temp2(1))
1213 CALL smumps_fusion_sort(tab(i+1),dim-i,tab1(i+1),tab2(i+1),
1214 & perm,result(i+1),temp1(i+1),temp2(i+1))
1215 i1=1
1216 i2=i+1
1217 j=1
1218 DO WHILE ((i1.LE.i).AND.(i2.LE.dim))
1219 IF((perm.EQ.3))THEN
1220 IF(temp1(i1).LE.temp1(i2))THEN
1221 tab(j)=result(i1)
1222 tab1(j)=temp1(i1)
1223 j=j+1
1224 i1=i1+1
1225 ELSE
1226 tab(j)=result(i2)
1227 tab1(j)=temp1(i2)
1228 j=j+1
1229 i2=i2+1
1230 ENDIF
1231 GOTO 3
1232 ENDIF
1233 IF((perm.EQ.4).OR.(perm.EQ.5))THEN
1234 IF (temp1(i1).GE.temp1(i2))THEN
1235 tab(j)=result(i1)
1236 tab1(j)=temp1(i1)
1237 j=j+1
1238 i1=i1+1
1239 ELSE
1240 tab(j)=result(i2)
1241 tab1(j)=temp1(i2)
1242 j=j+1
1243 i2=i2+1
1244 ENDIF
1245 GOTO 3
1246 ENDIF
1247 IF((perm.EQ.0).OR.(perm.EQ.1).OR.(perm.EQ.2)) THEN
1248 IF(temp1(i1).GT.temp1(i2))THEN
1249 tab1(j)=temp1(i1)
1250 tab2(j)=temp2(i1)
1251 tab(j)=result(i1)
1252 j=j+1
1253 i1=i1+1
1254 GOTO 3
1255 ENDIF
1256 IF(temp1(i1).LT.temp1(i2))THEN
1257 tab1(j)=temp1(i2)
1258 tab2(j)=temp2(i2)
1259 tab(j)=result(i2)
1260 j=j+1
1261 i2=i2+1
1262 GOTO 3
1263 ENDIF
1264 IF((temp1(i1).EQ.temp1(i2)))THEN
1265 IF(temp2(i1).LE.temp2(i2))THEN
1266 tab1(j)=temp1(i1)
1267 tab2(j)=temp2(i1)
1268 tab(j)=result(i1)
1269 j=j+1
1270 i1=i1+1
1271 ELSE
1272 tab1(j)=temp1(i2)
1273 tab2(j)=temp2(i2)
1274 tab(j)=result(i2)
1275 j=j+1
1276 i2=i2+1
1277 ENDIF
1278 ENDIF
1279 ENDIF
1280 3 CONTINUE
1281 ENDDO
1282 IF(i1.GT.i)THEN
1283 DO WHILE(i2.LE.dim)
1284 tab(j)=result(i2)
1285 tab1(j)=temp1(i2)
1286 tab2(j)=temp2(i2)
1287 j=j+1
1288 i2=i2+1
1289 ENDDO
1290 ELSE
1291 IF(i2.GT.dim)THEN
1292 DO WHILE(i1.LE.i)
1293 tab1(j)=temp1(i1)
1294 tab2(j)=temp2(i1)
1295 tab(j)=result(i1)
1296 j=j+1
1297 i1=i1+1
1298 ENDDO
1299 ENDIF
1300 ENDIF
1301 DO i=1,dim
1302 temp1(i)=tab1(i)
1303 temp2(i)=tab2(i)
1304 result(i)=tab(i)
1305 ENDDO
1306 RETURN

◆ smumps_reorder_tree()

subroutine smumps_reorder_tree ( integer n,
integer, dimension(nsteps) frere,
integer, dimension(n) step,
integer, dimension(n) fils,
integer, dimension(lna) na,
integer lna,
integer, dimension(nsteps) ne,
integer, dimension(nsteps) nd,
integer, dimension(ldad) dad,
integer ldad,
logical use_dad,
integer nsteps,
integer perm,
integer sym,
integer, dimension(80) info,
integer lp,
integer k215,
integer k234,
integer k55,
integer k199,
integer, dimension(nsteps) procnode,
integer slavef,
real peak,
integer sbtr_which_m )

Definition at line 14 of file sana_reordertree.F.

19 IMPLICIT NONE
20 INTEGER N,PERM,SYM, NSTEPS, LNA, LP,LDAD
21 INTEGER FRERE(NSTEPS), FILS(N), STEP(N)
22 INTEGER NA(LNA), NE(NSTEPS), ND(NSTEPS)
23 INTEGER K215,K234,K55,K199
24 INTEGER DAD(LDAD)
25 LOGICAL USE_DAD
26 INTEGER INFO(80)
27 INTEGER SLAVEF,PROCNODE(NSTEPS)
28 INTEGER :: SBTR_WHICH_M
29 EXTERNAL mumps_procnode
30 INTEGER MUMPS_PROCNODE
31 REAL PEAK
32 REAL, DIMENSION(:), ALLOCATABLE :: COST_TRAV
33 INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH
34 INTEGER IFATH,IN,NSTK,INODE,I,allocok,LOCAL_PERM
35 INTEGER(8) NCB
36 INTEGER(8) NELIM,NFR
37 INTEGER NFR4,NELIM4
38 INTEGER LEAF,NBLEAF,NBROOT, SIZE_TAB
39 INTEGER, DIMENSION (:), ALLOCATABLE :: IPOOL,TNSTK
40 INTEGER, DIMENSION (:), ALLOCATABLE,TARGET :: SON,TEMP
41 INTEGER(8), DIMENSION (:), ALLOCATABLE :: M,M_TOTAL, fact
42 INTEGER(8), DIMENSION (:), ALLOCATABLE :: TAB1,TAB2
43 INTEGER, DIMENSION (:), POINTER :: TAB
44 INTEGER dernier,fin
45 INTEGER cour,II
46 INTEGER CB_current,CB_MAX,ROOT_OF_CUR_SBTR
47 INTEGER(8), DIMENSION (:), ALLOCATABLE :: T1,T2
48 INTEGER, DIMENSION (:), ALLOCATABLE :: RESULT
49 INTEGER(8) MEM_SIZE,FACT_SIZE,SUM,MEM_SEC_PERM,FACT_SIZE_T,
50 & MEM_SIZE_T,TOTAL_MEM_SIZE,TMP_TOTAL_MEM_SIZE,TMP_SUM,
51 & SIZECB, SIZECB_LASTSON
52 INTEGER(8) TMP8
53 LOGICAL SBTR_M
54 INTEGER FIRST_LEAF,SIZE_SBTR
55 EXTERNAL mumps_in_or_root_ssarbr,mumps_inssarbr
56 LOGICAL MUMPS_IN_OR_ROOT_SSARBR,MUMPS_INSSARBR
57 DOUBLE PRECISION COST_NODE
58 include 'mumps_headers.h'
59 TOTAL_MEM_SIZE=0_8
60 ROOT_OF_CUR_SBTR=0
61.EQ..OR..EQ..OR. IF((PERM0)(PERM1)
62.EQ..OR..EQ..OR..EQ..OR. & (PERM2)(PERM3)(PERM4)
63.EQ..OR..EQ. & (PERM5)(PERM6))THEN
64 LOCAL_PERM=0
65 ENDIF
66 SBTR_M=.FALSE.
67 MEM_SIZE=0_8
68 FACT_SIZE=0_8
69.LT..OR..GT. IF ((PERM0 PERM7)) THEN
70 WRITE(*,*) "Internal Error in SMUMPS_REORDER_TREE",PERM
71 CALL MUMPS_ABORT()
72 END IF
73 NBLEAF = NA(1)
74 NBROOT = NA(2)
75.EQ..AND..EQ. IF((PERM0)(NBROOTNBLEAF)) RETURN
76.NE..AND..OR..EQ. IF ((PERM7)(SBTR_M(PERM2))) THEN
77.EQ..AND..NE. IF((SBTR_WHICH_M1)(PERM1))THEN
78 ALLOCATE(M_TOTAL(NSTEPS), stat=allocok )
79 IF (allocok > 0) THEN
80.GT. IF ( LP 0 )
81 & WRITE(LP,*)'memory allocation error in
82 & smumps_reorder_tree'
83 INFO(1)=-7
84 INFO(2)=NSTEPS
85 RETURN
86 ENDIF
87 ENDIF
88 ENDIF
89.NE. IF(PERM7)THEN
90 ALLOCATE(M(NSTEPS),stat=allocok )
91 IF (allocok > 0) THEN
92.GT. IF ( LP 0 )
93 & WRITE(LP,*)'memory allocation error
94 &in smumps_reorder_tree'
95 INFO(1)=-7
96 INFO(2)=NSTEPS
97 RETURN
98 ENDIF
99 ENDIF
100 ALLOCATE( IPOOL(NBLEAF), fact(NSTEPS),TNSTK(NSTEPS),
101 & stat=allocok )
102 IF (allocok > 0) THEN
103.GT. IF ( LP 0 )
104 & WRITE(LP,*)'memory allocation error in smumps_reorder_tree'
105 INFO(1)=-7
106 INFO(2)=NSTEPS
107 RETURN
108 ENDIF
109 II=0
110 DO I=1,NSTEPS
111 TNSTK(I) = NE(I)
112.GE. IF(NE(I)II) II=NE(I)
113 ENDDO
114 SIZE_TAB=max(II,NBROOT)
115 ALLOCATE(SON(II), TEMP(II),
116 & TAB1(SIZE_TAB), TAB2(SIZE_TAB), stat=allocok )
117 IF (allocok > 0) THEN
118.GT. IF ( LP 0 )
119 & WRITE(LP,*)'memory allocation error in smumps_reorder_tree'
120 INFO(1)=-7
121 INFO(2)=NSTEPS
122 RETURN
123 ENDIF
124 ALLOCATE(T1(SIZE_TAB),T2(SIZE_TAB),
125 & RESULT(SIZE_TAB),stat=allocok)
126 IF (allocok > 0) THEN
127.GT. IF ( LP 0 )
128 & WRITE(LP,*)'memory allocation error in smumps_reorder_tree'
129 INFO(1)=-7
130 INFO(2)=SIZE_TAB
131 RETURN
132 ENDIF
133.EQ. IF(PERM7) THEN
134 GOTO 001
135 ENDIF
136.EQ..OR..EQ. IF((PERM5)(PERM6))THEN
137 ALLOCATE(COST_TRAV(NSTEPS), stat=allocok )
138 IF (allocok > 0) THEN
139.GT. IF ( LP 0 )
140 & WRITE(LP,*)'memory allocation error
141 & in smumps_reorder_tree'
142 INFO(1)=-7
143 INFO(2)=NSTEPS
144 RETURN
145 ENDIF
146 COST_TRAV=0.0E0
147 COST_NODE=0.0d0
148 ENDIF
149.EQ. IF(NBROOTNBLEAF)THEN
150.NE..OR..EQ..OR..EQ. IF((PERM1)(PERM4)(PERM6))THEN
151 WRITE(*,*)'internal error in reordertree:'
152 WRITE(*,*)' problem with perm parameter in reordertree'
153 CALL MUMPS_ABORT()
154 ENDIF
155 DO I=1,NBROOT
156 TAB1(I)=int(ND(STEP(NA(I+2+NBLEAF))),8)
157 IPOOL(I)=NA(I+2+NBLEAF)
158 M(STEP(IPOOL(I)))=TAB1(I)*TAB1(I)
159 ENDDO
160 CALL SMUMPS_FUSION_SORT(NA(2+NBLEAF+1),NBROOT,TAB1,TAB2,4,
161 & RESULT,T1,T2)
162 GOTO 789
163 ENDIF
164.EQ..OR..EQ. IF((PERM3)(PERM4))THEN
165 ALLOCATE(DEPTH(NSTEPS),stat=allocok)
166 IF (allocok > 0) THEN
167.GT. IF ( LP 0 )
168 & WRITE(LP,*)'memory allocation error in
169 & smumps_reorder_tree'
170 INFO(1)=-7
171 INFO(2)=NSTEPS
172 RETURN
173 ENDIF
174 DEPTH=0
175 NBROOT = NA(2)
176 IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT)
177 fin=NBROOT
178 LEAF=NA(1)
179 499 CONTINUE
180 INODE=IPOOL(fin)
181.LT. IF(INODE0)THEN
182 WRITE(*,*)'internal error in reordertree inode < 0 !'
183 CALL mumps_abort()
184 ENDIF
185 in=inode
186 4602 in = fils(in)
187 IF (in .GT. 0 ) THEN
188 GOTO 4602
189 ENDIF
190 in=-in
191 DO i=1,ne(step(inode))
192 son(i)=in
193 in=frere(step(in))
194 ENDDO
195 DO i=1,ne(step(inode))
196 ipool(fin)=son(i)
197 depth(step(son(i)))=depth(step(inode))+1
198 son(i)=0
199 fin=fin+1
200 ENDDO
201 IF(ne(step(inode)).EQ.0)THEN
202 leaf=leaf-1
203 ELSE
204 fin=fin-1
205 GOTO 499
206 ENDIF
207 fin=fin-1
208 IF(fin.EQ.0) GOTO 489
209 GOTO 499
210 489 CONTINUE
211 ENDIF
212 DO i=1,nsteps
213 m(i)=0_8
214 IF (sbtr_m.OR.(perm.EQ.2)) THEN
215 IF((sbtr_which_m.EQ.1).AND.(perm.NE.1))THEN
216 m_total(i)=0_8
217 ENDIF
218 ENDIF
219 ENDDO
220 DO i=1,nsteps
221 fact(i)=0_8
222 ENDDO
223 ipool(1:nbleaf)=na(3:2+nbleaf)
224 leaf = nbleaf + 1
225 91 CONTINUE
226 IF (leaf.NE.1) THEN
227 leaf = leaf -1
228 inode = ipool(leaf)
229 ENDIF
230 96 CONTINUE
231 nfr = int(nd(step(inode)),8)
232 nstk = ne(step(inode))
233 nelim4 = 0
234 in = inode
235 101 nelim4 = nelim4 + 1
236 in = fils(in)
237 IF (in .GT. 0 ) GOTO 101
238 nelim=int(nelim4,8)
239 IF(ne(step(inode)).EQ.0) THEN
240 m(step(inode))=nfr*nfr
241 IF (sbtr_m.OR.(perm.EQ.2)) THEN
242 m_total(step(inode))=nfr*nfr
243 ENDIF
244 ENDIF
245 IF((perm.EQ.4).OR.(perm.EQ.3))THEN
246 IF(mumps_in_or_root_ssarbr(procnode(step(inode)),
247 & k199))THEN
248 depth(step(inode))=0
249 ENDIF
250 ENDIF
251 IF ( sym .eq. 0 ) THEN
252 fact(step(inode))=fact(step(inode))+
253 & (2_8*nfr*nelim)-(nelim*nelim)
254 ELSE
255 fact(step(inode))=fact(step(inode))+nfr*nelim
256 ENDIF
257 IF (use_dad) THEN
258 ifath = dad( step(inode) )
259 ELSE
260 in = inode
261 113 in = frere(in)
262 IF (in.GT.0) GO TO 113
263 ifath = -in
264 ENDIF
265 IF (ifath.EQ.0) THEN
266 nbroot = nbroot - 1
267 IF (nbroot.EQ.0) GOTO 116
268 GOTO 91
269 ELSE
270 fact(step(ifath))=fact(step(ifath))+fact(step(inode))
271 IF((perm.EQ.3).OR.(perm.EQ.4))THEN
272 depth(step(ifath))=max(depth(step(inode)),
273 & depth(step(ifath)))
274 ENDIF
275 ENDIF
276 tnstk(step(ifath)) = tnstk(step(ifath)) - 1
277 IF ( tnstk(step(ifath)) .EQ. 0 ) THEN
278 inode = ifath
279 in=inode
280 dernier=in
281 i=1
282 5700 in = fils(in)
283 IF (in .GT. 0 ) THEN
284 dernier=in
285 i=i+1
286 GOTO 5700
287 ENDIF
288 ncb=int(nd(step(inode))-i,8)
289 in=-in
290 IF(perm.NE.7)THEN
291 DO i=1,ne(step(inode))
292 son(i)=in
293 temp(i)=in
294 IF(in.GT.0) in=frere(step(in))
295 ENDDO
296 ELSE
297 DO i=ne(step(inode)),1,-1
298 son(i)=in
299 temp(i)=in
300 IF(in.GT.0) in=frere(step(in))
301 ENDDO
302 ENDIF
303 nfr = int(nd(step(inode)),8)
304 DO ii=1,ne(step(inode))
305 tab1(ii)=0_8
306 tab2(ii)=0_8
307 cour=son(ii)
308 nelim4=1
309 151 cour=fils(cour)
310 IF(cour.GT.0) THEN
311 nelim4=nelim4+1
312 GOTO 151
313 ENDIF
314 nelim=int(nelim4,8)
315 IF((sym.EQ.0).OR.(k215.NE.0)) THEN
316 sizecb=(int(nd(step(son(ii))),8)-nelim)
317 & *(int(nd(step(son(ii))),8)-nelim)
318 ELSE
319 sizecb=(int(nd(step(son(ii))),8)-nelim)
320 & *(int(nd(step(son(ii))),8)-
321 & nelim+1_8)/2_8
322 ENDIF
323 IF((perm.EQ.0).OR.(perm.EQ.5))THEN
324 IF (k234 .NE. 0 .AND. k55.EQ.0 ) THEN
325 tmp8=nfr
326 tmp8=tmp8*tmp8
327 tab1(ii)=max(tmp8, m(step(son(ii)))) - sizecb
328 tab2(ii)=sizecb
329 ELSE
330 tab1(ii)=m(step(son(ii)))- sizecb
331 tab2(ii)=sizecb
332 ENDIF
333 ENDIF
334 IF((perm.EQ.1).OR.(perm.EQ.6)) THEN
335 tab1(ii)=m(step(son(ii)))-sizecb
336 tab1(ii)=tab1(ii)-fact(step(son(ii)))
337 tab2(ii)=sizecb+fact(step(son(ii)))
338 ENDIF
339 IF(perm.EQ.2)THEN
340 IF (mumps_in_or_root_ssarbr(procnode(step(inode)),
341 & k199))THEN
342 tab1(ii)=m_total(step(son(ii)))-sizecb
343 & -fact(step(son(ii)))
344 tab2(ii)=sizecb
345 ELSE
346 tab1(ii)=m(step(son(ii)))-sizecb
347 tab2(ii)=sizecb
348 ENDIF
349 ENDIF
350 IF(perm.EQ.3)THEN
351 IF (mumps_in_or_root_ssarbr(procnode(step(inode)),
352 & k199))THEN
353 tab1(ii)=m(step(son(ii)))-sizecb
354 tab2(ii)=sizecb
355 ELSE
356 tab1(ii)=int(depth(step(son(ii))),8)
357 tab2(ii)=m(step(son(ii)))
358 ENDIF
359 ENDIF
360 IF(perm.EQ.4)THEN
361 IF (mumps_in_or_root_ssarbr(procnode(step(inode)),
362 & k199))THEN
363 tab1(ii)=m(step(son(ii)))-
364 & sizecb-fact(step(son(ii)))
365 tab2(ii)=sizecb
366 ELSE
367 tab1(ii)=int(depth(step(son(ii))),8)
368 tab2(ii)=m(step(son(ii)))
369 ENDIF
370 ENDIF
371 ENDDO
372 CALL smumps_fusion_sort(son,ne(step(inode)),tab1,tab2,
373 & local_perm
374 & ,result,t1,t2)
375 IF(perm.EQ.0) THEN
376 DO ii=1,ne(step(inode))
377 cour=temp(ii)
378 nelim4=1
379 153 cour=fils(cour)
380 IF(cour.GT.0) THEN
381 nelim4=nelim4+1
382 GOTO 153
383 ENDIF
384 nelim=int(nelim4,8)
385 IF((sym.EQ.0).OR.(k215.NE.0))THEN
386 sizecb=(int(nd(step(temp(ii))),8)-nelim)*
387 & (int(nd(step(temp(ii))),8)-nelim)
388 ELSE
389 sizecb=(int(nd(step(temp(ii))),8)-nelim)*
390 & (int(nd(step(temp(ii))),8)-nelim+1_8)/2_8
391 ENDIF
392 tab1(ii)=sizecb
393 ENDDO
394 CALL smumps_fusion_sort(temp,ne(step(inode)),tab1,tab2,3,
395 & result,t1,t2)
396 ENDIF
397 IF(perm.EQ.1) THEN
398 DO ii=1,ne(step(inode))
399 cour=temp(ii)
400 nelim4=1
401 187 cour=fils(cour)
402 IF(cour.GT.0) THEN
403 nelim4=nelim4+1
404 GOTO 187
405 ENDIF
406 nelim=int(nelim4,8)
407 IF((sym.EQ.0).OR.(k215.NE.0))THEN
408 sizecb=(int(nd(step(temp(ii))),8)-nelim)*
409 & (int(nd(step(temp(ii))),8)-nelim)
410 ELSE
411 sizecb=(int(nd(step(temp(ii))),8)-nelim)*
412 & (int(nd(step(temp(ii))),8)-nelim+1_8)/2_8
413 ENDIF
414 tab1(ii)=sizecb+fact(step(temp(ii)))
415 ENDDO
416 CALL smumps_fusion_sort(temp,ne(step(inode)),tab1,tab2,3,
417 & result,t1,t2)
418 ENDIF
419 CONTINUE
420 ifath=inode
421 DO ii=1,2
422 sum=0_8
423 fact_size=0_8
424 fact_size_t=0_8
425 mem_size=0_8
426 mem_size_t=0_8
427 cb_max=0
428 cb_current=0
429 tmp_sum=0_8
430 IF(ii.EQ.1) tab=>son
431 IF(ii.EQ.2) tab=>temp
432 DO i=1,ne(step(inode))
433 cour=tab(i)
434 nelim4=1
435 149 cour=fils(cour)
436 IF(cour.GT.0) THEN
437 nelim4=nelim4+1
438 GOTO 149
439 ENDIF
440 nelim=int(nelim4, 8)
441 nfr=int(nd(step(tab(i))),8)
442 IF((sym.EQ.0).OR.(k215.NE.0))THEN
443 sizecb=(nfr-nelim)*(nfr-nelim)
444 ELSE
445 sizecb=(nfr-nelim)*(nfr-nelim+1_8)/2_8
446 ENDIF
447 mem_size=max(mem_size,(m(step(tab(i)))+sum+fact_size))
448 IF (sbtr_m.OR.(perm.EQ.2)) THEN
449 mem_size_t=max(mem_size_t,(m_total(step(tab(i)))+
450 & sum+
451 & fact_size_t))
452 fact_size_t=fact_size_t+fact(step(tab(i)))
453 ENDIF
454 total_mem_size=max(total_mem_size,
455 & (m(step(tab(i)))+sum+fact_size))
456 tmp_sum=tmp_sum+fact(step(tab(i)))
457 sum=sum+sizecb
458 sizecb_lastson = sizecb
459 IF((perm.EQ.1).OR.(perm.EQ.4))THEN
460 fact_size=fact_size+fact(step(tab(i)))
461 ENDIF
462 ENDDO
463 IF((sym.EQ.0).OR.(k215.NE.0))THEN
464 sizecb=ncb*ncb
465 ELSE
466 sizecb=(ncb*(ncb+1_8))/2_8
467 ENDIF
468 IF (k234.NE.0 .AND. k55.EQ.0) THEN
469 total_mem_size=max(total_mem_size,
470 & ( ( int(nd(step(ifath)),8)
471 & * int(nd(step(ifath)),8) )
472 & + sum-sizecb_lastson+tmp_sum )
473 & )
474 ELSE IF (k234.NE.0 .AND. k55.NE.0) THEN
475 total_mem_size=max(total_mem_size,
476 & ( ( int(nd(step(ifath)),8)
477 & * int(nd(step(ifath)),8) )
478 & + sum + tmp_sum )
479 & )
480 ELSE
481 total_mem_size=max(total_mem_size,
482 & ( ( int(nd(step(ifath)),8)
483 & * int(nd(step(ifath)),8))
484 & + max(sum,sizecb) + tmp_sum )
485 & )
486 ENDIF
487 IF(ii.EQ.1)THEN
488 tmp_total_mem_size=total_mem_size
489 ENDIF
490 IF(ii.EQ.1)THEN
491 IF (k234.NE.0 .AND. k55.EQ.0) THEN
492 m(step(ifath))=max(mem_size,((int(nd(step(ifath)),8)
493 & *int(nd(step(ifath)),8))+sum-sizecb_lastson+
494 & fact_size))
495 ELSE IF (k234.NE.0 .AND. k55.NE.0) THEN
496 m(step(ifath))=max(mem_size,((int(nd(step(ifath)),8)
497 & *int(nd(step(ifath)),8))+sum+fact_size))
498 ELSE
499 m(step(ifath))=max(mem_size,((int(nd(step(ifath)),8)
500 & *int(nd(step(ifath)),8))+max(sum,sizecb)+fact_size))
501 ENDIF
502 IF (sbtr_m.OR.(perm.EQ.2)) THEN
503 m_total(step(ifath))=max(mem_size_t,
504 & ((int(nd(step(ifath)),8)
505 & *int(nd(step(ifath)),8))+max(sum,sizecb)+
506 & fact_size_t))
507 ENDIF
508 ENDIF
509 IF((ii.EQ.2).AND.(perm.EQ.1).OR.(perm.EQ.0).OR.
510 & (perm.EQ.5).OR.(perm.EQ.6).OR.
511 & (.NOT.sbtr_m.OR.(sbtr_which_m.NE.1)))THEN
512 mem_sec_perm=max(mem_size,((int(nd(step(ifath)),8)
513 & *int(nd(step(ifath)),8))+max(sum,sizecb)+fact_size))
514 ENDIF
515 IF((perm.EQ.2).OR.(perm.EQ.3).OR.(perm.EQ.4))THEN
516 mem_sec_perm=huge(mem_sec_perm)
517 ENDIF
518 ENDDO
519 IF(mem_sec_perm.EQ.m(step(ifath))) THEN
520 tab=>temp
521 ELSE IF (mem_sec_perm.LT.m(step(ifath))) THEN
522 WRITE(*,*)'Internal error 1 in SMUMPS_REORDER_TREE',
523 & mem_sec_perm, m(step(ifath))
524 CALL mumps_abort()
525 ELSE
526 total_mem_size=tmp_total_mem_size
527 tab=>son
528 ENDIF
529 DO i=ne(step(inode)),1,-1
530 IF(i.EQ.ne(step(inode))) THEN
531 fils(dernier)=-tab(i)
532 dernier=tab(i)
533 GOTO 222
534 ENDIF
535 IF(i.EQ.1) THEN
536 frere(step(dernier))=tab(i)
537 frere(step(tab(i)))=-inode
538 GOTO 222
539 ENDIF
540 IF(i.GT.1) THEN
541 frere(step(dernier))=tab(i)
542 dernier=tab(i)
543 GOTO 222
544 ENDIF
545 222 CONTINUE
546 ENDDO
547 GOTO 96
548 ELSE
549 GOTO 91
550 ENDIF
551 116 CONTINUE
552 nbroot = na(2)
553 ipool(1:nbroot) = na(3+nbleaf:2+nbleaf+nbroot)
554 IF (perm.eq.1) THEN
555 DO i=1,nbroot
556 tab1(i)=m(step(na(i+2+nbleaf)))-fact(step(na(i+2+nbleaf)))
557 tab1(i)=-tab1(i)
558 ENDDO
559 CALL smumps_fusion_sort(na(2+nbleaf+1),nbroot,tab1,tab2,4,
560 & result,t1,t2)
561 ipool(1:nbroot) = na(3+nbleaf:2+nbleaf+nbroot)
562 ENDIF
563 001 CONTINUE
564 fin=nbroot
565 leaf=na(1)
566 first_leaf=-9999
567 size_sbtr=0
568 999 CONTINUE
569 inode=ipool(fin)
570 IF(inode.LT.0)THEN
571 WRITE(*,*)'Internal Error in reordertree INODE < 0 !'
572 CALL mumps_abort()
573 ENDIF
574 in=inode
575 5602 in = fils(in)
576 IF (in .GT. 0 ) THEN
577 dernier=in
578 GOTO 5602
579 ENDIF
580 in=-in
581 IF((perm.EQ.5).OR.(perm.EQ.6))THEN
582 IF(slavef.NE.1)THEN
583 IF (use_dad) THEN
584 ifath=dad(inode)
585 ELSE
586 in = inode
587 395 in = frere(in)
588 IF (in.GT.0) GO TO 395
589 ifath = -in
590 ENDIF
591 nfr4 = nd(step(inode))
592 nfr = int(nfr4,8)
593 nelim4 = 0
594 in = inode
595 396 nelim4 = nelim4 + 1
596 in = fils(in)
597 IF (in .GT. 0 ) GOTO 396
598 nelim=int(nelim4,8)
599 IF((sym.EQ.0).OR.(k215.NE.0))THEN
600 sizecb=(nfr-nelim)*(nfr-nelim)
601 ELSE
602 sizecb=(nfr-nelim)*(nfr-nelim+1_8)/2_8
603 ENDIF
604 CALL mumps_get_flops_cost(nfr4,nelim4,nelim4,
605 & sym,1,cost_node)
606 IF(ifath.NE.0)THEN
607 IF(mumps_inssarbr(procnode(step(inode)),k199))THEN
608 cost_trav(step(inode))=cost_trav(step(
609 & root_of_cur_sbtr))
610 ELSE
611 cost_trav(step(inode))=real(cost_node)+
612 & cost_trav(step(ifath))+
613 & real(sizecb*18_8)
614 ENDIF
615 ELSE
616 cost_trav(step(inode))=real(cost_node)
617 ENDIF
618 ENDIF
619 ENDIF
620 DO i=1,ne(step(inode))
621 temp(i)=in
622 IF((perm.EQ.5).OR.(perm.EQ.6))THEN
623 IF((slavef.NE.1).AND.(.NOT.mumps_in_or_root_ssarbr(
624 & procnode(step(inode)),k199)))THEN
625 nfr4 = nd(step(inode))
626 nfr = int(nfr4,8)
627 nelim4 = 0
628 ii = temp(i)
629 845 nelim4 = nelim4 + 1
630 ii = fils(ii)
631 IF (ii .GT. 0 ) GOTO 845
632 nelim=int(nelim4,8)
633 CALL mumps_get_flops_cost(nfr4,nelim4,nelim4,
634 & sym,1,cost_node)
635 tab1(i)=int(real(cost_node)+
636 & cost_trav(step(inode)),8)
637 tab2(i)=0_8
638 ELSE
639 son(i)=in
640 ENDIF
641 ELSE
642 son(i)=in
643 ENDIF
644 in=frere(step(in))
645 ENDDO
646 IF((perm.EQ.5).OR.(perm.EQ.6))THEN
647 IF((slavef.NE.1).AND.(.NOT.mumps_in_or_root_ssarbr(
648 & procnode(step(inode)),k199)))THEN
649 CALL smumps_fusion_sort(temp,ne(step(inode)),tab1,tab2,
650 & local_perm
651 & ,result,t1,t2)
652 tab=>temp
653 DO i=ne(step(inode)),1,-1
654 IF(i.EQ.ne(step(inode))) THEN
655 fils(dernier)=-tab(i)
656 dernier=tab(i)
657 GOTO 221
658 ENDIF
659 IF(i.EQ.1) THEN
660 frere(step(dernier))=tab(i)
661 frere(step(tab(i)))=-inode
662 GOTO 221
663 ENDIF
664 IF(i.GT.1) THEN
665 frere(step(dernier))=tab(i)
666 dernier=tab(i)
667 GOTO 221
668 ENDIF
669 221 CONTINUE
670 son(ne(step(inode))-i+1)=tab(i)
671 ENDDO
672 ENDIF
673 ENDIF
674 DO i=1,ne(step(inode))
675 ipool(fin)=son(i)
676 son(i)=0
677 fin=fin+1
678 ENDDO
679 IF(ne(step(inode)).EQ.0)THEN
680 IF(perm.NE.7)THEN
681 na(leaf+2)=inode
682 ENDIF
683 leaf=leaf-1
684 ELSE
685 fin=fin-1
686 GOTO 999
687 ENDIF
688 fin=fin-1
689 IF(fin.EQ.0) THEN
690 GOTO 789
691 ENDIF
692 GOTO 999
693 789 CONTINUE
694 IF(perm.EQ.7) GOTO 5483
695 nbroot=na(2)
696 nbleaf=na(1)
697 peak=0.0e0
698 fact_size=0_8
699 DO i=1,nbroot
700 peak=max(peak,real(m(step(na(2+nbleaf+i)))))
701 fact_size=fact_size+fact(step(na(2+nbleaf+i)))
702 ENDDO
703 5483 CONTINUE
704 DEALLOCATE(ipool)
705 DEALLOCATE(fact)
706 DEALLOCATE(tnstk)
707 DEALLOCATE(son)
708 DEALLOCATE(tab2)
709 DEALLOCATE(tab1)
710 DEALLOCATE(t1)
711 DEALLOCATE(t2)
712 DEALLOCATE(result)
713 DEALLOCATE(temp)
714 IF(perm.NE.7)THEN
715 DEALLOCATE(m)
716 ENDIF
717 IF((perm.EQ.3).OR.(perm.EQ.4))THEN
718 DEALLOCATE(depth)
719 ENDIF
720 IF((perm.EQ.5).OR.(perm.EQ.6))THEN
721 DEALLOCATE(cost_trav)
722 ENDIF
723 IF ((perm.NE.7).AND.(sbtr_m.OR.(perm.EQ.2))) THEN
724 IF((sbtr_which_m.EQ.1).AND.(perm.NE.1).OR.(perm.EQ.2))THEN
725 DEALLOCATE(m_total)
726 ENDIF
727 ENDIF
728 RETURN
smumps_reorder_tree
subroutine smumps_reorder_tree(n, frere, step, fils, na, lna, ne, nd, dad, ldad, use_dad, nsteps, perm, sym, info, lp, k215, k234, k55, k199, procnode, slavef, peak, sbtr_which_m)
Definition sana_reordertree.F:19