*************************************************************************
*************************************************************************
PARAMETER (NUM=8,MC=101)
COMPLEX IC(NUM),BX,BY,B,BXSUM,BYSUM
REAL I0,IR,II,XX,ABX,ABY,RXY,MICRO
DIMENSION XA(NUM),YA(NUM)
OPEN (3,FILE='E:\tBX_INF.DAT',STATUS='UNKNOWN')
OPEN (4,FILE='E:\tBY_INF.DAT',STATUS='UNKNOWN')
*************************************************************************
* input data *
*************************************************************************
DATA H1/30.0/,H2/43.5/,H3/57.0/,H4/70.77/,I0/1000.0/
C
PAI=4*ATAN(1)
MICRO=4*PAI/10.0
*************************************************************************
* position *
*************************************************************************
RADA=0.0
RADB=-2.0*PAI/3.0
RADC=2.0*PAI/3.0
DO 10 I=1,NUM
IF (I.EQ.1) THEN
XA(I)=10.0
YA(I)=H1
RAD=RADA
ELSEIF (I.EQ.2) THEN
XA(I)=9.8
YA(I)=H2
RAD=RADB
ELSEIF (I.EQ.3) THEN
XA(I)=9.6
YA(I)=H3
RAD=RADC
ELSEIF (I.EQ.4) THEN
XA(I)=9.6
YA(I)=H4
ELSEIF (I.EQ.5) THEN
XA(I)=-9.6
YA(I)=H4
ELSEIF (I.EQ.6) THEN
XA(I)=-9.6
YA(I)=H3
RAD=RADA
ELSEIF (I.EQ.7) THEN
XA(I)=-9.8
YA(I)=H2
RAD=RADB
ELSEIF (I.EQ.8) THEN
XA(I)=-10.0
YA(I)=H1
RAD=RADC
ENDIF
*
IR=I0*COS(RAD)
II=I0*SIN(RAD)
IC(I)=CMPLX(IR,II)
IF (I.EQ.4.OR.I.EQ.5) THEN
IC(I)=CMPLX(0.0,0.0)
ENDIF
10 CONTINUE
************************************************************************
* magnetic field *
************************************************************************
DO 100 IX=1,MC
XX=(REAL(IX)-1.0)*100.0/100.0-50.0
YY=1.0
C
BXSUM=CMPLX(0.0,0.0)
BYSUM=CMPLX(0.0,0.0)
DO 150 I=1,NUM
D=SQRT((XX-XA(I))**2+(YA(I)-YY)**2)
B=MICRO*IC(I)/(2*PAI*D)
BX=B*(YA(I)-YY)/D
BY=B*(XX-XA(I))/D
C
BXSUM=BX+BXSUM
BYSUM=BY+BYSUM
150 CONTINUE
C
ABX=CABS(BXSUM)
ABY=CABS(BYSUM)
RXY=ABY/ABX
BXR=REAL(BXSUM)
BXI=IMAG(BXSUM)
BYR=REAL(BYSUM)
BYI=IMAG(BYSUM)
************************************************************************
IF (BXR .EQ. 0.0) THEN
THX=90.0
ELSE
THX=ATAN(BXI/BXR)*180.0/PAI
ENDIF
IF (BYR .EQ. 0.0) THEN
THY=90.0
ELSE
THY=ATAN(BYI/BYR)*180.0/PAI
ENDIF
*
IF (BXR.GT.0.0.AND.BXI.GT.0.0) THEN
THX=THX
ELSE IF (BXR.LT.0.0.AND.BXI.GT.0.0) THEN
THX=180.0+THX
ELSE IF (BXR.LT.0.0.AND.BXI.LT.0.0) THEN
THX=THX-180.0
ELSE IF (BXR.GT.0.0.AND.BXI.LT.0.0) THEN
THX=THX
ELSE IF (BXR.GT.0.0.AND.BXI.EQ.0.0) THEN
THX=0.0
ELSE IF (BXR.EQ.0.0.AND.BXI.GT.0.0) THEN
THX=90.0
ELSE IF (BXR.LT.0.0.AND.BXI.EQ.0.0) THEN
THX=180.0
ELSE IF (BXR.EQ.0.0.AND.BXI.LT.0.0) THEN
THX=-90.0
ENDIF
*
IF (BYR.GT.0.0.AND.BYI.GT.0.0) THEN
THY=THY
ELSE IF (BYR.LT.0.0.AND.BYI.GT.0.0) THEN
THY=THY+180.0
ELSE IF (BYR.LT.0.0.AND.BYI.LT.0.0) THEN
THY=THY-180.0
ELSE IF (BYR.GT.0.0.AND.BYI.LT.0.0) THEN
THY=THY
ELSE IF (BYR.GT.0.0.AND.BYI.EQ.0.0) THEN
THY=0.0
ELSE IF (BYR.EQ.0.0.AND.BYI.GT.0.0) THEN
THY=90.0
ELSE IF (BYR.LT.0.0.AND.BYI.EQ.0.0) THEN
THY=180.0
ELSE IF (BYR.EQ.0.0.AND.BYI.LT.0.0) THEN
THY=-90.0
ENDIF
*
THYX=THY-THX
IF(THYX.GT.180.0.AND.THYX.LE.360.0) THEN
THYX=THYX-360.0
ELSE IF(THYX.GE.-360.0.AND.THYX.LT.-180.0) THEN
THYX=THYX+360.0
ELSE IF(THYX.GE.-180.0.AND.THYX.LE.180.0) THEN
THYX=THYX
ENDIF
*************************************************************************
* output (dimension: ��T/deg) *
*************************************************************************
WRITE(3,600) XX,ABX,THX
600 FORMAT(' ',F7.2,2X,F13.5,2X,F7.1)
WRITE(4,700) XX,ABY,THY
700 FORMAT(' ',F7.2,2X,F13.5,2X,F7.1)
*************************************************************************
100 CONTINUE
CLOSE(3)
CLOSE(4)
STOP
END