perm filename CON.F4[1,LMM] blob sn#070808 filedate 1973-11-11 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00029 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	C    CONGEN. COMMON AREAS.
C00008 00003	C MAIN PROGRAM BEGINS HERE
C00009 00004		SUBROUTINE DOEASY
C00011 00005	C      DOEASY BEGINS HERE
C00014 00006		  SUBROUTINE CHOICE (AT)
C00016 00007	C CHOICE BEGINS HERE
C00018 00008		SUBROUTINE GSCHAR (ICA)
C00019 00009		 SUBROUTINE EQCL (N1,N2,SYM)
C00021 00010		 SUBROUTINE GMOL (II)
C00025 00011		 SUBROUTINE MIRROR
C00026 00012		 SUBROUTINE LINE (X1,Y1,X2,Y2,SYM)
C00029 00013		 SUBROUTINE CLRAR
C00030 00014		 SUBROUTINE GWOUT
C00032 00015		  SUBROUTINE CSRG  (MODE)
C00035 00016		 SUBROUTINE RINGGG (MODE,BRATAR,BRATC,RET)
C00041 00017		 SUBROUTINE BRANCH
C00042 00018		 SUBROUTINE WO (I17)
C00044 00019		 SUBROUTINE POSITION (CNT,STR,MODE,RET)
C00049 00020	C BEGINNING OF CODE
C00054 00021		 SUBROUTINE NDIRECT (I1,I2,I3,CNT,NDIR)
C00056 00022	C BEGINNING OF CODE
C00058 00023		 SUBROUTINE ND1 (I1,I2,I3,QAR,NDIR)
C00059 00024		 SUBROUTINE INTERSECT (I1,I2,RET)
C00062 00025		 SUBROUTINE RECPOS (LAT,NAT,RET)
C00071 00026		 SUBROUTINE UNPOS (NC)
C00072 00027		 SUBROUTINE ELIMEND
C00075 00028		 SUBROUTINE SAFMAF
C00077 00029		SUBROUTINE NMORGAN
C00082 ENDMK
CāŠ—;
C    CONGEN. COMMON AREAS.
	  IMPLICIT INTEGER (A-Z)
	COMMON /CQGR/ QFLG,QPIC,QX(100),QY(100)
	COMMON /CFILLIM/ FILLIM,STRCLIM
	COMMON /CFFF/ FILEU(80),FILE(80),BLK(80),WRD(80)
	1  ,LIM(80)
	COMMON /CWHERE/ IWHERE,FCNT,PPN
	COMMON /CFFXX/ FN,IEXT,HFILEN(40)
	COMMON /CE2SW/ E2SW,E2CNT
	COMMON /CFILEN/ HNAM(14),TCH(7),FHNAM(11)
	COMMON /CSST/ SW,SST(4),STT(8),SHUNT(5),FSHUNT(12)
	 COMMON /CLASS/ BNCNT,BNINCL(50,3)
	1  ,TERMC,TERMAT(20),TERMV(20)
	2  ,INCL,INCLA(20),INCLT(20,4)
	COMMON /CATMSOR/ ATMSOR(106)
	DATA (ATMSOR(I1),I1=1,106)/
	1   13, 15, 18, 36, 27, 11, 62, 38, 14, 55,
	2   44, 16, 37,  8,  1, 20, 89, 71, 65,  5,
	3   59, 32, 52, 51, 22, 43, 42, 41, 40, 39,
	4    6, 23,105,103, 90, 31, 87, 86, 84, 72,
	5   12, 67,  9, 64, 63, 29, 61, 60, 28, 58,
	6   57, 56, 24, 54, 53,  3, 30, 50, 49, 48,
	7   47, 46, 45,  2,106,  7,104, 25,102,101,
	8  100, 99, 98, 97, 96, 95, 94, 93, 92, 91,
	9    4, 19, 88, 26, 10, 85, 17, 83, 82, 81,
	1   80, 79, 78, 77, 76, 75, 74, 73, 21, 35,
	2   70, 69, 68, 34, 66, 33/
	COMMON /CPOSW/ POSW
	 COMMON /IO/ CID,COD,E2CID,ICNT,BOD
	 DATA CID,COD,E2CID /21,1,23/
C-----------------------------------------------------------------------
C		THE FOLLOWING BLOCK MUST NOT BE DISTURBED
C		12,033 WORDS
	COMMON /CACL/ DUM(4),NEW(1024)
	 COMMON /CASA/ NUMB,AR(10,100),CDUM(3000)
	COMMON /PUSH/ PDUM(3400)
	COMMON /CRNGH/ RNGH(120)
	  COMMON /INA/INA(2)
	COMMON /TRBLK/ RAR(256)
	  COMMON /DDF/DDFILE(10)
	COMMON /NMOR/ NN(100),EV(100),PST(100),SA(100)
	1  ,Z(2,100),ATS(100),AT(100),ASS(100)
	2  ,SUBQ(100),SUBS(100),SUBT(100)
	COMMON /CAHA/ HOLDA(100),HOLDB(100),HOLDBB(100)
	1  ,HOLDC(100),HOLDD(100),HOLDE(100),
	2  R1MARK(100),R2MARK(100),R3MARK(100)
	 COMMON /MARK/ CT(20),MK(100)
	COMMON /CEXT/ DR(10,100)
C-----------------------------------------------------------------------
	COMMON /CIOMNI/ IOMNI,IOMDEV,IOFST
	COMMON /CBB/ BUFQ(2)
	DIMENSION AREQ(10)
	EQUIVALENCE (AREQ(1),AR(1,1))
	 COMMON /CATAS/  ATAS(106)
	 DATA (ATAS(I1),I1=1,106)/
	1  'AC','AG','AL','AM','AR','AS','AT','AU','B','BA','BE','BI',
	2  'BK','BR','C','CA','CD','CE','CF','CL','CM','CO','CR','CS',
	3  'CU','D','DY','ER','ES','EU','F','FE','FM','FR','GA','GD',
	4  'GE','H','HE','HF','HG','HO','I','IN','IR','K','KR','LA',
	5  'LI','LU','LW','MD','MG','MN','MO','N','NA','NB','ND','NE',
	6  'NI','NO','NP','O','OS','P','PA','PB','PD','PM','PO','PR',
	7  'PT','PU','RA','RB','RE','RH','RN','RU','S','SB','SC','SE',
	8  'SI','SM','SN','SR','T','TA','TB','TC','TE','TH','TI','TL',
	9  'TM','U','V','W','XE','Y','YB','ZN','ZR',' '/
	COMMON /QSCALE/ SCALE,SCC

C MAIN PROGRAM BEGINS HERE
	IOMNI=0
	IOFST=0
	IOMDEV=0
	SCC=60
	POSW=1
	QFLG=0
	E2SW=2
	BNCNT=1
	FILLIM=80
	STRCLIM=10000
	DO 600 I1=1,4
	SST(I1)=1
	SHUNT(I1)=1
600	CONTINUE

	SHUNT(5)=1

	DO 609 I1=1,12
	FSHUNT(I1)=1
609	CONTINUE

	FSHUNT(12)=1
	SW=0
	  INITF=1

	DO 70 I1=1,1000
	AREQ(I1)=0
70	CONTINUE

	NUMB=0
	CALL DOEASY
	  END
	SUBROUTINE DOEASY
C DOEASY: MAIN LOOP IS HERE
	  IMPLICIT INTEGER (A-Z)
	COMMON /CQGR/ QFLG,QPIC,QX(100),QY(100)
	COMMON /CNEWHLD/ SSTATE(1000)
	COMMON /CWHERE/ IWHERE,FCNT,PPN
	COMMON /CFFXX/ FN,IEXT,HFILEN(40)
	 COMMON /CLASS/ BNCNT,BNINCL(50,3)
	1  ,TERMC,TERMAT(20),TERMV(20),INCL,INCLA(20),INCLT(20,4)
	COMMON /CTERSE/ TERSE,TRING,TFRAG,NOPIC,ATHN,BENDARM
	1  ,LSYM,DELTA
	COMMON /CGSC/ ATAR(80)
	 COMMON /CACL/ EKC,UPB,WC,ICC,CARCL(1000)
	 COMMON /CMI/ DUMCR(106),DUMAT(106),MATX(40),CONX(40),
	1 CONXT(6),ATXT(6),ATX(6,40),RCBX(6,40),CC,AACNT(40)
	2  ,REGA(10),P(25),LEVEL(12)
	COMMON /CSTRC/ STRCNT(11)
	COMMON /CAUTO/ IAUTO,IPROP,ICSTAR,IPREVF,IPREVR
	COMMON /CL4INT/ ISOCNT
	 COMMON /CASA/ NUMB,AR(10,100),BR(6,100),CR(6,100),DR(6,100),
	1  ER(6,100)
	COMMON /CREST/ LNUMB,STATE (1000)
	DIMENSION AREQ(10)
	EQUIVALENCE (AREQ(1),AR(1,1))
	COMMON /IO/ CID,COD
	COMMON /CSST/ SW,SST(4),STT(8),SHUNT(5),FSHUNT(12)
	EQUIVALENCE (PROBE,SW)
C      DOEASY BEGINS HERE
	TERSE=1
	TERMC=0
	INCL=0
	ATHN=0
	DELTA=1
	BENDARM=2
	LNUMB=0
	NUMB=0

	DO 66621 I1=1,1000
	AREQ(I1)=0
66621	CONTINUE

20	CALL CHOICE (AT)

	DO 7183 I1=1,1000
	STATE(I1)=AREQ(I1)
7183	CONTINUE

	LNUMB=NUMB
	IF(NUMB .EQ. 0 .OR. AT .NE. 'D') GO TO 21
	DO 86 I1=1,1000
	SSTATE(I1)=AREQ(I1)
86	CONTINUE

	LLNUMB=NUMB
	CALL CSRG (2)
C   MODE 0 FOR NO NUMBERS IN GMOL  MODE 2 FOR NUMBERS
	CALL GMOL (0)
	QFLG=0
	GOTO 20
