      SUBROUTINE FIELD
      COMMON/FLDCOM/ST,CT,SPH,CPH,R,BT,BP,BR,B,NMAX
      COMMON /COEFFS/G(18,18)
      DIMENSION P(18,18),DP(18,18),CONST(18,18),SP(18),CP(18),FN(18),FM(
     118)
      SAVE
      IF (P(1,1).EQ.1.0) GO TO 3
1     P(1,1)=1.
      DP(1,1)=0.
      SP(1)=0.
      CP(1)=1.
      DO 2 N=2,18
      FN(N)=N
      DO 2 M=1,N
      FM(M)=M-1
2     CONST(N,M)=FLOAT((N-2)**2-(M-1)**2)/FLOAT((2*N-3)*(2*N-5))
3     SP(2)=SPH
      CP(2)=CPH
      DO 4 M=3,NMAX
      SP(M)=SP(2)*CP(M-1)+CP(2)*SP(M-1)
4     CP(M)=CP(2)*CP(M-1)-SP(2)*SP(M-1)
      AOR=6371.2/R
      AR=AOR**2
      BT=0.
      BP=0.
      BR=0.
      DO 8 N=2,NMAX
      AR=AOR*AR
      DO 8 M=1,N
      IF(N.EQ.M) GO TO 5
6     P(N,M)=CT*P(N-1,M)-CONST(N,M)*P(N-2,M)
      DP(N,M)=CT*DP(N-1,M)-ST*P(N-1,M)-CONST(N,M)*DP(N-2,M)
      GO TO 7
5     P(N,N)=ST*P(N-1,N-1)
      DP(N,N)=ST*DP(N-1,N-1)+CT*P(N-1,N-1)
7     PAR=P(N,M)*AR
      IF (M.EQ.1) GO TO 9
      TEMP=G(N,M)*CP(M)+G(M-1,N)*SP(M)
      BP=BP-(G(N,M)*SP(M)-G(M-1,N)*CP(M))*FM(M)*PAR
      GO TO 10
9     TEMP=G(N,M)*CP(M)
      BP=BP-(G(N,M)*SP(M))*FM(M)*PAR
10    BT=BT+TEMP*DP(N,M)*AR
8     BR=BR-TEMP*FN(N)*PAR
      BP=BP/ST
      B= SQRT(BT*BT+BP*BP+BR*BR)
      RETURN
      END
