      	PROGRAM PHIPSI
C
C  Program to generate a Phi/Psi plot and to overlay alanine dipeptide
C  energy map on it.
C
C  MODIFICATIONS BY R.S. ZHOU TO LINK TO GRAFIT'S LIBRARIES (12/88).
C
      	PARAMETER MNR = 512
     	INTEGER   FILL, PHI, PSI, NRES(2)
     	CHARACTER FNAME*32, PNAME*32, LNAME*32, RESL*1
     	CHARACTER TITL*80, XTIT*80, YTIT*80, PLOTID*32
     	COMMON/PHIPSI/
     +  FNAME(2),PNAME,LNAME,TITL,XTIT,YTIT,MRES(2),LABEL(2),
     +  IRES(MNR,2),RESL(MNR,2),PHI(MNR,2),PSI(MNR,2),IREJ(MNR,2),
     +  XORG(4), HPAR(20), LPEN(10), LINE(10), FILL(10), LCON(10),
     +  XLPS(3), MARK(2), SIZE(2)

     	INTEGER   CRT
     	CHARACTER KEY*2, TEXT*80
     	DIMENSION RP(10), KP(10)
C
C  GET THE TYPE OF TERMINAL ON LINE...
C
C     	CRT = IF_DCL_PUT( 'PHIPSI' )
C     	IF( CRT.LT.0 ) GOTO 999
     	CALL IFINIT_SESSION
     	CRT = IFINIT_ITM(0)
C
C  INITIALIZE RUN PARAMETERS...
C
      	FNAME(1) = 'JUNK.DIH'	!INPUT TORSION ANGLE FILENAME  (*.DIH)
      	FNAME(2) = ' '		!INPUT TORSION ANGLE FILENAME  (*.DIH)
      	PNAME = 'JUNK.PAR'	!PLOT SETUP FILENAME  (*.PAR)
      	LNAME = 'JUNK.DES'	!PLOT LAYOUT FILENAME  (*.DES)
     	LABEL(1) = 0		!RESIDUE LABEL FLAG
     	LABEL(2) = 0		!RESIDUE LABEL FLAG
        MARK(1)  = 9            !MARKER SYMBOL
        MARK(2)  = 10           !MARKER SYMBOL
        SIZE(1)  = 0.06         !MARKER SIZE IN INCHES
        SIZE(2)  = 0.06         !MARKER SIZE IN INCHES
     	NRES(1)  = 0		!NUMBER OF RESIDUES IN THE INPUT FILE
     	NRES(2)  = 0		!NUMBER OF RESIDUES IN THE INPUT FILE
     	MRES(1)  = 0		!NUMBER OF RESIDUES AFTER EDITING
     	MRES(2)  = 0		!NUMBER OF RESIDUES AFTER EDITING
     	DO I=1, 10
     	   LCON(I) = 0
     	   LPEN(I) = 5
     	   LINE(I) = 1
     	   FILL(I) = 0
     	ENDDO
     	LPEN(1) = 4
     	LPEN(2) = 3
     	LPEN(3) = 2
     	LCON(1) = 3	!1ST CONTOUR LEVEL
     	LCON(2) = 6	!2ND CONTOUR LEVEL
     	LCON(3) = 9	!3RD CONTOUR LEVEL
     	XORG(1) = 3.0
     	XORG(2) = 2.0
     	XORG(3) = 4.0
     	XORG(4) = 4.0
     	XLPS(1) = 2.0
     	XLPS(2) = 2.4
     	XLPS(3) = 0.5
     	TITL = 'Ramachandran Plot'
     	XTIT = 'Phi'
     	YTIT = 'Psi'
     	PLOTID = ' '
C
C  SAY HELLO...
C
  1	CALL IFINIT_LINE(24)
        TEXT = 'PHIPSI: Ramachandran Plot Routine (limit:    residues)'
      	CALL IFANSI_TITLE( TEXT )
     	CALL IFANSI_VIDEO(60)
     	CALL IFANSI_IFL( MNR, 1, 3, 1, 42 )
      	CALL IFANSI_VIDEO(47)
     	CALL IFANSI_VIDEO(80)
     	CALL IFANSI_VIDEO(90)
        TEXT(1:33) = '                      M E N U   O'
        TEXT(34: ) = ' F   P L O T   S E T U P'
     	CALL IFANSI_TEXT( TEXT, 80, 2, 1 )
     	CALL IFANSI_VIDEO(47)
     	WRITE(6,1001)
1001	FORMAT(
     +' F1=',12x,'==> Input Phi/Psi file (contains    /    residues).'/
     +' F2=',12x,'==> Input Phi/Psi file (contains    /    residues).'/
     +' ID=',30x,'==> #1-2:-3 TO 3; #3-4:Symbols; #5-6:Sizes.'/
     +' CL=',30x,'==> Contour energy levels (2-50 kcal/mol).'/
     +' PN=',30x,'==> Contour colors for each contour level.'/
     +' LI=',30x,'==> Contour line-types for each contour level.'/
     +' FL=',30x,'==> Contour area-fill pattern numbers.'/
     +' GT=',30x,'==> Graph title (max 75 characters)'/
     +' XT=',30x,'==> X-axis label (max 75 characters)'/
     +' YT=',30x,'==> Y-axis label (max 75 characters)'/
     +' XY=',30x,'==> Plot origin and size.'/
     +' LP=',30x,'==> Contour label and position.')
     	CALL IFANSI_VIDEO(90)
     	WRITE(6,1002)
1002	FORMAT(80X,' ')
     	CALL IFANSI_VIDEO(47)
      	WRITE(6,1003)
1003	FORMAT(5x'To edit the run parameters, enter AC=p1,p2...',
     +' where AC is the 2 letter'/5x'Access-Code designated for',
     +' the parameter and p1,p2... are the desired'/5x'parameter',
     +' values. Enter REMOVE N to remove a residue N from the list.'/
     +,5x,'Enter GO to start plotting on screen.')
     	CALL IFANSI_VIDEO(90)
     	WRITE(6,1002)
     	CALL IFANSI_VIDEO(47)
     	WRITE(6,1005)