C-----------------------------------------------------------------
21	IF(NUMB .EQ. 0 .OR. AT .NE. 'Q') GO TO 921
	DO 986 I1=1,1000
	SSTATE(I1)=AREQ(I1)
986	CONTINUE
	LLNUMB=NUMB
	CALL CSRG (2)
C   MODE 0 FOR NO NUMBERS IN GMOL  MODE 2 FOR NUMBERS
	CALL GMOL (0)
	GOTO 20
C-----------------------------------------------------------------
921	ATHN=NUMB
230	CONTINUE
5111	CONTINUE
	IF(AT .NE. 'MORGA') GOTO 5112
	CALL NMORGAN
	GOTO 20
C-----------------------------------------------------------------
5112	CONTINUE
	IF(AT .NE. 'C') GOTO 9264
	DO 9265 I1=1,NUMB
	DO 9266 I2=10,5,-1
	IF(AR(I2,I1) .NE. 0) GOTO 9267
9266	CONTINUE
9267	I4=AR(2,I1)
	IF(I4 .EQ. 0) I4='C'
	TYPE 9268,I1,I4,(AR(I3,I1),I3=5,I2)
9268	FORMAT(1I3,1X,1A2,1X,6I3)
9265	CONTINUE
	GOTO 20
C-----------------------------------------------------------------
9264	CONTINUE
	GOTO 20
	END
	  SUBROUTINE CHOICE (AT)
C CHOICE: DECISION ROUTINE
	  IMPLICIT INTEGER (A-Z)
	COMMON /CREST/ LNUMB,STATE (1000)
	COMMON /CNEWHLD/ SSTATE(1000)
	COMMON /CFILLIM/ FILLIM,STRCLIM
	COMMON /CIOMNI/ IOMNI,IOMDEV,IOFST
	COMMON /CWHERE/ IWHERE,FCNT,PPN
	COMMON /CVTBAR/ VTB,DFSW
	DATA DFSW /0/
	COMMON /QSCALE/ SCALE,SCC
	COMMON /PUSH/ NEWS(1024)
	COMMON /CTERSE/ TERSE,TRING,TFRAG,NOPIC,ATHN,BENDARM,LSYM
	1  ,DELTA
	DATA LSYM /':'/
	COMMON /CATAS/ ATAS(106)
	COMMON /CGSC/ ATAR(80)
	 COMMON /CLASS/ BNCNT,BNINCL(50,3)
	1  ,TERMC,TERMAT(20),TERMV(20)
	2  ,INCL,INCLA(20),INCLT(20,4)
	COMMON /MARK/ TEMP(4)
	DATA LEV /8/
	DATA TOGG /2/
	COMMON /IO/ CID,COD
	 COMMON /CASA/ NUMB,AR(10,100),BR(6,100),CR(6,100),DR(6,100),
	1  ER(6,100)
	COMMON /CSST/ SW,SST(4),STT(8),SHUNT(5),FSHUNT(12)
	DATA (STT(I1),I1=1,8) /
	1  'RING','STIT','STIT','SUBST',
	2  'NUC','PATT','SEQ','PATT'/
	DIMENSION AREQ (10)
	EQUIVALENCE (AREQ(1),AR(1,1))
C CHOICE BEGINS HERE
	CALL GSCHAR (AT)
C-----------------------------------------------------------------
	IF(AT .NE. 'SYM') GOTO 416
	IF(LSYM .EQ. ':') GOTO 645
	LSYM=':'
	GOTO 416
645	LSYM='*'
C-----------------------------------------------------------------
416	IF(AT .NE. 'FORCE') GOTO 700
	TERSE=2
	LSYM='*'
	SCC=40
	GOTO 701
C-----------------------------------------------------------------
700	IF(AT .NE. 'CLEAR') GO TO 20
701	DO 600 I1=1,4
	SST(I1)=1
600	SHUNT(I1)=1

	SHUNT(5)=1
	BNCNT=1
	BNINCL(1,1)=0
	BNINCL(1,2)=0
	LNUMB=0
	TERMC=0
	INCL=0

	DO 21 I1=1,1000
	AREQ(I1)=0
	STATE(I1)=0
	SSTATE(I1)=0
21	CONTINUE

	NUMB=0
	ATHN=0
C-----------------------------------------------------------------
	IF(AT .NE. 'SCALE') GO TO 532
	SCC=100-SCC
	I1=1
	IF(SCC .EQ. 60) I1=2
	TYPE 533,I1
533	FORMAT(' SCALE NOW ',1I1/)
532	  CONTINUE
20	  CONTINUE
	END
	SUBROUTINE GSCHAR (ICA)
	IMPLICIT INTEGER (A-Z)
	COMMON /CGSC/ ATAR(80)
	TYPE 102
102	FORMAT(' *',$)
	ACCEPT 101,ICA,(ATAR(I1),I1=1,10)
101	FORMAT(1A5,1X,10I)
	DO 10 I11=10,0,-1
	IF(ATAR(I11) .NE. 0) GO TO 11
10	CONTINUE
11	CONTINUE
	END
	 SUBROUTINE EQCL (N1,N2,SYM)
C-----------------------------------------------------------------------
C A TOAD WHICH TOUTS FOR BONDCL
	 IMPLICIT INTEGER (A-Z)
	COMMON /CPCHAR/ PSINGLE,PDOUBLE,PTRIPLE,PALT,PTAUT
	DATA FSTSW /0/
	DIMENSION BONDMAP(15)
	DATA (BONDMAP(I1),I1=1,15)/
	1  '*','+','#','%','*','+','#','%',
	2  '.','*','*','*','+','#','$'/
	COMMON /CBNDST/ BNDST(14)
	 COMMON /CASA/ NUMB,AR(10,100)
	 COMMON /CLASS/ BNCNT,BNINCL(50,3)


	IF(BNCNT .EQ. 1) RETURN
	IF(FSTSW .EQ. 1) GO TO 50
	FSTSW=1
	BONDMAP(1)=PSINGLE
	BONDMAP(2)=PDOUBLE
	BONDMAP(3)=PTRIPLE
	BONDMAP(4)=PTAUT
	BONDMAP(5)=PSINGLE
	BONDMAP(6)=PDOUBLE
	BONDMAP(7)=PTRIPLE
	BONDMAP(8)=PTAUT
	BONDMAP(9)=PALT
50	CONTINUE
	 DO 60 I1=1,BNCNT-1
	IF(BNINCL(I1,1) .EQ. N1 .AND. BNINCL(I1,2)
	1  .EQ. N2) GO TO 61
	IF(BNINCL(I1,1) .EQ. N2 .AND.BNINCL(I1,2)
	1  .EQ. N1) GO TO 61
60	 CONTINUE
	RETURN
61	CONTINUE
	I2=BNINCL(I1,3)
	SYM=BONDMAP(I2)
	 END
	 SUBROUTINE GMOL (II)
C-----------------------------------------------------------------------
	 IMPLICIT INTEGER (A-Z)
	COMMON /CREGNO/ REGNO
	 COMMON /IO/ CID,COD,E2CID
	COMMON /CPCHAR/ PSINGLE,PDOUBLE,PTRIPLE,PALT,PTAUT
	DATA PSINGLE,PDOUBLE,PTRIPLE,PALT,PTAUT
	1   /'*','+','#','.','%'/
	COMMON /CMIRSUP/ MIRSUP
	DATA MIRSUP /0/
	DATA ERCNT /0/
	COMMON /CACL/ DUMM(4),BND(10,100)
	COMMON /CATAS/ ATAS(106)
	 COMMON /MD/ MDX,MDY
	 COMMON /CASA/ NUMB,AR(10,100),ARP(100,1)
	COMMON /CE2SW/ E2SW,E2CNT
	COMMON /CIOMNI/ IOMNI,IOMDEV

	DATA DCON /20/
	DATA DOFF /25/
	 DIMENSION PT(5)
	IF(E2CNT .EQ. 0 .OR. E2SW .EQ. 1) GO TO 300
	ERCNT=ERCNT+1
	RETURN
300	CONTINUE
	CALL CLRAR
	 MINX=10000
	 MINY=10000
	 MAXX=0
	 MAXY=0
	 DO 80 I1=1,NUMB
	 I2=AR(3,I1)
	 I3=AR(4,I1)
	 IF(I2 .GT. MAXX)MAXX=I2
	 IF(I2 .LT. MINX) MINX=I2
	 IF(I3 .GT. MAXY) MAXY=I3
	 IF(I3 .LT. MINY) MINY=I3
80	 CONTINUE
	 IF(((MAXY-MINY)-(MAXX-MINX)) .LT. 10) GO TO 81
	 IF(MIRSUP .EQ. 0) CALL MIRROR
81	 CONTINUE
	 DO 10 I1=1,NUMB
	 IF(AR(3,I1) .EQ. 0 .OR. AR(4,I1) .EQ. 0) GO TO 11
	 I2=(AR(3,I1)/DCON)+DOFF
	 I3=(AR(4,I1)/DCON)+DOFF
	I99=AR(2,I1)
	IF(II .NE. 2) GO TO 70
	CALL QPACN (I99,PT,5)
	ARP(I2,I3)=PT(1)
	IF(PT(2) .NE. ' ') ARP(I2+1,I3)=PT(2)
	GO TO 71
70	CONTINUE
	IF(I99 .EQ. 0) I99=' '
	ENCODE (5,101,PTT) I1,I99
101	FORMAT(1I2,1A2)
	CALL QPACN (PTT,PT,5)
	I21=1
	IF(PT(1) .EQ. ' ') I21=2
	I22=5
	IF(PT(4) .EQ. ' ') I22=3
	IF(PT(3) .EQ. ' ') I22=2
	DO 90 I11=I21,I22
	ARP(I2+I11-I21,I3)=PT(I11)
90	CONTINUE
71	CONTINUE
	DO 20 I4=5,10
	I55=AR(I4,I1)
	 IF(I55 .EQ. 0) GO TO 60
	 IF(I55 .LT. I1) GO TO 20
	 I10=(AR(3,I55)/DCON)+DOFF
	 I11=(AR(4,I55)/DCON)+DOFF
	SYM=PSINGLE
	IF(II .EQ. 2) GO TO 510
	CALL EQCL (I1,I55,SYM)
	GO TO 50
