Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0026/adsam.cdk
There are 2 other files named adsam.cdk in the archive. Click here to see a list.
$JOB ADSAM[30,30]
$FORTRAN ADSAM
C                                                                       ADSA  10
C     ..................................................................ADSA  20
C                                                                       ADSA  30
C        SAMPLE MAIN PROGRAM FOR MATRIX ADDITION - ADSAM                ADSA  40
C                                                                       ADSA  50
C        PURPOSE                                                        ADSA  60
C           MATRIX ADDITION SAMPLE PROGRAM                              ADSA  70
C                                                                       ADSA  80
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED                  ADSA  90
C           MADD                                                        ADSA 100
C           MATIN                                                       ADSA 110
C           MXOUT                                                       ADSA 120
C           LOC                                                         ADSA 130
C                                                                       ADSA 140
C        METHOD                                                         ADSA 150
C           TWO INPUT MATRICES ARE READ FROM THE STANDARD INPUT DEVICE. ADSA 160
C           THEY ARE ADDED AND THE RESULTANT MATRIX IS LISTED ON        ADSA 170
C           THE STANDARD OUTPUT DEVICE. THIS CAN BE REPEATED FOR ANY    ADSA 180
C           NUMBER OF PAIRS OF MATRICES UNTIL A BLANK CARD IS           ADSA 190
C           ENCOUNTERED                                                 ADSA 200
C                                                                       ADSA 210
C     ..................................................................ADSA 220
C                                                                       ADSA 230
C        MATRICES ARE DIMENSIONED FOR 1000 ELEMENTS. THEREFORE, PRODUCT ADSA 240
C        OF NUMBER OF ROWS BY NUMBER OF COLUMNS CANNOT EXCEED 1000.     ADSA 250
C                                                                       ADSA 260
      DIMENSION A(1000),B(1000),R(1000)                                 ADSA 270
C                                                                       ADSA 280
   10 FORMAT(1H1,15HMATRIX ADDITION)                                    ADSA 290
   11 FORMAT(1H0,44HDIMENSIONED AREA TOO SMALL FOR INPUT MATRIX ,I4)    ADSA 300
   12 FORMAT(1H0,20HEXECUTION TERMINATED)                               ADSA 310
   13 FORMAT(1H0,32HMATRIX DIMENSIONS NOT CONSISTENT)                   ADSA 320
   14 FORMAT(1H0,42HINCORRECT NUMBER OF DATA CARDS FOR MATRIX ,I4)      ADSA 330
   15 FORMAT(1H0,18HGO ON TO NEXT CASE)                                 ADSA 340
   16 FORMAT(1H0,11HEND OF CASE)                                        ADSA 350
C                                                                       ADSA 360
C     ..................................................................ADSA 370
C                                                                       ADSA 380
      WRITE(6,10)                                                       ADSA 390
   20 CALL MATIN(ICODA,A,1000,NA,MA,MSA,IER)                            ADSA 400
      IF( NA ) 25,95,25                                                 ADSA 410
   25 IF(IER-1) 40,30,35                                                ADSA 420
   30 WRITE(6,11) ICODA                                                 ADSA 430
      GO TO 45                                                          ADSA 440
   35 WRITE(6,14) ICODA                                                 ADSA 450
   37 WRITE(6,12)                                                       ADSA 460
      GO TO 95                                                          ADSA 470
   40 CALL MXOUT(ICODA,A,NA,MA,MSA,60,120,2)                            ADSA 480
   45 CALL MATIN(ICODB,B,1000,NB,MB,MSB,IER)                            ADSA 490
      IF(IER-1) 60,50,55                                                ADSA 500
   50 WRITE(6,11) ICODB                                                 ADSA 510
      WRITE(6,15)                                                       ADSA 520
      GO TO 20                                                          ADSA 530
   55 WRITE(6,14) ICODB                                                 ADSA 540
      GO TO 37                                                          ADSA 550
   60 IF(NA-NB) 75,70,75                                                ADSA 560
   70 IF(MA-MB) 75,80,75                                                ADSA 570
   75 WRITE(6,13)                                                       ADSA 580
      WRITE(6,15)                                                       ADSA 590
      GO TO 20                                                          ADSA 600
   80 CALL MXOUT(ICODB,B,NB,MB,MSB,60,120,2)                            ADSA 610
      ICODR=ICODA+ICODB                                                 ADSA 620
      CALL MADD(A,B,R,NA,MA,MSA,MSB)                                    ADSA 630
      MSR=MSA                                                           ADSA 640
      IF(MSA-MSB) 90,90,85                                              ADSA 650
   85 MSR=MSB                                                           ADSA 660
   90 CALL MXOUT(ICODR,R,NA,MA,MSR,60,120,2)                            ADSA 670
      WRITE(6,16)                                                       ADSA 680
      GO TO 20                                                          ADSA 690
   95 RETURN                                                            ADSA 700
      END                                                               ADSA 710
