      	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
     	CHARACTER FNAME*32, PNAME*32, LNAME*32, RESL*1
     	CHARACTER TITL*80, XTIT*80, YTIT*80, PLOTID*32
     	COMMON/PHIPSI/ FNAME,PNAME,LNAME,TITL,XTIT,YTIT,MRES,LABEL,
     +  MAPS,IRES(MNR),RESL(MNR),PHI(MNR),PSI(MNR),IREJ(MNR),XORG(4),
     +  HPAR(20), LPEN(10), LINE(10), FILL(10), LCON(10), XLPS(3)

     	INTEGER   CRT
     	CHARACTER KEY*2, TEXT*80
     	DIMENSION RP(10), KP(10)
     	DATA HPAR/ 1.,1.,1.,1.,0,0,1.,1.,1.,0,5.,1.,1.,0,0,0,0,0,0,0 /
C
C  GET THE TYPE OF TERMINAL ON LINE...
C
     	CRT = IFINIT(0)
     	IF( CRT.EQ.0 ) GOTO 999
C
C  INITIALIZE RUN PARAMETERS...
C
      	FNAME = 'JUNK.DIH'	!INPUT TORSION ANGLE FILENAME  (*.DIH)
      	PNAME = 'JUNK.PAR'	!PLOT SETUP FILENAME  (*.PAR)
      	LNAME = 'JUNK.DES'	!PLOT LAYOUT FILENAME  (*.DES)
     	LABEL = 0		!RESIDUE LABEL FLAG
     	NRES  = 0		!NUMBER OF RESIDUES IN THE INPUT FILE
     	MRES  = 0		!NUMBER OF RESIDUES AFTER EDITING
     	MAPS  = 4		!MAP GRID EXPANSION FACTOR
     	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)
      	CALL IFANSI_TITLE('PHIPSI: Ramachandran Plot Routine
     + (limit:    residues)')
     	CALL IFANSI_VIDEO(60)
     	CALL IFANSI_IFL( MNR, 1, 3, 1, 42 )
      	CALL IFANSI_VIDEO(47)
     	CALL IFANSI_VIDEO(80)
     	CALL IFANSI_VIDEO(90)
     	CALL IFANSI_TEXT('                      M E N U   O
     + F   P L O T   S E T U P', 80, 2, 1 )
     	CALL IFANSI_VIDEO(47)
     	WRITE(6,1001)
1001	FORMAT(
     +' FF=               ',
     +'   ==> Input Phi/Psi file [.DIH] (contains    /    residues).'/
     +' RL=                  ==> Residue label:',
     +' 0=No,1=L,2=N,3=Both,-N=Skip the overlap.'/
     +' GF=               ',
     +'   ==> Map smoothing/grid expansion factor (0 to 5).'/
     +' 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. To continue with the run, simply hit the RETURN',
     +' key.'/5X'Enter REMOVE N to remove a residue N from plotting.')
     	CALL IFANSI_VIDEO(90)
     	WRITE(6,1002)
     	CALL IFANSI_VIDEO(47)
     	WRITE(6,1005)
1005	FORMAT(' oops:'/' PHIPSI>')
C
C  PRESENT THE DEFAULT RUN PARAMETERS...
C
2000	CALL IFANSI_VIDEO(30)		!REVERSE VIDEO ON
      	TEXT = ' '
     	CALL IFANSI_TEXT( FNAME, 18, 3, 4 )
     	CALL IFANSI_IFL( NRES, 1, 3, 3, 62 )
     	CALL IFANSI_IFL( MRES, 1, 3, 3, 66 )
     	CALL IFANSI_IFL( LABEL, 1, 3, 4, 4 )
     	CALL IFANSI_TEXT( TEXT,   15, 4, 7 )
     	CALL IFANSI_IFL(  MAPS, 1, 3, 5, 4 )
     	CALL IFANSI_TEXT( TEXT,   15, 5, 7 )
     	CALL IFANSI_IFL( LCON, 10, 3, 6, 4 )
     	CALL IFANSI_IFL( LPEN, 10, 3, 7, 4 )
     	CALL IFANSI_IFL( LINE, 10, 3, 8, 4 )
     	CALL IFANSI_IFL( FILL, 10, 3, 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, 7.2, 13, 4 )
     	CALL IFANSI_TEXT( TEXT, 2, 13, 32 )
     	CALL IFANSI_FFL( XLPS, 3, 7.2, 14, 4 )
     	CALL IFANSI_TEXT( TEXT, 9, 14, 25 )
C
C  START THE LOOP PROMPT...
C
111	CALL IFANSI_VIDEO(30)
      	CALL IFANSI_CURSOR(22,9)
     	CALL IFANSI_CLEAR(4)
      	READ(5,222,ERR=999,END=999) TEXT
222	FORMAT(A)

     	IF( TEXT.EQ.' ' ) GOTO 777
     	NCH = IFMISC_STRIP(TEXT)
     	CALL  IFMISC_UPPER(TEXT)
     	KEY = TEXT(1:2)
     	IF( KEY.EQ.'EX' .OR. KEY.EQ.'QU' ) GOTO 999
C
C  REMOVE A RESIDUE...
C
     	IF( TEXT(1:6).EQ.'REMOVE' ) THEN
     	    IF( NRES.EQ.0 ) GOTO 4444
     	    IF( NCH.LT.8 ) GOTO 3333
     	    DECODE( NCH-7, 333, TEXT(8:), ERR=3333 ) KRES
333	    FORMAT(I)
     	    IF( KRES.LT.1 .OR. KRES.GT.NRES ) GOTO 3333
     	    IREJ(KRES) = -IREJ(KRES)
     	    IF( IREJ(KRES).LT.0 ) THEN
     		MRES = MRES-1
     	    ELSE
     		MRES = MRES+1
     	    ENDIF
     	    CALL IFANSI_IFL( MRES, 1, 3, 3, 66 )
     	    GOTO 111
     	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.'FF' ) THEN	!READ PHI/PSI FILE
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    FNAME = TEXT
      	    CALL IFMISC_DEFEXT( FNAME, '.DIH' )
      	    OPEN( UNIT=1, FILE=FNAME, 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 = 0
     	    GOTO 555
  557	    NRES = NRES + 1
     	    READ(TEXT,558,ERR=2222) RESL(NRES), IRES(NRES),
     +      PHI(NRES), PSI(NRES)
  558	    FORMAT(3X,A1,I3,3X,I4,8X,I4)
     	    IREJ(NRES) = 1
     	    IF( NRES.GT.MNR ) GOTO 666
      	    GOTO 555
  666	    CLOSE( UNIT=1 )
     	    CALL PHIPSI_CLEAR_OOPS
     	    PNAME = FNAME
     	    LNAME = FNAME
      	    CALL IFMISC_NAMEXT( PNAME, '.PAR' )
      	    CALL IFMISC_NAMEXT( LNAME, '.DES' )
     	    MRES = NRES
     	    CALL PHIPSI_SETUP( 1 )
      	    GOTO 2000
     	ENDIF

      	IF( KEY.EQ.'RL' ) THEN	!GET RESIDUE LABEL FLAG
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    NCH = IFMISC_DECODE( TEXT, 1, RP, KP )
     	    IF( NCH.EQ.0 ) GOTO 3333
      	    IF( ABS(RP(1)).GT.3.0 ) GOTO 3333
      	    LABEL = RP(1)
     	    CALL IFANSI_IFL( LABEL, 1, 3, 4, 4 )
     	    GOTO 111
      	ENDIF

      	IF( KEY.EQ.'GF' ) THEN	!GET GRID EXPANSION FACTOR
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    NCH = IFMISC_DECODE( TEXT, 1, RP, KP )
     	    IF( NCH.EQ.0 ) GOTO 3333
      	    IF( RP(1).LT.0.0 .OR. RP(1).GT.5.0 ) GOTO 3333
      	    MAPS = RP(1)
     	    CALL IFANSI_IFL( MAPS, 1, 3, 5, 4 )
      	    GOTO 111
      	ENDIF

      	IF( KEY.EQ.'CL' ) THEN	!GET CONTOUR LEVELS
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    NCH = IFMISC_DECODE( TEXT, 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, 3, 6, 4 )
     	    GOTO 111
      	ENDIF

      	IF( KEY.EQ.'PN' ) THEN	!GET CONTOUR COLORS
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    NCH = IFMISC_DECODE( TEXT, 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, 3, 7, 4 )
     	    GOTO 111
      	ENDIF

      	IF( KEY.EQ.'LI' ) THEN	!GET CONTOUR LINE TYPE
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    NCH = IFMISC_DECODE( TEXT, 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, 3, 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, 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, 3, 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, 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, 7.2, 13, 4 )
     	    GOTO 111
     	ENDIF
     	IF( KEY.EQ.'LP' ) THEN
     	    IF( NCH.EQ.0 ) GOTO 3333
     	    NCH = IFMISC_DECODE( TEXT, 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, 7.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.GT.2 ) THEN
     	    NRES = NRES - 1
            GOTO 666
     	ELSE
     	    CALL PHIPSI_OOPS(' File format not recognized.')
      	    CLOSE(UNIT=1)
     	    NRES = 0
     	    MRES = 0
     	ENDIF
      	GOTO 111
3333	CALL PHIPSI_OOPS(' Invalid entry or parameter out of range.')
      	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.EQ.0 ) GOTO 779
C
C  REPACK RESIDUE LIST IF REJECTION HAS BEEN DONE...
C
     	IF( MRES.LT.NRES ) THEN
     	    MRES = 0
     	    DO  I=1, NRES
     		IF( IREJ(I).GT.0 ) THEN
     		    MRES = MRES + 1
     		    RESL(MRES) = RESL(I)
     		    IRES(MRES) = IRES(I)
     		     PHI(MRES) =  PHI(I)
     		     PSI(MRES) =  PSI(I)
     		ENDIF
     	    ENDDO
     	ENDIF
C
C  INITIALIZE THE PLOT...
C
  779	CALL PHIPSI_SETUP(0)
  778	CALL IFINIT_LINE(3)
     	CALL IFINIT_PLOT( XORG(1), XORG(2), FNAME )
     	IF( IFCTRL_C() ) GOTO 887
C
C  OPEN A GRAPHICS SEGMENT TO SAVE THE PLOT...
C
     	CALL IFANSI_VIDEO(47)
     	WRITE(6,4321)
4321	FORMAT('$Press CTRL/C to cancel plotting...')
     	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.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_MAIN(0,XORG(1),XORG(2),LNAME)
 887	CALL IFINIT_PLOT_END
C
C  PRESENT THE COMMAND MENU...
C
 888	CALL IFANSI_VIDEO(30)
     	WRITE(6,5000)
5000	FORMAT(' PHIPSI_MENU (Please press a desired function code):')
     	CALL IFANSI_VIDEO(47)
     	WRITE(6,5001)
5001	FORMAT(' 0>Exit 1>Hardcopy PF1>Hardcopy 2>Layout 3>Dialogue',
     +' 6>Redraw PF4>DCL_prompt')
     	CALL IFANSI_CURSOR(0,40)
  889	CALL IFQIOW_KEY(KID)

     	IF( KID.EQ.26 .OR. KID.EQ.48 ) GOTO 999		!exit
     	IF( KID.EQ.49 ) THEN				!hardcopy
     	    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,-20)
     	    CALL IFFEED( HPAR(1), PLOTID, ' ' )
     	ELSE IF( KID.EQ.50 .OR. KID.EQ.81 ) THEN	!layout
     	    CALL LAYOUT_MAIN( 2, XORG(1), XORG(2), LNAME )
     	ELSE IF( KID.EQ.13 .OR. KID.EQ.51 .OR. KID.EQ.82 ) THEN
     	    GOTO 1				!dialogue
     	ELSE IF( KID.EQ.54 ) THEN		!redraw
     	    GOTO 778
     	ELSE IF( KID.EQ.36 .OR. KID.EQ.83 ) THEN	!DCL prompt
     	    CALL IFMISC_SPAWN( TEXT, 0 )
     	    CALL IFINIT_LINE( -3 )
     	ELSE
     	    GOTO 889
     	ENDIF
     	GOTO 888