510	CONTINUE
	IB=BND(I4,I1)
	IF(IB .EQ. 2 .OR. IB .EQ. 6) SYM=PDOUBLE
	IF(IB .EQ. 3 .OR. IB .EQ. 7) SYM=PTRIPLE
	IF(IB .EQ. 4 .OR. IB .EQ. 8) SYM=PTAUT
	IF(IB .EQ. 9) SYM=PALT
50	 CONTINUE
	 CALL LINE (I2,I3,I10,I11,SYM)
20	CONTINUE
60	 CONTINUE
10	 CONTINUE
	 CALL GWOUT
	RETURN
11	CONTINUE
	ERCNT=ERCNT+1
	 END
	 SUBROUTINE MIRROR
	 IMPLICIT INTEGER (A-Z)
	 COMMON /CASA/ NUMB,MOLLY(10,100)
	 DO 31 I2=1,NUMB
	 IX=MOLLY(3,I2)
	 IY=MOLLY(4,I2)
	 MOLLY(3,I2)=IY
	 MOLLY(4,I2)=IX
31	 CONTINUE
	 END
	 SUBROUTINE LINE (X1,Y1,X2,Y2,SYM)
C DRAW ANY HORIZ,VERT OR DIAG LINE
	 IMPLICIT INTEGER (A-Z)
	COMMON /CVTBAR/ VTB,DFSW
	COMMON /CTERSE/ TERSE,TRING,TFRAG,NOPIC,ATHN,BENDARM,LSYM
	 COMMON /CASA/ DDD(1001),AR(100,1)
	 COMMON /MD/ MDX,MDY
	 DATA MDX,MDY /100,100/

	DATA BKSL,VTBAR /"560000000000,"760000000000/
	IF(X1 .EQ. 0 .OR. Y1 .EQ. 0 .OR. X2 .EQ. 0 .OR. Y2 .EQ. 0)
	1  CALL WO ('LINE')
	 IF(Y1 .EQ. Y2) GO TO 10
	 IF(X1 .NE. X2) GO TO 20
	IF(SYM .EQ. LSYM .AND. VTB .EQ. 1) SYM=VTBAR
	IF(SYM .EQ. LSYM .AND. VTB .EQ. 0) SYM='ā†‘'
	 IF(Y1 .LE. Y2) GO TO 1
	 TY1=Y2
	 TY2=Y1
	 GO TO 2
1	 CONTINUE
	 TY1=Y1
	 TY2=Y2
2	 CONTINUE
	 DO 30 I1=TY1,TY2
	 IF(I1 .GT. MDY .OR. I1 .LT. 1) GO TO 30
	 IF(AR(X1,I1) .NE. ' ') GO TO 30
	 AR(X1,I1)=SYM
30	 CONTINUE
	 RETURN
20	 CONTINUE
	 I4=IABS(X1-X2)   +1
	 TX1=X1
	 TY1=Y1
	 TY2=Y2
	 IF(X1 .LT. X2) GO TO 21
	 TX1=X2
	 TY1=Y2
	 TY2=Y1
21	 CONTINUE
	 IF(TY1 .GT. TY2) GO TO 22
	IF(SYM .EQ. LSYM) SYM='/'
	 DO 50 I1=1,I4
	 I6=TX1-1+I1
	 I7=TY1-1+I1
	 IF(I7 .GT. TY2) I7=TY2
	 IF(I6 .GT. MDX .OR. I6 .LT. 1 .OR. I7 .GT. MDY .OR. I7 .LT.1)
	1    GO TO 50
	 IF(AR(I6,I7) .NE. ' ') GO TO 50
	 AR(I6,I7)=SYM
50	 CONTINUE
	 RETURN
22	 CONTINUE
	IF(SYM .EQ. LSYM) SYM=BKSL
	 DO 51 I1=1,I4
	 I6=TX1-1+I1
	 I7=TY1+1-I1
	 IF(I7 .LT. TY2) I7=TY2
	 IF(I6 .GT. MDX .OR. I6 .LT. 1 .OR. I7 .GT. MDY .OR. I7 .LT.1)
	1    GO TO 51
	 IF(AR(I6,I7) .NE. ' ') GO TO 51
	 AR(I6,I7)=SYM
51	 CONTINUE
	 RETURN
10	 CONTINUE
	IF(SYM .EQ. LSYM) SYM='-'
	 IF(X1 .LE. X2) GO TO 11
	 TX1=X2
	 TX2=X1
	 GO TO 12
11	 CONTINUE
	 TX1=X1
	 TX2=X2
12	 CONTINUE
	 DO 40 I1=TX1,TX2
	 IF(I1 .GT. MDX .OR. I1 .LT. 1) GO TO 40
	 IF(AR(I1,Y1) .NE. ' ') GO TO 40
	 AR(I1,Y1)=SYM
40	 CONTINUE
	 END
	 SUBROUTINE CLRAR
C CLEAR THE PRINTOUT ARRAY
	 IMPLICIT INTEGER (A-Z)
	 COMMON /CASA/ DDDD(1001),AR(10)
	 COMMON /MD/ MDX,MDY
	 I2=MDX*MDY
	 DO 10 I1=1,I2
	 AR(I1)=' '
10	 CONTINUE
	 END
	 SUBROUTINE GWOUT
C WRITES OUT THE GRAPH IMAGE
	 IMPLICIT INTEGER (A-Z)
	DATA I111 /0/
	COMMON /CREGNO/ REGNO
	 COMMON /IO/ CID,COD
	 COMMON /CASA/ DDDD(1001),AR(100,1)
	 DIMENSION ARE(1)
	 EQUIVALENCE (AR(1,1),ARE(1))
	 COMMON /MD/ MDX,MDY
	 DATA YLEN /1/

	I111=I111+1
	 XMAX=0
	 YMAX=0
	 XMIN=MDX
	 YMIN=MDY
	 I12=MDX*MDY
	 DO 10 I11=1,I12
	 IF(ARE(I11) .EQ. ' ') GO TO 10
	 I2=MOD(I11,MDX)
	 IF(I2 .EQ. 0) I2=MDX
	 I1=(I11/MDX)+1
	 IF(I2 .GT. XMAX) XMAX=I2
	 IF(I2 .LT. XMIN) XMIN=I2
	 IF(I1 .GT. YMAX) YMAX=I1
	 IF( I1 .LT. YMIN) YMIN=I1
10	 CONTINUE
	 XMAX=XMAX+YLEN
	 YMAX=YMAX+YLEN
	 XMIN=XMIN-YLEN
	 YMIN=YMIN-YLEN
	 IF( XMIN .LT. 1 ) XMIN=1
	 IF(YMIN .LT. 1) YMIN=1
	 IF(XMAX .GT. MDX) XMAX=MDX
	 IF(YMAX .GT. MDY) YMAX=MDY
	 DO 30 I1=YMAX,YMIN,-1
	 I3=XMAX
	 DO 31 I4=XMIN,XMAX
	 IF(AR(I3,I1) .NE. ' ') GO TO 32
	 I3=I3-1
31	 CONTINUE
32	 CONTINUE
	 WRITE(5,101)(AR(I2,I1),I2=XMIN,I3)
	 DO 40 I47=XMIN,I3
	 AR(I47,I1)=' '
40	 CONTINUE
30	 CONTINUE
101	 FORMAT(' ',130A1)
	 END
	  SUBROUTINE CSRG  (MODE)
	 IMPLICIT INTEGER (A-Z)
	 COMMON /PUSLIM/ P1LIM,P2LIM,P3LIM
	 COMMON /RECC/ RECCNT,RECLIM
	COMMON /CE2SW/ E2SW,E2CNT
	 COMMON /CDQCS/ DQCSRG
	COMMON /CSEQ/ SEQ(100),MSEQ(100)
	 COMMON /ACARR/ ACAR(80)
	 COMMON /FRDIR/ FRDIR
	 COMMON /OTHRING/ ORC,ORING(100)
	 COMMON /RNGGR/ RNGGR
	 COMMON /CASA/ NUMB,AR(10,100),BR(6,100),CR(6,100),DR(6,100),
	1   ER(6,100),BNDH(6,100)
	 DIMENSION AREQ(10)
	 EQUIVALENCE (AREQ(1),AR(1,1))
	 DIMENSION EREQ(10)
	 EQUIVALENCE (EREQ(1),ER(1,1))
	 DIMENSION BREQ(10)
	 EQUIVALENCE (BREQ(1),BR(1,1))
	 COMMON /STPOS/ STPOS
	 COMMON /CPOSW/ POSW
	 COMMON /IO/ CID,COD
	  DATA COD /1/
	 COMMON /QSCALE/ SCALE,SCC
	DATA SCC /80/
	 DATA SCALE /60/

	 DIMENSION RINGT(100)

	E2CNT=0
	SCALE=SCC
	P1LIM=990
	P2LIM=1990
	P3LIM=290
	RECLIM=40

	DO 90 I1=1,NUMB
	AR(4,I1)=I1
90	CONTINUE

	 	IF(MODE .EQ. 1) CALL NMORGAN

	 DO 900 I1=1,NUMB
	SEQ(I1)=AR(3,I1)
	MSEQ(I1)=AR(4,I1)
	AR(4,I1)=0
	 AR(3,I1)=0
	DO 91 I2=5,10
	BNDH(I2-4,I1)=AR(I2,I1)
91	CONTINUE
900	 CONTINUE

	 I13=NUMB*6

	 DO 12 I1=1,I13
	 BREQ(I1)=0
	 BREQ(I1+600 )=0
	 BREQ(I1+1200)=0
	 BREQ(I1+1800)=0
	 EREQ(I1)=0
