Portál AbcLinuxu, 19. listopadu 2025 17:03
SUBROUTINE DAPRX(X,Y,N,M,CP)
C ****************
C
C APROXIMATION OF THE MEASURED VALUES BY THE POLYNOM
C
C PARAMETERS X,Y ... INPUT VALUES IN D.P. ARRAYS
C N ... NO. OF POINTS
C M ... DEGREE OF POLYNOM
C CP ... OUTPUT ARRAY CONTAINING THE
C COEFFICIENTS
C
DOUBLE PRECISION X(1),Y(1),C(20,11),CP(20),B(40),DPV
DOUBLE PRECISION U,S,P
IF((N-M).GT.1) GO TO 67
WRITE(*,66)
66 FORMAT(' *** ERROR *** IN APPROXIMATION , M >N-1 !!! ',/)
RETURN
67 CONTINUE
M1=M
M=M+1
M2=2*M1
DO 490 K=1,M2
B(K)=0.D0
DO 490 I=1,N
B(K)=B(K)+X(I)**K
490 CONTINUE
C
DO 570 I=1,M
DO 570 J=1,M
I2=I+J-2
IF(I2.NE.0) GO TO 560
C(1,1)=N
GO TO 570
560 C(I,J)=B(I2)
570 CONTINUE
C
C(1,M+1)=0.D0
DO 630 I=1,N
630 C(1,M+1)=C(1,M+1)+Y(I)
DO 690 K=2,M
C(K,M+1)=0.D0
DO 690 I=1,N
C(K,M+1)=C(K,M+1)+Y(I)*(X(I)**(K-1))
690 CONTINUE
C
N1=M+1
J=1
K=1
I=1
740 I3=I+K
DPV=C(I,J)*C(I3,J)
IF(DPV.NE.0.D0) GO TO 790
U=1.D0
S=0.0D0
GO TO 820
790 P=DSQRT(C(I,J)*C(I,J)+C(I3,J)*C(I3,J))
U=C(I,J)/P
S=-1.D0*C(I3,J)/P
820 DO 860 J1=J,N1
P=U*C(I,J1)-S*C(I3,J1)
C(I3,J1)=S*C(I,J1)+U*C(I3,J1)
C(I,J1)=P
860 CONTINUE
K=K+1
KH=K+I-M
IF(KH.LE.0) GO TO 740
K=1
I=I+1
J=J+1
IF((J-M).LT.0) GO TO 740
C
I=M
950 C(I,N1)=C(I,N1)/C(I,I)
K=I-1
970 IF(K.LE.0) GO TO 1010
C(K,N1)=C(K,N1)-C(K,I)*C(I,N1)
K=K-1
GO TO 970
1010 I=I-1
IF((I-1).GE.0) GO TO 950
C
DO 1011 I=1,20
1011 CP(I)=C(I,M+1)
RETURN
END
). Muselo by se v te subroutine nejak dynamicky naalokovat velikost toho pole, a to ja nevim, jak se ve Fortranu dela (a nebo tam dat dostatecne velke hodnoty, kterych nedosahnete). Ale predrecnik ma pravdu v tom, ze pokud se budete snazit aproximaci vylepsit pouzitim polynomu vyssiho radu, muze se vam to paradoxne zhorsit, protoze se vam ten polynom zvlni (jak se prizpusobi ruznym chybam) a bude davat horsi vysledky nez polynom radu nizsiho. Lepe by bylo asi zvolit nejaky druh regrese. Jeste bych rad upozornil, ze procedura DPVAL patrne funguje jenom na polynomy do radu 10.
Jiste existuje uz naprogramovana routina. Vasim ukolem je najit jijestli tim myslis, ze chces nasmerovat, kde mas hledat, tak osobne bych se asi zkusil podivat do cernlibu, je to v F77 a je toho tam opravdu hodne, pokud by ses spokojil i s C/C++, tak gsl, pripadne sem si pomerne jisty, ze to umi Root
NLSCON
ODRPACK
GREGPrvni dve jsou k nalezeni na www.netlib.org, GREG jsem nikde nez v repozitari u nas na ustavu nenasel. Jsou to sice rutiny vhodne na nelinearni regresi (v NLSCON je G-N metoda a v ODRPACK je L-M). Vyhodou pouziti techto rutin je, ze ziskas "zadarmo" treba i kovariancni matici odhadnutych parametru a z ni muzes spocitat nejistoty v extrapolovanych hodnotach. Jinak na stupen polynomu bych doporucoval F-test - testovat zda-li se vazena suma ctrvercu reziduii pridanim dalsiho parametru do polynomu zmensila. Nejsem matematik ale chemik, kdyztak at me povolanejsi opravi. Jeste se mrknu po jednom svem programku, ktery sem spachal kdysi pred lety. Mozna se ti bude hodit ale nic nezarucuju.
Tiskni
Sdílej:
ISSN 1214-1267, (c) 1999-2007 Stickfish s.r.o.