C
C  END OF THE RUN...
C
999	CALL IFINIT_EXIT
      	CALL EXIT
      	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,PNAME,LNAME,TITL,XTIT,YTIT,MRES,LABEL,
     +  MAPS,IRES(MNR),RESL(MNR),PHI(MNR),PSI(MNR),IREJ(MNR),XORG(4),
     +  HPAR(20), LPEN(10), LINE(10), FILL(10), LCON(10), XLPS(3)

     	DIMENSION ENERG(19,19), Z(100,100)
     	DIMENSION EN01(19),EN02(19),EN03(19),EN04(19),EN05(19),EN06(19),
     +  EN07(19),EN08(19),EN09(19),EN10(19),EN11(19),EN12(19),EN13(19),
     +  EN14(19),EN15(19),EN16(19),EN17(19),EN18(19),EN19(19)
     	EQUIVALENCE (ENERG(1,1),EN01(1)),(ENERG(1,2),EN02(1)),
     +(ENERG(1, 3),EN03(1)),(ENERG(1, 4),EN04(1)),(ENERG(1, 5),EN05(1)),
     +(ENERG(1, 6),EN06(1)),(ENERG(1, 7),EN07(1)),(ENERG(1, 8),EN08(1)),
     +(ENERG(1, 9),EN09(1)),(ENERG(1,10),EN10(1)),(ENERG(1,11),EN11(1)),
     +(ENERG(1,12),EN12(1)),(ENERG(1,13),EN13(1)),(ENERG(1,14),EN14(1)),
     +(ENERG(1,15),EN15(1)),(ENERG(1,16),EN16(1)),(ENERG(1,17),EN17(1)),
     +(ENERG(1,18),EN18(1)),(ENERG(1,19),EN19(1))
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----PSI RUNS AS EN01 = -180; EN19 = +180
C---- PHI  -180  -160  -140  -120  -100   -80   -60   -40   -20
C----         0    20    40    60    80   100   120   140   160   180
      DATA EN01 /2.797,1.769,2.465,3.067,3.372,3.399,4.685,18.57, 40. ,
     +      49. , 50. ,19.08, 6.63,12.50,25.50,27.47,23.76,10.46,2.797/
      DATA EN02 /7.068,6.228,6.843,7.319,7.551,7.871,10.41,38.22, 51. ,
     +      52. , 45. ,13.80, 9.51,16.25,28.45,31.12,27.36,14.33, 7.07/
      DATA EN03 /11.38,10.46,10.85,11.20,11.48,12.17,16.86,49.89, 52. ,
     +      50. ,29.68,13.49,12.80,19.64,31.81,34.51,31.0 ,18.32,11.37/
      DATA EN04 /12.53,11.43,11.61,11.35,12.16,13.06,17.37,37.26, 49. ,
     +      40. ,19.45,13.62,13.45,19.83,32.00,35.01,31.81,19.45,12.53/
      DATA EN05 /12.71,11.46,11.53,11.72,12.94,12.81,15.38,23.88,32.3 ,
     +     24.76,20.08,19.05,14.73,19.20,31.66,34.76,32.00,19.75,12.71/
      DATA EN06 /9.389,8.120,8.235,8.461,8.662,9.025,10.14,13.38,16.72,
     +     20.9 ,40.85,43.26,19.30,15.19,28.19,31.61,28.80,16.52,9.390/
      DATA EN07 /5.620,4.698,5.193,5.394,5.137,4.823,4.867,6.060,12.3 ,
     +      45. , 55. , 57. ,39.13,12.20,24.81,28.02,25.02,12.65,5.620/
      DATA EN08 /6.372,6.780,7.501,6.542,4.880,3.600,3.217,6.454,37.0 ,
     +      55. , 70. , 80. , 46. ,16.84,25.32,22.36,24.24,12.30,6.372/
      DATA EN09 /14.20,15.12,12.76,8.580,5.470,4.139,5.802,24.41 ,52. ,
     +      75. , 75. , 61. ,43.1 ,18.62,26.51,28.62,26.74,17.22,14.20/
      DATA EN10 /21.86,16.98,10.82,6.604,4.930,6.084,17.04 ,50. , 57. ,
     +      75. , 69. , 50. ,20.29,15.81,27.08,31.45,37.60,26.00,21.86/
      DATA EN11 /14.22,8.222,4.974,3.757,4.384,8.850,40.78 ,61. , 75. ,
     +      75. , 55. ,25.00 ,8.00,13.84,27.61,33.78,34.58,24.18,14.22/
      DATA EN12 /6.203,3.123,2.302,2.270,2.907,6.830 ,46. , 80. , 65. ,
     +      47. ,36.84 ,6.76 ,5.16,13.06,26.78,31.20,29.17,15.69,6.203/
      DATA EN13 /4.152,2.133,1.806,1.555,0.903,0.797,35.27 ,55. , 50. ,
     +      30. ,10.94 ,4.95 ,5.43,12.84,25.58,28.69,25.54,12.33,4.152/
      DATA EN14 /4.422,2.590,2.139,1.637,0.608,0.000,11.86,37.45 ,45. ,
     +      32. ,11.70 ,8.67 ,7.03,13.28,25.33,28.10,25.00,12.21,4.422/
      DATA EN15 /4.925,3.066,2.603,2.189,1.631,1.542,4.560,10.4 ,12.1 ,
     +     17.2 ,24.57,16.26 ,9.30,13.97,25.61,28.36,25.32,12.65,4.925/
      DATA EN16 /4.704,2.854,2.571,2.496,2.396,2.490,3.312,5.011,11.0 ,
     +     34.0 , 45. ,30.24,11.26,14.07,25.56,28.36,25.23,12.48,4.704/
      DATA EN17 /3.468,3.286,1.806,2.139,2.316,2.402,2.660,4.842,21.2 ,
     +      48. , 51. ,42.3 ,10.67,13.06,24.77,27.6 ,24.30,11.34,3.468/
      DATA EN18 /2.139,0.709,1.192,1.781,2.057,2.101,2.502,8.248 ,30. ,
     +      48. , 50. ,33.73 ,7.80,11.87,23.94,26.76,23.24,10.04,2.139/
      DATA EN19 /2.797,1.769,2.465,3.067,3.372,3.399,4.685,18.57 ,40. ,
     +      49. , 50. ,19.08 ,6.63,12.50,25.50,27.47,23.76,10.46,2.797/
