Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0026/dapll.ssp
There are 2 other files named dapll.ssp in the archive. Click here to see a list.
C                                                                       DAPL  10
C     ..................................................................DAPL  20
C                                                                       DAPL  30
C        SUBROUTINE DAPLL                                               DAPL  40
C        PURPOSE                                                        DAPL  50
C           SET UP NORMAL EQUATIONS FOR A LINEAR LEAST SQUARES FIT      DAPL  60
C           TO A GIVEN DISCRETE FUNCTION                                DAPL  70
C                                                                       DAPL  80
C        USAGE                                                          DAPL  90
C           CALL DAPLL(FFCT,N,IP,P,WORK,DATI,IER)                       DAPL 100
C           SUBROUTINE FFCT REQUIRES AN EXTERNAL STATEMENT              DAPL 110
C                                                                       DAPL 120
C        DESCRIPTION OF PARAMETERS                                      DAPL 130
C           FFCT  - USER CODED SUBROUTINE WHICH MUST BE DECLARED        DAPL 140
C                   EXTERNAL IN THE MAIN PROGRAM. IT IS CALLED          DAPL 150
C                   CALL FFCT(I,N,IP,P,DATI,WGT,IER) AND RETURNS        DAPL 160
C                   THE VALUES OF THE FUNDAMENTAL FUNCTIONS FOR         DAPL 170
C                   THE I-TH ARGUMENT IN P(1) UP TO P(IP)               DAPL 180
C                   FOLLOWED BY THE I-TH FUNCTION VALUE IN P(IP+1)      DAPL 190
C                   N IS THE NUMBER OF ALL POINTS                       DAPL 200
C                   P,DATI,WGT MUST BE OF DOUBLE PRECISION.             DAPL 210
C                   DATI IS A DUMMY PARAMETER WHICH IS USED AS ARRAY    DAPL 220
C                   NAME. THE GIVEN DATA SET MAY BE ALLOCATED IN DATI   DAPL 230
C                   WGT IS THE WEIGHT FACTOR FOR THE I-TH POINT         DAPL 240
C                   IER IS USED AS RESULTANT ERROR PARAMETER IN FFCT    DAPL 250
C           N     - NUMBER OF GIVEN POINTS                              DAPL 260
C           IP    - NUMBER OF FUNDAMENTAL FUNCTIONS USED FOR LEAST      DAPL 270
C                   SQUARES FIT                                         DAPL 280
C                   IP SHOULD NOT EXCEED N                              DAPL 290
C           P     - WORKING STORAGE OF DIMENSION IP+1, WHICH            DAPL 300
C                   IS USED AS INTERFACE BETWEEN APLL AND THE USER      DAPL 310
C                   CODED SUBROUTINE FFCT                               DAPL 320
C                   P MUST BE OF DOUBLE PRECISION.                      DAPL 330
C           WORK  - WORKING STORAGE OF DIMENSION (IP+1)*(IP+2)/2.       DAPL 340
C                   ON RETURN WORK CONTAINS THE SYMMETRIC COEFFICIENT   DAPL 350
C                   MATRIX OF THE NORMAL EQUATIONS IN COMPRESSED FORM,  DAPL 360
C                   I.E. UPPER TRINGULAR PART ONLY STORED COLUMNWISE.   DAPL 370
C                   THE FOLLOWING IP POSITIONS CONTAIN THE RIGHT        DAPL 380
C                   HAND SIDE AND WORK((IP+1)*(IP+2)/2) CONTAINS        DAPL 390
C                   THE WEIGHTED SQUARE SUM OF THE FUNCTION VALUES      DAPL 400
C                   WORK MUST BE OF DOUBLE PRECISION.                   DAPL 410
C           DATI  - DUMMY ENTRY TO COMMUNICATE AN ARRAY NAME BETWEEN    DAPL 420
C                   MAIN LINE AND SUBROUTINE FFCT.                      DAPL 430
C                   DATI MUST BE OF DOUBLE PRECISION.                   DAPL 440
C           IER   - RESULTING ERROR PARAMETER                           DAPL 450
C                   IER =-1 MEANS FORMAL ERRORS IN SPECIFIED DIMENSIONS DAPL 460
C                   IER = 0 MEANS NO ERRORS                             DAPL 470
C                   IER = 1 MEANS ERROR IN EXTERNAL SUBROUTINE FFCT     DAPL 480
C                                                                       DAPL 490
C        REMARKS                                                        DAPL 500
C           TO ALLOW FOR EASY COMMUNICATION OF INTEGER VALUES           DAPL 510
C           BETWEEN MAINLINE AND EXTERNAL SUBROUTINE FFCT, THE ERROR    DAPL 520
C           PARAMETER IER IS TREATED AS A VECTOR OF DIMENSION 1 WITHIN  DAPL 530
C           SUBROUTINE DAPLL. ADDITIONAL COMPONENTS OF IER MAY BE       DAPL 540
C           INTRODUCED BY THE USER FOR COMMUNICATION BACK AND FORTH.    DAPL 550
C           IN THIS CASE, HOWEVER, THE USER MUST SPECIFY IER AS A       DAPL 560
C           VECTOR IN HIS MAINLINE.                                     DAPL 570
C           EXECUTION OF SUBROUTINE DAPLL IS A PREPARATORY STEP FOR     DAPL 580
C           CALCULATION OF THE LINEAR LEAST SQUARES FIT.                DAPL 590
C           NORMALLY IT IS FOLLOWED BY EXECUTION OF SUBROUTINE DAPFS    DAPL 600
C                                                                       DAPL 610
C       SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED                   DAPL 620
C           THE EXTERNAL SUBROUTINE FFCT MUST BE FURNISHED BY THE USER  DAPL 630
C                                                                       DAPL 640
C        METHOD                                                         DAPL 650
C           HANDLING OF THE GIVEN DATA SET (ARGUMENTS,FUNCTION VALUES   DAPL 660
C           AND WEIGHTS) IS COMPLETELY LEFT TO THE USER                 DAPL 670
C           ESSENTIALLY HE HAS THREE CHOICES                            DAPL 680
C           (1) THE I-TH VALUES OF ARGUMENT, FUNCTION VALUE AND WEIGHT  DAPL 690
C               ARE CALCULATED WITHIN SUBROUTINE FFCT FOR GIVEN I.      DAPL 700
C           (2) THE I-TH VALUES OF ARGUMENT, FUNCTION VALUE AND WEIGHT  DAPL 710
C               ARE DETERMINED BY TABLE LOOK UP. THE STORAGE LOCATIONS  DAPL 720
C               REQUIRED ARE ALLOCATED WITHIN THE DUMMY ARRAY DATI      DAPL 730
C               (POSSIBLY IN P TOO, IN EXCESS OF THE SPECIFIED IP + 1   DAPL 740
C               LOCATIONS).                                             DAPL 750
C               ANOTHER POSSIBILITY WOULD BE TO USE COMMON AS INTERFACE DAPL 760
C               BETWEEN MAIN LINE AND SUBROUTINE FFCT AND TO ALLOCATE   DAPL 770
C               STORAGE FOR THE DATA SET IN COMMON.                     DAPL 780
C           (3) THE I-TH VALUES OF ARGUMENT, FUNCTION VALUE AND WEIGHT  DAPL 790
C               ARE READ IN FROM AN EXTERNAL DEVICE. THIS MAY BE EASILY DAPL 800
C               ACCOMPLISHED SINCE I IS USED STRICTLY INCREASING FROM   DAPL 810
C               ONE UP TO N WITHIN APLL                                 DAPL 820
C                                                                       DAPL 830
C     ..................................................................DAPL 840
C                                                                       DAPL 850
      SUBROUTINE DAPLL(FFCT,N,IP,P,WORK,DATI,IER)                       DAPL 860
