Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap2_198111 - decus/20-0026/soln.cdk
There are 2 other files named soln.cdk in the archive. Click here to see a list.
$JOB SOLN[30,30]
$FORTRAN SOLN
C                                                                       SOLN  10
C     ..................................................................SOLN  20
C                                                                       SOLN  30
C        SAMPLE MAIN PROGRAM - SOLN                                     SOLN  40
C                                                                       SOLN  50
C        PURPOSE                                                        SOLN  60
C           SOLUTION OF A SET OF SIMULTANEOUS EQUATIONS                 SOLN  70
C                                                                       SOLN  80
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED                  SOLN  90
C           SIMQ                                                        SOLN 100
C           MATIN                                                       SOLN 110
C           MXOUT                                                       SOLN 120
C           LOC                                                         SOLN 130
C                                                                       SOLN 140
C        METHOD                                                         SOLN 150
C           A MATRIX OF SIMULTANEOUS EQUATIONS COEFFICIENTS AND A VECTORSOLN 160
C           OF CONSTANTS ARE READ FROM THE STANDARD INPUT DEVICE. THE   SOLN 170
C           SOLUTION IS OBTAINED AND LISTED ON THE STANDARD OUTPUT      SOLN 180
C           DEVICE. THIS PROCEDURE IS REPEATED FOR OTHER SETS OF        SOLN 190
C           EQUATIONS UNTIL A BLANK CARD IS ENCOUNTERED.                SOLN 200
C                                                                       SOLN 210
C     ..................................................................SOLN 220
C                                                                       SOLN 230
C        MATRIX IS DIMENSIONED FOR 2500 ELEMENTS. THEREFORE, NUMBER OF  SOLN 240
C        EQUATIONS TO BE SOLVED CANNOT EXCEED 50 UNLESS DIMENSION       SOLN 250
C        STATEMENT IS CHANGED                                           SOLN 260
C                                                                       SOLN 270
      DIMENSION A(2500),B(50)                                           SOLN 280