12	 CONTINUE

	 AR(3,1)=500
	 AR(4,1)=500
	 STPOS=0
	 FRDIR=0

	 CALL SAFMAF

	 CALL ELIMEND

	 CALL RINGGG (0,RINGT,CRINGT,RET)

	 CALL BRANCH

	 DO 1047 I1=1,100
	 ORING(I1)=0
1047	 CONTINUE

	 ORC=1

	DO 92 I1=1,NUMB
	AR(1,I1)=I1
	DO 93 I2=5,10
	AR(I2,I1)=BNDH(I2-4,I1)
93	CONTINUE
92	CONTINUE

	 END
	 SUBROUTINE RINGGG (MODE,BRATAR,BRATC,RET)
C-----------------------------------------------------------------------
C   IN PUSH1    WD1=ATOM POINTER   WD2=NEIGHBOR   WD3=NEXT PLACE TO STOR
C     IN TEMAR

	 IMPLICIT INTEGER (A-Z)

	 COMMON /RECC/ RECCNT,RECLIM
	 DIMENSION BRATAR(10)
	 COMMON /OTHRING/ ORC,ORING(100)
	 COMMON /PUSH/ PUSH1(1000),PUSH2(2000),PUSH3(300)
	 COMMON /PUSLIM/ P1LIM,P2LIM,P3LIM
	 COMMON /CASA/ NUMB,AR(10,100),BR(6,100),CR(6,100),DR(6,100)
	COMMON /ARCC/ SMRAR(90),TEMAR(90)

	 IC=0
	 ORC=1
	 BRATC=0
	 IF(MODE .NE. 0) IC=MODE-1
	 PC=4
10	 CONTINUE
	 IC=IC+1
	 IF(IC .GT. NUMB) GO TO 11
	 IF(AR(1,IC) .GT. 100) GO TO 10
	 PUSH1(1)=IC
	 ICL=0
	 I2=PC+1
	 IT=1
	 TEMAR(1)=IC
	 SMR=1000
400	 CONTINUE
C   BEGIN NEIGHBOR SEARCH
	 ID=4
200	 CONTINUE
	 ID=ID+1
	 I31=AR(ID,IC)
	 IF(I31 .GT. 100) GO TO 200
	 IF(I31 .EQ. 0 )GO TO 500
	 IF(ID .GT. 10) GO TO 500
	 IF(I31 .EQ. ICL) GO TO 200
300	 CONTINUE
	 DO 301 I3=1,IT
	 IF(TEMAR(I3) .EQ. I31) GO TO 302
301	 CONTINUE
C   THIS ATOM NOT YET ON THE LIST
	 IT=IT+1
	 TEMAR(IT)=I31
	 PUSH1(I2)=IC
	 PUSH1(I2+1)=ID
	 PUSH1(I2+2)=IT-1
	 PUSH1(I2+3)=ICL
	 I2=I2+PC
	 IF(I2 .LE. P1LIM) GO TO 5051
	 TYPE 5052
5052	 FORMAT(' PUSH1 OVERFLOW'/)
	 RECCNT=1000000
	 RETURN
5051	 CONTINUE
	 ICL=IC
	 IC=I31
	 GO TO 400
302	 CONTINUE
	 IF(I3 .NE. 1) GO TO 200
C   LOOP BACK TO STARTING POINT
	 IF(IT .GE. SMR) GO TO 200
C   THE PROGRAM CAN ONLY HANDLEUP TO 7 MEMBERED RINGS
C   ABORT ALL LARGER RINGS
	IF(IT .GT. 7) GO TO 200
C   SEE IF ANY ATOM IN THIS RING IS NOT POSITIONED
	DO 950 I95=1,IT
	I96=TEMAR(I95)
	IF(AR(3,I96) .EQ. 0) GO TO 951
950	CONTINUE
C   ALL ATOMS POSITIONED
	GO TO 200
951	CONTINUE
C   RING IS SMALLER   SAVE IT
	 SMR=IT
	 DO 304 I32=1,IT
	 SMRAR(I32)=TEMAR(I32)
304	 CONTINUE
	 GO TO 200
500	 CONTINUE
C   POP THE STACK
	 I2=I2-PC
	 IC=PUSH1(I2)
	 ID=PUSH1(I2+1)
	 IT=PUSH1(I2+2)
	 ICL=PUSH1(I2+3)
	 IF(I2 .NE. 1) GO TO 200
600	 CONTINUE
C   POPPED BACK TO BASE
	 IF(SMR .EQ. 1000) GO TO 10
C   THERE IS A RING
C   FIRST ATOM IN RING MUST BE POSITIONED
	 IF(AR(3,IC) .NE. 0) GO TO 606
C   MARK THIS RING AS A NON CENTRAL RING
	 DO 607 I6=1,SMR
	 I61=SMRAR(I6)
	 ORING(I61)=ORC
607	 CONTINUE
	 ORC=ORC+1
	 GO TO 10
606	 CONTINUE
	 I77=SMRAR(2)
	 IF(AR(3,I77) .NE. 0) GO TO 77
C   SECOND ATOM OF RING NOT POSITIONED
	 I78=SMRAR(SMR)
	 IF(AR(3,I78) .EQ. 0) GO TO 77
C   LAST ATOM OF RING IS POSITIONED   REVERSE THE RING LIST
	 DO 78 I79=SMR,2,-1
	 SMRAR(I79)=SMRAR(I79-1)
78	 CONTINUE
	 SMRAR(1)=I78
77	 CONTINUE
	 CALL POSITION (SMR,SMRAR,MODE,RET)
C   IF NON CENTRAL RING CANT BE POSITIONED INCREASE LEG
	IF(RET .NE. 0) RETURN
C   ELIMINATE ATOMS IN RING WITH ONLY TWO RING NEIGHBORS
	 DO 601 I6=1,SMR
	 I61=SMRAR(I6)
	 I63=0
	 DO 602 I62=5,10
	 I622=AR(I62,I61)
	 IF(I622 .GT. 0 .AND. I622 .LT. 200) I63=I63+1
	 IF(I622 .LT. 200) GO TO 602
C   PUT THIS BRANCH ON BRATAR
	 I622=I622-200
	 DO 6022 I6022=1,BRATC
	 IF(BRATAR(I6022) .EQ. I622) GO TO 602
6022	 CONTINUE
C   OK PUT IT ON
	 BRATC=BRATC+1
	 BRATAR(BRATC)=I622
602	 CONTINUE
	 IF(I63 .NE. 2) GO TO 601
C   ELIMINATE THIS ATOM
	 AR(1,I61)=AR(1,I61)+100
	 DO 603 I62=5,10
	 I64=AR(I62,I61)
	 IF(I64 .EQ. 0 .OR. I64 .GT. 100) GO TO 603
	 AR(I62,I61)=I64+100
	 DO 605 I65=5,10
	 IF(AR(I65 ,I64) .EQ. I61) GO TO 6061
605	 CONTINUE
	 CALL WO ('R605')
6061	 CONTINUE
	 AR(I65,I64)=AR(I65,I64)+100
603	 CONTINUE
601	 CONTINUE
	 GO TO 10
11	 CONTINUE
	 END
	 SUBROUTINE BRANCH
	 IMPLICIT INTEGER (A-Z)

	 COMMON /RECC/ RECCNT,RECLIM
	 DATA RECLIM /300/
	 COMMON /CASA/ NUMB,AR(10,100),BR(6,100),CR(6,100),DR(6,100)

	 RECCNT=0
	 DO 9 I9=1,6
	 REP=0
	 DO 10 I1=1,NUMB
	 IF(AR(3,I1) .NE. 0) GO TO 10
	 DO 20 I2=5,10
	 I3=AR(I2,I1)
	 IF(I3 .EQ. 0) GO TO 21
	 IF(I3 .GT. 100) I3=I3-100
	 IF(I3 .GT. 100) I3=I3-100
	 IF(AR(3,I3) .EQ. 0) GO TO 20
	 CALL RECPOS (I3,I1,RET)
	 IF(RECCNT .GE. RECLIM) RETURN
	 REP=REP+RET
	 GO TO 21
20	 CONTINUE
21	 CONTINUE
10	 CONTINUE
	 IF(REP .EQ. 0 .AND. I9 .NE. 1) GO TO 99
9	 CONTINUE
99	 CONTINUE
	 END
	 SUBROUTINE WO (I17)
	 IMPLICIT INTEGER (A-Z)
	COMMON /CREGNO/ REGNO
	 COMMON /CPOSW/ POSW
	COMMON /CE2SW/ E2SW,E2CNT
	DATA E2SW /0/
	 COMMON /CASA/ NUMB,AR(10,100),BR(6,100),CR(6,100),DR(6,100),
	1   ER(6,100)
	 COMMON /IO/ CID,COD,E2CID
	COMMON /CRPIC/ RHGH,RPIC(48)

	E2CNT=E2CNT+1
	IF(E2CNT .NE. 1) RETURN
	WRITE (E2CID,102) REGNO
102	FORMAT(1X,1I9)
	RHGH=1
	TYPE 108
108	FORMAT(' STRUCTURE CANT BE DISPLAYED')
30	CONTINUE
	 DO 10 I1=1,NUMB
	 DO 20 I2=10,5,-1
	 IF(AR(I2,I1) .NE. 0) GO TO 21
20	 CONTINUE
21	 CONTINUE
	IJK=MOD(AR(1,I1),100)
	DO 930 I3=1,I2
	AR(I3,I1)=MOD(AR(I3,I1),100)
930	CONTINUE
	 WRITE(5,101) IJK,AR(2,I1),(AR(I4,I1),I4=5,I2)
10	 CONTINUE
101	 FORMAT(1X,1I3,1X,1A2,1X,8I4)
	NUMB=0
	DO 50 I1=1,10
	AR(I1,1)=0