1005	FORMAT(' oops:')
C
C  PRESENT THE DEFAULT RUN PARAMETERS...
C
2000	CALL IFANSI_VIDEO(30)		!REVERSE VIDEO ON
      	TEXT = ' '
     	CALL IFANSI_TEXT( FNAME(1), 12, 3, 4 )
     	CALL IFANSI_IFL( NRES(1), 1, 'I3', 3, 49 )
     	CALL IFANSI_IFL( MRES(1), 1, 'I3', 3, 53 )
     	CALL IFANSI_TEXT( FNAME(2), 12, 4, 4 )
     	CALL IFANSI_IFL( NRES(2), 1, 'I3', 4, 49 )
     	CALL IFANSI_IFL( MRES(2), 1, 'I3', 4, 53 )
     	CALL IFANSI_IFL( LABEL, 2, '2I3', 5, 4 )
     	CALL IFANSI_IFL( MARK,  2, '2I3', 5, 10)
     	CALL IFANSI_FFL( SIZE,2, '2F6.2', 5, 16)
     	CALL IFANSI_TEXT( TEXT, 6, 5, 28 )
     	CALL IFANSI_IFL( LCON, 10, '10I3', 6, 4 )
     	CALL IFANSI_IFL( LPEN, 10, '10I3', 7, 4 )
     	CALL IFANSI_IFL( LINE, 10, '10I3', 8, 4 )
     	CALL IFANSI_IFL( FILL, 10, '10I3', 9, 4 )
     	CALL IFANSI_TEXT( TITL, 30, 10, 4 )
     	CALL IFANSI_TEXT( XTIT, 30, 11, 4 )
     	CALL IFANSI_TEXT( YTIT, 30, 12, 4 )
     	CALL IFANSI_FFL( XORG, 4, '4F7.2', 13, 4 )
     	CALL IFANSI_TEXT( TEXT, 2, 13, 32 )
     	CALL IFANSI_FFL( XLPS, 3, '3F7.2', 14, 4 )
     	CALL IFANSI_TEXT( TEXT, 9, 14, 25 )
C
C  START THE LOOP PROMPT...
C
  111	CALL IFANSI_VIDEO(47)
     	CALL IFANSI_TEXT('PHIPSI> ', 8, 22, 1 )
     	CALL IFANSI_CLEAR(4)
     	CALL IFANSI_VIDEO(30)
      	READ(5,222,ERR=999,END=999) TEXT
  222	FORMAT(A)
     	NCH = IFMISC_STRIP(TEXT)
     	IF( NCH.EQ.0 ) GOTO 111
     	KEY = TEXT(1:2)
     	CALL  IFMISC_UPPER(2,KEY)
     	IF( KEY.EQ.'GO' ) GOTO 777
     	IF( KEY.EQ.'EX' .OR. KEY.EQ.'QU' ) GOTO 999