C                                                                       DAPL 870
C                                                                       DAPL 880
C        DIMENSIONED DUMMY VARIABLES                                    DAPL 890
      DIMENSION P(1),WORK(1),DATI(1),IER(1)                             DAPL 900
      DOUBLE PRECISION P,WORK,DATI,WGT,AUX                              DAPL 910
C                                                                       DAPL 920
C        CHECK FOR FORMAL ERRORS IN SPECIFIED DIMENSIONS                DAPL 930
      IF(N)10,10,1                                                      DAPL 940
    1 IF(IP)10,10,2                                                     DAPL 950
    2 IF(N-IP)10,3,3                                                    DAPL 960
C                                                                       DAPL 970
C        SET WORKING STORAGE AND RIGHT HAND SIDE TO ZERO                DAPL 980
    3 IPP1=IP+1                                                         DAPL 990
      M=IPP1*(IP+2)/2                                                   DAPL1000
      IER(1)=0                                                          DAPL1010
      DO 4 I=1,M                                                        DAPL1020
    4 WORK(I)=0.D0                                                      DAPL1030
C                                                                       DAPL1040
C        START GREAT LOOP OVER ALL GIVEN POINTS                         DAPL1050
      DO 8 I=1,N                                                        DAPL1060
      CALL FFCT(I,N,IP,P,DATI,WGT,IER)                                  DAPL1070
      IF(IER(1))9,5,9                                                   DAPL1080
    5 J=0                                                               DAPL1090
      DO 7 K=1,IPP1                                                     DAPL1100
      AUX=P(K)*WGT                                                      DAPL1110
      DO 6 L=1,K                                                        DAPL1120
      J=J+1                                                             DAPL1130
    6 WORK(J)=WORK(J)+P(L)*AUX                                          DAPL1140
    7 CONTINUE                                                          DAPL1150
    8 CONTINUE                                                          DAPL1160
C                                                                       DAPL1170
C        NORMAL RETURN                                                  DAPL1180
    9 RETURN                                                            DAPL1190
C                                                                       DAPL1200
C        ERROR RETURN IN CASE OF FORMAL ERRORS                          DAPL1210
   10 IER(1)=-1                                                         DAPL1220
      RETURN                                                            DAPL1230
      END                                                               DAPL1240