SUBROUTINE WRINF3(NOR,LOC,LAMBDA,POINTR)
USE Numeric_Kinds_Module
!
!   $RCSfile: wrinf3.f,v $ $Revision: 1.3 $
!   $Date: 89/07/28 09:57:50 $
!   $State: Stable $
!
!
! **********************************************************************
!
!     PURPOSE -
!
!         WRITES INFORMATION FOR MSGLVL=2 AND 3.
!
!     INPUT PARAMETERS -
!
!         NOR    = THE 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.
!
!
! **********************************************************************
!
SAVE
REAL(Kind=WP_Kind)   A, ALTMU, B, CK, CL, COEFF, FACTOR, LAMBDA(1), SRELPR,  MU, NEXTMU, OLDMU, RDUMP, SECOND, SMALL, TEMP, TIME, &
                TIMTQL, TLDL, TOLBPI, TOLLDL, TOLPDM, TOLS1I, TOLZBT, TOLZNU, TOPINV, TOPM, TPRED, TSAVE, TVECOP, WRR
INTEGER   ADDRSS, CNEG, CNEGF, CONV, COPT, COUNT, CPOS, D, DAFILE, DUMMY, ERRNO, I, IDUMP, IMAX, ITERNO, K, KFILE, LEFTP,         &
                LENADR, LOC, LP, M, MAXIW, MAXL, MAXREC, MAXW, MSGLVL, MXREST, N, NBADMU, NMXRST, NOR, NREAD, NUMEIG, NUMVEC,     &
                NWRITE, OLCPOS, P, PFCONV, PMAX, POINTN, POINTP, POINTR(1), POPT, REST, RFIRST, RIGHTC, RIGHTM, RIGHTP,           &
                RNEW, ROLD, SACNEG, SACPOS, STADEW, TCONV, NERR  , NOUT , VER, PROFIL, WRI
LOGICAL   DIAGM, MEQI, SAFRST, UPDATE, USEMX, ZERBET, WRL
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   /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/ PMAX, POPT, COPT, MXREST
COMMON   /STLMPF/ PROFIL
COMMON   /STLMPR/ MSGLVL, NERR  , NOUT
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   /STLMWR/ WRR(5), WRI(5), WRL(5)
!
!
IF(.NOT. NOR == 20) GOTO 100
IF(LOC==1)THEN
!!!GOTO(10,15,20,30,60),LOC
!
!     *******************************
!     ROUTINE STLM. INPUT PARAMETERS.
!     *******************************
10    WRITE(NOUT ,1000) VER,N,A,B,MAXL,PROFIL,PMAX,MXREST, MSGLVL, MAXW, MAXIW, NERR  , NOUT
!
1000  FORMAT(///1X,60("*"),2(/1X,"*",58X,"*")/1X,"*",10X, "I N P U T  T O  S T L M  P A C K A G E",         &
             10X,"*",2(/1X,"*",58X,"*")/1X,60("*")/// 4X, "VER", I54/                                           &
             4X, "N", I56/ 4X, "A", ES56.7/  4X, "B", ES56.7/  4X, "MAXL", I53/  4X, "PROFIL", I51/         &
             4X, "PMAX", I53/ 4X, "MXREST", I51/4X, "MSGLVL", I51/ 4X, "MAXW", I53/ 4X, "MAXIW", I52/           &
             4X, "NERR  ", I51/ 4X, "OUT ", I52)