C
C  REMOVE A RESIDUE...
C
C     	IF( TEXT(1:6).EQ.'REMOVE' ) THEN
C     	    IF( NRES(1).EQ.0 ) GOTO 4444
C     	    IF( NCH.LT.8 ) GOTO 3333
C     	    DECODE( NCH-7, 333, TEXT(8:), ERR=3333 ) KRES
C333	    FORMAT(I)
C     	    IF( KRES.LT.1 .OR. KRES.GT.NRES(1) ) GOTO 3333
C     	    IREJ(KRES) = -IREJ(KRES)
C     	    IF( IREJ(KRES).LT.0 ) THEN
C     		MRES(1) = MRES(1)-1
C     	    ELSE
C     		MRES(1) = MRES(1)+1
C     	    ENDIF
C      	    CALL IFANSI_IFL( MRES(1), 1, 'I3', 3, 53 )
C     	    GOTO 111
C     	ENDIF
C
C  GET THE RUN PARAMETER NUMBER...
C
      	IF( NCH.LT.3 .OR. TEXT(3:3).NE.'=' ) GOTO 3333
     	TEXT= TEXT(4:)
     	NCH = NCH - 3
     	IF( KEY.EQ.'F1' .OR. KEY.EQ.'F2' ) THEN	!READ PHI/PSI FILE
     	    IF( NCH.EQ.0 ) GOTO 3333
            K = 1
            IF( KEY.EQ.'F2' ) K = 2
     	    FNAME(K) = TEXT
      	    CALL IFMISC_DEFEXT( FNAME(K), '.DIH' )
      	    OPEN( UNIT=1, FILE=FNAME(K), STATUS='OLD',
     +      FORM='FORMATTED', CARRIAGECONTROL='LIST', ERR=1111 )
     	    NCH = 0
  555	    READ(1,556,END=666) TEXT
  556	    FORMAT(A)
     	    IF( TEXT.EQ.' ' ) GOTO 555
     	    IF( NCH.EQ.1 ) GOTO 557
     	    NPS = INDEX( TEXT, 'PHI' )
     	    IF( NPS.EQ.0 ) GOTO 555
     	    NPS = INDEX( TEXT, 'PSI' )
     	    IF( NPS.EQ.0 ) GOTO 555
     	    NCH = 1
     	    NRES(K) = 0
     	    GOTO 555
  557	    NRES(K) = NRES(K) + 1
     	    READ(TEXT,558,ERR=2222) RESL(NRES(K),K), IRES(NRES(K),K),
     +      PHI(NRES(K),K), PSI(NRES(K),K)
  558	    FORMAT(3X,A1,I3,3X,I4,8X,I4)
     	    IREJ(NRES(K),K) = 1
     	    IF( NRES(K).GT.MNR ) GOTO 666
      	    GOTO 555
  666	    CLOSE( UNIT=1 )
     	    CALL PHIPSI_CLEAR_OOPS
     	    IF( K.EQ.1 ) THEN
                PNAME = FNAME(K)
     	        LNAME = FNAME(K)
      	        CALL IFMISC_NAMEXT( PNAME, '.PAR' )
      	        CALL IFMISC_NAMEXT( LNAME, '.DES' )
     	        CALL PHIPSI_SETUP( 1 ) 
            ENDIF
     	    MRES(K) = NRES(K)
      	    GOTO 2000
     	ENDIF

      	IF( KEY.EQ.'ID' ) THEN	!GET RESIDUE LABEL FLAG
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    NCH = IFMISC_DECODE( TEXT, NCH, 6, RP, KP )
     	    IF( NCH.EQ.0 ) GOTO 3333
      	    IF( KP(1).NE.0 ) THEN
                IF( ABS(RP(1)).GT.3.0 ) GOTO 3333
        	LABEL(1) = RP(1)+0.5
     	        CALL IFANSI_IFL( LABEL(1), 1, 'I3', 5, 4 )
            ENDIF
      	    IF( KP(2).NE.0 ) THEN
                IF( ABS(RP(2)).GT.3.0 ) GOTO 3333
        	LABEL(2) = RP(2)+0.5
     	        CALL IFANSI_IFL( LABEL(2), 1, 'I3', 5, 7 )
            ENDIF
      	    IF( KP(3).NE.0 ) THEN
                IF( RP(3).LT.1 .OR. RP(3).GT.99 ) GOTO 3333
        	MARK(1) = RP(3)+0.5
      	        CALL IFANSI_IFL( MARK(1), 1, 'I3', 5, 10 )
            ENDIF
      	    IF( KP(4).NE.0 ) THEN
                IF( RP(4).LT.1 .OR. RP(4).GT.99 ) GOTO 3333
        	MARK(2) = RP(4)+0.5
      	        CALL IFANSI_IFL( MARK(2), 1, 'I3', 5, 13 )
            ENDIF
      	    IF( KP(5).NE.0 ) THEN
                IF( RP(5).LT.0.01 .OR. RP(5).GT.0.2 ) GOTO 3333
        	SIZE(1) = RP(5)
      	        CALL IFANSI_FFL( SIZE(1), 1, 'F6.2', 5, 16 )
            ENDIF
      	    IF( KP(6).NE.0 ) THEN
                IF( RP(6).LT.0.01 .OR. RP(6).GT.0.2 ) GOTO 3333
        	SIZE(2) = RP(6)
      	        CALL IFANSI_FFL( SIZE(2), 1, 'F6.2', 5, 19 )
            ENDIF
     	    GOTO 111
      	ENDIF

      	IF( KEY.EQ.'CL' ) THEN	!GET CONTOUR LEVELS
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    NCH = IFMISC_DECODE( TEXT, NCH, 10, RP, KP )
     	    IF( NCH.EQ.0 ) GOTO 3333
      	    DO I=1, 10
      	       IF( KP(I).EQ.1 ) THEN
      	           IF( RP(I).LT.0.0 .OR. RP(I).GT.50.0 ) GOTO 3333
      	           LCON(I) = RP(I)
      	       ENDIF
      	    ENDDO
     	    CALL IFANSI_IFL( LCON, 10, '10I3', 6, 4 )
     	    GOTO 111
      	ENDIF

      	IF( KEY.EQ.'PN' ) THEN	!GET CONTOUR COLORS
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    NCH = IFMISC_DECODE( TEXT, NCH, 10, RP, KP )
     	    IF( NCH.EQ.0 ) GOTO 3333
      	    DO I=1, 10
      	       IF( KP(I).EQ.1 ) THEN
      	           IF( RP(I).LT.1.0 .OR. RP(I).GT.8.0 ) GOTO 3333
      	           LPEN(I) = RP(I)
      	       ENDIF
      	    ENDDO
     	    CALL IFANSI_IFL( LPEN, 10, '10I3', 7, 4 )
     	    GOTO 111
      	ENDIF

      	IF( KEY.EQ.'LI' ) THEN	!GET CONTOUR LINE TYPE
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    NCH = IFMISC_DECODE( TEXT, NCH, 10, RP, KP )
     	    IF( NCH.EQ.0 ) GOTO 3333
      	    DO I=1, 10
      	       IF( KP(I).EQ.1 ) THEN
      	           IF( RP(I).LT.1.0 .OR. RP(I).GT.9.0 ) GOTO 3333
      	           LINE(I) = RP(I)
      	       ENDIF
      	    ENDDO
     	    CALL IFANSI_IFL( LINE, 10, '10I3', 8, 4 )
     	    GOTO 111
      	ENDIF

      	IF( KEY.EQ.'FL' ) THEN	!GET CONTOUR AREA FILL PATTERN
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    NCH = IFMISC_DECODE( TEXT, NCH, 10, RP, KP )
     	    IF( NCH.EQ.0 ) GOTO 3333
      	    DO I=1, 10
      	       IF( KP(I).EQ.1 ) THEN
      	           IF( ABS(RP(I)).GT.99.0 ) GOTO 3333
      	           FILL(I) = RP(I)
      	       ENDIF
      	    ENDDO
     	    CALL IFANSI_IFL( FILL, 10, '10I3', 9, 4 )
     	    GOTO 111
      	ENDIF

     	IF( KEY.EQ.'GT' ) THEN
     	    TITL = TEXT
     	    CALL IFANSI_TEXT( TITL, 30, 10, 4 )
     	    GOTO 111
     	ENDIF

     	IF( KEY.EQ.'XT' ) THEN
     	    XTIT = TEXT
     	    CALL IFANSI_TEXT( XTIT, 30, 11, 4 )
     	    GOTO 111
     	ENDIF

     	IF( KEY.EQ.'YT' ) THEN
     	    YTIT = TEXT
     	    CALL IFANSI_TEXT( YTIT, 30, 12, 4 )
     	    GOTO 111
     	ENDIF

     	IF( KEY.EQ.'XY' ) THEN
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    NCH = IFMISC_DECODE( TEXT, NCH, 4, RP, KP )
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    DO  I=1, 4
     		IF( KP(I).EQ.1 ) THEN
     		    IF( RP(I).LE.0.0 .OR. RP(I).GT.99.0 ) GOTO 3333
     		    XORG(I) = RP(I)
     		ENDIF
     	    ENDDO
     	    CALL IFANSI_FFL( XORG, 4, '4F7.2', 13, 4 )
     	    GOTO 111
     	ENDIF
     	IF( KEY.EQ.'LP' ) THEN
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    NCH = IFMISC_DECODE( TEXT, NCH, 3, RP, KP )
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    IF( KP(1).EQ.1 ) THEN
     		IF( RP(1).LT.0.0 .OR. RP(1).GT.2.0 ) GOTO 3333
     		XLPS(1) = RP(1)
     	    ENDIF
     	    IF( KP(2).EQ.1 ) THEN
     		IF( ABS(RP(2)).GT.99.0 ) GOTO 3333
     		XLPS(2) = RP(2)
     	    ENDIF
     	    IF( KP(3).EQ.1 ) THEN
     		IF( ABS(RP(3)).GT.99.0 ) GOTO 3333
     		XLPS(3) = RP(3)
     	    ENDIF
     	    CALL IFANSI_FFL( XLPS, 3, '3F7.2', 14, 4 )
     	    GOTO 111
     	ENDIF

     	GOTO 3333
