home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / LLSQ.ZIP / MFEOUT.FOR < prev    next >
Encoding:
Text File  |  1984-02-26  |  5.1 KB  |  66 lines
  1. $DEBUG
  2.       SUBROUTINE MFEOUT (A,MDA,M,N,NAMES,MODE)                          MFT00100
  3. C     C.L.LAWSON AND R.J.HANSON, JET PROPULSION LABORATORY, 1973 JUN 12 MFT00200
  4. C     TO APPEAR IN 'SOLVING LEAST SQUARES PROBLEMS', PRENTICE-HALL, 1974MFT00300
  5. C          SUBROUTINE FOR MATRIX OUTPUT WITH LABELING.                  MFT00400
  6. C                                                                       MFT00500
  7. C     A( )         MATRIX TO BE OUTPUT                                  MFT00600
  8. C                  MDA     FIRST DIMENSION OF A ARRAY                   MFT00700
  9. C                  M         NO. OF ROWS IN A MATRIX                    MFT00800
  10. C                  N         NO. OF COLS IN A MATRIX                    MFT00900
  11. C     NAMES()      ARRAY OF NAMES.  IF NAMES(1) = 1H , THE REST         MFT01000
  12. C                  OF THE NAMES() ARRAY WILL BE IGNORED.                MFT01100
  13. C     MODE         =1   FOR   4P8F15.0  FORMAT  FOR V MATRIX.           MFT01200
  14. C                  =2   FOR   8E15.8  FORMAT  FOR CANDIDATE SOLUTIONS.  MFT01300
  15. C                                                                       MFT01400
  16.       DIMENSION    A(MDA,01)                                            MFT01500
  17.       CHARACTER*4 IHEAD(2), BLANK, NAME, NAMES(N)
  18.       LOGICAL   NOTBLK                                                  MFT01700
  19.       DATA  MAXCOL/8/, BLANK/'    '/,IHEAD(1)/' COL'/,IHEAD(2)/'SOLN'/  MFT01800
  20. C                                                                       MFT01900
  21.       NOTBLK=NAMES(1).NE.BLANK                                          MFT02100
  22.       IF (M.LE.0.OR.N.LE.0) RETURN                                      MFT02000
  23. C                                                                       MFT02200
  24.       IF (MODE.EQ.2) GO TO 10                                           MFT02300
  25.       WRITE (6,70)                                                      MFT02400
  26.       GO TO 20                                                          MFT02500
  27.    10 WRITE (6,80)                                                      MFT02600
  28.    20 CONTINUE                                                          MFT02700
  29. C                                                                       MFT02800
  30.       NBLOCK=N/MAXCOL                                                   MFT02900
  31.       LAST=N-NBLOCK*MAXCOL                                              MFT03000
  32.       NCOL=MAXCOL                                                       MFT03100
  33.       J1=1                                                              MFT03200
  34. C                                                                       MFT03300
  35. C                            MAIN LOOP STARTS HERE                      MFT03400
  36. C                                                                       MFT03500
  37.    30 IF (NBLOCK.GT.0) GO TO 40                                         MFT03600
  38.       IF (LAST.LE.0) RETURN                                             MFT03700
  39.       NCOL=LAST                                                         MFT03800
  40.       LAST=0                                                            MFT03900
  41. C                                                                       MFT04000
  42.    40 J2=J1+NCOL-1                                                      MFT04100
  43.       WRITE (6,90) (IHEAD(MODE),J,J=J1,J2)                              MFT04200
  44. C                                                                       MFT04300
  45.            DO 60 I=1,M                                                  MFT04400
  46.            NAME=BLANK                                                   MFT04500
  47.            IF (NOTBLK) NAME=NAMES(I)                                    MFT04600
  48. C                                                                       MFT04700
  49.            IF (MODE.EQ.2) GO TO 50                                      MFT04800
  50.            WRITE (6,100) I,NAME,(A(I,J),J=J1,J2)                        MFT04900
  51.            GO TO 60                                                     MFT05000
  52.    50      WRITE (6,110) I,NAME,(A(I,J),J=J1,J2)                        MFT05100
  53.    60      CONTINUE                                                     MFT05200
  54. C                                                                       MFT05300
  55.       J1=J1+MAXCOL                                                      MFT05400
  56.       NBLOCK=NBLOCK-1                                                   MFT05500
  57.       GO TO 30                                                          MFT05600
  58. C                                                                       MFT05700
  59.    70 FORMAT ('0V-MATRIX OF THE SINGULAR VALUE DECOMPOSITION OF A*D.',  MFT05800
  60.      *        ' (ELEMENTS OF V SCALED UP BY A FACTOR OF 10**4)' )       MFT05900
  61.    80 FORMAT ('0SEQUENCE OF CANDIDATE SOLUTIONS, X')                    MFT06000
  62.    90 FORMAT ('0',11X,8(6X,A4,I4,1X)/1X)                                MFT06100
  63.   100 FORMAT (1X,I3,2X,A4,2X,4P8F15.0)                                  MFT06200
  64.   110 FORMAT (1X,I3,2X,A4,2X,8E15.8)                                    MFT06300
  65.       END                                                               MFT06400
  66.