!
IF(VER <= 2) WRITE(NOUT , 1002) DAFILE, MAXREC
1002  FORMAT(4X, "DAFILE", I51/ 4X, "MAXREC", I51)
!
IF(VER == 1) WRITE(NOUT , 1001) KFILE
1001  FORMAT(4X, "KFILE", I52)
!
WRITE(NOUT , 1003)
1003  FORMAT(//1X,"*** INPUT ***")
!
GOTO 9999
!
!     *******************
!     START OF ITERATION.
!     *******************
ELSEIF(LOC==2)THEN
15    IF(ITERNO == 1) WRITE(NOUT ,1010)
1010  FORMAT(//)
!
WRITE(NOUT ,1020) ITERNO
1020  FORMAT(1X,60("=")///4X,"ITERATION NUMBER",I41)
!
GOTO 9999
!
!     *************
!     AFTER DECOMP.
!     *************
ELSEIF(LOC==3)THEN
20    WRITE(NOUT ,1025) MU,RNEW,REST
1025  FORMAT(/4X,"SHIFT",ES52.7/  4X,"NO. OF EIGENVALUES LESS THAN THE SHIFT",I19/ &
             4X,"NO. OF REMAINING EIGENVALUES IN THE INTERVAL",I13)
!
GOTO 9999
!
!     ****************************
!     BEFORE END OF THE ITERATION.
!     ****************************
ELSEIF(LOC==4)THEN
30    TEMP=SECOND(DUMMY)-TSAVE
WRITE(NOUT ,1030) TEMP
1030  FORMAT(4X,"THIS ITERATION TOOK",ES30.1," SECONDS")
!
IF(.NOT. CPOS+RNEW == N) GOTO 40
  WRITE(NOUT ,1050)
1050    FORMAT(4X,"WE HAVE REACHED THE LAST EIGENVALUE.")
!
  GOTO 50
!
40    IF(UPDATE) WRITE(NOUT ,1060) TPRED
1060  FORMAT(4X,"PREDICTED TIME FOR THE NEXT ITERATION", ES12.1," SECONDS")
!
50    WRITE(NOUT ,1080)
1080  FORMAT(/1X,"*** SHIFT ***")
!
GOTO 9999
!
!     ******************
!     OUTPUT PARAMETERS.
!     ******************
ELSEIF(LOC==5)THEN
60    WRITE(NOUT ,1090) ITERNO,WRI(1),WRR(1)
1090  FORMAT(///1X,60("*"),2(/1X,"*",58X,"*")/1X,"*",7X,"O U T P U T  F R O M  S T L M  P A C K A G E",     &
             7X,"*",2(/1X,"*",58X,"*")/1X,60("*")/// 4X,"NUMBER OF ITERATIONS",I37/                            &
             4X,"TOTAL NUMBER OF COMPUTED EIGENPAIRS",I22/4X,"BG        ",ES47.7)
!
IF(ERRNO < 2501 .OR. ERRNO > 2513) WRITE(NOUT ,1100) WRI(2)
1100  FORMAT(/4X,"NUMBER OF EIGENVALUES LESS THAN A",I24)
!
IF(SAFRST) WRITE(NOUT ,1110) CNEGF
1110  FORMAT(4X,"OF THESE",I5," WERE ACCEPTED.")
!
IF(ERRNO /= 0) WRITE(NOUT ,1120) ERRNO
1120  FORMAT(/4X,"AN ERROR OCCURRED, ERROR NUMBER",I26)
!
WRITE(NOUT ,1130) TIME(20)
1130  FORMAT(/4X,"TOTAL TIME USED FOR THE RUN",ES22.1," SECONDS")
!
IF(.NOT. TCONV > 0) GOTO 70
  TEMP=TCONV
  TEMP=TIME(20)/TEMP
  WRITE(NOUT ,1140) TEMP
1140    FORMAT(4X,"TIME/EIGENPAIR",ES35.1," SECONDS")
!
ENDIF
70    WRITE(NOUT ,1150) TLDL
1150  FORMAT(4X,"THE FIRST LDLT-DECOMPOSITION TOOK",ES16.1, " SECONDS")
!
TEMP=N
TEMP=TVECOP/TEMP
IF(UPDATE) WRITE(NOUT ,1160) TOPINV,TOPM,TEMP
1160  FORMAT(4X,"OPINV  (SOLVES LDLT*X=B)",ES25.1," SECONDS"/ 4X,"OPM    (Y=M*X)",ES35.1," SECONDS"/       &
             4X,"VECTOROPERATIONS",ES18.1," SECONDS/MULTIPLICATION")
!
WRITE(NOUT ,1170)
1170  FORMAT(//1X,"*** OUTPUT ***"//1X,"*** STLM ***")
!
GOTO 9999
!
!     ***************
!     ROUTINE ALWAYS.
!     ***************
100   IF(.NOT. NOR == 2) GOTO 200
!
WRITE(NOUT ,2000)
2000  FORMAT(4X,"THE FOLLOWING EIGENVALUES WERE ACCEPTED.")
!
IF(.NOT. CNEG+CPOS > 0) GOTO 140
  WRITE(NOUT ,2010)
2010    FORMAT(/6X,"LESS THAN THE SHIFT.", 9X,"GREATER THAN THE SHIFT.")
!
  SACNEG=CNEG
  SACPOS=CPOS
  IMAX=MAX0(CNEG,CPOS)
!
  DO 130 I=1,IMAX
    IF(.NOT. (SACNEG > 0 .AND. SACPOS > 0)) GOTO 110
      POINTN=POINTR(I)
      POINTP=I+CNEG
      POINTP=POINTR(POINTP)
!
      WRITE(NOUT ,2020) LAMBDA(POINTN),LAMBDA(POINTP)
2020        FORMAT(1X,ES25.7,ES30.7)
!
      SACNEG=SACNEG-1
      SACPOS=SACPOS-1
!
      GOTO 130
!
110       IF(.NOT. SACNEG > 0) GOTO 120
      POINTN=POINTR(I)
      WRITE(NOUT ,2030) LAMBDA(POINTN)
2030        FORMAT(1X,ES25.7)
!
      GOTO 130
!
120       POINTP=I+CNEG
    POINTP=POINTR(POINTP)
!
    WRITE(NOUT ,2040) LAMBDA(POINTP)
2040      FORMAT(1X,ES55.7)
!
130       CONTINUE
!
140   IF(REST == 0) WRITE(NOUT ,2050)
2050  FORMAT(/4X,"WE HAVE NOW COMPUTED ALL ", "EIGENVALUES IN THE INTERVAL.")
!
IF(.NOT. REST > 0) GOTO 9999
  WRITE(NOUT ,2060) REST
2060    FORMAT(/4X,"THERE REMAIN(S)",I5, " EIGENVALUE(S) IN THE INTERVAL."/ 4X,"FUNCTION SELDOM WILL BE USED.")
!
  WRITE(NOUT ,2000)
  WRITE(NOUT ,2010)
!
  GOTO 9999
!
!     ***************
!     ROUTINE SELDOM.
!     ***************
200   IF(.NOT. NOR == 19) GOTO 9999
IF(.NOT. CNEG > 0) GOTO 9999
  DO 210 I=1,CNEG
    POINTN=POINTR(I)
    WRITE(NOUT ,2030) LAMBDA(POINTN)
210       CONTINUE
!
  IF(REST == 0) WRITE(NOUT ,2070)
2070    FORMAT(/4X,"WE HAVE NOW COMPUTED THE REMAINING ONES.")
!
!
9999  RETURN
END