1111	CALL PHIPSI_OOPS(' Can not open/find the input file.')
      	CLOSE(UNIT=1)
      	GOTO 111
2222	IF( NRES(K).GT.2 ) THEN
     	    NRES(K) = NRES(K) - 1
            GOTO 666
     	ELSE
     	    CALL PHIPSI_OOPS(' File format not recognized.')
      	    CLOSE(UNIT=1)
     	    NRES(K) = 0
     	    MRES(K) = 0
     	ENDIF
      	GOTO 111
3333	CALL PHIPSI_OOPS(' Invalid parameter(s).')
      	GOTO 111
4444	CALL PHIPSI_OOPS(' No data yet to work on.')
      	GOTO 111
C
C  CONTINUE WITH THE RUN...
C
  777	CALL PHIPSI_CLEAR_OOPS
     	IF( MRES(1).EQ.0 .AND. MRES(2).EQ.0 ) GOTO 779
C
C  REPACK RESIDUE LIST IF REJECTION HAS BEEN DONE...
C
        DO K=1, 2
     	IF( MRES(K).LT.NRES(K) ) THEN
     	    MRES(K) = 0
     	    DO  I=1, NRES(K)
     		IF( IREJ(I,K).GT.0 ) THEN
     		    MRES(K) = MRES(K) + 1
     		    RESL(MRES(K),K) = RESL(I,K)
     		    IRES(MRES(K),K) = IRES(I,K)
     		     PHI(MRES(K),K) =  PHI(I,K)
     		     PSI(MRES(K),K) =  PSI(I,K)
     		ENDIF
     	    ENDDO
     	ENDIF
        ENDDO
C
C  INITIALIZE THE PLOT...
C
  779	CALL PHIPSI_SETUP(0)
  778	CALL IFINIT_LINE(3)
     	CALL IFANSI_VIDEO(47)
     	CALL IFINIT_PLOT( XORG(1), XORG(2), FNAME(1) )
     	IF( IFCTRL_C() ) GOTO 887
C
C  OPEN A GRAPHICS SEGMENT TO SAVE THE PLOT...
C
     	IF( CRT.EQ.2 ) THEN
     	    CALL IFSEG_PIVOT( 0.0, 0.0 )
     	    CALL IFSEG_OPEN( 15 )
     	ENDIF
C
C  DRAW GRAPH TITLE AND AXES...
C
     	CALL IFSPEN( 1 )
     	IF(TITL.NE.' ') CALL IFTEXT_CENT(0,XORG(3),-1.,-1.,TITL,.15,.15)
     	IF( IFCTRL_C() ) GOTO 887
     	CALL IFAXIS( 1, XORG(3), XORG(4), XTIT, -180.0, 60.0, 0.0,
     +  6, -5, 0, 11 )
     	IF( IFCTRL_C() ) GOTO 887
     	CALL IFAXIS( 4, XORG(3), XORG(4), YTIT, -180.0, 60.0, 0.0,
     +  6, -5, 0, 11 )
     	IF( IFCTRL_C() ) GOTO 887
C
C  CONTOUR THE DIALANINE ENERGY MAP...
C
     	CALL PHIPSI_MAP
     	IF( IFCTRL_C() ) GOTO 887
C
C  OVERLAY THE OBSERVED PHI/PSI DATA POINTS...
C
     	IF( MRES(1).GT.0 .OR. MRES(2).GT.0 ) CALL PHIPSI_PLOT
     	IF( IFCTRL_C() ) GOTO 887
     	IF( CRT.EQ.2 ) CALL IFSEG_OPEN(0)
C
C  OVERLAY THE LAYOUT FILE IF ANY...
C
     	IF(LNAME.NE.' ') CALL LAYOUT_AUX(0,XORG(1),XORG(2),LNAME)
 887	CALL IFINIT_PLOT_END
     	IF( CRT.EQ.1 ) THEN
     	    CALL IFANSI_CURSOR(1,1)
     	    CALL IFANSI_CLEAR(6)
     	ENDIF
C
C  PRESENT THE COMMAND MENU...
C
 888	CALL IFANSI_VIDEO(47)
     	WRITE(6,5000)
5000	FORMAT(' PHIPSI> Please press a desired function key:')
 889	WRITE(6,5001)
5001	FORMAT(' PHIPSI> ?>Help 0>Exit 1>Hardcopy 2>Layout',
     +' 3>Dialogue 6>Redraw $>DCL ...')
     	CALL IFANSI_CURSOR(0,8)
     	CALL IFQIOW_KEY(KID)

     	IF( KID.EQ.26 .OR. KID.EQ.48 .OR. KID.EQ.69 ) GOTO 999
     	IF( KID.EQ.49 .OR. KID.EQ.72 ) THEN
     	    CALL IFCOPY( HPAR(1), PLOTID )
     	    CALL PHIPSI_SETUP( 0 )
     	    CALL IFINIT_LINE( -3 )
     	ELSE IF( KID.EQ.-80 ) THEN	!HARDCOPY WITHOUT PAGE SETUP
     	    CALL IFANSI_CURSOR(0,14)
     	    CALL IFANSI_LEDS(1)
     	    CALL IFFEED( HPAR(1), PLOTID, ' ' )
     	    CALL IFANSI_LEDS(0)
     	ELSE IF( KID.EQ.50 .OR. KID.EQ.-81 ) THEN !layout
     	    CALL LAYOUT_AUX( 2, XORG(1), XORG(2), LNAME )
     	ELSE IF( KID.EQ.51 .OR. KID.EQ.-82 ) THEN
     	    GOTO 1				!dialogue
     	ELSE IF( KID.EQ.54 ) THEN	!redraw
     	    GOTO 778
     	ELSE IF( KID.EQ.13 .OR. KID.EQ.63
     +  .OR. KID.EQ.32 .OR. KID.EQ.-81 ) THEN	!help
     	    CALL IFMISC_HLP( 'PHIPSI', '$ MENU', -2, 0 )
     	ELSE IF( KID.EQ.36 .OR. KID.EQ.-83 ) THEN	!DCL prompt
     	    CALL IFMISC_SPAWN( '$', 0 )
     	    CALL IFINIT_LINE( -3 )
     	ELSE
     	    CALL IFMISC_OOPS( 5, 0, 0, ' ' )
     	ENDIF
     	GOTO 889