50	CONTINUE
	 END
	 SUBROUTINE POSITION (CNT,STR,MODE,RET)
	 IMPLICIT INTEGER (A-Z)
	 COMMON /FRDIR/ FRDIR
	 DIMENSION RNGDIR(56)
	 DATA (RNGDIR(I1),I1=1,56) /
	1  3,3,1,1,2,2,2,3,
	2 4,1,1,2,2,3,3,4,
	3 5,5,1,2,2,3,4,5,
	4 6,6,1,3,3,3,5,6,
	5 7,7,1,3,3,4,6,7,
	6   0,0,0,0,0,0,0,0,
	7   0,0,0,0,0,0,0,0/
	 DIMENSION TSTR(20)
	 COMMON /RNGGR/ RNGGR
	 COMMON /STPOS/ STPOS
	 COMMON /CASA/ NUMB,AR(10,100),BR(6,100),CR(6,100),DR(6,100),
	1   ER(6,100)
	 COMMON /REVT/ REVT(8)
	 DATA (REVT(I1),I1=1,8)/ 5,6,7,8,1,2,3,4/
	 DIMENSION STR(10)
	 DIMENSION DIRT(140)
	 DIMENSION T5(10,7),T6(12,7)
	1  ,T7(14,7),T3(12,7),T4(8,7)
	 DATA (DIRT(I1),I1=1,140)/
	1  0,0,0,0,0,0,0,0,0,0,
	2  0,0,0,0,0,0,0,0,0,0,
	3  2,4,7,3,6,8,2,5,8,1,
	4  4,6,   0,0,0,0,0,0,0,0,
	5  1,3,5,7,2,4,6,8,   0,0,
	6  0,0,0,0,0,0,0,0,0,0,
	7  1,3,5,6,8,1,2,4,5,7,
	8  0,0,0,0,0,0,0,0,0,0,
	9  1,2,4,5,6,8,3,4,6,7,8,2,
	1  0,0,0,0,0,0,0,0,
	2  1,2,3,4,5,6,8,1,2,4,
	3  5,6,7,8,   0,0,0,0,0,0,
	4  0,0,0,0,0,0,0,0,0,0,
	5  0,0,0,0,0,0,0,0,0,0/
	 DATA ((T3(I1,I2),I1=1,12),I2=1,7)    /
	1  5,6,4,3,1,2,12,10,11,8,9,7,
	2  7,8,2,4,5,6,7,1,6,3,8,5,
	3  4,5,2,10,7,8,4,1,8,3,5,7,
	4  5,6,7,10,2,3,5,1,3,4,6,5,
	5  12,14,3,13,2,4,12,1,4,5,14,2,
	6   0,0,0,0,0,0,0,0,0,0,0,0,
	7   0,0,0,0,0,0,0,0,0,0,0,0/
	 DATA ((T4(I1,I2),I1=1,8 ),I2=1,7)    /
	1  8,3,4,10,5,6,1,2,
	2  3,4,1,2,7,8,6,5,
	3  3,10,1,2,4,5,7,8,
	4  4,10,1,7,5,6,2,3,
	5  5,13,1,3,12,14,2,4,
	6   0,0,0,0,0,0,0,0,
	7   0,0,0,0,0,0,0,0/
	 DATA ((T5(I1,I2),I1=1,10),I2=1,7)    /
	1  8,3,10,1,2,8,5,6,10,4,
	2  3,4,1,5,6,3,7,8,1,2,
	3  3,10,1,7,8,3,4,5,1,2,
	4  4,10,1,2,3,4,5,6,1,7,
	5  5,13,1,2,4,5,12,14,1,3,
	6   0,0,0,0,0,0,0,0,0,0,
	7   0,0,0,0,0,0,0,0,0,0/
	 DATA ((T6(I1,I2),I1=1,12),I2=1,7)    /
	1  8,5,6,10,1,2,3,6,1,4,2,5,
	2  3,7,8,1,5,6,4,8,5,2,6,7,
	3  3,4,5,1,7,8,10,5,7,2,8,4,
	4  4,5,6,1,2,3,10,11,12,7,8,9,
	5  5,12,14,1,2,4,13,14,2,3,4,12,
	6   0,0,0,0,0,0,0,0,0,0,0,0,
	7   0,0,0,0,0,0,0,0,0,0,0,0/
	 DATA ((T7(I1,I2),I1=1,14),I2=1,7)    /
	1  8,5,3,6,10,1,2,8,5,6,10,1,4,2,
	2  3,7,4,8,1,5,6,3,7,8,1,5,2,6,
	3  3,4,10,5,1,7,8,3,4,5,1,7,2,8,
	4  4,5,10,6,1,2,3,4,5,6,1,2,7,3,
	5  5,12,13,14,1,9,10,5,6,7,1,2,3,4,
	6   0,0,0,0,0,0,0,0,0,0,0,0, 0,0,
	7   0,0,0,0,0,0,0,0,0,0,0,0, 0,0/
	 DIMENSION LENT(140)
	 DATA (LENT(I1),I1=1,140)/
	1  1,1,1,1,1,1,1,1,1,1,
	2  1,1,1,1,1,1,1,1,1,1,
	3  1,1,2,2,1,1,1,2,1,2,
	4  1,1,1,1,1,1,1,1,1,1,
	5  1,1,1,1,1,1,1,1,1,1,
	6  1,1,1,1,1,1,1,1,1,1,
	7  1,2,1,1,1,1,1,1,1,2,
	8  1,1,1,1,1,1,1,1,1,1,
	9  1,1,1,1,1,1,1,1,1,1,
	1  1,1,1,1,1,1,1,1,1,1,
	2  1,1,2,1,1,2,2,1,2,2,
	3  1,1,2,1,1,1,1,1,1,1,
	4  1,1,1,1,1,1,1,1,1,1,
	5  1,1,1,1,1,1,1,1,1,1/
	 COMMON /QSCALE/ SCALE
C BEGINNING OF CODE
	RET=0
	 IF(FRDIR .EQ. 0) GO TO 3000
	 FD1=((CNT-3)*8)+FRDIR
	 FRDIR=0
	 NPH=RNGDIR(FD1)
	 GO TO 1001
3000	 CONTINUE
	 IF(STPOS .NE. 0) GO TO 13
	 STPOS=1
	 ORCNT=6
	 OPH=1
	 GO TO 14
13	 CONTINUE
	 I1=STR(1)
	 DO 10 I2=5,10
	 IF(AR(I2,I1) .EQ. STR(2)) GO TO 11
10	 CONTINUE
	 CALL WO ('WE10')
11	 CONTINUE
	 ORCNT=BR(I2-4,I1)
	 I97=STR(2)
	 IF(ORCNT .GT. 100 .OR. AR(3,I97) .EQ. 0) GO TO 1002
	 I99=STR(1)
	 STR(1)=I97
	 STR(2)=I99
	 I95=3
	 DO 1004 I96=CNT,3,-1
	 TSTR(I95)=STR(I96)
	 I95=I95+1
1004	 CONTINUE
	 DO 1003 I98=3,CNT
	 STR(I98)=TSTR(I98)
1003	 CONTINUE
1002	 CONTINUE
	 IF(ORCNT .GT. 100) ORCNT=ORCNT-100
	 OPH=CR(I2-4,I1)
12	 CONTINUE
14	 CONTINUE
	 GO TO (1,1,300,400,500,600,700,800,900),ORCNT
300	 CONTINUE
	 NPH=T3(OPH,CNT-2)
	 GO TO 1000
400	 CONTINUE
	 NPH=T4(OPH,CNT-2)
	 GO TO 1000
500	 CONTINUE
	 NPH=T5(OPH,CNT-2)
	 GO TO 1000
600	 CONTINUE
	 NPH=T6(OPH,CNT-2)
	 GO TO 1000
700	 CONTINUE
	 NPH=T7(OPH,CNT-2)
	 GO TO 1000
1000	 CONTINUE
	 IF(MODE .EQ. 0) GO TO 1001
C   NON CENTRAL RING   USE PHASE 1
	 NPH=1
1001	 CONTINUE
	 OFF=(CNT-2)*20
	 QOFF=(((NPH-1)/  CNT)*  CNT)+1
	 STR(CNT+1)=STR(1)
	 DO 20 I3=1,CNT
	 I4=DIRT(OFF+NPH)
	 I5=STR(I3)
	 I6=STR(I3+1)
	 IF(AR(3,I6) .NE. 0) GO TO 2200
	 LX=AR(3,I5)
	 LY=AR(4,I5)
	 GO TO (31,32,33,34,35,36,37,38),I4
31	 CONTINUE
	 DX=0
	 DY=1
	 GO TO 39
32	 CONTINUE
	 DX=1
	 DY=1
	 GO TO 39
33	 CONTINUE
	 DX=1
	 DY=0
	 GO TO 39
34	 CONTINUE
	 DX=1
	 DY=-1
	 GO TO 39
35	 CONTINUE
	 DX=0
	 DY=-1
	 GO TO 39
36	 CONTINUE
	 DX=-1
	 DY=-1
	 GO TO 39
37	 CONTINUE
	 DX=-1
	 DY=0
	 GO TO 39
38	 CONTINUE
	 DX=-1
	 DY=1
	 GO TO 39
39	 CONTINUE
	 IL=LENT(OFF+NPH)
	 I92     =LX+(DX*SCALE*IL)
	 I93     =LY+(DY*SCALE*IL)
	 DO 2000 I91=1,NUMB
	 IF(AR(3,I91) .NE. I92) GO TO 2000
	 IF(I91 .EQ. I6) GO TO 2000
	 IF(AR(4,I91) .NE. I93) GO TO 2000
C   NODE OVERLAP
C   IF NON CENTRAL RING OVERLAPS BALK
	IF(MODE .EQ. 0) GO TO 2002
	RET=1
	RETURN
2002	CONTINUE
	 I92=I92-20
	 I93=I93+20
	 GO TO 2001
2000	 CONTINUE
2001	 CONTINUE
	 AR(3,I6)=I92
	 AR(4,I6)=I93
2200	 CONTINUE
	 DO 40 I7=5,10
	 IF(AR(I7,I5) .EQ. I6) GO TO 41
40	 CONTINUE
	 CALL WO ('POS40')
41	 CONTINUE
	 BR(I7-4,I5)=CNT
	 CR(I7-4,I5)=NPH
	 ER(I7-4,I5)=I4
	 DO 42 I8=5,10
	 IF(AR(I8,I6) .EQ. I5) GO TO 43