C
C  LOAD PHI/PSI ENERGY VALUES INTO RHO ARRAY...
C
     	NC = 19
     	NR = 19
     	DO  I=1, NC
     	    DO  J=1, NR
     		Z(I,J) = ENERG(J,I)
     	    ENDDO
     	ENDDO
C
C  EXPAND THE MAP IF REQUIRED...
C
     	IF( IFCTRL_C() ) RETURN
     	IF(MAPS.GT.0.0) CALL IFMISC_MAP_EXPAND(MAPS,100,NC,NR,Z)
C
C  CONTOUR THE MAP LEVEL BY LEVEL...
C
     	TEXT = '   kcal/mol'
     	YPS  = XLPS(3)
     	DO  111 I=1, 10
     	IF( IFCTRL_C() ) RETURN
     	    IF( LCON(I).EQ.0 ) GOTO 111
     	    CALL IFSPEN( LPEN(I) )
     	    CALL IFSTYL( LINE(I), 0 )
     	    CALL IFMISC_MAP( 100, NC, NR, FLOAT(LCON(I)),
     +                Z(1,1), FILL(I), XORG(3), XORG(4) )
     	IF( IFCTRL_C() ) RETURN
     	    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() ) RETURN
     	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
     	RETURN
     	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,PNAME,LNAME,TITL,XTIT,YTIT,MRES,LABEL,
     +  MAPS,IRES(MNR),RESL(MNR),PHI(MNR),PSI(MNR),IREJ(MNR),XORG(4),
     +  HPAR(20), LPEN(10), LINE(10), FILL(10), LCON(10), XLPS(3)

     	CHARACTER TEXT*4
     	DIMENSION XPS(2,MNR), YPS(2,MNR)