C
C  END OF THE RUN...
C
999	CALL IFINIT_EXIT
      	CALL EXIT
      	END

     	SUBROUTINE PHIPSI_OOPS( TEXT )
     	CHARACTER TEXT*(*)
     	CALL PHIPSI_CLEAR_OOPS
     	CALL IFANSI_VIDEO(70)
     	NCH = IFMISC_LENG( TEXT )
     	CALL IFANSI_TEXT( TEXT, NCH, 21, 6 )
     	RETURN
     	END

     	SUBROUTINE PHIPSI_CLEAR_OOPS
     	CALL IFANSI_CURSOR(21,6)
     	CALL IFANSI_CLEAR(4)
     	RETURN
     	END

     	SUBROUTINE PHIPSI_PLOT
C
C	THIS ROUTINE DRAWS THE RESIDUE PHI/PSI POINTS.
C
      	PARAMETER MNR = 512
     	INTEGER   FILL, PHI, PSI
     	CHARACTER FNAME*32, PNAME*32, LNAME*32, RESL*1
     	CHARACTER TITL*80, XTIT*80, YTIT*80
     	COMMON/PHIPSI/
     +  FNAME(2),PNAME,LNAME,TITL,XTIT,YTIT,MRES(2),LABEL(2),
     +  IRES(MNR,2),RESL(MNR,2),PHI(MNR,2),PSI(MNR,2),IREJ(MNR,2),
     +  XORG(4), HPAR(20), LPEN(10), LINE(10), FILL(10), LCON(10),
     +  XLPS(3), MARK(2), SIZE(2)

     	CHARACTER TEXT*4
     	DIMENSION XPS(2,MNR), YPS(2,MNR)
C
C  DRAW THE DATA POINTS FIRST...
C
     	IJ = 0
        CALL IFSTYL(1,2)
        DO K=1, 2
     	   ILABEL = IABS(LABEL(K))
     	DO I=1, MRES(K)
     	   XPS1 = XORG(3)*FLOAT(PHI(I,K)+180)/360.0
     	   YPS1 = XORG(4)*FLOAT(PSI(I,K)+180)/360.0
           CALL IFSPEN(1+K)
     	   CALL IFMARK( XPS1, YPS1, SIZE(K), 0.0, MARK(K) )
     	   TEXT = ' '
     	   IF( ILABEL.EQ.1 ) THEN
     	       NCH = 1
     	       TEXT = RESL(I,K)
     	   ENDIF
     	   IF( ILABEL.GT.1 ) THEN
     	       NCH = 1
     	       IF( IRES(I,K).GT.9 ) NCH = 2
     	       IF( IRES(I,K).GT.99) NCH = 3
               IF( NCH.EQ.1 ) WRITE(TEXT(1:),111) IRES(I,K)
               IF( NCH.EQ.2 ) WRITE(TEXT(1:),112) IRES(I,K)
               IF( NCH.EQ.3 ) WRITE(TEXT(1:),113) IRES(I,K)
  111	       FORMAT(I1)
  112	       FORMAT(I2)
  113	       FORMAT(I3)
     	       IF( ILABEL.EQ.3 ) THEN
     	           TEXT(2: ) = TEXT(1:)
     		   TEXT(1:1) = RESL(I,K)
     	           NCH = NCH + 1
     	       ENDIF
     	   ENDIF
     	   XPS2 = XPS1 - 0.02*NCH
     	   YPS2 = YPS1 + 0.05
     	   IF( LABEL(K).GT.0 ) GOTO 222
     	   DO J=1, IJ		!SKIP OVERLAPPING LABEL
     	      DIST=SQRT((XPS2-XPS(2,J))**2+(YPS2-YPS(2,J))**2)
     	      IF( DIST.LT.0.2 ) GOTO 333
     	   ENDDO
     	   DO J=1, I-1
     	      DIST=SQRT((XPS2-XPS(1,J))**2+(YPS2-YPS(1,J))**2)
     	      IF( DIST.LT.0.2 ) GOTO 333
     	   ENDDO
  222      CALL IFSPEN(6)
     	   CALL IFTEXT( XPS2, YPS2, TEXT, 0.08, 0.08, 0.0 )
     	   IJ = IJ+1
     	   XPS(2,IJ) = XPS2
     	   YPS(2,IJ) = YPS2
  333	   XPS(1,I)  = XPS1
     	   YPS(1,I)  = YPS1
     	ENDDO
        ENDDO
        CALL IFSPEN(1)
        CALL IFSTYL(1,1)
     	RETURN
     	END

     	SUBROUTINE PHIPSI_SETUP( ICODE )
C
C	THIS ROUTINE READS AND WRITES A PLOT SETUP FILE.
C
      	PARAMETER MNR = 512
     	INTEGER   FILL, PHI, PSI
     	CHARACTER FNAME*32, PNAME*32, LNAME*32, RESL*1
     	CHARACTER TITL*80, XTIT*80, YTIT*80
     	COMMON/PHIPSI/
     +  FNAME(2),PNAME,LNAME,TITL,XTIT,YTIT,MRES(2),LABEL(2),
     +  IRES(MNR,2),RESL(MNR,2),PHI(MNR,2),PSI(MNR,2),IREJ(MNR,2),
     +  XORG(4), HPAR(20), LPEN(10), LINE(10), FILL(10), LCON(10),
     +  XLPS(3), MARK(2), SIZE(2)
     	CHARACTER KEY*4, REST*125
     	DIMENSION RP(20), KP(20)

     	IF( PNAME.EQ.' ' ) RETURN
     	CALL IFMISC_DEFEXT( PNAME, '.PAR' )
     	IF( ICODE.EQ.1 ) GOTO 111