42	 CONTINUE
	 CALL WO ('POS42')
43	 CONTINUE
	 BR(I8-4,I6)=CNT   +100
	 CR(I8-4,I6)=NPH
	 ER(I8-4,I6)=REVT(I4)
	 NPH=NPH+1
	 NPHT=MOD(NPH,CNT)
	 IF(NPHT .EQ. 1  ) NPH=QOFF
20	 CONTINUE
	 IP=IP+1
	 IF(RNGGR .EQ. 1)
	1 CALL GMOL (0)
	 RETURN
800	 CONTINUE
900	 CONTINUE
1	 CONTINUE
	 CALL WO ('POEXT')
	 END
	 SUBROUTINE NDIRECT (I1,I2,I3,CNT,NDIR)
	 IMPLICIT INTEGER (A-Z)
	COMMON /CTERSE/ TERSE,TRING,TFRAG,NOPIC,ATHN,BENDARM
	DIMENSION BENDA(8)
	DATA (BENDA(I1),I1=1,8)/ 4,7,7,7,2,3,3,3/
	 COMMON /IO/ CID,COD
	 COMMON /REVT/ REVT(8)
	 DIMENSION NDT(4,56)
	 DATA ((NDT(I1,I2),I1=1,4),I2=1,56) /
	1  6,4,0,1,   8,2,0,5,   8,5,0,2,   1,6,0,4,   1,4,0,6,   5,2,0,8,
	2  2,4,0,7,   8,6,0,3,   6,3,0,8,   2,7,0,4,   7,4,0,2,   3,8,0,6,
	3  1,5,0,3,   5,1,0,7,   7,3,0,1,   3,7,0,5,
	4  4,8,0,2,   6,2,0,8,   2,6,0,4,   8,4,0,6,
	5  3,5,0,8,   5,7,0,2,   1,3,0,6,   1,7,0,4,
	6  1,3,7,5,   5,3,7,1,   1,5,3,7,   1,5,7,3,
	7  2,4,8,6,   2,6,8,4,   4,2,6,8,   4,8,6,2,
	8  2,5,8,1,  4,1,6,5,  3,6,8,7,  2,4,7,3,
	9  7,4,1,8, 3,5,8,6, 5,7,2,8,  1,3,6,4,
	1  1,4,5,7,  1,5,6,3,  1,5,8,3,  1,2,5,7,
	2  1,2,6,4,  2,6,7,4,  2,3,6,8,  2,5,6,8,
	3  1,4,8,6,  3,4,8,6,  4,5,8,2,  4,7,8,2,
	4  3,7,8,5,  3,6,7,1,  2,3,7,5,  3,4,7,1/
C BEGINNING OF CODE
	 NDIR=0
	 IF(I2 .NE. 0) GO TO 12
	 NDIR=REVT(I1)
	IF(BENDARM .EQ. 2) NDIR=BENDA(I1)
	 GO TO 11
	 RETURN
12	 CONTINUE
	 I41=1
	 IF(I3 .NE. 0) I41=25
	 DO 10 I4=I41,56
	 CALL ND1(I1,I2,I3,NDT(1,I4),NDIR)
	 IF(NDIR .NE. 0) GO TO 11
	 IF(I4 .GE. 13 .AND. I4 .LE. 20) GO TO 10
	 CALL ND1(I1,I3,I2,NDT(1,I4),NDIR)
	 IF(NDIR .NE. 0) GO TO 11
	 CALL ND1(I2,I1,I3,NDT(1,I4),NDIR)
	 IF(NDIR .NE. 0) GO TO 11
	 CALL ND1(I2,I3,I1,NDT(1,I4),NDIR)
	 IF(NDIR .NE. 0) GO TO 11
	 CALL ND1(I3,I1,I2,NDT(1,I4),NDIR)
	 IF(NDIR .NE. 0) GO TO 11
	 CALL ND1(I3,I2,I1,NDT(1,I4),NDIR)
	 IF(NDIR .NE. 0) GO TO 11
10	 CONTINUE
	 CALL WO ('ND10')
C       WRITE(COD,101) I1,I2,I3
C101    FORMAT(1X,3I4)
	 RETURN
11	 CONTINUE
	 IF(CNT .EQ. 0) GO TO 20
C   SAME DIRECTION GENERATED AGAIN
	 IF(CNT .EQ. 1) NDIR=MOD(NDIR,8)+1
	 IF(CNT .NE. 2) GO TO 30
	 NDIR=NDIR-1
	 IF(NDIR .EQ. 0) NDIR=8
30	 CONTINUE
	 IF(CNT .NE. 3) GO TO 40
	 NDIR=MOD(NDIR,8)+1
	 NDIR=MOD(NDIR,8)+1
40	 CONTINUE
	 IF(CNT .NE. 4) GO TO 50
	 NDIR=NDIR-1
	 IF(NDIR .EQ. 0) NDIR=8
	 NDIR=NDIR-1
	 IF(NDIR .EQ. 0) NDIR=8
50	 CONTINUE
	 RETURN
20	 CONTINUE
	 END
	 SUBROUTINE ND1 (I1,I2,I3,QAR,NDIR)
	 IMPLICIT INTEGER (A-Z)
	 DIMENSION QAR(4)
	 NDIR=0
	 IF(I1 .EQ. QAR(1) .AND. I2 .EQ. QAR(2) .AND. I3 .EQ. QAR(3))
	1  NDIR=QAR(4)
	 END
	 SUBROUTINE INTERSECT (I1,I2,RET)
	 REAL MM,QM,MC,QC,MX,MY,M1X,M1Y,M2X,M2Y,M3X,M3Y,M4X,M4Y,TT,TB
	 IMPLICIT INTEGER (A-Z)
	 COMMON /CASA/ NUMB,AR(10,100),BR(6,100),CR(6,100),DR(6,100)
	 RET=0
	 I1X=AR(3,I1)
	 I1Y=AR(4,I1)
	 I2X=AR(3,I2)
	 I2Y=AR(4,I2)
	 MM=1000000.
	TT=I1Y-I2Y
	TB=I1X-I2X
	 IF(I1X .NE. I2X) MM=TT/TB
	 M1X=I1X
	 M1Y=I1Y
	 M2X=I2X
	 M2Y=I2Y
	 MC=M2Y-(MM*M2X)
	 DO 10 I3=1,NUMB
	 IF(I3 .EQ. I1 .OR. I3 .EQ. I2) GO TO 10
	 I3X=AR(3,I3)
	 IF(I3X .EQ. 0) GO TO 10
	 I3Y=AR(4,I3)
	 M3X=I3X
	 M3Y=I3Y
	 DO 20 I4=5,10
	 I41=AR(I4,I3)
	 IF(I41 .EQ. 0) GO TO 10
	IF(I41 .LT. I3) GO TO 20
	 IF(I41 .GT. 100) I41=I41-100
	 IF(I41 .GT. 100) I41=I41-100
	 IF(I41 .EQ. I1 .OR. I41 .EQ. I2) GO TO 20
	 I4X=AR(3,I41)
	 IF(I4X .EQ. 0) GO TO 20
	 I4Y=AR(4,I41)
C   GOT 4 POINTS
	 QM=1000000.
	TT=I3Y-I4Y
	TB=I3X-I4X
	 IF(I3X .NE. I4X)QM=TT/TB
	 M4X=I4X
	 M4Y=I4Y
	 QC=M4Y-(QM*M4X)
	IF(QM.EQ.MM) GO TO 21
	MX=(QC-MC)/(MM-QM)
	IF((M1X-MX)*(MX-M2X).GE.0.AND.(M3X-MX)*(MX-M4X).GE.0) GO TO 60
	GO TO 20
21	IF(MC.NE.QC) GO TO 20
	IF(ABS(QM).GT.1.0) GO TO 22
	IF((M1X-M3X)*(M3X-M2X).GE.0.OR.(M1X-M4X)*(M4X-M2X).GE.0)GOTO60
	GO TO 20
22		CONTINUE
	IF((M1Y-M3Y)*(M3Y-M2Y).GE.0.OR.(M1Y-M4Y)*(M4Y-M2Y).GE.0) GO TO 60
20	 CONTINUE
10	 CONTINUE
	 RETURN
60	 CONTINUE
	 RET=1
	 END
	 SUBROUTINE RECPOS (LAT,NAT,RET)
	 IMPLICIT INTEGER (A-Z)
	 COMMON /REVT/ REVT(8)
	 COMMON /FRDIR/ FRDIR
	 COMMON /QSCALE/ SCALE
	 COMMON /RECC/ RECCNT,RECLIM
	 COMMON /PUSLIM/ P1LIM,P2LIM,P3LIM
	 COMMON /PUSH/ PUSH1(1000),PUSH2(2000),PUSH3(300)
	 COMMON /CASA/ NUMB,AR(10,100),BR(6,100),CR(6,100),DR(6,100),
	1   ER(6,100)
	 COMMON /OTHRING/ ORC,ORING(100)

	 DIMENSION NDAR(3)
	 PL=12
	 IP3=1
	 I2=10
	 LC=LAT
	 NC=NAT
600	 CONTINUE
	 IF(I2 .LE. P2LIM) GO TO 5051
	 TYPE 5052
	 RECCNT=1000000
	 RETURN
5052	 FORMAT(' PUSH2 OVERFLOW'/)
5051	 CONTINUE
	 DISC=0
	 DIRC=0
	 RNGSW=1
	 RNG=0
	 RET=0
400	 CONTINUE
C   BEGIN TO POSITION THIS ATOM
C   ASSUMES THAT NEIGHBORS ARE ORDERED ACCORDING TO LENGTH
	 NDAR(1)=0
	 NDAR(2)=0
	 NDAR(3)=0
	 I41=1
	 DO 401 I4=5,10
	 I42=AR(I4,LC)
	 IF(I42 .EQ. 0) GO TO 4205
	 IF(I42 .GT. 100) I42=I42-100
	 IF(I42 .GT. 100) I42=I42-100
	 IF(AR(3,I42) .EQ. 0) GO TO 401
