mirror of
https://github.com/eddyem/BTA_lib.git
synced 2026-03-22 01:31:17 +03:00
copy
This commit is contained in:
eddyem
328
slalib/fitxy.f
Normal file
328
slalib/fitxy.f
Normal file
@@ -0,0 +1,328 @@
|
||||
SUBROUTINE sla_FITXY (ITYPE,NP,XYE,XYM,COEFFS,J)
|
||||
*+
|
||||
* - - - - - -
|
||||
* F I T X Y
|
||||
* - - - - - -
|
||||
*
|
||||
* Fit a linear model to relate two sets of [X,Y] coordinates.
|
||||
*
|
||||
* Given:
|
||||
* ITYPE i type of model: 4 or 6 (note 1)
|
||||
* NP i number of samples (note 2)
|
||||
* XYE d(2,np) expected [X,Y] for each sample
|
||||
* XYM d(2,np) measured [X,Y] for each sample
|
||||
*
|
||||
* Returned:
|
||||
* COEFFS d(6) coefficients of model (note 3)
|
||||
* J i status: 0 = OK
|
||||
* -1 = illegal ITYPE
|
||||
* -2 = insufficient data
|
||||
* -3 = no solution
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) ITYPE, which must be either 4 or 6, selects the type of model
|
||||
* fitted. Both allowed ITYPE values produce a model COEFFS which
|
||||
* consists of six coefficients, namely the zero points and, for
|
||||
* each of XE and YE, the coefficient of XM and YM. For ITYPE=6,
|
||||
* all six coefficients are independent, modelling squash and shear
|
||||
* as well as origin, scale, and orientation. However, ITYPE=4
|
||||
* selects the "solid body rotation" option; the model COEFFS
|
||||
* still consists of the same six coefficients, but now two of
|
||||
* them are used twice (appropriately signed). Origin, scale
|
||||
* and orientation are still modelled, but not squash or shear -
|
||||
* the units of X and Y have to be the same.
|
||||
*
|
||||
* 2) For NC=4, NP must be at least 2. For NC=6, NP must be at
|
||||
* least 3.
|
||||
*
|
||||
* 3) The model is returned in the array COEFFS. Naming the
|
||||
* elements of COEFFS as follows:
|
||||
*
|
||||
* COEFFS(1) = A
|
||||
* COEFFS(2) = B
|
||||
* COEFFS(3) = C
|
||||
* COEFFS(4) = D
|
||||
* COEFFS(5) = E
|
||||
* COEFFS(6) = F
|
||||
*
|
||||
* the model is:
|
||||
*
|
||||
* XE = A + B*XM + C*YM
|
||||
* YE = D + E*XM + F*YM
|
||||
*
|
||||
* For the "solid body rotation" option (ITYPE=4), the
|
||||
* magnitudes of B and F, and of C and E, are equal. The
|
||||
* signs of these coefficients depend on whether there is a
|
||||
* sign reversal between XE,YE and XM,YM; fits are performed
|
||||
* with and without a sign reversal and the best one chosen.
|
||||
*
|
||||
* 4) Error status values J=-1 and -2 leave COEFFS unchanged;
|
||||
* if J=-3 COEFFS may have been changed.
|
||||
*
|
||||
* See also sla_PXY, sla_INVF, sla_XY2XY, sla_DCMPF
|
||||
*
|
||||
* Called: sla_DMAT, sla_DMXV
|
||||
*
|
||||
* Last revision: 8 September 2005
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER ITYPE,NP
|
||||
DOUBLE PRECISION XYE(2,NP),XYM(2,NP),COEFFS(6)
|
||||
INTEGER J
|
||||
|
||||
INTEGER I,JSTAT,IW(4),NSOL
|
||||
DOUBLE PRECISION A,B,C,D,AOLD,BOLD,COLD,DOLD,SOLD,
|
||||
: P,SXE,SXEXM,SXEYM,SYE,SYEYM,SYEXM,SXM,
|
||||
: SYM,SXMXM,SXMYM,SYMYM,XE,YE,
|
||||
: XM,YM,V(4),DM3(3,3),DM4(4,4),DET,
|
||||
: SGN,SXXYY,SXYYX,SX2Y2,SDR2,XR,YR
|
||||
|
||||
|
||||
|
||||
* Preset the status
|
||||
J=0
|
||||
|
||||
* Variable initializations to avoid compiler warnings
|
||||
A = 0D0
|
||||
B = 0D0
|
||||
C = 0D0
|
||||
D = 0D0
|
||||
AOLD = 0D0
|
||||
BOLD = 0D0
|
||||
COLD = 0D0
|
||||
DOLD = 0D0
|
||||
SOLD = 0D0
|
||||
|
||||
* Float the number of samples
|
||||
P=DBLE(NP)
|
||||
|
||||
* Check ITYPE
|
||||
IF (ITYPE.EQ.6) THEN
|
||||
|
||||
*
|
||||
* Six-coefficient linear model
|
||||
* ----------------------------
|
||||
|
||||
* Check enough samples
|
||||
IF (NP.GE.3) THEN
|
||||
|
||||
* Form summations
|
||||
SXE=0D0
|
||||
SXEXM=0D0
|
||||
SXEYM=0D0
|
||||
SYE=0D0
|
||||
SYEYM=0D0
|
||||
SYEXM=0D0
|
||||
SXM=0D0
|
||||
SYM=0D0
|
||||
SXMXM=0D0
|
||||
SXMYM=0D0
|
||||
SYMYM=0D0
|
||||
DO I=1,NP
|
||||
XE=XYE(1,I)
|
||||
YE=XYE(2,I)
|
||||
XM=XYM(1,I)
|
||||
YM=XYM(2,I)
|
||||
SXE=SXE+XE
|
||||
SXEXM=SXEXM+XE*XM
|
||||
SXEYM=SXEYM+XE*YM
|
||||
SYE=SYE+YE
|
||||
SYEYM=SYEYM+YE*YM
|
||||
SYEXM=SYEXM+YE*XM
|
||||
SXM=SXM+XM
|
||||
SYM=SYM+YM
|
||||
SXMXM=SXMXM+XM*XM
|
||||
SXMYM=SXMYM+XM*YM
|
||||
SYMYM=SYMYM+YM*YM
|
||||
END DO
|
||||
|
||||
* Solve for A,B,C in XE = A + B*XM + C*YM
|
||||
V(1)=SXE
|
||||
V(2)=SXEXM
|
||||
V(3)=SXEYM
|
||||
DM3(1,1)=P
|
||||
DM3(1,2)=SXM
|
||||
DM3(1,3)=SYM
|
||||
DM3(2,1)=SXM
|
||||
DM3(2,2)=SXMXM
|
||||
DM3(2,3)=SXMYM
|
||||
DM3(3,1)=SYM
|
||||
DM3(3,2)=SXMYM
|
||||
DM3(3,3)=SYMYM
|
||||
CALL sla_DMAT(3,DM3,V,DET,JSTAT,IW)
|
||||
IF (JSTAT.EQ.0) THEN
|
||||
DO I=1,3
|
||||
COEFFS(I)=V(I)
|
||||
END DO
|
||||
|
||||
* Solve for D,E,F in YE = D + E*XM + F*YM
|
||||
V(1)=SYE
|
||||
V(2)=SYEXM
|
||||
V(3)=SYEYM
|
||||
CALL sla_DMXV(DM3,V,COEFFS(4))
|
||||
|
||||
ELSE
|
||||
|
||||
* No 6-coefficient solution possible
|
||||
J=-3
|
||||
|
||||
END IF
|
||||
|
||||
ELSE
|
||||
|
||||
* Insufficient data for 6-coefficient fit
|
||||
J=-2
|
||||
|
||||
END IF
|
||||
|
||||
ELSE IF (ITYPE.EQ.4) THEN
|
||||
|
||||
*
|
||||
* Four-coefficient solid body rotation model
|
||||
* ------------------------------------------
|
||||
|
||||
* Check enough samples
|
||||
IF (NP.GE.2) THEN
|
||||
|
||||
* Try two solutions, first without then with flip in X
|
||||
DO NSOL=1,2
|
||||
IF (NSOL.EQ.1) THEN
|
||||
SGN=1D0
|
||||
ELSE
|
||||
SGN=-1D0
|
||||
END IF
|
||||
|
||||
* Form summations
|
||||
SXE=0D0
|
||||
SXXYY=0D0
|
||||
SXYYX=0D0
|
||||
SYE=0D0
|
||||
SXM=0D0
|
||||
SYM=0D0
|
||||
SX2Y2=0D0
|
||||
DO I=1,NP
|
||||
XE=XYE(1,I)*SGN
|
||||
YE=XYE(2,I)
|
||||
XM=XYM(1,I)
|
||||
YM=XYM(2,I)
|
||||
SXE=SXE+XE
|
||||
SXXYY=SXXYY+XE*XM+YE*YM
|
||||
SXYYX=SXYYX+XE*YM-YE*XM
|
||||
SYE=SYE+YE
|
||||
SXM=SXM+XM
|
||||
SYM=SYM+YM
|
||||
SX2Y2=SX2Y2+XM*XM+YM*YM
|
||||
END DO
|
||||
|
||||
*
|
||||
* Solve for A,B,C,D in: +/- XE = A + B*XM - C*YM
|
||||
* + YE = D + C*XM + B*YM
|
||||
V(1)=SXE
|
||||
V(2)=SXXYY
|
||||
V(3)=SXYYX
|
||||
V(4)=SYE
|
||||
DM4(1,1)=P
|
||||
DM4(1,2)=SXM
|
||||
DM4(1,3)=-SYM
|
||||
DM4(1,4)=0D0
|
||||
DM4(2,1)=SXM
|
||||
DM4(2,2)=SX2Y2
|
||||
DM4(2,3)=0D0
|
||||
DM4(2,4)=SYM
|
||||
DM4(3,1)=SYM
|
||||
DM4(3,2)=0D0
|
||||
DM4(3,3)=-SX2Y2
|
||||
DM4(3,4)=-SXM
|
||||
DM4(4,1)=0D0
|
||||
DM4(4,2)=SYM
|
||||
DM4(4,3)=SXM
|
||||
DM4(4,4)=P
|
||||
CALL sla_DMAT(4,DM4,V,DET,JSTAT,IW)
|
||||
IF (JSTAT.EQ.0) THEN
|
||||
A=V(1)
|
||||
B=V(2)
|
||||
C=V(3)
|
||||
D=V(4)
|
||||
|
||||
* Determine sum of radial errors squared
|
||||
SDR2=0D0
|
||||
DO I=1,NP
|
||||
XM=XYM(1,I)
|
||||
YM=XYM(2,I)
|
||||
XR=A+B*XM-C*YM-XYE(1,I)*SGN
|
||||
YR=D+C*XM+B*YM-XYE(2,I)
|
||||
SDR2=SDR2+XR*XR+YR*YR
|
||||
END DO
|
||||
|
||||
ELSE
|
||||
|
||||
* Singular: set flag
|
||||
SDR2=-1D0
|
||||
|
||||
END IF
|
||||
|
||||
* If first pass and non-singular, save variables
|
||||
IF (NSOL.EQ.1.AND.JSTAT.EQ.0) THEN
|
||||
AOLD=A
|
||||
BOLD=B
|
||||
COLD=C
|
||||
DOLD=D
|
||||
SOLD=SDR2
|
||||
END IF
|
||||
|
||||
END DO
|
||||
|
||||
* Pick the best of the two solutions
|
||||
IF (SOLD.GE.0D0.AND.(SOLD.LE.SDR2.OR.NP.EQ.2)) THEN
|
||||
COEFFS(1)=AOLD
|
||||
COEFFS(2)=BOLD
|
||||
COEFFS(3)=-COLD
|
||||
COEFFS(4)=DOLD
|
||||
COEFFS(5)=COLD
|
||||
COEFFS(6)=BOLD
|
||||
ELSE IF (JSTAT.EQ.0) THEN
|
||||
COEFFS(1)=-A
|
||||
COEFFS(2)=-B
|
||||
COEFFS(3)=C
|
||||
COEFFS(4)=D
|
||||
COEFFS(5)=C
|
||||
COEFFS(6)=B
|
||||
ELSE
|
||||
|
||||
* No 4-coefficient fit possible
|
||||
J=-3
|
||||
END IF
|
||||
ELSE
|
||||
|
||||
* Insufficient data for 4-coefficient fit
|
||||
J=-2
|
||||
END IF
|
||||
ELSE
|
||||
|
||||
* Illegal ITYPE - not 4 or 6
|
||||
J=-1
|
||||
END IF
|
||||
|
||||
END
|
||||
Reference in New Issue
Block a user