C
C  WRITE THE CURRENT PLOT SETUP INTO A SETUP FILE...
C
     	OPEN( 1, FILE=PNAME, STATUS='UNKNOWN', FORM='FORMATTED',
     +  CARRIAGECONTROL='LIST' )
     	WRITE(1,1000) TITL, XTIT, YTIT, LABEL, MARK, SIZE,
     +  (XLPS(I),I=1,3), (XORG(I),I=1,4), (LCON(I),I=1,10),
     +  (LPEN(I),I=1,10), (LINE(I),I=1,10), (FILL(I),I=1,10),
     +  (HPAR(I),I=1,20)
1000	FORMAT('%This is PHIPSI plot setup file.'/
     +'TITL=',A75,/'XLAB=',A75,/'YLAB=',A75,/'OVER=',4I4,9F8.3,/
     +'CLEV=',10I4,/'LPEN=',10I4,/'LINE=',10I4,/'FILL=',10I4,/
     +'HPAR=',20F5.1)
     	GOTO 999
C
C  READ A SETUP FILE...
C
 111	OPEN( 1, FILE=PNAME, STATUS='OLD', FORM='FORMATTED',
     +  CARRIAGECONTROL='LIST', ERR=999 )
C
C  READ KEYWORD LINES ONE BY ONE...
C
 222	READ(1,333,END=999) KEY, REST
 333	FORMAT(A4,X,A125)
     	IF( KEY.EQ.' ' .OR. REST.EQ.' ' ) GOTO 222

     	NCH = IFMISC_STRIP(REST)
     	IF( KEY.EQ.'TITL' ) THEN
     	    TITL = REST
     	    GOTO 222
     	ENDIF
     	IF( KEY.EQ.'XLAB' ) THEN
     	    XTIT = REST
     	    GOTO 222
     	ENDIF
     	IF( KEY.EQ.'YLAB' ) THEN
     	    YTIT = REST
     	    GOTO 222
     	ENDIF
     	IF( KEY.EQ.'OVER' ) THEN
     	    NCH = IFMISC_DECODE( REST, NCH, 13, RP, KP )
    	    IF( NCH.EQ.0 ) GOTO 222
     	    LABEL(1) = RP(1)
     	    LABEL(2) = RP(2)
     	    MARK(1) = RP(3)
     	    MARK(2) = RP(4)
     	    SIZE(1) = RP(5)
     	    SIZE(2) = RP(6)
     	    DO I=1, 3
     		XLPS(I) = RP(I+6)
     	    ENDDO
     	    DO I=1, 4
     		XORG(I) = RP(I+9)
     	    ENDDO
     	    GOTO 222
     	ENDIF
     	IF( KEY.EQ.'CLEV' ) THEN
     	    NCH = IFMISC_DECODE( REST, NCH, 10, RP, KP )
     	    IF( NCH.EQ.0 ) GOTO 222
     	    DO I=1, 10
     		LCON(I) = RP(I)
     	    ENDDO
     	    GOTO 222
     	ENDIF
     	IF( KEY.EQ.'LPEN' ) THEN
     	    NCH = IFMISC_DECODE( REST, NCH, 10, RP, KP )
     	    IF( NCH.EQ.0 ) GOTO 222
     	    DO I=1, 10
     		LPEN(I) = RP(I)
     	    ENDDO
     	    GOTO 222
     	ENDIF
     	IF( KEY.EQ.'LINE' ) THEN
     	    NCH = IFMISC_DECODE( REST, NCH, 10, RP, KP )
     	    IF( NCH.EQ.0 ) GOTO 222
     	    DO I=1, 10
     		LINE(I) = RP(I)
     	    ENDDO
     	    GOTO 222
     	ENDIF
     	IF( KEY.EQ.'FILL' ) THEN
     	    NCH = IFMISC_DECODE( REST, NCH, 10, RP, KP )
     	    IF( NCH.EQ.0 ) GOTO 222
     	    DO I=1, 10
     		FILL(I) = RP(I)
     	    ENDDO
     	    GOTO 222
     	ENDIF
     	IF( KEY.EQ.'HPAR' ) THEN
     	    NCH = IFMISC_DECODE( REST, NCH, 20, RP, KP )
     	    IF( NCH.EQ.0 ) GOTO 222
     	    DO I=1, 20
     		HPAR(I) = RP(I)
     	    ENDDO
     	    GOTO 222
     	ENDIF
     	GOTO 222

 999	CLOSE(1)
     	RETURN
     	END

     	SUBROUTINE PHIPSI_MAP
C
C	THIS ROUTINE CONTOURS THE DIALANINE MAP.
C
      	PARAMETER MNR = 512
     	INTEGER   FILL, PHI, PSI
     	CHARACTER TEXT*12
     	CHARACTER FNAME*32, PNAME*32, LNAME*32, RESL*1
     	CHARACTER TITL*80, XTIT*80, YTIT*80
     	COMMON/PHIPSI/
     +  FNAME(2),PNAME,LNAME,TITL,XTIT,YTIT,MRES(2),LABEL(2),
     +  IRES(MNR,2),RESL(MNR,2),PHI(MNR,2),PSI(MNR,2),IREJ(MNR,2),
     +  XORG(4), HPAR(20), LPEN(10), LINE(10), FILL(10), LCON(10),
     +  XLPS(3), MARK(2), SIZE(2)
     	COMMON/PHIPSI_MAP/ MC,JR(1000),X(1000),Y(1000),Z(8281) !Z(91,91)
C
C----Alanine dipeptide.  CH3 staggered against CA.  Zero is C7
C---- (PHI = -80; PSI=80).  Energies (kcal/mol) above zero.  Higher
C---- energies (.gt. 50.) reduced to smaller values to avoid spurious
C---- contours.  From David Peters, Royal Holloway College, University
C---- of London.  Literature reference: D. Peters and J. Peters J. Mol.
C---- Struc. 85, 107-123 (1981).
C
C  LOAD PHI/PSI DATA FROM GRAFIT$EXE:GRAFIT_PHIPSI.MAP
C  WHICH HAS BEEN EXPANDED BY SPLINE-FUNCTION TO 91x91 GRID MAP
C
     	OPEN( UNIT=13, FILE='GRAFIT$EXE:GRAFIT_PHIPSI.MAP',
     +  STATUS='OLD', FORM='UNFORMATTED', READONLY, ERR=777 )
     	READ(13) NC, NR
     	READ(13) (Z(I),I=1,8281)
     	CLOSE(UNIT=13)
     	MC = NC
     	GOTO 10
  777	WRITE(6,778)
  778	FORMAT('_oops: can not find the energy map file.')
     	RETURN