C                                                                       SOLN 290
   10 FORMAT(1H1,34HSOLUTION OF SIMULTANEOUS EQUATIONS)                 SOLN 300
   11 FORMAT(1H0,44HDIMENSIONED AREA TOO SMALL FOR INPUT MATRIX ,I4)    SOLN 310
   12 FORMAT(1H0,20HEXECUTION TERMINATED)                               SOLN 320
   13 FORMAT(1H0,47HROW AND COLUMN DIMENSIONS NOT EQUAL FOR MATRIX ,I4) SOLN 330
   14 FORMAT(1H0,42HINCORRECT NUMBER OF DATA CARDS FOR MATRIX ,I4)      SOLN 340
   15 FORMAT(1H0,18HGO ON TO NEXT CASE)                                 SOLN 350
   16 FORMAT(1H0,38HSTRUCTURE CODE IS NOT ZERO FOR MATRIX ,I4)          SOLN 360
   17 FORMAT(1H1,17HORIGINAL B VECTOR,////)                             SOLN 370
   18 FORMAT(1H1,15HSOLUTION VALUES,////)                               SOLN 380
   19 FORMAT(1H0,18HMATRIX IS SINGULAR)                                 SOLN 390
   20 FORMAT(7F10.0)                                                    SOLN 400
   21 FORMAT(I3,10X,E16.6)                                              SOLN 410
   22 FORMAT(1H0,11HEND OF CASE)                                        SOLN 420
C                                                                       SOLN 430
C     ..................................................................SOLN 440
C                                                                       SOLN 450
      WRITE (6,10)                                                      SOLN 460
   25 CALL MATIN(ICOD,A,2500,N,M,MS,IER)                                SOLN 470
      IF(N) 30,95,30                                                    SOLN 480
   30 IF(IER-1) 45,35,40                                                SOLN 490
   35 WRITE(6,11) ICOD                                                  SOLN 500
      GO TO 90                                                          SOLN 510
   40 WRITE(6,14) ICOD                                                  SOLN 520
      GO TO 95                                                          SOLN 530
   45 IF(N-M) 50,55,50                                                  SOLN 540
   50 WRITE(6,13) ICOD                                                  SOLN 550
      GO TO 90                                                          SOLN 560
   55 IF(MS) 60,65,60                                                   SOLN 570
   60 WRITE(6,16) ICOD                                                  SOLN 580
      GO TO 90                                                          SOLN 590
   65 CALL MXOUT(ICOD,A,N,M,MS,60,120,2)                                SOLN 600
      READ(5,20)(B(I),I=1,N)                                            SOLN 610
      WRITE(6,17)                                                       SOLN 620
      DO 70 I=1,N                                                       SOLN 630
   70 WRITE(6,21) I,B(I)                                                SOLN 640
      CALL SIMQ(A,B,N,KS)                                               SOLN 650
      IF(KS-1) 80,75,80                                                 SOLN 660
   75 WRITE(6,19)                                                       SOLN 670
      WRITE(6,15)                                                       SOLN 680
      GO TO 25                                                          SOLN 690
   80 WRITE(6,18)                                                       SOLN 700
      DO 85 I=1,N                                                       SOLN 710
   85 WRITE(6,21) I,B(I)                                                SOLN 720
      WRITE(6,22)                                                       SOLN 730
      GO TO 25                                                          SOLN 740
   90 READ(5,20)(B(I),I=1,N)                                            SOLN 750
      WRITE(6,15)                                                       SOLN 760
      GO TO 25                                                          SOLN 770
   95 WRITE(6,12)                                                       SOLN 780
      RETURN                                                            SOLN 790
      END                                                               SOLN 800
$FORTRAN MATIN
C                                                                       MATI  10
C     ..................................................................MATI  20
C                                                                       MATI  30
C        SUBROUTINE MATIN                                               MATI  40
C                                                                       MATI  50
C        PURPOSE                                                        MATI  60
C           READS CONTROL CARD AND MATRIX DATA ELEMENTS FROM LOGICAL    MATI  70
C           UNIT 5                                                      MATI  80
C                                                                       MATI  90
C        USAGE                                                          MATI 100
C           CALL MATIN(ICODE,A,ISIZE,IROW,ICOL,IS,IER)                  MATI 110
C                                                                       MATI 120
C        DESCRIPTION OF PARAMETERS                                      MATI 130
C           ICODE-UPON RETURN, ICODE WILL CONTAIN FOUR DIGIT            MATI 140
C                 IDENTIFICATION CODE FROM MATRIX PARAMETER CARD        MATI 150
C           A    -DATA AREA FOR INPUT MATRIX                            MATI 160
C           ISIZE-NUMBER OF ELEMENTS DIMENSIONED BY USER FOR AREA A     MATI 170
C           IROW -UPON RETURN, IROW WILL CONTAIN ROW DIMENSION FROM     MATI 180
C                 MATRIX PARAMETER CARD                                 MATI 190
C           ICOL -UPON RETURN, ICOL WILL CONTAIN COLUMN DIMENSION FROM  MATI 200
C                 MATRIX PARAMETER CARD                                 MATI 210
C           IS   -UPON RETURN, IS WILL CONTAIN STORAGE MODE CODE FROM   MATI 220
C                 MATRIX PARAMETER CARD WHERE                           MATI 230
C                 IS=0 GENERAL MATRIX                                   MATI 240
C                 IS=1 SYMMETRIC MATRIX                                 MATI 250
C                 IS=2 DIAGONAL MATRIX                                  MATI 260
C           IER  -UPON RETURN, IER WILL CONTAIN AN ERROR CODE WHERE     MATI 270
C                 IER=0   NO ERROR                                      MATI 280
C                 IER=1   ISIZE IS LESS THAN NUMBER OF ELEMENTS IN      MATI 290
C                         INPUT MATRIX                                  MATI 300
C                 IER=2   INCORRECT NUMBER OF DATA CARDS                MATI 310
C                                                                       MATI 320
C        REMARKS                                                        MATI 330
C           NONE                                                        MATI 340
C                                                                       MATI 350
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED                  MATI 360
C           LOC                                                         MATI 370
C                                                                       MATI 380
C        METHOD                                                         MATI 390
C           SUBROUTINE ASSUMES THAT INPUT MATRIX CONSISTS OF PARAMETER  MATI 400
C           CARD FOLLOWED BY DATA CARDS                                 MATI 410
C           PARAMETER CARD HAS THE FOLLOWING FORMAT                     MATI 420
C             COL. 1- 2 BLANK                                           MATI 430
C             COL. 3- 6 UP TO FOUR DIGIT IDENTIFICATION CODE            MATI 440
C             COL. 7-10 NUMBER OF ROWS IN MATRIX                        MATI 450
C             COL.11-14 NUMBER OF COLUMNS IN MATRIX                     MATI 460
C             COL.15-16 STORAGE MODE OF MATRIX WHERE                    MATI 470
C                 0 - GENERAL MATRIX                                    MATI 480
C                 1 - SYMMETRIC MATRIX                                  MATI 490
C                 2 - DIAGONAL MATRIX                                   MATI 500
C           DATA CARDS ARE ASSUMED TO HAVE SEVEN FIELDS OF TEN COLUMNS  MATI 510
C           EACH.  DECIMAL POINT MAY APPEAR ANYWHERE IN A FIELD.  IF NO MATI 520
C           DECIMAL POINT IS INCLUDED, IT IS ASSUMED THAT THE DECIMAL   MATI 530
C           POINT IS AT THE END OF THE 10 COLUMN FIELD. NUMBER IN EACH  MATI 540
C           FIELD MAY BE PRECEDED BY BLANKS.  DATA ELEMENTS MUST BE     MATI 550
C           PUNCHED BY ROW.  A ROW MAY CONTINUE FROM CARD TO CARD.      MATI 560
C           HOWEVER EACH NEW ROW MUST START IN THE FIRST FIELD OF THE   MATI 570
C           NEXT CARD.  ONLY THE UPPER TRIANGULAR PORTION OF A SYMMETRICMATI 580
C           OR THE DIAGONAL ELEMENTS OF A DIAGONAL MATRIX ARE CONTAINED MATI 590
C           ON DATA CARDS.  THE FIRST ELEMENT OF EACH NEW ROW WILL BE   MATI 600
C           THE DIAGONAL ELEMENT FOR A MATRIX WITH  SYMMETRIC OR        MATI 610
C           DIAGONAL STORAGE MODE. COLUMNS 71-80 OF DATA CARDS MAY BE   MATI 620
C           USED FOR IDENTIFICATION, SEQUENCE NUMBERING, ETC..          MATI 630
C           THE LAST DATA CARD FOR ANY MATRIX MUST BE FOLLOWED BY A CARDMATI 640
C           WITH A 9 PUNCH IN COLUMN 1.                                 MATI 650
C                                                                       MATI 660
C.......................................................................MATI 670
C                                                                       MATI 680
      SUBROUTINE MATIN(ICODE,   A,ISIZE,IROW,ICOL,IS,IER)               MATI 690
      DIMENSION A(1)                                                    MATI 700
      DIMENSION CARD(8)                                                 MATI 710
    1 FORMAT(7F10.0)                                                    MATI 720
    2 FORMAT(I6,2I4,I2)                                                 MATI 730
C                                                                       MATI 740
      IDC=7                                                             MATI 750
      IER=0                                                             MATI 760
      READ( 5,2,END=999)ICODE,IROW,ICOL,IS                              MATI 770
      CALL LOC(IROW,ICOL,ICNT,IROW,ICOL,IS)                             MATI 780
      IF(ISIZE-ICNT)6,7,7                                               MATI 790
    6 IER=1                                                             MATI 800
    7 IF (ICNT)38,38,8                                                  MATI 810
    8 ICOLT=ICOL                                                        MATI 820
      IROCR=1                                                           MATI 830
C                                                                       MATI 840
C        COMPUTE NUMBER OF CARDS FOR THIS ROW                           MATI 850
C                                                                       MATI 860
   11 IRCDS=(ICOLT-1)/IDC+1                                             MATI 870
      IF(IS-1)15,15,12                                                  MATI 880
   12 IRCDS=1                                                           MATI 890
C                                                                       MATI 900
C        SET UP LOOP FOR NUMBER OF CARDS IN ROW                         MATI 910
C                                                                       MATI 920
   15 DO 31 K=1,IRCDS                                                   MATI 930
      READ(5,1)(CARD(I),I=1,IDC)                                        MATI 940
C                                                                       MATI 950
C        SKIP THROUGH DATA CARDS IF INPUT AREA TOO SMALL                MATI 960
C                                                                       MATI 970
      IF(IER)16,16,31                                                   MATI 980
   16 L=0                                                               MATI 990
C                                                                       MATI1000
C        COMPUTE COLUMN NUMBER FOR FIRST FIELD IN CURRENT CARD          MATI1010
C                                                                       MATI1020
      JS=(K-1)*IDC+ICOL-ICOLT+1                                         MATI1030
      JE=JS+IDC-1                                                       MATI1040
      IF(IS-1)19,19,17                                                  MATI1050
   17 JE=JS                                                             MATI1060
C                                                                       MATI1070
C        SET UP LOOP FOR DATA ELEMENTS  WITHIN CARD                     MATI1080
C                                                                       MATI1090
   19 DO 30 J=JS,JE                                                     MATI1100
      IF(J-ICOL)20,20,31                                                MATI1110
   20 CALL LOC(IROCR ,J,IJ,IROW,ICOL,IS)                                MATI1120
      L=L+1                                                             MATI1130
   30 A(IJ)=CARD(L)                                                     MATI1140
   31 CONTINUE                                                          MATI1150
      IROCR=IROCR+1                                                     MATI1160
      IF(IROW-IROCR) 38,35,35                                           MATI1170
   35 IF(IS-1)37,36,36                                                  MATI1180
   36 ICOLT=ICOLT-1                                                     MATI1190
   37 GO TO 11                                                          MATI1200
   38 READ(5,1,END=999) CARD(1)                                         MATI1210
      IF(CARD(1)-9.E9)39,40,39                                          MATI1220
   39 IER=2                                                             MATI1230
   40 RETURN                                                            MATI1240
999	STOP
      END                                                               MATI1250
$FORTRAN MXOUT
C                                                                       MXOU  10
C     ..................................................................MXOU  20
C                                                                       MXOU  30
C        SUBROUTINE MXOUT                                               MXOU  40
C                                                                       MXOU  50
C        PURPOSE                                                        MXOU  60
C           PRODUCES AN OUTPUT LISTING OF ANY SIZED ARRAY ON            MXOU  70
C           LOGICAL UNIT 6                                              MXOU  80
C                                                                       MXOU  90
C        USAGE                                                          MXOU 100
C           CALL MXOUT(ICODE,A,N,M,MS,LINS,IPOS,ISP)                    MXOU 110
C                                                                       MXOU 120
C        DESCRIPTION OF PARAMETERS                                      MXOU 130
C           ICODE- INPUT CODE NUMBER TO BE PRINTED ON EACH OUTPUT PAGE  MXOU 140
C           A-NAME OF OUTPUT MATRIX                                     MXOU 150
C           N-NUMBER OF ROWS IN A                                       MXOU 160
C           M-NUMBER OF COLUMNS IN A                                    MXOU 170
C           MS-STORAGE MODE OF A WHERE MS=                              MXOU 180
C                  0-GENERAL                                            MXOU 190
C                  1-SYMMETRIC                                          MXOU 200
C                  2-DIAGONAL                                           MXOU 210
C           LINS-NUMBER OF PRINT LINES ON THE PAGE (USUALLY 60)         MXOU 220
C           IPOS-NUMBER OF PRINT POSITIONS ACROSS THE PAGE (USUALLY 132)MXOU 230
C           ISP-LINE SPACING CODE, 1 FOR SINGLE SPACE, 2 FOR DOUBLE     MXOU 240
C               SPACE                                                   MXOU 250
C                                                                       MXOU 260
C        REMARKS                                                        MXOU 270
C           NONE                                                        MXOU 280
C                                                                       MXOU 290
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED                  MXOU 300
C           LOC                                                         MXOU 310
C                                                                       MXOU 320
C        METHOD                                                         MXOU 330
C           THIS SUBROUTINE CREATES A STANDARD OUTPUT LISTING OF ANY    MXOU 340
C           SIZED ARRAY WITH ANY STORAGE MODE. EACH PAGE IS HEADED WITH MXOU 350
C           THE CODE NUMBER,DIMENSIONS AND STORAGE MODE OF THE ARRAY.   MXOU 360
C           EACH COLUMN AND ROW IS ALSO HEADED WITH ITS RESPECTIVE      MXOU 370
C           NUMBER.                                                     MXOU 380
C                                                                       MXOU 390
C     ..................................................................MXOU 400
C                                                                       MXOU 410
      SUBROUTINE MXOUT (ICODE,A,N,M,MS,LINS,IPOS,ISP)                   MXOU 420
      DIMENSION A(1),B(8)                                               MXOU 430
    1 FORMAT(1H1,5X, 7HMATRIX ,I5,6X,I3,5H ROWS,6X,I3,8H COLUMNS,       MXOU 440
     18X,13HSTORAGE MODE ,I1,8X,5HPAGE ,I2,/)                           MXOU 450
    2 FORMAT(12X,8HCOLUMN  ,7(3X,I3,10X))                               MXOU 460
    3 FORMAT(1H )                                                       MXOU 470
    4 FORMAT(1H ,7X,4HROW ,I3,7(E16.6))                                 MXOU 480
    5 FORMAT(1H0,7X,4HROW ,I3,7(E16.6))                                 MXOU 490
C                                                                       MXOU 500
      J=1                                                               MXOU 510
C                                                                       MXOU 520
C        WRITE HEADING                                                  MXOU 530
C                                                                       MXOU 540
      NEND=IPOS/16-1                                                    MXOU 550
      LEND=(LINS/ISP)-2                                                 MXOU 560
      IPAGE=1                                                           MXOU 570
   10 LSTRT=1                                                           MXOU 580
   20 WRITE(6,1)ICODE,N,M,MS,IPAGE                                      MXOU 590
      JNT=J+NEND-1                                                      MXOU 600
      IPAGE=IPAGE+1                                                     MXOU 610
   31 IF(JNT-M)33,33,32                                                 MXOU 620
   32 JNT=M                                                             MXOU 630
   33 CONTINUE                                                          MXOU 640
      WRITE(6,2)(JCUR,JCUR=J,JNT)                                       MXOU 650
      IF(ISP-1) 35,35,40                                                MXOU 660
   35 WRITE(6,3)                                                        MXOU 670
   40 LTEND=LSTRT+LEND-1                                                MXOU 680
      DO 80 L=LSTRT,LTEND                                               MXOU 690
C                                                                       MXOU 700
C        FORM OUTPUT ROW LINE                                           MXOU 710
C                                                                       MXOU 720
      DO 55 K=1,NEND                                                    MXOU 730
      KK=K                                                              MXOU 740
      JT = J+K-1                                                        MXOU 750
      CALL LOC(L,JT,IJNT,N,M,MS)                                        MXOU 760
      B(K)=0.0                                                          MXOU 770
      IF(IJNT)50,50,45                                                  MXOU 780
   45 B(K)=A(IJNT)                                                      MXOU 790
   50 CONTINUE                                                          MXOU 800
C                                                                       MXOU 810
C        CHECK IF LAST COLUMN.  IF YES GO TO 60                         MXOU 820
C                                                                       MXOU 830
      IF(JT-M) 55,60,60                                                 MXOU 840
   55 CONTINUE                                                          MXOU 850
C                                                                       MXOU 860
C        END OF LINE, NOW WRITE                                         MXOU 870
C                                                                       MXOU 880
   60 IF(ISP-1)65,65,70                                                 MXOU 890
   65 WRITE(6,4)L,(B(JW),JW=1,KK)                                       MXOU 900
      GO TO 75                                                          MXOU 910
   70 WRITE(6,5)L,(B(JW),JW=1,KK)                                       MXOU 920
C                                                                       MXOU 930
C        IF END OF ROWS,GO CHECK COLUMNS                                MXOU 940
C                                                                       MXOU 950
   75 IF(N-L)85,85,80                                                   MXOU 960
   80 CONTINUE                                                          MXOU 970
C                                                                       MXOU 980
C        END OF PAGE, NOW CHECK FOR MORE OUTPUT                         MXOU 990
C                                                                       MXOU1000
      LSTRT=LSTRT+LEND                                                  MXOU1010
      GO TO 20                                                          MXOU1020
C                                                                       MXOU1030
C        END OF COLUMNS, THEN RETURN                                    MXOU1040
C                                                                       MXOU1050
   85 IF(JT-M)90,95,95                                                  MXOU1060
   90 J=JT+1                                                            MXOU1070
      GO TO 10                                                          MXOU1080
   95 RETURN                                                            MXOU1090
      END                                                               MXOU1100
$DECK SOL.CDR
  000100100010                                                                20
 1.0000000 0.6644085 0.7601008 0.7507505 0.4299425 0.0033291 0.7284786        30
 0.6751766 0.8635910 0.7446845                                                40
 0.6644085 1.0000000 0.6271802 0.6194650 0.3547574 0.0027470 0.6010878        50
 0.5571068 0.7125728 0.6144597                                                60
 0.7601008 0.6271802 1.0000000 0.7086843 0.4058519 0.0031426 0.6876602        70
 0.6373449 0.8152021 0.7029582                                                80
 0.7507505 0.6194650 0.7086843 1.0000000 0.4008593 0.0031039 0.6792011        90
 0.6295047 0.8051740 0.6943108                                               100
 0.4299425 0.3547574 0.4058519 0.4008593 1.0000000 0.0017776 0.3889673       110
 0.3605070 0.4611099 0.3976204                                               120
 0.0033291 0.0027470 0.0031426 0.0031039 0.0017776 1.0000000 0.0030119       130
 0.0027915 0.0035705 0.0030789                                               140
 0.7284786 0.6010878 0.6876602 0.6792011 0.3889673 0.0030119 1.0000000       150
 0.6108296 0.7812874 0.6737132                                               160
 0.6751766 0.5571068 0.6373449 0.6295047 0.3605070 0.0027915 0.6108296       170
 1.0000000 0.7241215 0.6244183                                               180
 0.8635910 0.7125728 0.8152021 0.8051740 0.4611099 0.0035705 0.7812874       190
 0.7241215 1.0000000 0.7986682                                               200
 0.7446845 0.6144597 0.7029582 0.6943108 0.3976204 0.0030789 0.6737132       210
 0.6244183 0.7986682 1.0000000                                               220
9                                                                            230
 110.     -120.       10.      145.      -50.       44.2      -14.           240
  38.5      22.     1650.                                                    250
$EOD
.ASSIGN CDR 5
.ASSIGN LPT 6
.SET CDR SOL
.EXECUTE/REL SOLN,MATIN,MXOUT,WES:SSP/LIB
%FIN::
.DELETE SOL.CDR