home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / DOOG / PCSSP1.ZIP / ITRPAPSM.ZIP / APLL.FOR < prev    next >
Text File  |  1985-11-29  |  5KB  |  121 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE APLL
  5. C
  6. C        PURPOSE
  7. C           SET UP NORMAL EQUATIONS FOR A LINEAR LEAST SQUARES FIT
  8. C           TO A GIVEN DISCRETE FUNCTION
  9. C
  10. C        USAGE
  11. C           CALL APLL(FFCT,N,IP,P,WORK,DATI,IER)
  12. C           SUBROUTINE FFCT REQUIRES AN EXTERNAL STATEMENT
  13. C
  14. C        DESCRIPTION OF PARAMETERS
  15. C           FFCT  - USER CODED SUBROUTINE WHICH MUST BE DECLARED
  16. C                   EXTERNAL IN THE MAIN PROGRAM. IT IS CALLED
  17. C                   CALL FFCT(I,N,IP,P,DATI,WGT,IER) AND RETURNS
  18. C                   THE VALUES OF THE FUNDAMENTAL FUNCTIONS FOR
  19. C                   THE I-TH ARGUMENT IN P(1) UP TO P(IP)
  20. C                   FOLLOWED BY THE I-TH FUNCTION VALUE IN P(IP+1)
  21. C                   N IS THE NUMBER OF ALL POINTS
  22. C                   DATI IS A DUMMY PARAMETER WHICH IS USED AS ARRAY
  23. C                   NAME. THE GIVEN DATA SET MAY BE ALLOCATED IN DATI
  24. C                   WGT IS THE WEIGHT FACTOR FOR THE I-TH POINT
  25. C                   IER IS USED AS RESULTANT ERROR PARAMETER IN FFCT
  26. C           N     - NUMBER OF GIVEN POINTS
  27. C           IP    - NUMBER OF FUNDAMENTAL FUNCTIONS USED FOR LEAST
  28. C                   SQUARES FIT
  29. C                   IP SHOULD NOT EXCEED N
  30. C           P     - WORKING STORAGE OF DIMENSION IP+1, WHICH
  31. C                   IS USED AS INTERFACE BETWEEN APLL AND THE USER
  32. C                   CODED SUBROUTINE FFCT
  33. C           WORK  - WORKING STORAGE OF DIMENSION (IP+1)*(IP+2)/2.
  34. C                   ON RETURN WORK CONTAINS THE SYMMETRIC COEFFICIENT
  35. C                   MATRIX OF THE NORMAL EQUATIONS IN COMPRESSED FORM,
  36. C                   I.E. UPPER TRINGULAR PART ONLY STORED COLUMNWISE.
  37. C                   THE FOLLOWING IP POSITIONS CONTAIN THE RIGHT
  38. C                   HAND SIDE AND WORK((IP+1)*(IP+2)/2) CONTAINS
  39. C                   THE WEIGHTED SQUARE SUM OF THE FUNCTION VALUES
  40. C           DATI  - DUMMY ENTRY TO COMMUNICATE AN ARRAY NAME BETWEEN
  41. C                   MAIN LINE AND SUBROUTINE FFCT.
  42. C           IER   - RESULTING ERROR PARAMETER
  43. C                   IER =-1 MEANS FORMAL ERRORS IN SPECIFIED DIMENSIONS
  44. C                   IER = 0 MEANS NO ERRORS
  45. C                   IER = 1 MEANS ERROR IN EXTERNAL SUBROUTINE FFCT
  46. C
  47. C        REMARKS
  48. C           TO ALLOW FOR EASY COMMUNICATION OF INTEGER VALUES
  49. C           BETWEEN MAINLINE AND EXTERNAL SUBROUTINE FFCT, THE ERROR
  50. C           PARAMETER IER IS TREATED AS A VECTOR OF DIMENSION 1 WITHIN
  51. C           SUBROUTINE APLL. ADDITIONAL COMPONENTS OF IER MAY BE
  52. C           INTRODUCED BY THE USER FOR COMMUNICATION BACK AND FORTH.
  53. C           IN THIS CASE, HOWEVER, THE USER MUST SPECIFY IER AS A
  54. C           VECTOR IN HIS MAINLINE.
  55. C           EXECUTION OF SUBROUTINE APLL IS A PREPARATORY STEP FOR
  56. C           CALCULATION OF THE LINEAR LEAST SQUARES FIT.
  57. C           NORMALLY IT IS FOLLOWED BY EXECUTION OF SUBROUTINE APFS
  58. C
  59. C       SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  60. C           THE EXTERNAL SUBROUTINE FFCT MUST BE FURNISHED BY THE USER
  61. C
  62. C        METHOD
  63. C           HANDLING OF THE GIVEN DATA SET (ARGUMENTS,FUNCTION VALUES
  64. C           AND WEIGHTS) IS COMPLETELY LEFT TO THE USER
  65. C           ESSENTIALLY HE HAS THREE CHOICES
  66. C           (1) THE I-TH VALUES OF ARGUMENT, FUNCTION VALUE AND WEIGHT
  67. C               ARE CALCULATED WITHIN SUBROUTINE FFCT FOR GIVEN I.
  68. C           (2) THE I-TH VALUES OF ARGUMENT, FUNCTION VALUE AND WEIGHT
  69. C               ARE DETERMINED BY TABLE LOOK UP. THE STORAGE LOCATIONS
  70. C               REQUIRED ARE ALLOCATED WITHIN THE DUMMY ARRAY DATI
  71. C               (POSSIBLY IN P TOO, IN EXCESS OF THE SPECIFIED IP + 1
  72. C               LOCATIONS).
  73. C               ANOTHER POSSIBILITY WOULD BE TO USE COMMON AS INTERFACE
  74. C               BETWEEN MAIN LINE AND SUBROUTINE FFCT AND TO ALLOCATE
  75. C               STORAGE FOR THE DATA SET IN COMMON.
  76. C           (3) THE I-TH VALUES OF ARGUMENT, FUNCTION VALUE AND WEIGHT
  77. C               ARE READ IN FROM AN EXTERNAL DEVICE. THIS MAY BE EASILY
  78. C               ACCOMPLISHED SINCE I IS USED STRICTLY INCREASING FROM
  79. C               ONE UP TO N WITHIN APLL
  80. C
  81. C     ..................................................................
  82. C
  83.       SUBROUTINE APLL(FFCT,N,IP,P,WORK,DATI,IER)
  84. C
  85. C
  86. C        DIMENSIONED DUMMY VARIABLES
  87.       DIMENSION P(1),WORK(1),DATI(1),IER(1)
  88. C
  89. C        CHECK FOR FORMAL ERRORS IN SPECIFIED DIMENSIONS
  90.       IF(N)10,10,1
  91.     1 IF(IP)10,10,2
  92.     2 IF(N-IP)10,3,3
  93. C
  94. C        SET WORKING STORAGE AND RIGHT HAND SIDE TO ZERO
  95.     3 IPP1=IP+1
  96.       M=IPP1*(IP+2)/2
  97.       IER(1)=0
  98.       DO 4 I=1,M
  99.     4 WORK(I)=0.
  100. C
  101. C        START GREAT LOOP OVER ALL GIVEN POINTS
  102.       DO 8 I=1,N
  103.       CALL FFCT(I,N,IP,P,DATI,WGT,IER)
  104.       IF(IER(1))9,5,9
  105.     5 J=0
  106.       DO 7 K=1,IPP1
  107.       AUX=P(K)*WGT
  108.       DO 6 L=1,K
  109.       J=J+1
  110.     6 WORK(J)=WORK(J)+P(L)*AUX
  111.     7 CONTINUE
  112.     8 CONTINUE
  113. C
  114. C        NORMAL RETURN
  115.     9 RETURN
  116. C
  117. C        ERROR RETURN IN CASE OF FORMAL ERRORS
  118.    10 IER(1)=-1
  119.       RETURN
  120.       END
  121.