C
C  CONTOUR THE MAP LEVEL BY LEVEL...
C
  10	TEXT = '   kcal/mol'
     	YPS  = XLPS(3)
     	DO  111 I=1, 10
     	    IF( IFCTRL_C() ) GOTO 999
     	    IF( LCON(I).EQ.0 ) GOTO 111
     	    CALL IFSPEN( LPEN(I) )
     	    CALL IFSTYL( LINE(I), 0 )
     	    CALL PHIPSI_CONTOR(NC,NR,LCON(I),FILL(I),XORG(3),XORG(4))
     	    IF( IFCTRL_C() ) GOTO 999
     	    IF( XLPS(1).LT.1.0 ) GOTO 111
     	    ENCODE( 2, 222, TEXT(1:2) ) LCON(I)
     	    YPS = XLPS(3) + 0.25*I
     	    CALL IFTEXT( XLPS(2), YPS, TEXT, 0.1, 0.1, 0.0 )
     	    CALL IFPLOT(     XLPS(2), YPS-0.05, 3 )
     	    CALL IFPLOT( XLPS(2)+1.1, YPS-0.05, 2 )
111	CONTINUE
222	FORMAT(I2)
C
C  RESET PLOTTING STYLUS...
C
     	CALL IFSTYL( 1, 0 )
     	CALL IFSPEN(1)
C
C  BOX THE CONTOUR LABELS....
C
     	IF( IFCTRL_C() ) GOTO 999
     	IF( XLPS(1).GT.1.0 .AND. YPS.GT.XLPS(3) ) THEN
     	    CALL IFPLOT( XLPS(2)-0.15, XLPS(3)+0.1, 3 )
     	    CALL IFPLOT( XLPS(2)-0.15, YPS+0.25, 2 )
     	    CALL IFPLOT( XLPS(2)+1.25, YPS+0.25, 2 )
     	    CALL IFPLOT( XLPS(2)+1.25, XLPS(3)+0.1, 2 )
     	    CALL IFPLOT( XLPS(2)-0.15, XLPS(3)+0.1, 2 )
     	ENDIF
  999	RETURN
     	END

     	SUBROUTINE PHIPSI_CONTOR( NC, NR, IL, JF, XS, YS )
C
C	THIS ROUTINE CONTOURS A MAP.
C
C	NC --------- NUMBER OF COLUMNS (X) TO BE PLOTTED.
C	NR --------- NUMBER OF    ROWS (Y) TO BE PLOTTED.
C	IL --------- CONTOUR LEVEL.
C	JF --------- PATTERN OF AREA-FILL IF FILL IS DESIRED.
C	XS,YS ------ WIDTH AND HEIGHT OF THE GRAPH IN INCHES.
C
     	COMMON/PHIPSI_MAP/ MC,JR(1000),X(1000),Y(1000),Z(8281) !Z(91,91)
     	COMMON/PHIPSI_XYBND/ MT, NT, XINC, YINC, XSIZ, YSIZ
     	COMMON/PHIPSI_CAVIN/ IX, IY, IDX, IDY, ISS, MMM,
     +  NP, N, CV, IS, IS0, IX0, IY0, DCP, IFF, INX(8), INY(8)
     	DATA INX/ -1, -1,  0,  1,  1,  1,  0, -1 /
     	DATA INY/  0,  1,  1,  1,  0, -1, -1, -1 /
C
C  INITIALIZE...
C
     	MT   = NC
     	NT   = NR
     	XSIZ = XS
     	YSIZ = YS
     	XINC = XSIZ/(MT-1)
     	YINC = YSIZ/(NT-1)
     	IFF  = JF
     	CV   = FLOAT(IL)
     	NP   = 0
     	ISS  = 0
     	MT1  = MT-1
     	NT1  = NT-1
     	MMM  = 10*MC-1
