diff --git a/util/psb_gps_mod.f90 b/util/psb_gps_mod.f90 index 33a1d991..35afa751 100644 --- a/util/psb_gps_mod.f90 +++ b/util/psb_gps_mod.f90 @@ -45,8 +45,8 @@ module psb_gps_mod ! private ! common /CC/ XCC,SIZEG,STPT - integer(psb_ipk_), save :: xcc,n,idpth,ideg - integer(psb_ipk_),allocatable,SAVE ::SIZEG(:),STPT(:) + integer(psb_ipk_), save :: xcc,n,idpth,ideg + integer(psb_ipk_),allocatable,SAVE :: SIZEG(:),STPT(:) ! ! COMMON /LVLW/ NHIGH,NLOW,NACUM integer(psb_ipk_),allocatable,target,save :: NHIGH(:),NLOW(:),NACUM(:),AUX(:) @@ -111,18 +111,17 @@ CONTAINS ! USE INTEGER*2 NDSTK WITH AN IBM 360 OR 370. use psb_base_mod implicit none - INTEGER(psb_ipk_) :: NDSTK, NR, IDEGE, IOLD, NDEG, IBW2, IPF2 IDPTHE - INTEGER(psb_ipk_) :: STNODE, RVNODE, RENUM, STNUM, CCSTOR, SBNUM + INTEGER(psb_ipk_) :: NR, IDEGE, IBW2, IPF2, IDPTHE +!!$ INTEGER(psb_ipk_) :: STNODE, RVNODE, RENUM, STNUM, CCSTOR, SBNUM ! COMMON /GRA/ N, IDPTH, IDEG ! IT IS ASSUMED THAT THE GRAPH HAS AT MOST 50 CONNECTED COMPONENTS. ! COMMON /CC/ XCC, SIZEG(50), STPT(50) ! COMMON /LVLW/ NHIGH(100), NLOW(100), NACUM(100) - DIMENSION CCSTOR(NR), IOLD(NR) - DIMENSION NDSTK(NR,IDEGE), LVL(NR), LVLS1(NR), LVLS2(NR), RENUM(NR+1), NDEG(NR) -!!$ integer(psb_ipk_) :: stnode, rvnode, stnum, sbnum -!!$ integer(psb_ipk_) :: ndstk(nr,iedge), iold(nr), renum(nr+1), ndeg(nr) -!!$ integer(psb_ipk_) :: lvl(nr), lvls1(nr), lvls2(nr), ccstor(nr) - + integer(psb_ipk_) :: stnode, rvnode, stnum, sbnum + integer(psb_ipk_) :: ndstk(nr,idege), iold(nr), renum(nr+1), ndeg(nr) + integer(psb_ipk_) :: lvl(nr), lvls1(nr), lvls2(nr), ccstor(nr) + integer(psb_ipk_) :: nflg, info, i, ibw1, ipf1, idflt, isdir, lroot, lowdg + integer(psb_ipk_) :: lvlbot, lvln, lvlwth, maxlw, num n = nr ideg = idege idpth = 0 @@ -226,9 +225,10 @@ CONTAINS ! IT IN THE ARRAY NDEG. THE BANDWIDTH AND PROFILE FOR THE ORIGINAL ! OR INPUT RENUMBERING OF THE GRAPH IS COMPUTED ALSO. ! USE INTEGER*2 NDSTK WITH AN IBM 360 OR 370. - INTEGER(psb_ipk_) :: NDSTK + implicit none + INTEGER(psb_ipk_) :: NR, IBW1, IPF1, NDSTK(NR,IDEG), NDEG(N), IOLD(N) ! COMMON /GRA/ N, IDPTH, IDEG - DIMENSION NDSTK(NR,IDEG), NDEG(N), IOLD(N) + integer(psb_ipk_) :: i, itst, j, idif, irw IBW1 = 0 IPF1 = 0 @@ -261,13 +261,15 @@ CONTAINS ! =1 IF WIDTH OF LVLS1 <= WIDTH OF LVLS2, OTHERWISE =2 ! LVL,IWK- WORKING STORAGE ! USE INTEGER*2 NDSTK WITH AN IBM 360 OR 370. - INTEGER(psb_ipk_) :: NDSTK - INTEGER(psb_ipk_) :: FLAG, SND, SND1, SND2 + implicit none + INTEGER(psb_ipk_) :: FLAG, SND, SND1, SND2, NR, idflt ! COMMON /GRA/ N, IDPTH, IDEG ! IT IS ASSUMED THAT THE LAST LEVEL HAS AT MOST 100 NODES. ! COMMON /CC/ NDLST(100) integer(psb_ipk_),POINTER :: NDLST(:) - DIMENSION NDSTK(NR,IDEG), NDEG(1), LVL(N), LVLS1(N), LVLS2(N),IWK(N) + integer(psb_ipk_) :: NDSTK(NR,IDEG), NDEG(1), LVL(N), LVLS1(N), LVLS2(N),IWK(N) + integer(psb_ipk_) :: i, j, mtw2, ndxn, ndxl, inow, lvlbot,lvln,lvlwth + integer(psb_ipk_) :: k,mtw1, maxlw ! NDLST => AUX ! @@ -337,8 +339,10 @@ CONTAINS ! IBORT- INPUT PARAM WHICH TRIGGERS EARLY RETURN IF ! MAXLW BECOMES >= IBORT ! USE INTEGER*2 NDSTK WITH AN IBM 360 OR 370. - INTEGER(psb_ipk_) :: NDSTK - DIMENSION NDSTK(NR,IDEG), LVL(N), IWK(N), NDEG(N) + implicit none + integer(psb_ipk_) :: IROOT, NR, NDSTK(NR,*), LVL(*), IWK(*), NDEG(*) + integer(psb_ipk_) :: LVLWTH, LVLBOT, LVLN, MAXLW, IBORT + integer(psb_ipk_) :: itest, iwknow, itop, lvltop,j , inow, ndrow MAXLW = 0 ITOP = LVLN INOW = LVLN @@ -372,9 +376,11 @@ CONTAINS ! SORTDG SORTS STK2 BY DEGREE OF THE NODE AND ADDS IT TO THE END ! OF STK1 IN ORDER OF LOWEST TO HIGHEST DEGREE. X1 AND X2 ARE THE ! NUMBER OF NODES IN STK1 AND STK2 RESPECTIVELY. - INTEGER(psb_ipk_) :: X1, X2, STK1, STK2, TEMP + implicit none + INTEGER(psb_ipk_) :: X1, X2, STK1, STK2, TEMP,NDEG ! COMMON /GRA/ N, IDPTH, IDEG DIMENSION NDEG(N), STK1(X1+X2), STK2(X2) + integer(psb_ipk_) :: ind,itest,i,j,istk2,jstk2 IND = X2 10 ITEST = 0 IND = IND - 1 @@ -407,8 +413,9 @@ CONTAINS ! IT IS ASSUMED THAT THERE ARE AT MOST 100 LEVELS. ! COMMON /LVLW/ NHIGH(100), NLOW(100), NACUM(100) use psb_base_mod - DIMENSION LVL(N), LVLS1(N), LVLS2(N) - integer(psb_ipk_) :: SZ + implicit none + integer(psb_ipk_) :: LVL(N), LVLS1(N), LVLS2(N) + integer(psb_ipk_) :: SZ,i,itemp !----------------------------------------------------- SZ=SIZE(NACUM) IF(SZ < IDPTH) THEN @@ -433,10 +440,11 @@ CONTAINS END SUBROUTINE SETUP ! FUNCTION SORT2() result(val) + implicit none INTEGER(psb_ipk_) :: val ! SORT2 SORTS SIZEG AND STPT INTO DESCENDING ORDER ACCORDING TO ! VALUES OF SIZEG. XCC=NUMBER OF ENTRIES IN EACH ARRAY - INTEGER(psb_ipk_) :: TEMP + INTEGER(psb_ipk_) :: TEMP,ind,itest,i,j ! IT IS ASSUMED THAT THE GRAPH HAS AT MOST 50 CONNECTED COMPONENTS. !COMMON /CC/ XCC, SIZEG(50), STPT(50) @@ -464,6 +472,7 @@ CONTAINS ! SUBROUTINE PIKLVL(LVLS1, LVLS2, CCSTOR, IDFLT, ISDIR) use psb_base_mod + implicit none ! PIKLVL CHOOSES THE LEVEL STRUCTURE USED IN NUMBERING GRAPH ! LVLS1- ON INPUT CONTAINS FORWARD LEVELING INFO ! LVLS2- ON INPUT CONTAINS REVERSE LEVELING INFO @@ -478,14 +487,14 @@ CONTAINS ! STPT(I)- INDEX INTO CCSTORE OF 1ST NODE IN ITH CON COMPT ! ISDIR- FLAG WHICH INDICATES WHICH WAY THE LARGEST CONNECTED ! COMPONENT FELL. =+1 IF LOW AND -1 IF HIGH - INTEGER(psb_ipk_) :: CCSTOR, ENDC + INTEGER(psb_ipk_) :: LVLS1(N), LVLS2(N), CCSTOR(N),idflt,isdir ! COMMON /GRA/ N, IDPTH, IDEG ! IT IS ASSUMED THAT THE GRAPH HAS AT MOST 50 COMPONENTS AND ! THAT THERE ARE AT MOST 100 LEVELS. ! COMMON /LVLW/ NHIGH(100), NLOW(100), NACUM(100) ! COMMON /CC/ XCC, SIZEG(50), STPT(50) - DIMENSION LVLS1(N), LVLS2(N), CCSTOR(N) - integer(psb_ipk_) :: SZ + integer(psb_ipk_) :: SZ, ENDC,i,j,idpth,max1,max2,inode + integer(psb_ipk_) :: lvlnh, it, k, lvlnl ! FOR EACH CONNECTED COMPONENT DO DO 80 I=1,XCC J = STPT(I) @@ -551,6 +560,7 @@ CONTAINS SUBROUTINE NUMBER(SND, NUM, NDSTK, LVLS2, NDEG, RENUM, LVLST,LSTPT,& & NR, NFLG, IBW2, IPF2, IPFA, ISDIR) use psb_base_mod + implicit none ! NUMBER PRODUCES THE NUMBERING OF THE GRAPH FOR MIN BANDWIDTH ! SND- ON INPUT THE NODE TO BEGIN NUMBERING ON ! NUM- ON INPUT AND OUTPUT, THE NEXT AVAILABLE NUMBER @@ -566,17 +576,17 @@ CONTAINS ! IPFA- WORKING STORAGE USED TO COMPUTE PROFILE AND BANDWIDTH ! ISDIR- INDICATES STEP DIRECTION USED IN NUMBERING(+1 OR -1) ! USE INTEGER*2 NDSTK WITH AN IBM 360 OR 370. - INTEGER(psb_ipk_) :: NDSTK - INTEGER(psb_ipk_) :: SND, XA, XB, XC, XD, CX, ENDC,RENUM, TEST + INTEGER(psb_ipk_) :: SND, NUM, XA, XB, XC, XD, CX, ENDC, TEST, NR, ISDIR ! COMMON /GRA/ N, IDPTH, IDEG ! THE STORAGE IN COMMON BLOCKS CC AND LVLW IS NOW FREE AND CAN ! BE USED FOR STACKS. !COMMON /LVLW/ STKA(100), STKB(100), STKC(100) !COMMON /CC/ STKD(100) - DIMENSION IPFA(N) - DIMENSION NDSTK(NR,IDEG), LVLS2(N), NDEG(N), RENUM(N+1), LVLST(N),LSTPT(N) + INTEGER(psb_ipk_) :: IPFA(N), NDSTK(NR,IDEG), LVLS2(N),& + & NDEG(N), RENUM(N+1), LVLST(N),LSTPT(N),ipf2,ibw2,nflg, nbw integer(psb_ipk_),POINTER :: STKA(:),STKB(:),STKC(:),STKD(:) - integer(psb_ipk_) :: SZ1,SZ2 + integer(psb_ipk_) :: SZ1,SZ2,i,j,nstpt,lvln, lst, lnd, inx, max, ipro,& + & lvlnl, k, it ! STKA => NHIGH STKB => NLOW