$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 ADS.CDR
  00010008001100                                                              20
 0.7601008 0.6271802 1.0000000 0.7086843 0.4058519 0.0031426 0.6876602        30
 0.6751766 0.8635910 0.7446845 0.6963269                                      40
 0.6644085 1.0000000 0.6271802 0.6194650 0.3547574 0.0027470 0.6010878        50
 0.5571068 0.7125728 0.6144597 0.5745585                                      60
 1.0000000 0.6644085 0.7601008 0.7507505 0.4299425 0.0033291 0.7284786        70
 0.6373449 0.8152021 0.7029582 0.6573101                                      80
 0.6963269 0.5745585 0.6573101 0.6492243 0.3718001 0.0028789 0.6299642        90
 0.6295047 0.8051740 0.6943108 0.6492243                                     100
 0.7446845 0.6144597 0.7029582 0.6943108 0.3976204 0.0030789 0.6737132       110
 0.3605070 0.4611099 0.3976204 0.3718001                                     120
 0.6751766 0.5571068 0.6373449 0.6295047 0.3605070 0.0027915 0.6108296       130
 0.0027915 0.0035705 0.0030789 0.0028789                                     140
 0.0033291 0.0027470 0.0031426 0.0031039 0.0017776 1.0000000 0.0030119       150
 0.6108296 0.7812874 0.6737132 0.6299642                                     160
 0.4299425 0.3547574 0.4058519 0.4008593 1.0000000 0.0017776 0.3889673       170
 1.0000000 0.7241215 0.6244183 0.5838704                                     180
9                                                                            190
  00020008001100                                                             200
 0.7507505 0.6194650 0.7086843 1.0000000 0.4008593 0.0031039 0.6792011       210
 0.7241215 1.0000000 0.7986682 0.7468050                                     220
 0.7446845 0.6144597 0.7029582 0.6943108 0.3976204 0.0030789 0.6737132       230
 0.6244183 0.7986682 1.0000000 0.6439786                                     240
 0.8635910 0.7125728 0.8152021 0.8051740 0.4611099 0.0035705 0.7812874       250
 0.5838704 0.7468050 0.6439786 1.0000000                                     260
 0.6963269 0.5745585 0.6573101 0.6492243 0.3718001 0.0028789 0.6299642       270
 1.0000000 0.6644085 0.7601008 0.7507505 0.4299425 0.0033291 0.7284786       280
 0.6751766 0.5571068 0.6373449 0.6295047 0.3605070 0.0027915 0.6108296       290
 0.7284786 0.6010878 0.6876602 0.6792011 0.3889673 0.0030119 1.0000000       300
 0.7446845 0.6144597 0.7029582 0.6943108 0.3976204 0.0030789 0.6737132       310
 0.4299425 0.3547574 0.4058519 0.4008593 1.0000000 0.0017776 0.3889673       320
 0.8635910 0.7125728 0.8152021 0.8051740 0.4611099 0.0035705 0.7812874       330
 0.7601008 0.6271802 1.0000000 0.7086843 0.4058519 0.0031426 0.6876602       340
 0.7601008 0.6271802 1.0000000 0.7086843 0.4058519 0.0031426 0.6876602       350
 0.6963269 0.5745585 0.6573101 0.6492243 0.3718001 0.0028789 0.6299642       360
9                                                                            370
                                                                             380
$EOD
.ASSIGN CDR 5
.ASSIGN LPT 6
.SET CDR ADS
.EXECUTE/REL ADSAM,MATIN,MXOUT,WES:SSP/LIB
%FIN::
.DELETE ADS.CDR