C
C  DRAW THE DATA POINTS FIRST...
C
     	IJ = 0
     	ILABEL = IABS(LABEL)
     	DO I=1, MRES
     	   XPS1 = XORG(3)*FLOAT(PHI(I)+180)/360.0
     	   YPS1 = XORG(4)*FLOAT(PSI(I)+180)/360.0
     	   CALL IFMARK( XPS1, YPS1, 0.05, 0.0, 9 )
     	   TEXT = ' '
     	   IF( ILABEL.EQ.1 ) THEN
     	       NCH = 1
     	       TEXT = RESL(I)
     	   ENDIF
     	   IF( ILABEL.GT.1 ) THEN
     	       NCH = 1
     	       IF( IRES(I).GT.9 ) NCH = 2
     	       IF( IRES(I).GT.99) NCH = 3
     	       ENCODE( NCH, 111, TEXT ) IRES(I)
  111	       FORMAT(I<NCH>)
     	       IF( ILABEL.EQ.3 ) THEN
     	           TEXT(2: ) = TEXT(1:)
     		   TEXT(1:1) = RESL(I)
     	           NCH = NCH + 1
     	       ENDIF
     	   ENDIF
     	   XPS2 = XPS1 - 0.02*NCH
     	   YPS2 = YPS1 + 0.05
     	   IF( LABEL.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(3)
     	   CALL IFTEXT( XPS2, YPS2, TEXT, 0.08, 0.08, 0.0 )
     	   CALL IFSPEN(1)
     	   IJ = IJ+1
     	   XPS(2,IJ) = XPS2
     	   YPS(2,IJ) = YPS2
  333	   XPS(1,I)  = XPS1
     	   YPS(1,I)  = YPS1
     	ENDDO
     	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,PNAME,LNAME,TITL,XTIT,YTIT,MRES,LABEL,
     +  MAPS,IRES(MNR),RESL(MNR),PHI(MNR),PSI(MNR),IREJ(MNR),XORG(4),
     +  HPAR(20), LPEN(10), LINE(10), FILL(10), LCON(10), XLPS(3)
     	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, MAPS, LABEL, (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=',2I4,7F8.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

     	CALL 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, 9, RP, KP )
    	    IF( NCH.EQ.0 ) GOTO 222
     	    MAPS = RP(1)
     	    LABEL= RP(2)
     	    DO I=1, 3
     		XLPS(I) = RP(I+2)
     	    ENDDO
     	    DO I=1, 4
     		XORG(I) = RP(I+5)
     	    ENDDO
     	    GOTO 222
     	ENDIF
     	IF( KEY.EQ.'CLEV' ) THEN
     	    NCH = IFMISC_DECODE( REST, 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, 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, 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, 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, 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