C   FOUND A NEIGHBOR ON LAT WHICH IS POSITIONED
	 NDAR(I41)=ER(I4-4,LC)
	 I41=I41+1
401	 CONTINUE
4205	 CONTINUE
	 IF(I41 .NE. 1) GO TO 420
C   NO NEIGHBORS ARE SET  USE DIRECTION 3
	 NDIR=3
	 GO TO 471
420	 CONTINUE
	 CALL NDIRECT (NDAR(1),NDAR(2),NDAR(3),DIRC,NDIR)
471	 CONTINUE
	 RECCNT=RECCNT+1
	 IF(RECCNT .GE. RECLIM) RETURN
C   CHANGE LENGTH OF ARM
	 DISC=DISC+1
	 IF(DISC .LE.  5) GO TO 410
470	 CONTINUE
C   CHANGE DIRECTION
	 DISC=0
	 DIRC=DIRC+1
	 IF(DIRC .GE. 4) GO TO 502
C   CLEAR POSITIONING OF ATOM
	 AR(3,NC)=0
	 AR(4,NC)=0
	 NCP1=NC+100
	 NCP2=NC+200
	 DO 531 I431=5,10
	 I432=AR(I431,LC)
	 IF(I432 .EQ. NC .OR. I432 .EQ. NCP1 .OR. I432 .EQ. NCP2)
	1  GO TO 532
531	 CONTINUE
	 CALL WO ('RP531')
532	 CONTINUE
	 ER(I431-4,LC)=0
	 LCP1=LC+100
	 LCP2=LC+200
	 DO 533 I433=5,10
	 I434=AR(I433,NC)
	 IF( I434 .EQ. LC .OR. I434 .EQ. LCP1 .OR. I434 .EQ. LCP2)
	1  GO TO 534
533	 CONTINUE
	 CALL WO ('RP533')
534	 CONTINUE
	 ER(I433-4,NC)=0
	 I411X=AR(3,NC)
	 I411Y=AR(4,NC)
	 GO TO 420
410	 CONTINUE
	 GO TO (411,412,413,414,415,416,417,418),NDIR
411	 CONTINUE
	 AR(3,NC)=AR(3,LC)
	 AR(4,NC)=AR(4,LC)+(DISC*SCALE)
	 GO TO 430
412	 CONTINUE
	 AR(3,NC)=AR(3,LC)+(DISC*SCALE)
	 AR(4,NC)=AR(4,LC)+(DISC*SCALE)
	 GO TO 430
413	 CONTINUE
	 AR(3,NC)=AR(3,LC)+(DISC*SCALE)
	 AR(4,NC)=AR(4,LC)
	 GO TO 430
414	 CONTINUE
	 AR(3,NC)=AR(3,LC)+(DISC*SCALE)
	 AR(4,NC)=AR(4,LC)-(DISC*SCALE)
	 GO TO 430
415	 CONTINUE
	 AR(3,NC)=AR(3,LC)
	 AR(4,NC)=AR(4,LC)-(DISC*SCALE)
	 GO TO 430
416	 CONTINUE
	 AR(3,NC)=AR(3,LC)-(DISC*SCALE)
	 AR(4,NC)=AR(4,LC)-(DISC*SCALE)
	 GO TO 430
417	 CONTINUE
	 AR(3,NC)=AR(3,LC)-(DISC*SCALE)
	 AR(4,NC)=AR(4,LC)
	 GO TO 430
418	 CONTINUE
	 AR(3,NC)=AR(3,LC)-(DISC*SCALE)
	 AR(4,NC)=AR(4,LC)+(DISC*SCALE)
	 GO TO 430
430	 CONTINUE
	 IF(I411X .EQ. 0 .OR. (I411X .EQ. AR(3,NC) .AND.
	1  I411Y .EQ. AR(4,NC))) GO TO 4119
C       WRITE(COD,4118) I411X,I411Y,AR(3,NC),AR(4,NC)
C4118   FORMAT(' OLD ',2I5,' NEW ',2I5)
	 AR(3,NC)=I411X
	 AR(4,NC)=I411Y
4119	 CONTINUE
	 CALL INTERSECT (LC,NC,RET)
	 IF(RET .NE. 1) GO TO 4717
	 AR(3,NC)=0
	 AR(4,NC)=0
	 GO TO 470
4717	 CONTINUE
	 NCP1=NC+100
	 NCP2=NC+200
	 DO 431 I431=5,10
	 I432=AR(I431,LC)
	 IF(I432 .EQ. NC .OR. I432 .EQ. NCP1 .OR. I432 .EQ. NCP2)
	1  GO TO 432
431	 CONTINUE
	 CALL WO ('RP431')
432	 CONTINUE
	 ER(I431-4,LC)=NDIR
	 LCP1=LC+100
	 LCP2=LC+200
	 DO 433 I433=5,10
	 I434=AR(I433,NC)
	 IF( I434 .EQ. LC .OR. I434 .EQ. LCP1 .OR. I434 .EQ. LCP2)
	1  GO TO 434
433	 CONTINUE
	 CALL WO ('RP433')
434	 CONTINUE
	 ER(I433-4,NC)=REVT(NDIR)
	 IF(ORING(NC) .EQ. 0) GO TO 480
	IF(DISC .LT. 2) GO TO 471
C   NON CENTRAL RING
	 FRDIR=NDIR
	 CALL RINGGG (NC,PUSH3(IP3),RNG,RET)
	 IF(RET .EQ. 1) GO TO 470
	 I5=0
	 RNGSW=2
540	 CONTINUE
	 I5=I5+1
	 IF(I5 .GT. RNG) GO TO 500
	 I55=PUSH3(IP3+I5-1)
	 DO 541 I54=5,10
	 I51=AR(I54,I55)
	 IF(I51 .EQ. 0) GO TO 540
	 IF(I51 .LE. 200) GO TO 541
	 I51=I51-200
	 IF(AR(3,I51) .NE. 0) GO TO 542
541	 CONTINUE
	 CALL WO ('RP541')
542	 CONTINUE
C   SAVE THIS ATOM
	 PUSH2(I2)=LC
	 PUSH2(I2+1)=NC
	 PUSH2(I2+2)=DISC
	 PUSH2(I2+3)=DIRC
	 PUSH2(I2+4)=I5
	 PUSH2(I2+5)=RNG
	 PUSH2(I2+6)=IP3
	 PUSH2(I2+7)=RNGSW
	 PUSH2(I2+8)=I51
	 PUSH2(I2+9)=NDAR(1)
	 PUSH2(I2+10)=NDAR(2)
	 PUSH2(I2+11)=NDAR(3)
	 IP3=IP3+RNG
	 IF(IP3 .LE. P3LIM) GO TO 5055
	 TYPE 5056
	 RECCNT=1000000
	 RETURN
5056	 FORMAT(' PUSH3 OVERFLOW'/)
5055	 CONTINUE
	 I2=I2+PL
	 LC=I51
	 NC=I55
	 GO TO 600
480	 CONTINUE
	 I5=4
440	 CONTINUE
	 I5=I5+1
	 IF(I5 .GT. 10) GO TO 500
	 I51=AR(I5,NC)
	 IF(I51 .LT. 200) GO TO 440
	 I51=I51-200
	 IF(AR(3,I51) .NE. 0) GO TO 440
C   SAVE THIS ATOM
	 PUSH2(I2)=LC
	 PUSH2(I2+1)=NC
	 PUSH2(I2+2)=DISC
	 PUSH2(I2+3)=DIRC
	 PUSH2(I2+4)=I5
	 PUSH2(I2+5)=RNG
	 PUSH2(I2+6)=IP3
	 PUSH2(I2+7)=RNGSW
	 PUSH2(I2+8)=I51
	 PUSH2(I2+9)=NDAR(1)
	 PUSH2(I2+10)=NDAR(2)
	 PUSH2(I2+11)=NDAR(3)
	 I2=I2+PL
	 LC=NC
	 NC=I51
	 GO TO 600
502	 CONTINUE
	 RET=1
500	 CONTINUE
	 I2=I2-PL
	 IF(I2 .LE. 1) GO TO 700
	 LC=PUSH2(I2)
	 NC=PUSH2(I2+1)
	 DISC=PUSH2(I2+2)
	 DIRC=PUSH2(I2+3)
	 I5=PUSH2(I2+4)
	 RNG=PUSH2(I2+5)
	 IP3=PUSH2(I2+6)
	 RNGSW=PUSH2(I2+7)
	 I51=PUSH2(I2+8)
	 NDAR(1)=PUSH2(I2+9 )
	 NDAR(1)=PUSH2(I2+10)
	 NDAR(1)=PUSH2(I2+11)
	 IF(RET .EQ. 0) GO TO 501
	 RET=0
	 CALL UNPOS (NC)
	 GO TO 471
501	 CONTINUE
	 GO TO (440,540),RNGSW
700	 CONTINUE
	 END
	 SUBROUTINE UNPOS (NC)
	 IMPLICIT INTEGER (A-Z)
	 COMMON /CASA/ NUMB,AR(10,100),BR(6,100),CR(6,100),DR(6,100)
	 COMMON /PUSH4/ PUSH4(100)
	 IP4=2
	 PUSH4(1)=NC
	 PUSH4(2)=0
	 DO 10 PP4=1,100
	 PN=PUSH4(PP4)
	 IF(PN .EQ. 0) GO TO 11
	 AR(3,PN)=0
	 AR(4,PN)=0
	 DO 20 I1=5,10
	 I2=AR(I1,PN)
	 IF(I2 .EQ. 0 .OR. DR(I1-4,PN) .EQ. 0) GO TO 20
	 IF(I2 .GT. 100) I2=I2-100
	 IF(I2 .GT. 100) I2=I2-100
	 IF(AR(3,I2) .EQ. 0) GO TO 20
	 PUSH4(IP4)=I2
	 PUSH4(IP4+1)=0
	 IP4=IP4+1
