      PROGRAM EQUIPOT
C
C     EQUIPOTENTIAL CURVES FOR TWO POINT CHARGES
C
C     -----------------------------------------------
C     AUTHOR: ROBERT EHRLICH (GEORGE MASON U    1973)
C     UPDATE: PETER SIGNEL (MSU PHYSICS DEPT 3/01/86)
C     UPDATE: GARY HERZENSTIEL (MSU CPS DEPT 6/12/86)
C     Updated  November 1987  E.J.D.Kales
C
C     THIS PROGRAM DISPLAYS EQUIPOTENTIAL CURVES FOR TWO
C     POINT CHARGES
C
C     SUBROUTINES: GETCORD - GET THE COORDINATES ON THE 2 CHARGES
C                  CALPOT  - CALCULATES THE EQUIPOTENTIAL MATRIX
C                  DISPLAY - DISPLAY THIS MATRIX
C                  QUERY   - ASKS IF USER WANTS TO GO AGAIN
C
C                              E Q U I P O T
C                                    :
C            --------------------------------------------------
C            :             :                    :             :
C         GETCORD        CALPOT              DISPLAY        QUERY
C      (A1,A2,Q1,Q2) (A1,A2,Q1,Q2,PICT) (A1,A2,Q1,Q2,PICT) (AGAIN)
C
C     ***** DECLARATIONS *****
      REAL A1,A2,Q1,Q2
      CHARACTER PICT(61)*101,AGAIN
      OPEN(UNIT=3,FILE='OUTPUT.LST')
C                    
C     ***** M A I N   B O D Y *****
C
 10   WRITE(3,'(A1)') 12
      CALL GETCORD(A1,A2,Q1,Q2        )
      CALL CALPOT (A1,A2,Q1,Q2,   PICT)
      CALL DISPLAY(A1,A2,Q1,Q2,PICT   )
      CALL QUERY  (              AGAIN)
C     IF USER IS DONE, END
      IF(AGAIN.EQ.'Y')GOTO 10
      STOP
      END
C
C     ***** G E T C O R D *****
C
      SUBROUTINE GETCORD(A1,A2,Q1,Q2     )
C
C     PROMPTS THE USER FOR A1,A2,Q1,Q2
C
C     ***** DECLARATIONS *****
      REAL A1,A2,Q1,Q2
C
      PRINT *,'Please supply A1, A2, Q1, & Q2 values:'
      WRITE(*,20) 'A1='
      READ *,A1
      WRITE(*,20) 'A2='
      READ *,A2
      WRITE(*,20) 'Q1='
      READ *,Q1
      WRITE(*,20) 'Q2='
      READ *,Q2      
  20  FORMAT(A3/)
      PRINT *
      WRITE(*,34) A1,A2,Q1,Q2
      WRITE(3,34) A1,A2,Q1,Q2
 34   FORMAT('M348P2.FOR  Equipotential curves for 2 Point-Charges:'/
     +'  A1=',F8.5,'  A2=',F8.5,'  Q1=',F8.5,'  Q2=',F8.5)
      RETURN
      END
C
C     ***** C A L P O T *****
C
      SUBROUTINE CALPOT(A1,A2,Q1,Q2,    PICT)
C
C     calculates electric potential matrix
C
C     ***** DECLARATIONS *****
      CHARACTER PICT(61)*101
      INTEGER J,K,JV,JTEST
      REAL XSCLE,YSCLE
      REAL A1,A2,Q1,Q2,AJ,AK,ALG2,X,Y,R1,R2,V
C
C     PICT   - THE ARRAY HOLDING NET ELECTRICAL POTENTIALS
C
      ALG2=ALOG(2.0)/2.0
      XSCLE=0.20000
      YSCLE=0.33333
      WRITE(3,38) XSCLE,YSCLE
 38   FORMAT('80 Width     XSCLE=',F6.4,'  YSCLE=',F6.4)
CC    38   FORMAT('120 Width    XSCLE=',F6.4,'  YSCLE=',F6.4)
C
C     THESE LOOPS GO OVER 61 ROWS AND 101 COLUMNS
C
      DO 40,J=1,61
C
          DO 40,K=1,101
C
C             THE X AND Y COORDINATES ARE CALCULATED FROM THE
C             ROW AND COLUMN INDICES J AND K.  RECALL THAT X
C             AND Y MUST LIE BETWEEN -10 AND +10
C
              AJ=J
              AK=K
              X=(AK-51.)*XSCLE
              Y=(AJ-31.)*YSCLE
C
C             CALCULATE DISTANCES R1 & R2 TO THE POINT (X,Y) 
C             OF THE 2 POINT CHARGES.  OFFSET BY +.000001 TO 
C             INSURE R1 & R2 ARE NOT ZERO.
C
              R1=SQRT((X-A1)**2+Y**2)+.000001
              R2=SQRT((X-A2)**2+Y**2)+.000001
C
C             CALCULATE THE NET ELECTRICAL POTENTIAL FOR 
C             THE 2 POINT CHARGES PLUS THE OFFSET OF .000001
C
              V=Q1/R1+Q2/R2+.000001
C
C             THE QUANTITY JV IS SO DEFINED THAT IT INCREASES BY
C             TWO IF V IS DOUBLED
C
              JV=ALOG(ABS(V))/ALG2
              JTEST=JV-2*(JV/2)
C
C             PUT JTEST INTO THE PICT ARRAY FOR LATER DISPLAYING
C
              IF(JTEST.NE.0)THEN
                  PICT(J)(K:K)=' '
              ELSEIF(V.GE.0)THEN
                  PICT(J)(K:K)='+'
              ELSE
                  PICT(J)(K:K)='='
              ENDIF
C
40    CONTINUE
      RETURN
      END
C
C     ***** D I S P L A Y *****
C
      SUBROUTINE DISPLAY(A1,A2,Q1,Q2,PICT     )
C
C     SHOWS THE PICT MATRIX
C
C     ***** DECLARATIONS *****
      REAL A1,A2,Q1,Q2
      CHARACTER PICT(61)*101
      INTEGER J
C
C     DISPLAY MATRIX PICT
CC                                 ^ 
CC {see also XSCLE and YSCLE above ^ }
CC for wide carriage printer:
CC      WRITE(3,55) (PICT(J),J=1,61)
CC 55     FORMAT(A101)
CC for small carriage printer:
        WRITE(3,56) (PICT(J)(1:80),J=1,61)
 56     FORMAT(A80)
      RETURN
      END
C
C     ***** Q U E R Y *****
C
      SUBROUTINE QUERY(    AGAIN)
C
C     ***** DECLARATIONS *****
      CHARACTER AGAIN
C
      WRITE(*,62)
 62   FORMAT(
     +'Would you like to do this again using new values? (Y/N)? '/)
      READ(*,'(A1)')AGAIN
      PRINT *
      RETURN
      END
C     ***** P R O G R A M   E N D *****