C
C  CONTOUR THE MAP...
C
     	DO 111 I=1,MT1
     	   IF( Z(I).GE.CV .OR. Z(I+1).LT.CV ) GOTO 111
     	   IX0 = I+1
     	   IX  = I+1
     	   IY0 = 1
     	   IY  = 1
     	   IS0 = 1
     	   IS  = 1
     	   IDX = -1
     	   IDY = 0
     	   CALL PHIPSI_TRACE
  111	CONTINUE

     	J = MT-MC
     	DO 222 I=1,NT1
     	   J = J+MC
     	   IF( Z(J).GE.CV .OR. Z(J+MC).LT.CV ) GOTO 222
     	   IX0 = MT
     	   IX  = MT
     	   IY0 = I+1
     	   IY  = I+1
     	   IDX = 0
     	   IDY = -1
     	   IS0 = 7
     	   IS  = 7
     	   CALL PHIPSI_TRACE
  222	CONTINUE

     	J = MT+NT1*MC+1
     	DO 333 I=1,MT1
     	   J = J-1
     	   IF( Z(J).GE.CV .OR. Z(J-1).LT.CV ) GOTO 333
     	   IX0 = MT-I
     	   IX  = MT-I
     	   IY0 = NT
     	   IY  = NT
     	   IDX = 1
     	   IDY = 0
     	   IS0 = 5
     	   IS  = 5
     	   CALL PHIPSI_TRACE
  333	CONTINUE

     	J = NT*MC+1
     	DO 444 I=1,NT1
     	   J = J-MC
     	   IF( Z(J).GE.CV .OR. Z(J-MC).LT.CV ) GOTO 444
     	   IX0 = 1
     	   IX  = 1
     	   IY0 = NT-I
     	   IY  = NT-I
     	   IDX = 0
     	   IDY = 1
     	   IS0 = 3
     	   IS  = 3
     	   CALL PHIPSI_TRACE
  444	CONTINUE

     	ISS = 1
     	L   = 0
     	DO 666 J=2,NT1
     	L = L+MC
     	DO 555 I=1,MT1
     	   L = L+1
     	   IF( Z(L).GE.CV .OR. Z(L+1).LT.CV ) GOTO 555
     	   K = L+1
     	   DO ID=1,NP
     	      IF( JR(ID).EQ.K ) GOTO 555
  	   ENDDO
     	   IX0 = I+1
     	   IX  = I+1
     	   IY0 = J
     	   IY  = J
     	   IDX = -1
     	   IDY = 0
     	   IS0 = 1
     	   IS  = 1
     	   CALL PHIPSI_TRACE
  555	CONTINUE
  666	L = L-MT1
     	RETURN
     	END

     	SUBROUTINE PHIPSI_TRACE
     	COMMON/PHIPSI_MAP/ MC,JR(1000),X(1000),Y(1000),Z(8281) !Z(91,91)
     	COMMON/PHIPSI_XYBND/ MT, NT, XINC, YINC, XSIZ, YSIZ
     	COMMON/PHIPSI_CAVIN/ IX, IY, IDX, IDY, ISS, MMM,
     +  NP, N, CV, IS, IS0, IX0, IY0, DCP, IFF, INX(8), INY(8)
     	LOGICAL YES

     	N  = 0
     	JY = MC*(IY-1)+IX
     	MY = MC*IDY+IDX+JY
     	YES = .FALSE.
  100   IF (N.EQ.MMM) THEN
     	    YES = .TRUE.
     	    GO TO 310
        ENDIF
     	N = N+1
     	IF (IDX .GT. 0) GO TO 120
     	IF (IDX .LT. 0) GO TO 110
     	Y(N)=FLOAT(IY-1)+FLOAT(IDY)*(Z(JY)-CV)/(Z(JY)-Z(MC*IDY+JY))
     	X(N)=FLOAT(IX-1)
     	GO TO 130
  110	NP=NP+1
     	JR(NP)=JY
  120	X(N)=FLOAT(IX-1)+FLOAT(IDX)*(Z(JY)-CV)/(Z(JY)-Z(JY+IDX))
     	Y(N)=FLOAT(IY-1)
  130	IS=IS+1
  140	IF (IS .LE. 8) GO TO 150
     	IS=IS-8
  150	IDX=INX(IS)
     	IDY=INY(IS)
     	IX2=IX+IDX
     	IY2=IY+IDY
     	IR=IDX*IDY
     	IF (ISS .EQ. 0) GO TO 160
     	IF ((IS.NE.IS0) .OR. (IY.NE.IY0) .OR. (IX.NE.IX0)) GO TO 170
     	N=N+1
     	X(N)=X(1)
     	Y(N)=Y(1)
     	GO TO 310
  160	IF( (IX2.EQ.0).OR.(IX2.GT.MT).OR.(IY2.EQ.0).OR.(IY2.GT.NT) )
     +	GO TO 310
  170	MY=MC*IDY+IDX+JY
     	IF (IR .GT. 0) GO TO 200
     	IF (IR .LT. 0) GO TO 190
     	IF (CV .GT. Z(MY)) GO TO 100
     	IX=IX2
     	IY=IY2
  180	IS=IS+5
     	JY=MY
     	GO TO 140
  190	KY=JY+IDX
     	LY=MY-IDX
     	GO TO 210
  200	KY=MY-IDY
     	LY=JY+IDY
  210	DCP=(Z(JY)+Z(KY)+Z(LY)+Z(MY))*.25
     	IF (CV .LE. DCP) GO TO 220
     	CALL PHIPSI_GETPT(JY)
     	GO TO 130
  220	IF (IR .GE. 0) GO TO 230
     	IX=IX2
     	IDX=-IDX
     	CALL PHIPSI_GETPT(KY)
     	IY=IY2
     	IDY=-IDY
     	GO TO 240
  230	IY=IY2
     	IDY=-IDY
     	CALL PHIPSI_GETPT(KY)
     	IX=IX2
     	IDX=-IDX
  240	IF (CV .LE. Z(MY)) GO TO 180
     	CALL PHIPSI_GETPT(MY)
     	IF (IR .GE. 0) GO TO 250
     	IX=IX+IDX
     	IDX=-IDX
     	GO TO 260
  250	IY=IY+IDY
     	IDY=-IDY
  260	IF (CV .GT. Z(LY)) GO TO 290
     	IS=IS-1
     	JY=LY
     	GO TO 150
  290	CALL PHIPSI_GETPT(LY)
     	IF (IR .GE. 0) GO TO 300
     	IY=IY+IDY
     	GO TO 130
  300	IX=IX+IDX
     	GO TO 130
  310	DO 320 I=1, N
     	X(I) = X(I)*XINC
  320	Y(I) = Y(I)*YINC
C
C  PLOT THE CONTOUR LINE...
C  IF AREA-FILL IS ON, CLOSE AN OPEN LOOP BY ADDING A CORNER POINT...
C
     	IF( IFF.NE.0 .AND. ABS(X(1)-X(N)).GT.0.01
     +.AND. ABS(Y(1)-Y(N)).GT.0.01 ) THEN
     	    IF( X(1).EQ.0.0 .OR. X(N).EQ.0.0 ) THEN
     		X(N+1) = 0.0
     	    ELSE
     		X(N+1) = XSIZ
     	    ENDIF
     	    IF( Y(1).EQ.0.0 .OR. Y(N).EQ.0.0 ) THEN
     		Y(N+1) = 0.0
     	    ELSE
     		Y(N+1) = YSIZ
     	    ENDIF
     	    N = N + 1
     	ENDIF
     	IF( IFF.NE.0 ) CALL IFFILL( IFF )
     	CALL IFCURV( N, 0, X, Y )
     	IF( IFF.NE.0 ) CALL IFFILL( 0 )
     	IF( YES ) THEN
     	    N = 0
     	    YES = .FALSE.
     	    GOTO 100
      	ENDIF
     	RETURN
     	END

     	SUBROUTINE PHIPSI_GETPT(J)
     	COMMON/PHIPSI_MAP/ MC,JR(1000),X(1000),Y(1000),Z(8281) !Z(91,91)
     	COMMON/PHIPSI_CAVIN/ IX, IY, IDX, IDY, ISS, MMM,
     +  NP, N, CV, IS, IS0, IX0, IY0, DCP, IFF, INX(8), INY(8)

     	N = N+1
     	B = Z(J)-DCP
     	IF( B.NE.0 ) THEN
     	    V = 0.5*(Z(J)-CV)/B
     	ELSE
     	    V = 0.5
     	ENDIF
     	X(N) = FLOAT(IX-1)+FLOAT(IDX)*V
     	Y(N) = FLOAT(IY-1)+FLOAT(IDY)*V
     	RETURN
     	END