20	 CONTINUE
10	 CONTINUE
11	 CONTINUE
	 END
	 SUBROUTINE ELIMEND
	 IMPLICIT INTEGER (A-Z)
	 DIMENSION TAR1(10),TAR2(10)
	 COMMON /CASA/ NUMB,AR(10,100),BR(6,100),CR(6,100),DR(6,100)
	 DO 60 I1=1,NUMB
	 IF(AR(6,I1) .NE. 0) GO TO 60
C    ONLY ONE ATTACHMENT
	 I2=AR(5,I1)
	 DO 61 I3=5,10
	 IF(AR(I3,I2) .EQ. I1) GO TO 62
61	 CONTINUE
	 CALL WO ('EE60')
62	 CONTINUE
	 DR(I3,I2)=1
	 AR(1,I1)=AR(1,I1)+200
60	 CONTINUE
40	 CONTINUE
	 FND=0
	 DO 10 I1=NUMB,1,-1
	 IF(AR(1,I1) .GT. 100) GO TO 10
	 I3=0
	 DO 20 I2=5,10
	 IF(AR(I2,I1) .EQ. 0) GO TO 20
	 IF(AR(I2,I1) .GT. 200) GO TO 20
	 I3=I3+1
	 I4=AR(I2,I1)
	 I41=I2
20	 CONTINUE
	 IF(I3 .GT. 1 .OR. I3 .EQ. 0) GO TO 10
	 AR(I41,I1)=AR(I41,I1)+200
	 FND=1
	 I8=0
	 DO 400 I9=1,6
	 IF(DR(I9,I1) .GT. I8) I8=DR(I9,I1)
400	 CONTINUE
	 DO 30 I2=5,10
	 IF(AR(I2,I4) .EQ. I1) GO TO 31
30	 CONTINUE
	 CALL WO ('EE30')
31	 CONTINUE
	 AR(I2,I4)=AR(I2,I4)+200
	 AR(1,I1)=AR(1,I1)+200
	 DR(I2-4,I4)=I8+1
10	 CONTINUE
	 IF(FND .EQ. 1) GO TO 40
	 DO 50 I1=1,NUMB
	 IF(AR(1,I1) .LT. 200) GO TO 50
51	 CONTINUE
	 I5=1
	 DO 95 I2=1,6
	TAR1(I2)=0
	TAR2(I2)=0
	 IF(AR(I2+4,I1) .EQ. 0 .OR. DR(I2,I1) .NE. 0 ) GO TO 95
	 TAR1(I5)=DR(I2,I1)
	 TAR2(I5)=AR(I2+4,I1)
	 I5=I5+1
95	 CONTINUE
	 DO 80 I2=1,6
	 I4=0
	 DO 70 I3=1,6
	 IF(DR(I3,I1) .LE. TAR1(I2)) GO TO 70
	 TAR1(I5)=DR(I3,I1)
	 TAR2(I5)=AR(I3+4,I1)
	 I4=I3
70	 CONTINUE
	 IF(I4 .EQ. 0) GO TO 81
	 DR(I4,I1)=-1
	 I5=I5+1
80	 CONTINUE
81	CONTINUE
	 DO 90 I2=1,6
	 AR(I2+4,I1)=TAR2(I2)
	 DR(I2,I1)=TAR1(I2)
90	 CONTINUE
50	 CONTINUE
	 END
	 SUBROUTINE SAFMAF
	 IMPLICIT INTEGER (A-Z)
	 DIMENSION STPAR(12)
	 DATA (STPAR(I1),I1=1,12) /500,500,700,700,300,300
	1  ,700,300,300,700,300,500/
	 COMMON /CASA/ NUMB,AR(10,100),BR(6,100),CR(6,100),DR(6,100)
	 COMMON /PUSH4/ PUSH4(100)

	 STC=1
	 DO 30 I3=1,NUMB
	 IF(AR(3,I3) .NE. 0 .AND. I3 .NE. 1) GO TO 30
	 AR(3,I3)=STPAR(STC)
	 AR(4,I3)=STPAR(STC+1)
	 STC=STC+2
	 IP4=2
	 PUSH4(1)=I3
	 PUSH4(2)=0
	 DO 10 PP4=1,100
	 PN=PUSH4(PP4)
	 IF(PN .EQ. 0) GO TO 11
	 DO 20 I1=5,10
	 I2=AR(I1,PN)
	 IF(I2 .EQ. 0) GO TO 20
	 IF(AR(3,I2) .NE. 0) GO TO 20
	 AR(3,I2)=AR(3,I2)-1
	 PUSH4(IP4)=I2
	 PUSH4(IP4+1)=0
	 IP4=IP4+1
20	 CONTINUE
10	 CONTINUE
11	 CONTINUE
30	 CONTINUE
	 DO 40 I1=1,NUMB
	 AR(3,I1)=AR(3,I1)+1
40	 CONTINUE
	 END
	SUBROUTINE NMORGAN
	IMPLICIT INTEGER (A-Z)
	COMMON /CASA/ NUMB,AR(1000)
	 COMMON /IO/ CID,COD,FILSIZ,ICNT
	COMMON /CPOSW/ POSW
	COMMON /NMOR/ NN(100),EV(100),PST(100),SA(100)
	1  ,Z(2,100),ATS(100),AT(100),ASS(100)
	2  ,SUBQ(100),SUBS(100),SUBT(100)
	DIMENSION ZS(2)
	EQUIVALENCE (ZS(1),Z(1,1))

	I11=0
	DO 10 I1=1,NUMB
	DO 20 I2=5,10
	IF(AR(I2+I11) .EQ. 0) GO TO 21
20	CONTINUE
	I2=11
21	CONTINUE
	AT(I1)=AR(2+I11)
	I2=I2-5
	NN(I1)=I2
	EV(I1)=I2
	SA(I1)=I2
	I11=I11+10
10	CONTINUE
	OK=0
30	CONTINUE
	CALL SORT (SA,NUMB,1)
	NK=1
	I2=SA(1)
	PST(1)=EV(1)
	DO 50 I1=2,NUMB
	PST(I1)=EV(I1)
	IF(SA(I1) .EQ. I2) GO TO 50
	NK=NK+1
	I2=SA(I1)
50	CONTINUE
	IF(NK .LE. OK) GO TO 51
	OK=NK
	I11=0
	DO 60 I1=1,NUMB
	I2=NN(I1)
	I5=0
	IF(I2 .EQ. 0) GO TO 72
	DO 70 I3=1,I2
	I4=AR(I3+4+I11)
	IF(I4 .GE. 1 .AND. I4 .LE. 100) GO TO 71
	TYPE 101,I1,I2
101	FORMAT(' NMORGAN ',2I3/)
	RETURN
71	CONTINUE
	I5=I5+PST(I4)
70	CONTINUE
72	CONTINUE
	EV(I1)=I5
	SA(I1)=I5
	I11=I11+10
60	CONTINUE
	GO TO 30
51	CONTINUE
	IF(POSW .NE. 0) GO TO 89
	KUMB=(NUMB*10)
	WRITE (COD,102)(AR(I111),I111=1,KUMB,10)
	WRITE(COD,102)(EV(I111),I111=1,NUMB)
102	FORMAT(1X,30I4)
	WRITE(COD,102)(SA(I111),I111=1,NUMB)
89	CONTINUE
	DO 82 I1=1,NUMB
	ATS(I1)=0
82	CONTINUE
	I13=SA(NUMB)
	DO 90 I1=NUMB,1,-1
	IF(EV(I1) .NE. I13) GO TO 90
	DO 80 I2=1,NUMB
	PST(I2)=0
80	CONTINUE
	I2=0
	I3=1
	SA(1)=I1
120	CONTINUE
	I2=I2+1
	IF(I2 .GT. I3) GO TO 121
	I4=SA(I2)
	I44=(I4-1)*10
	I5=NN(I4)
	IF(I5 .EQ. 0) GO TO 132
	K6=0
	DO 100 I6=1,I5
	I7=AR(I6+4+I44)
	ZS(3+K6)=I7
	ZS(1+K6)=EV(I7)
	ZS(2+K6)=AT(I7)
	K6=K6+3
100	CONTINUE
	CALL SORT (Z,I5,3)
	K6=(I5-1)*3
	DO 110 I6=I5,1,-1
	I8=ZS(3+K6)
	DO 130 I7=1,I3
	IF(I8 .EQ. SA(I7)) GO TO 131
130	CONTINUE
132	CONTINUE
	I3=I3+1
	SA(I3)=I8
	PST(I3)=AT(I8)
	IF(AT(I8) .LT. ATS(I3)) GO TO 90
C   THE ATOM SEQUENCE OF DEVELOPING STRUCTURE IS GTE
	IF(AT(I8) .EQ. ATS(I3)) GO TO 138
131	CONTINUE
	DO 139 I18=1,NUMB
	ATS(I18)=0
139	CONTINUE
138	CONTINUE
	K6=K6-3
110	CONTINUE
	GO TO 120
121	CONTINUE
	DO 140 I2=1,NUMB
	ATS(I2)=PST(I2)
	ASS(I2)=SA(I2)
140	CONTINUE
	I11=I1
90	CONTINUE
	DO 150 I1=1,NUMB
	Z(2,I1)=I1
	Z(1,I1)=ASS(I1)
150	CONTINUE
	CALL SORT (Z,NUMB,2)
	IF(POSW .EQ. 0)
	1  WRITE(COD,102)(Z(1,I111),Z(2,I111),I111=1,NUMB)
	I11=0
	DO 160 I1=1,NUMB
	I2=NN(I1)
	DO 170 I3=1,I2
	I4=AR(I3+4+I11)
	AR(I3+4+I11)=Z(2,I4)
170	CONTINUE
	AR(1+I11)=Z(2,I1)
	IF(I2 .GT. 1) CALL SORT (AR(5+I11),I2,1)
	I11=I11+10
160	CONTINUE
	CALL SORT (AR,NUMB,10)
C	IF(POSW .EQ. 0) CALL PRAR (AR,NUMB,'NMORG')
	END