SUBROUTINE WRINF4(NOR,LOC,ALPHA,BETA,BETAPI,LAMBDA, NU,POINTR,S,PMAX) USE Numeric_Kinds_Module ! ! $RCSfile: wrinf4.f,v $ $Revision: 1.3 $ ! $Date: 89/07/28 09:57:51 $ ! $State: Stable $ ! ! ! ********************************************************************** ! ! PURPOSE - ! ! WRITES INFORMATION FOR MSGLVL=4. ! ! INPUT PARAMETERS - ! ! NOR = NUMBER OF THE ROUTINE CALLING WRINFO. ! LOC = THE LOCATION IN THAT ROUTINE. ! ! PLEASE SEE THE PROGRAMMERS GUIDE FOR INFORMATION ABOUT ! PARAMETERS NOT EXPLAINED ABOVE, AND FOR MORE DETAILS ABOUT ! THE FUNCTION OF THE ROUTINE. ! ! ! ********************************************************************** ! INTEGER PMAX REAL(Kind=WP_Kind) STIME1(8), STIME2(8), STIME3(8), A, ALPHA(1), ALTMU, B, BETA(1), BETAPI(1), CK, CL, & COEFF, FACTOR, FTCONV, LAMBDA(1), SRELPR, MU, NEXTMU, NU(1), OLDMU, RDUMP, S(PMAX,1), SECOND, SMALL, TEMP, & TIME, TIMTQL, TLDL, TOLBPI, TOLLDL, TOLPDM, TOLS1I, TOLZBT, TOLZNU, TOPINV, TOPM, TPRED, TSAVE, TSTLM, & TVECOP, WRR INTEGER ACTIVE, ADDRSS, CNEG, CNEGF, CONV, COPT, COUNT, CPOS, D, DAFILE, DUMMY, ERRNO, I, & IDUMP, ITERNO, J, J1, J2, J3, K, KFILE, LEFTP, LENADR, LOC, LP, M, MAXIW, MAXL, MAXREC, MAXW, MSGLVL, MV, & MXNEW, MXOLD, MXREST, MXRST, N, NBADMU, NIL, NMXRST, NOR, NREAD, NUMEIG, NUMVEC, NWRITE, OLCPOS, P, & PERCNT(8), PFCONV, PMAX1, POINTR(1), POPT, PVADR, REST, RFIRST, RIGHTC, RIGHTM, RIGHTP, RNEW, ROLD, SCPX, & SOLCPX, STADEW, TCONV, NERR , NOUT , V, VER, WAD, WRI, X LOGICAL DIAGM, MEQI, SAFRST, UPDATE, USEMX, WRL, ZERBET COMMON /STLMAD/ ADDRSS, DAFILE, KFILE, LP, MAXL, NREAD, NWRITE COMMON /STLMCT/ N, ITERNO, TCONV, CNEG, CPOS, OLCPOS, RNEW, ROLD, REST, P, USEMX, ZERBET COMMON /STLMDS/ K, M, D, DIAGM COMMON /STLMER/ RDUMP, ERRNO, IDUMP(2) COMMON /STLMEW/ LEFTP, LENADR, MAXREC, NUMVEC, RIGHTC, RIGHTM,RIGHTP, STADEW COMMON /STLMFT/ CNEGF, RFIRST, SAFRST COMMON /STLMID/ NIL, MV, V, MXNEW, MXOLD, MXRST, SCPX, SOLCPX, X COMMON /STLMIN/ A, B, NUMEIG, MAXW, MAXIW COMMON /STLMMI/ MEQI COMMON /STLMMU/ MU, OLDMU, NEXTMU, ALTMU COMMON /STLMOP/ TLDL, TOPINV, TOPM, TIMTQL, TVECOP, TPRED, TSAVE, COEFF(4), CK, CL, CONV, PFCONV, UPDATE COMMON /STLMPL/ PMAX1, POPT, COPT, MXREST COMMON /STLMPR/ MSGLVL, NERR , NOUT COMMON /STLMPV/ PVADR(8) COMMON /STLMST/ TIME(24), COUNT(24), NBADMU, NMXRST, DUMMY COMMON /STLMTL/ SRELPR, TOLBPI, TOLS1I, FACTOR, TOLPDM, TOLZBT, TOLZNU, TOLLDL(3) COMMON /STLMVR/ SMALL, VER COMMON /STLMWH/ WAD(2), ACTIVE(2) COMMON /STLMWR/ WRR(5), WRI(5), WRL(5) ! CHARACTER(LEN=1) COMM1, COMM2 CHARACTER(LEN=1), PARAMETER:: s1I="S", BLANK=" ", BPI="B" ! ! IF(.NOT. NOR == 20) GOTO 100 !GOTO(10,20,25,30,40),LOC IF(LOC==1)GOTO 10 IF(LOC==2)GOTO 20 IF(LOC==3)GOTO 25 IF(LOC==4)GOTO 30 IF(LOC==5)GOTO 40 ! ! ******************************* ! ROUTINE STLM. INPUT PARAMETERS. ! ******************************* 10 WRITE(NOUT ,1000) 1000 FORMAT(////1X,120("*")/1X,120("*")/1X,120("*")/ 2(1X,"***",114X,"***"/),1X,"***", & 38X,"I N P U T T O S T L M P A C K A G E",38X,"***" /2(1X,"***",114X,"***"/),1X,120("*")/1X,120("*")/ & 1X,120("*")) ! WRITE(NOUT ,1010) A,ADDRSS,PVADR(1),B,PVADR(2),PVADR(3),COPT,D,DAFILE,DIAGM,FACTOR,K,KFILE,PVADR(4), & LENADR,LP,M,SRELPR,MAXIW,MAXL,MAXREC,MAXW,MEQI, MSGLVL ! WRITE(NOUT ,1020) MXREST,N,PVADR(5),NUMEIG,NUMVEC,PMAX, PVADR(6),POPT,PVADR(7),PVADR(8),SMALL,STADEW, & TOLBPI,TOLLDL(1),TOLLDL(2),TOLPDM,TOLS1I, TOLZBT,TOLZNU,NOUT ,NERR ,VER,WAD(1),WAD(2) ! 1010 FORMAT(/// & 6X,"A = ",ES17.7,5X, "ADDRSS = ",I17 , 5X,"ALPHA = ",I17 ,5X,"B = ",ES17.7// & 6X,"BETA = ",I17 ,5X,"BETAPI = ",I17 , 5X,"COPT = ",I17 ,5X,"D = ",I17 // & 6X,"DAFILE = ",I17 ,5X,"DIAGM = ",L17 , 5X,"FACTOR = ",ES17.7,5X,"K = ",I17 // & 6X,"KFILE = ",I17 ,5X,"LAMBDA = ",I17 , 5X,"LENADR = ",I17 ,5X,"LP = ",I17 // & 6X,"M = ",I17 ,5X,"SRELPR = ",ES17.7, 5X,"MAXIW = ",I17 ,5X,"MAXL = ",I17 // & 6X,"MAXREC = ",I17 ,5X,"MAXW = ",I17 , 5X,"MEQI = ",L17 ,5X,"MSGLVL = ",I17 /) ! 1020 FORMAT(6X,"MXREST = ",I17 ,5X,"N = ",I17 , 5X,"NU = ",I17 ,5X,"NUMEIG = ",I17 // & 6X,"NUMVEC = ",I17 ,5X,"PMAX = ",I17 , 5X,"POINTR = ",I17 ,5X,"POPT = ",I17 // & 6X,"S = ",I17 ,5X,"SCR = ",I17 , 5X,"SMALL = ",ES17.7,5X,"STADEW = ",I17 // & 6X,"TOLBPI = ",ES17.7,5X, "TOLLDL1= ",ES17.7, 5X,"TOLLDL2= ",ES17.7,5X,"TOLPDM = ",ES17.7// & 6X,"TOLS1I = ",ES17.7,5X, "TOLZBT = ",ES17.7, 5X,"TOLZNU = ",ES17.7,5X,"NOUT = ",I17 // & 6X,"NERR = ",I17 ,5X,"VER = ",I17 , 5X,"WAD(1) = ",I17 ,5X,"WAD(2) = ",I17 & //1X,"*** INPUT ***") ! GOTO 9999 ! ! ******************* ! START OF ITERATION. ! ******************* 20 IF(ITERNO == 1) WRITE(NOUT ,1110) 1110 FORMAT(//) ! WRITE(NOUT ,1120) ITERNO 1120 FORMAT(1X,120("=")/1X,56("=")," ITERNO ",56("=")/1X, 120("=")/1X,I61) ! IF(ITERNO > 1) WRITE(NOUT ,1121) TCONV,OLCPOS,ROLD,OLDMU 1121 FORMAT(//16X,"TCONV",14X,"OLCPOS",16X,"ROLD",15X,"OLDMU"/ 1X,3I20,ES20.7) ! GOTO 9999 ! ! ************* ! AFTER DECOMP. ! ************* 25 WRITE(NOUT ,1122) MU,REST,RNEW 1122 FORMAT(/1X,"STLM",14X,"MU",16X,"REST",16X,"RNEW"/ 1X,ES20.7,2I20) ! IF(VER < 3) WRITE(NOUT , 1271) LEFTP, RIGHTC, RIGHTM, RIGHTP ! GOTO 9999 ! ! ******************************* ! BEFORE THE END OF AN ITERATION. ! ******************************* 30 TEMP=SECOND(DUMMY)-TSAVE WRITE(NOUT ,1130) SCPX,TCONV,TEMP 1130 FORMAT(/1X,"STLM",12X,"SCPX",15X,"TCONV",8X,"SECOND-TSAVE"/ 1X,2I20,ES20.7//1X,"*** SHIFT ***") ! GOTO 9999 ! ! ****************** ! OUTPUT PARAMETERS. ! ****************** 40 WRITE(NOUT ,1140) 1140 FORMAT(////1X,120("*")/1X,120("*")/1X,120("*")/ 2(1X,"***",114X,"***"/),1X,"***", & 35X,"O U T P U T F R O M S T L M P A C K A G E",35X, "***"/2(1X,"***",114X,"***"/),1X,120("*")/1X,120("*")/ & 1X,120("*")) ! WRITE(NOUT ,1150) ITERNO,TCONV,CNEG,CPOS,OLCPOS,RNEW, ROLD,REST,P,USEMX,ZERBET 1150 FORMAT(///1X,"/STLMCT/"/15X,"ITERNO",15X,"TCONV", 16X,"CNEG",16X,"CPOS",14X,"OLCPOS",16X,"RNEW"/1X, & 6I20//17X,"ROLD",16X,"REST",19X,"P",15X,"USEMX", 14X,"ZERBET"/1X,3I20,2L20) ! WRITE(NOUT ,1160) ERRNO 1160 FORMAT(/1X,"/STLMER/"/16X,"ERRNO"/1X,I20) ! IF(VER < 3) WRITE(NOUT , 1165) LEFTP, RIGHTC, RIGHTM, RIGHTP 1165 FORMAT(/1X,"/STLMEW/"/16X,"LEFTP",14X,"RIGHTC",14X,"RIGHTM", 14X,"RIGHTP"/1X,4I20) ! WRITE(NOUT ,1170) CNEGF,RFIRST 1170 FORMAT(/1X,"/STLMFT/"/16X,"CNEGF",14X,"RFIRST"/1X,2I20) ! WRITE(NOUT ,1175) SCPX,SOLCPX 1175 FORMAT(/1X,"/STLMID/"/17X,"SCPX",14X,"SOLCPX"/1X,2I20) ! WRITE(NOUT ,1180) MU,OLDMU,NEXTMU,ALTMU 1180 FORMAT(/1X,"/STLMMU/"/19X,"MU",15X,"OLDMU",14X,"NEXTMU",15X,"ALTMU"/1X,4ES20.7) ! WRITE(NOUT ,1190) ACTIVE 1190 FORMAT(/1X,"/STLMWH/"/12X,"ACTIVE(1)",11X,"ACTIVE(2)"/1X,2I20) ! WRITE(NOUT ,1200) 1200 FORMAT(////1X,"INFORMATION FROM /STLMST/") ! TSTLM=TIME(20) FTCONV=TCONV IF(TCONV == 0) FTCONV=1.0D0 IF(.NOT. UPDATE) GOTO 45 ! ************************************************************ ! IF THE ROUTINE IS ONLY TIMED IN FRSTIT, ! TOTAL TIME FOR THE ROUTINE = COUNT * TIME FOR ONE REFERENCE. ! ************************************************************ TEMP=COUNT(12) IF(TIME(12) <= 1.0D-20) TIME(12)=TEMP*TVECOP TEMP=COUNT(13) IF(TIME(13) <= 1.0D-20) TIME(13)=TEMP*TOPINV TEMP=COUNT(14) IF(TIME(14) <= 1.0D-20) TIME(14)=TEMP*TOPM TEMP=COUNT(18) IF(TIME(18) <= 1.0D-20) TIME(18)=TEMP*TVECOP TEMP=COUNT(21) IF(TIME(21) <= 1.0D-20) TIME(21)=TEMP*TVECOP 45 CONTINUE ! DO 60 I=1,3 ! ************************* ! WRITE IN GROUPS OF EIGHT. ! ************************* J1=1+(I-1)*8 J2=J1+7 ! IF(I == 1) WRITE(NOUT ,1210) 1210 FORMAT(32X,"ALLOC",6X,"ALWAYS",6X,"DECOMP", 7X,"ERROR",6X,"FRSTIT",6X,"IMTQL2", 6X,"INITLA",7X,"INITU") ! IF(I == 2) WRITE(NOUT ,1220) 1220 FORMAT(//35X,"IO",6X,"LANCZO",8X,"LDLT",6X,"MULVEC", 7X,"OPINV",9X,"OPM",6X,"PREPSV",6X,"RANDVC") ! IF(I == 3) WRITE(NOUT ,1230) 1230 FORMAT(//31X,"SAVEXL",6X,"SCPROD",6X,"SELDOM",8X,"STLM", 6X,"SUBVEC",6X,"TRANSF",6X,"TRIDIG",2X,"(REORTHO.)") ! WRITE(NOUT ,1240) (COUNT(J),J=J1,J2) 1240 FORMAT(1X,"COUNT",19X,8I12) ! ! ************************ ! HERE WE COMPUTE ! COUNT = NUMBER OF CALLS. ! TIME = USED TIME. ! TIME / COUNT. ! TIME / TIME FOR STLM. ! TIME / TCONV. ! ! REORTHO. IS THE ! REORTHOGONALIZATION IN ! LANCZOS. ! ************************ DO 50 J=J1,J2 J3=J-J1+1 STIME1(J3)=TIME(J) TEMP=COUNT(J) STIME2(J3)=0.0D0 IF(COUNT(J) /= 0) STIME2(J3)=TIME(J)/TEMP PERCNT(J3)=(TIME(J)/TSTLM)*1.0D2+0.5D0 STIME3(J3)=TIME(J)/FTCONV 50 CONTINUE ! WRITE(NOUT ,1250) STIME1,STIME2,PERCNT,STIME3 1250 FORMAT(1X,"TIME",20X,8ES12.1/1X,"TIME/COUNT",14X,8ES12.1/ 1X, & "TIME/STLM IN P.C.",7X,8I12/ 1X,"TIME/TCONV",14X,8ES12.1) ! 60 CONTINUE ! WRITE(NOUT ,1260) NBADMU,NMXRST,NREAD,NWRITE,WRI(1),WRI(2),WRR(1) 1260 FORMAT(/15X,"NBADMU",14X,"NMXRST", 15X,"NREAD",14X,"NWRITE"/1X,4I20// & 15X,"NTCONV",15X,"NLEFT",18X,"BG"/1X,2I20,ES20.7/ //1X,"*** OUTPUT ***"//1X,"*** STLM ***") ! GOTO 9999 ! ! *************** ! ROUTINE ALWAYS. ! *************** 100 IF(.NOT. NOR == 2) GOTO 200 ! WRITE(NOUT ,1270) RDUMP,WRL(2),REST,WRR(1) 1270 FORMAT(/1X,"ALWAYS",11X,"DOT",14X,"POSDOT",16X,"REST",15X,"TNORM"/1X,ES20.7,L20,I20,ES20.7) ! IF(VER < 3) WRITE(NOUT , 1271) LEFTP, RIGHTC, RIGHTM, RIGHTP 1271 FORMAT(/16X,"LEFTP",14X,"RIGHTC",14X,"RIGHTM", 14X,"RIGHTP"/1X,4I20) ! GOTO 9999 ! ! *************** ! ROUTINE DECOMP. ! *************** 200 IF(.NOT. NOR == 3) GOTO 300 ! WRITE(NOUT ,1280) MU,RNEW,NBADMU,NMXRST,REST 1280 FORMAT(/1X,"DECOMP",12X,"MU",16X,"RNEW",14X,"NBADMU", 14X,"NMXRST",16X,"REST"/1X,ES20.7,4I20) ! GOTO 9999 ! ! *************** ! ROUTINE FRSTIT. ! *************** 300 IF(.NOT. NOR == 5) GOTO 400 ! WRITE(NOUT ,1290) NIL,MV,V,MXNEW,MXOLD,MXRST,X,POPT,COPT,MXREST 1290 FORMAT(/1X,"FRSTIT",11X,"NIL",18X,"MV",19X,"V",15X,"MXNEW", 15X,"MXOLD",15X,"MXRST"/1X,6I20//20X,"X",16X,"POPT", & 16X,"COPT",14X,"MXREST"/1X,4I20) ! WRITE(NOUT ,1300) TLDL,TOPINV,TOPM,TIMTQL,TVECOP,TPRED,TSAVE,COEFF,CK,CL,UPDATE,USEMX 1300 FORMAT(/17X,"TLDL",14X,"TOPINV",16X,"TOPM",14X,"TIMTQL",14X,"TVECOP",15X,"TPRED"/1X,6ES20.7//16X,"TSAVE", & 12X,"COEFF(1)",12X,"COEFF(2)",12X,"COEFF(3)", 12X,"COEFF(4)"/1X,5ES20.7//19X,"CK",18X,"CL", & 14X,"UPDATE",15X,"USEMX"/1X,2ES20.7,2L20) ! WRITE(NOUT ,1305) (WRR(I),I=1,3),(WRI(I),I=1,4) 1305 FORMAT(/20X,"A",19X,"B",19X,"C", 18X,"TC",18X,"TP",16X,"LOOP"/1X,3ES20.7,3I20//18X,"LIM"/ 1X,I20) ! GOTO 9999 ! ! *************** ! ROUTINE TRIDIG. ! *************** 400 IF(.NOT. NOR == 23) GOTO 500 !GOTO(410,430),LOC IF(LOC==2)GOTO 430 ! 410 WRITE(NOUT ,1310) CNEG,CPOS,CONV,PFCONV,P,ZERBET 1310 FORMAT(/1X,"TRIDIG",10X,"CNEG",16X,"CPOS",16X,"CONV",14X,"PFCONV",19X,"P",14X,"ZERBET"/1X,5I20,L20// & 5X,"I",1X,"COMM",11X,"LAMBDA(I)",1X,"BETAPI(I)", 15X,"NU(I)",4X,"S(1,I)",4X,"S(P,I)",12X,"ALPHA(I)", & 13X,"BETA(I)") ! WRITE(NOUT ,1330) ! DO 420 I=1,P COMM1=BLANK COMM2=BLANK IF(ABS(BETAPI(I)) <= TOLBPI) COMM1=BPI IF(ABS(S(1,I)) <= TOLS1I) COMM2=S1I ! WRITE(NOUT ,1320) I,COMM1,COMM2,LAMBDA(I),BETAPI(I),NU(I), S(1,I),S(P,I),ALPHA(I),BETA(I) 1320 FORMAT(1X,I5,3X,2A1,2(ES20.7,ES10.2),ES10.2,2ES20.7) ! IF(MOD(I,5) == 0) WRITE(NOUT ,1330) 1330 FORMAT(1X,120("-")) ! 420 CONTINUE ! GOTO 9999 ! 430 WRITE(NOUT ,1340) CONV,CNEG,CPOS,WRI(1),WRI(2), WRR(1),WRR(2),WRL(1),NEXTMU,ALTMU 1340 FORMAT(/1X,"TRIDIG",10X,"CONV",16X,"CNEG",16X,"CPOS", 14X,"NUMDEL",14X,"S1IDEL"/1X,5I20//16X,"MINNU", & 15X,"MAXNU",15X,"POSNU",14X,"NEXTMU",15X,"ALTMU"/ 1X,2ES20.7,L20,2ES20.7) ! I=CNEG+CPOS ! IF(I > 0) WRITE(NOUT ,1350) (POINTR(J),J=1,I) 1350 FORMAT(/1X,"POINTR"/(1X,30I4)) ! GOTO 9999 ! ! ************** ! ROUTINE NEWPC. ! ************** 500 IF(.NOT. NOR == 25) GOTO 600 !GOTO(510,520),LOC IF(LOC==2)GOTO 520 ! 510 WRITE(NOUT ,1360) (WRR(I),I=1,4),(WRI(I),I=1,4) 1360 FORMAT(/1X,"NEWPC",14X,"A",19X,"B",19X,"C",14X,"WEIGHT", 18X,"TC",18X,"TP"/1X,4ES20.7,2I20//17X,"LOOP",17X,"LIM"/ 1X,2I20) ! GOTO 9999 ! 520 TEMP=SECOND(DUMMY)-TSAVE WRITE(NOUT ,1370) (WRR(I),I=1,2),COPT,POPT,MXREST,CL,CK,TPRED, TEMP 1370 FORMAT(/20X,"L",19X,"K",16X,"COPT",16X,"POPT",14X,"MXREST", & 18X,"CL"/1X,2ES20.7,3I20,ES20.7//19X,"CK",15X,"TPRED", 8X,"SECOND-TSAVE"/1X,3ES20.7) ! GOTO 9999 ! ! *************** ! ROUTINE SELDOM. ! *************** 600 IF(.NOT. NOR == 19) GOTO 9999 ! WRITE(NOUT ,1380) REST,WRI(1),RDUMP,WRL(2),WRR(1) 1380 FORMAT(/1X,"SELDOM",10X,"REST",16X,"NUMR", 17X,"DOT",14X,"POSDOT",15X,"TNORM"/ 1X,2I20,ES20.7,L20,ES20.7) ! ! 9999 RETURN END