SUBROUTINE NAAPSE(R,NNATOM,IAINI,IAFIN,NUCB, 1 NUSAPB,NUSAPA,IABMAK,NUMAKE,IABCUT,NNCUT) C BOND-MAKING ATOM-PAIRS ARE SELECTED. C NUSAPB IS NUMBER OF SELECTED ATOM-PAIRS BEFORE THIS SUB. IS CALLED C NUSAPB IS NUMBER OF SELECTED ATOM-PAIRS AFTER THIS SUB. IS CALLED IMPLICIT REAL (A-H,O-Z) INTEGER*2 ATBOND CHARACTER*80 COMAND, DUMMY INCLUDE 'SIZES' LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI DIMENSION R(NNATOM) DIMENSION IABMAK(2,NUMAKE),IABCUT(2,NNCUT) COMMON /ATOMS/ CO(3,NUMATM), IE(NUMATM), NATOMS, ATCHG( NUMATM) COMMON /NABOND/ BOND(3,400) COMMON /NAREAL/ FORINI(50),FORFIN(50),ALLINI(30),ALLFIN(30), 1 XREC(5),YREC(5), CT(50),ST(50),DTHETA,CD,SD, 2 A,COEFF1,COEFF2,COEFF3,DLIM,DLIM2 COMMON /NAINTE/ NO,NUBOND,ITABLE,INDCL COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM), . ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO * *************** * LOCAL FUNCTION DEFINITION ATDIST(I,J) = SQRT((CO(1,I)-CO(1,J))**2+ . (CO(2,I)-CO(2,J))**2+ . (CO(3,I)-CO(3,J))**2) *************** IF(ITABLE.EQ.1.OR.DEBUGN) THEN CALL DEBUGR( ' BOND-TABLE BELOW ' ) CALL DEBUGR( ' (FOR EXAMPLE, 56=( 12, 36) INDICATES THAT') CALL DEBUGR( ' THE 56-TH BOND IS FORMED BETWEEN 12-TH AND' ) CALL DEBUGR( ' 36-TH ATOM )' ) ENDIF NUATOM=NNATOM MANUPB=NUCB NUCUT=NNCUT NO=4*NUSAPB INIFIN=IAFIN-IAINI IF(INIFIN.LT.1) GO TO 1040 IAFIN1=IAFIN-1 C DO 1010 IA=IAINI,IAFIN1 IA1=IA+1 DO 1020 IB=IA1,IAFIN DO 20 L=1,NUMAKE IF( IA.EQ.IABMAK(1,L) .AND. IB.EQ.IABMAK(2,L)) GO TO 21 20 CONTINUE 21 IF ( ATBOND( IA, IB) .GT. 0 ) THEN 31 KA=IA KB=IB D2D2AB = ATDIST( IA, IB ) CALL NAPOCA(KA,KB,CO,IE,R,NUATOM,BOND,MANUPB,D2D2AB, 1 IABCUT,NUCUT) ENDIF 1020 CONTINUE 1010 CONTINUE GO TO 1040 C 1040 NUSAPA=NO/4 NNBOND=NUSAPA-NUSAPB IF (DEBUGN) THEN WRITE( COMAND, 200) SDLIM,NUMAKE,NUCUT,NNBOND 200 FORMAT( ' DLIM=',F8.3,' NUMAKE=',I4,' NUCUT=',I4,10X, 1 'NUMBER OF BONDS=',I6) CALL DEBUGR( COMAND ) ENDIF RETURN END SUBROUTINE NAARC(XO,YO,R,THETAI,THETAF) C ARC IS DRAWN. IMPLICIT REAL (A-H, O-Z) COMMON /NAREAL/ FORINI(50),FORFIN(50),ALLINI(30),ALLFIN(30), 1 XREC(5),YREC(5), CT(50),ST(50),DTHETA,CD,SD, 2 A,COEFF1,COEFF2,COEFF3,DLIM,DLIM2 THEINI=THETAI+0.01 THEFIN=THETAF-0.01 II=INT((THEFIN-THEINI)/DTHETA) SINOLD= SIN(THEINI) COSOLD= COS(THEINI) XINI=R*COSOLD+XO YINI=R*SINOLD+YO XFIN=R* COS(THEFIN)+XO YFIN=R* SIN(THEFIN)+YO IF(II.GT.0) GO TO 20 CALL NAPLOT(XINI,YINI,2) CALL NAPLOT(XFIN,YFIN,3) RETURN 20 CALL NAPLOT(XINI,YINI,2) DO 10 I=1,II SINTHE=SINOLD*CD+COSOLD*SD COSTHE=COSOLD*CD-SINOLD*SD XR=R*COSTHE+XO YR=R*SINTHE+YO CALL NAPLOT(XR,YR,3) SINOLD=SINTHE COSOLD=COSTHE 10 CONTINUE CALL NAPLOT(XFIN,YFIN,3) RETURN END SUBROUTINE NACICI(JA,JB,D2D2AB,FTHINI,FTHFIN,CO,R,NUATOM) C THE HIDDEN REGION OF CIRCLE-JB BY CIRCLE-JA IS CALCULATED. IMPLICIT REAL (A-H, O-Z) DIMENSION CO(3,NUATOM),R(NUATOM) CHARACTER*80 DUMMY C COZ(JA).GT.COZ(JB) XV=CO(1,JA)-CO(1,JB) YV=CO(2,JA)-CO(2,JB) CALL NAXYTH(XV,YV,THETA) D2JAJB= SQRT(D2D2AB) DENOMI=2.*R(JB)*D2JAJB IF(DENOMI.LT.0.00001) THEN WRITE(DUMMY,100) JA,JB CALL DEBUGR( DUMMY ) ENDIF 100 FORMAT( ' DENOMI UNDER FLOW AT SUB. NACICI JA=',I4, 1 ' JB=',I4,' ]]]]]') COSTH1=(D2D2AB+R(JB)**2-R(JA)**2)/DENOMI THETA1= ACOS(COSTH1) FTHINI=THETA-THETA1 FTHFIN=THETA+THETA1 IF(FTHINI.GT.0.0) GO TO 10 FTHINI=FTHINI+6.283186 10 IF(FTHFIN.LT.6.283187) RETURN FTHFIN=FTHFIN-6.283186 RETURN END SUBROUTINE NACIDI(CO,R,NUATOM,INIATO,LASATO,NUSIDE,BOND,NUCB) C ATOMIC CIRCLES FROM INIATO TO LASATO ARE DISPLAYED WITH HIDDEN C LINE ELIMINATION. IMPLICIT REAL (A-H, O-Z) INCLUDE 'SIZES' INTEGER*2 ATBOND DIMENSION CO(3,NUATOM),R(NUATOM) ,BOND(3,NUCB) CHARACTER*80 DUMMY C? CHARACTER*6 ATSYMB COMMON /NAREAL/ FORINI(50),FORFIN(50),ALLINI(30),ALLFIN(30), 1 XREC(5),YREC(5), CT(50),ST(50),DTHETA,CD,SD, 2 A,COEFF1,COEFF2,COEFF3,DLIM,DLIM2 COMMON /NAINTE/ NO,NUBOND,ITABLE,INDCL COMMON /ATOMS/ DUMCO(3,NUMATM), IE(NUMATM), NATOMS, ATCHG( NUMATM) COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM), . ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO C? COMMON /ATSYMB/ ATSYMB( 200) COMMON /COLORS/ ICOLAT( 200) DIMENSION THETA(8),TT(8) C NNATOM=NUATOM INDCL=0 MAXNFR=0 NUPOI3=4*NUBOND-3 DO 10 JB=INIATO,LASATO IF (IMASK(JB).NE.0) GO TO 10 IF (IREM(IE(JB)).NE.0) GO TO 10 KB=JB NUFORE=0 C HIDDEN BY CIRCLES DO 20 JA=1,NUATOM IF (IMASK(JA).NE.0) GO TO 20 IF (IREM(IE(JA)).NE.0) GO TO 20 IF(CO(3,JA).LT.CO(3,JB)) GO TO 20 IF(JA.EQ.JB) GO TO 20 RSUM=R(JA)+R(JB) DX=CO(1,JA)-CO(1,JB) IF( ABS(DX).GT.RSUM) GO TO 20 DY=CO(2,JA)-CO(2,JB) IF( ABS(DY).GT.RSUM) GO TO 20 D2D2AB=DX*DX+DY*DY RSUM2=RSUM*RSUM IF(D2D2AB.GT.RSUM2) GO TO 20 RDEF=R(JA)-R(JB) IF( (RDEF*RDEF).LT.D2D2AB ) GO TO 21 C ( D2(JA,JB).LE.RDEF ) IF( R(JB).GT.R(JA) ) GO TO 20 GO TO 10 21 CONTINUE NUFORE=NUFORE+1 IF(NUFORE.GT.50) GO TO 40 KA=JA CALL NACICI(KA,KB,D2D2AB,FORINI(NUFORE),FORFIN(NUFORE), 1 CO,R,NNATOM) 20 CONTINUE C HIDDEN BY BONDS IF(NUBOND.EQ.0) GO TO 40 COXPR=CO(1,JB)+R(JB) COXMR=CO(1,JB)-R(JB) COYPR=CO(2,JB)+R(JB) COYMR=CO(2,JB)-R(JB) DO 30 NO1=1,NUPOI3,4 C BONDS UNDER THE ATOM-JB ARE EXCLUDED. IF(CO(3,JB).GT.BOND(3,NO1)) GO TO 30 C THE BONDS BELONGING TO THE ATOM-JB ARE EXCLUDED. NO2=NO1+1 IF(JB.EQ.INT(BOND(3,NO2))) GO TO 30 NO3=NO1+2 NO4=NO1+3 C MOST BONDS WHOSE PROJECTIVE FIGURES ON X-Y PLANE ARE OUTSIDE C THE PROJECTIVE FIGURE OF ATOM-JB ARE EXCLUDED. IDIREC=INT(BOND(3,NO4)) GO TO (91,92,93,94,95),IDIREC 91 IF(BOND(1,NO1).GT.COXPR) GO TO 30 IF(BOND(2,NO2).LT.COYMR) GO TO 30 IF(BOND(1,NO3).LT.COXMR) GO TO 30 IF(BOND(2,NO4).GT.COYPR) GO TO 30 GO TO 96 92 IF(BOND(2,NO1).GT.COYPR) GO TO 30 IF(BOND(1,NO2).GT.COXPR) GO TO 30 IF(BOND(2,NO3).LT.COYMR) GO TO 30 IF(BOND(1,NO4).LT.COXMR) GO TO 30 GO TO 96 93 IF(BOND(1,NO1).LT.COXMR) GO TO 30 IF(BOND(2,NO2).GT.COYPR) GO TO 30 IF(BOND(1,NO3).GT.COXPR) GO TO 30 IF(BOND(2,NO4).LT.COYMR) GO TO 30 GO TO 96 94 IF(BOND(2,NO1).LT.COYMR) GO TO 30 IF(BOND(1,NO2).LT.COXMR) GO TO 30 IF(BOND(2,NO3).GT.COYPR) GO TO 30 IF(BOND(1,NO4).GT.COXPR) GO TO 30 GO TO 96 95 IF( MIN(BOND(1,NO1),BOND(1,NO2),BOND(1,NO3),BOND(1,NO4)).GT. 1 COXPR) GO TO 30 IF( MAX(BOND(1,NO1),BOND(1,NO2),BOND(1,NO3),BOND(1,NO4)).LT. 1 COXMR) GO TO 30 IF( MIN(BOND(2,NO1),BOND(2,NO2),BOND(2,NO3),BOND(2,NO4)).GT. 1 COYPR) GO TO 30 IF( MAX(BOND(2,NO1),BOND(2,NO2),BOND(2,NO3),BOND(2,NO4)).LT. 1 COYMR) GO TO 30 96 ZL=BOND(3,NO1) ZS=BOND(3,NO3) IF( ABS(ZL-ZS).GT.0.0001) GO TO 97 DD1=(CO(1,JB)-BOND(1,NO1))**2+(CO(2,JB)-BOND(2,NO1))**2 DD4=(CO(1,JB)-BOND(1,NO4))**2+(CO(2,JB)-BOND(2,NO4))**2 R2=R(JB)**2 IF( ABS(DD1-R2).LT.1.E-5.AND. ABS(DD4-R2).LT.1.E-5) GOTO 30 GO TO 31 97 IF(CO(3,JB).LT.ZS) GO TO 31 TCROS=(ZL-CO(3,JB))/(ZL-ZS) XREC(1)=BOND(1,NO1) XREC(5)=BOND(1,NO1) YREC(1)=BOND(2,NO1) YREC(5)=BOND(2,NO1) XREC(2)=(BOND(1,NO2)-BOND(1,NO1))*TCROS+BOND(1,NO1) YREC(2)=(BOND(2,NO2)-BOND(2,NO1))*TCROS+BOND(2,NO1) XREC(3)=(BOND(1,NO3)-BOND(1,NO4))*TCROS+BOND(1,NO4) YREC(3)=(BOND(2,NO3)-BOND(2,NO4))*TCROS+BOND(2,NO4) XREC(4)=BOND(1,NO4) YREC(4)=BOND(2,NO4) GO TO 32 31 XREC(1)=BOND(1,NO1) XREC(5)=BOND(1,NO1) YREC(1)=BOND(2,NO1) YREC(5)=BOND(2,NO1) XREC(2)=BOND(1,NO2) YREC(2)=BOND(2,NO2) XREC(3)=BOND(1,NO3) YREC(3)=BOND(2,NO3) XREC(4)=BOND(1,NO4) YREC(4)=BOND(2,NO4) 32 CONTINUE NFOR=0 DO 33 II=1,4 I=II CALL NACILI(KB,I,T1,T2,IND,CO,R,NNATOM) C IF IND=0,THE LINE I-(I+1) IS INCLUDED IN OR IS OUTSIDE CIRCLE-JB IF(IND.EQ.0) GO TO 33 IF(IND.EQ.1) GO TO 34 NFOR=NFOR+1 CALL NATTHE(KB,I,T1,THETA(NFOR),CO,NNATOM) NFOR=NFOR+1 CALL NATTHE(KB,I,T2,THETA(NFOR),CO,NNATOM) GO TO 33 34 NFOR=NFOR+1 CALL NATTHE(KB,I,T1,THETA(NFOR),CO,NNATOM) 33 CONTINUE C IF NFOR=0,THERE IS NO CROSSPOINTS. IF(NFOR.EQ.0) GO TO 38 C THERE IS AT LEAST ONE CROSSPOINT. IF(NFOR.EQ.1) GO TO 30 JM=NFOR-1 DO 35 J=1,JM JP=J+1 DO 35 JJ=JP,NFOR IF(THETA(J).LT.THETA(JJ)) GO TO 35 OLD=THETA(J) THETA(J)=THETA(JJ) THETA(JJ)=OLD 35 CONTINUE C NN IS THE NUMBER OF CROSSPOINTS. C NN.LE.NFOR NN=1 TT(1)=THETA(1) DO 36 K=1,JM ABSTHE= ABS(THETA(K)-THETA(K+1)) IF(ABSTHE.LT.1.E-06) GO TO 36 NN=NN+1 TT(NN)=THETA(K+1) 36 CONTINUE C IF NN=1,THE CIRCLE-JB IS NOT HIDDEN BY THE RECTANGLE-NO1234. IF(NN.LT.2) GO TO 30 NNM=NN-1 DO 37 KK=1,NNM TM=(TT(KK)+TT(KK+1))*0.5 XM= COS(TM)*R(JB)+CO(1,JB) YM= SIN(TM)*R(JB)+CO(2,JB) CALL NAXYIN(XM,YM,INOUT) C IF INOUT=1,(TT(KK),TT(KK+1)) IS ENUMERATED AS FORBIDDEN REGION. IF(INOUT.EQ.0) GO TO 37 NUFORE=NUFORE+1 IF(NUFORE.GT.50) GO TO 40 FORINI(NUFORE)=TT(KK) FORFIN(NUFORE)=TT(KK+1) 37 CONTINUE TM=(TT(NN)+TT(1))*0.5-3.141593 XM= COS(TM)*R(JB)+CO(1,JB) YM= SIN(TM)*R(JB)+CO(2,JB) CALL NAXYIN(XM,YM,INOUT) IF(INOUT.EQ.0) GO TO 30 NUFORE=NUFORE+1 IF(NUFORE.GT.50) GO TO 40 FORINI(NUFORE)=TT(NN) FORFIN(NUFORE)=TT(1) GO TO 30 38 CALL NAXYIN(COXPR,CO(2,JB),INOUT1) CALL NAXYIN(COXMR,CO(2,JB),INOUT2) C IF INOUT1=1 AND INOUT2=1,ATOM-JB IS HIDDEN BY BOND-NO1234. IF(INOUT1.EQ.1.AND.INOUT2.EQ.1) GO TO 10 30 CONTINUE C DRAW THIS CIRCLE 40 CONTINUE IF(NUFORE.EQ.0) GO TO 42 N=NUFORE DO 45 J=1,N IF(FORFIN(J).GT.FORINI(J)) GO TO 45 IF( ABS(FORFIN(J)-FORINI(J)).LT.1.E-06) GO TO 45 NUFORE=NUFORE+1 FORINI(NUFORE)=FORINI(J) FORFIN(NUFORE)=6.28318 FORINI(J)=0.0 45 CONTINUE CALL NAPARM(NUFORE,NUALRE,6.28318) IF(NUALRE.EQ.0) GO TO 10 DO 41 IARC=1,NUALRE * ADJUST COLORS IF( ISCOLO.GT.0) CALL PLOT(FLOAT(ICOLAT(IE(JB))),0.0,99) CALL NAARC(CO(1,JB),CO(2,JB),R(JB),ALLINI(IARC),ALLFIN(IARC)) 41 CONTINUE GO TO 10 42 CONTINUE * ADJUST COLORS IF( ISCOLO.GT.0) CALL PLOT(FLOAT(ICOLAT(IE(JB))),0.0,99) CALL NACIRC(CO(1,JB),CO(2,JB),R(JB),NUSIDE,JB) IF(NUFORE.GT.MAXNFR) MAXNFR=NUFORE 10 CONTINUE IF(MAXNFR.GT.49) THEN CALL DEBUGR( . ' HIDDEN LINE ELIMINATION IS NOT PERFECTLY PERFORMED') CALL DEBUGR(' BY LACK OF DIMENSION IN SUB. NAPARM-NACIDI ]]]]]') ENDIF IF( ISCOLO.GT.0) CALL PLOT( 1.0, 0.0, 99) RETURN END SUBROUTINE NACILI(IA,I,TS,TL,IND,CO,R,NUATOM) C IND IS THE NUMBER OF CROSSPOINTS BETWEEN CIRCLE-IA AND LINE-I. IMPLICIT REAL (A-H, O-Z) CHARACTER*80 DUMMY DIMENSION CO(3,NUATOM),R(NUATOM) COMMON /NAREAL/ FORINI(50),FORFIN(50),ALLINI(30),ALLFIN(30), 1 XREC(5),YREC(5), CT(50),ST(50),DTHETA,CD,SD, 2 A,COEFF1,COEFF2,COEFF3,DLIM,DLIM2 X21=XREC(I+1)-XREC(I) Y21=YREC(I+1)-YREC(I) X1A=XREC(I)-CO(1,IA) Y1A=YREC(I)-CO(2,IA) AA=X21*X21+Y21*Y21 BB=X1A*X21+Y1A*Y21 CC=X1A*X1A+Y1A*Y1A-R(IA)**2 DISCRI=BB*BB-AA*CC IF(DISCRI.GT.0.0) GO TO 10 IND=0 RETURN 10 SQRTD= SQRT(DISCRI) IF(AA.LT.0.0001) GO TO 60 TS=-(SQRTD+BB)/AA TL= (SQRTD-BB)/AA IF(TS.LT.TL) GO TO 50 TTT=TS TS=TL TL=TTT 50 IF(TS.GT.1.0 .OR. TL.LT.0.0) GO TO 40 IF(TS.LT.0.0 .AND. TL.GT.1.0) GO TO 40 IF(TS.GE.0.0 .AND. TL.LE.1.0) GO TO 30 IND=1 IF(TL.LT.1.0) GO TO 20 RETURN 20 TS=TL RETURN 30 IND=2 RETURN 60 WRITE (DUMMY, 100) IA,I CALL DEBUGR( DUMMY ) 100 FORMAT( 'AA UNDER FLOW AT SUB. NACILI IA=',I4,' I=', 1 I4,' ]]') 40 IND=0 RETURN END SUBROUTINE NACIRC(X0,Y0,R,NUSIDE,IDENT) C CIRCLE IS DRAWN. IMPLICIT REAL (A-H, O-Z) CHARACTER*80 DUMMY INCLUDE 'SIZES' INTEGER*2 ATBOND COMMON /NAREAL/ FORINI(50),FORFIN(50),ALLINI(30),ALLFIN(30), 1 XREC(5),YREC(5), CT(50),ST(50),DTHETA,CD,SD, 2 A,COEFF1,COEFF2,COEFF3,DLIM,DLIM2 REAL XX,YY,Z,THETA CHARACTER*6 TSTRNG C? CHARACTER*6 ATSYMB CHARACTER*6 CBCD LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI CHARACTER*6 ATLABS COMMON /LABELS/ ATLABS( NUMATM) C? COMMON /ATSYMB/ ATSYMB( 200) COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM), . ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO COMMON /ATOMS/ CO(3,NUMATM), IE(NUMATM), NATOMS, ATCHG( NUMATM) C IF (DEBUGN) THEN C? WRITE (DUMMY,*) 'IN NACIRC, IDENT=',IDENT,'; AT NR=',IE(IDENT) WRITE (DUMMY, '(''IN NACIRC, IDENT='',I4,''; AT NR='',I4)') . IDENT, IE(IDENT) CALL DEBUGR( DUMMY ) ENDIF CALL NAPLOT(X0+R,Y0,2) DO 10 I=1,NUSIDE X=R*CT(I)+X0 Y=R*ST(I)+Y0 CALL NAPLOT(X,Y,3) 10 CONTINUE THETA=0 Z=.15 IF (LATYPE.EQ.0) THEN RETURN ELSE TSTRNG = ATLABS( IDENT) N = INDEX( TSTRNG, '"') - 1 CBCD = TSTRNG( 1: N) IF (DEBUGN) THEN WRITE( DUMMY, '('' IN NACIRC, ATOM IS '', A)' ) TSTRNG( 1: N) CALL DEBUGR( DUMMY(1:40) ) ENDIF XX = X0 - .18 YY = Y0 - .08 c@ CALL NASIM( XX, YY, Z, CBCD, THETA, N) CALL NASIM( XX, YY, Z, TSTRNG, THETA, N) ENDIF c@ ELSEIF (LATYPE.EQ.2) THEN c@ TSTRNG = ATSYMB( IE( IDENT) ) c@ N = INDEX( TSTRNG, ' ') - 1 c@ DO 33 NN= 1, N c@ IBCD( NN) = ICHAR( TSTRNG( NN: NN) ) c@ 33 CONTINUE c@C c@ IF (DEBUGN) THEN c@ WRITE (DUMMY,1000) TSTRNG( :N) c@ CALL DEBUGR( DUMMY(1:40) ) c@1000 FORMAT ( ' IN NACIRC, ATOM IS ',A ) c@ ENDIF c@ XX = X0 - .18 c@ YY = Y0 - .08 c@ CALL NASIM( XX, YY, Z, IBCD, THETA, N) c@C c@ ELSEIF (LATYPE.EQ.1) THEN c@ WRITE ( DUMMY, '( I6 )' ) IDENT c@ CALL LCLEAN( DUMMY, DUMMY, .TRUE.) c@ N = INDEX( DUMMY, ' ') - 1 c@ DO 43 NN= 1, N c@ IBCD( NN) = ICHAR( DUMMY( NN: NN) ) c@ 43 CONTINUE c@C c@ IF (DEBUGN) THEN c@ WRITE ( DUMMY,1000) DUMMY( :N) c@ CALL DEBUGR( DUMMY(1:40) ) c@ ENDIF c@ XX = X0 - .08 c@ YY = Y0 - .08 c@ CALL NASIM( XX, YY, Z, IBCD, THETA, N) c@ ENDIF RETURN END SUBROUTINE NACLDI(CO,R,NUATOM,INIATO,LASATO,NUSIDE, 1 BOND,NUCB,INIBON,LASBON) C ATOMIC CIRCLES FROM INIATO TO LASATO AND LINES WHICH REPRESENT C BONDS FROM INIBON TO LASBON ARE DISPLAYED WITHOUT HIDDEN LINE ELIM. IMPLICIT REAL (A-H, O-Z) INCLUDE 'SIZES' INTEGER*2 ATBOND DIMENSION CO(3,NUATOM),R(NUATOM),BOND(3,NUCB) COMMON /NAINTE/ NO,NUBOND,ITABLE,INDCL COMMON /ATOMS/ DUMCO(3,NUMATM), IE(NUMATM), NATOMS, ATCHG( NUMATM) COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM), . ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO INDCL=0 DO 10 IA=INIATO,LASATO IF (IMASK(IA).NE.0) GO TO 10 IF (IREM(IE(IA)).NE.0) GO TO 10 CALL NACIRC( CO(1,IA),CO(2,IA),R(IA),NUSIDE, IA ) 10 CONTINUE IF(NUBOND.EQ.0) RETURN INDCL=1 NO1I=4*INIBON-3 NO1L=4*LASBON-3 DO 20 NN=NO1I,NO1L,4 CALL NAPLOT(BOND(1,NN),BOND(2,NN),2) CALL NAPLOT(BOND(1,NN+1),BOND(2,NN+1),3) CALL NAPLOT(BOND(1,NN+2),BOND(2,NN+2),2) CALL NAPLOT(BOND(1,NN+3),BOND(2,NN+3),3) 20 CONTINUE RETURN END SUBROUTINE NACSCA(NUSIDE) C CT AND ST FOR DRAWING CIRCLES ARE CALCULATED. IMPLICIT REAL (A-H, O-Z) COMMON /NAREAL/ FORINI(50),FORFIN(50),ALLINI(30),ALLFIN(30), 1 XREC(5),YREC(5), CT(50),ST(50),DTHETA,CD,SD, 2 A,COEFF1,COEFF2,COEFF3,DLIM,DLIM2 DTHETA=6.282/NUSIDE CD= COS(DTHETA) SD= SIN(DTHETA) COSOLD=1.0 SINOLD=0. DO 10 I=1,NUSIDE COSTHE=COSOLD*CD-SINOLD*SD SINTHE=SINOLD*CD+COSOLD*SD CT(I)=COSTHE ST(I)=SINTHE COSOLD=COSTHE SINOLD=SINTHE 10 CONTINUE RETURN END SUBROUTINE NALIDI(CO,R,NUATOM,BOND,NUCB,INIBON,LASBON) IMPLICIT REAL (A-H, O-Z) INCLUDE 'SIZES' INTEGER*2 ATBOND CHARACTER*80 DUMMY DIMENSION CO(3,NUATOM),R(NUATOM) ,BOND(3,NUCB) C LINES WHICH REPRESENT BONDS FROM INIBON TO LASBON ARE DISPLAYED C WITH HIDDEN LINE ELIMINATION. COMMON /NAREAL/ FORINI(50),FORFIN(50),ALLINI(30),ALLFIN(30), 1 XREC(5),YREC(5), CT(50),ST(50),DTHETA,CD,SD, 2 A,COEFF1,COEFF2,COEFF3,DLIM,DLIM2 COMMON /NAINTE/ NO,NUBOND,ITABLE,INDCL COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM), . ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO COMMON /ATOMS/ DUMCO(3,NUMATM), IE(NUMATM), NATOMS, ATCHG( NUMATM) DIMENSION NN(5),TTT(4),XXXX(4),YYYY(4),ZZZZ(4) C ** IF(NUBOND.EQ.0) RETURN NO1D=4*INIBON-3 NO3D=4*LASBON-1 NUPOI3=NO3D-2 INDCL=1 MAXNFR=0 IND13=1 DO 10 NO13=NO1D,NO3D,2 NUFORE=0 IF(IND13.EQ.1) GO TO 11 NO1=NO13+1 NO2=NO13 ZI1=BOND(3,NO13-2) ZF1=BOND(3,NO13) IND13=1 GO TO 12 11 NO1=NO13 NO2=NO13+1 ZI1=BOND(3,NO13) ZF1=BOND(3,NO13+2) IND13=3 C ZF1 IS LESS THAN ZI1. 12 XI1=BOND(1,NO1) YI1=BOND(2,NO1) XF1=BOND(1,NO2) YF1=BOND(2,NO2) XIFMAX=XI1 IF(XF1.GT.XIFMAX) XIFMAX=XF1 XIFMIN=XI1 IF(XF1.LT.XIFMIN) XIFMIN=XF1 YIFMAX=YI1 IF(YF1.GT.YIFMAX) YIFMAX=YF1 YIFMIN=YI1 IF(YF1.LT.YIFMIN) YIFMIN=YF1 XF1XI1=XF1-XI1 YF1YI1=YF1-YI1 ZF1ZI1=ZF1-ZI1 C HIDDEN BY CIRCLE DO 20 IA=1,NUATOM IF (IMASK(IA).NE.0) GO TO 20 IF (IREM(IE(IA)).NE.0) GO TO 20 IF(CO(3,IA).LT.ZF1) GO TO 20 IF(XIFMAX.LT.(CO(1,IA)-R(IA))) GO TO 20 IF(XIFMIN.GT.(CO(1,IA)+R(IA))) GO TO 20 IF(YIFMAX.LT.(CO(2,IA)-R(IA))) GO TO 20 IF(YIFMIN.GT.(CO(2,IA)+R(IA))) GO TO 20 BB=XI1-CO(1,IA) DD=YI1-CO(2,IA) P=XF1XI1*XF1XI1+YF1YI1*YF1YI1 Q=XF1XI1*BB+YF1YI1*DD S=BB*BB+DD*DD-R(IA)**2 D4=Q*Q-P*S IF(D4.LE.0.0) GO TO 20 SQRTD4= SQRT(D4) IF(P.LT.0.0001) THEN WRITE( DUMMY,100) NO13,IA CALL DEBUGR( DUMMY ) ENDIF 100 FORMAT(' P UNDER FLOW AT SUB. NALIDI NO13=',I4,' IA=',I4,' ]]]]]') T1=-(SQRTD4+Q)/P T2= (SQRTD4-Q)/P IF(T1.GE.1.0 .OR. T2.LE.0.0) GO TO 20 C THE PROJECTIVE FIGURE ON X-Y PLANE OF THE LINE NO1-NO2 IS C PARTIALLY OR WHOLLY INCLUDED IN THAT OF THE ATOM-IA. TI=T1 TF=T2 IF(T1.LT.0.0) TI=0.0 IF(T2.GT.1.0) TF=1.0 Z1=ZF1ZI1*TI+ZI1 Z2=ZF1ZI1*TF+ZI1 VZ1=Z1-CO(3,IA) VZ2=Z2-CO(3,IA) C IF VZ1 & VZ2 .GE.0.0,THE LINE NO1-NO2 IS OVER THE ATOM IA. IF(VZ1.GE.0.0 .AND. VZ2.GE.0.0) GO TO 20 C IF VZ1 & VZ2.LE.0.0,(T1,T2) IS ENUMERATED AS FORBIDDEN REGION. IF(VZ1.LE.0.0 .AND. VZ2.LE.0.0) GO TO 21 IF( ABS(ZF1ZI1).LT.0.0001) THEN WRITE( DUMMY,200) NO13,IA CALL DEBUGR( DUMMY ) ENDIF 200 FORMAT(' ZF1ZI1 UNDER FLOW AT SUB. NALIDI NO13=',I4,' IA=',I4, . ' ]]]]]') TC=(CO(3,IA)-ZI1)/ZF1ZI1 IF(VZ1.GT.0.0 .AND. VZ2.LT.0.0) GO TO 22 C VZ1.LT.0.0 & VZ2.GT.0.0 C (T1,TC) IS ENUMERATED AS FORBIDDEN REGION. TF=TC GO TO 21 C VZ1.GT.0.0 & VZ2.LT.0.0 C (TC,T2) IS TO BE ENUMERATED AS FORBIDDEN REGION, 22 TI=TC 21 NUFORE=NUFORE+1 IF(NUFORE.GT.50) GO TO 42 FORINI(NUFORE)=TI FORFIN(NUFORE)=TF 20 CONTINUE C HIDDEN BY BOND DO 30 N1=1,NUPOI3,4 C BONDS UNDER THE LINE NO1-NO2 ARE EXCLUDED. IF(BOND(3,N1).LT.ZF1) GO TO 30 N3=N1+2 IF(N1.EQ.NO13 .OR. N3.EQ.NO13) GO TO 30 C MOST BONDS WHOSE PROJECTIVE FIGURES ON X-Y PLANE ARE OUTSIDE C THE PROJECTIVE FIGURE OF LINE NO1-NO2 ARE EXCLUDED. N2=N1+1 N4=N1+3 IDIREC=INT(BOND(3,N4)) GO TO (91,92,93,94,95),IDIREC 91 IF(BOND(1,N1).GT.XIFMAX) GO TO 30 IF(BOND(2,N2).LT.YIFMIN) GO TO 30 IF(BOND(1,N3).LT.XIFMIN) GO TO 30 IF(BOND(2,N4).GT.YIFMAX) GO TO 30 GO TO 96 92 IF(BOND(2,N1).GT.YIFMAX) GO TO 30 IF(BOND(1,N2).GT.XIFMAX) GO TO 30 IF(BOND(2,N3).LT.YIFMIN) GO TO 30 IF(BOND(1,N4).LT.XIFMIN) GO TO 30 GO TO 96 93 IF(BOND(1,N1).LT.XIFMIN) GO TO 30 IF(BOND(2,N2).GT.YIFMAX) GO TO 30 IF(BOND(1,N3).GT.XIFMAX) GO TO 30 IF(BOND(2,N4).LT.YIFMIN) GO TO 30 GO TO 96 94 IF(BOND(2,N1).LT.YIFMIN) GO TO 30 IF(BOND(1,N2).LT.XIFMIN) GO TO 30 IF(BOND(2,N3).GT.YIFMAX) GO TO 30 IF(BOND(1,N4).GT.XIFMAX) GO TO 30 GO TO 96 95 IF( MIN(BOND(1,N1),BOND(1,N2),BOND(1,N3),BOND(1,N4)).GT.XIFMAX) 1 GO TO 30 IF(MAX(BOND(1,N1),BOND(1,N2),BOND(1,N3),BOND(1,N4)).LT.XIFMIN) 1 GO TO 30 IF( MIN(BOND(2,N1),BOND(2,N2),BOND(2,N3),BOND(2,N4)).GT.YIFMAX) 1 GO TO 30 IF( MAX(BOND(2,N1),BOND(2,N2),BOND(2,N3),BOND(2,N4)).LT.YIFMIN) 1 GO TO 30 C NUMBERING 96 NN(1)=N1 NN(2)=N2 NN(3)=N3 NN(4)=N4 NN(5)=N1 NFOR=0 DO 31 II=1,4 NI=NN(II) NF=NN(II+1) CALL NALILI(XI1,YI1,XF1,YF1,BOND(1,NI),BOND(2,NI), 1 BOND(1,NF),BOND(2,NF),TT1,TT2,IND,1) IF(IND.EQ.0) GO TO 31 NFOR=NFOR+1 TTT(NFOR)=TT1 XXXX(NFOR)=(BOND(1,NF)-BOND(1,NI))*TT2+BOND(1,NI) YYYY(NFOR)=(BOND(2,NF)-BOND(2,NI))*TT2+BOND(2,NI) III=II GO TO (51,52,53,54),III 51 ZZZZ(NFOR)=BOND(3,N1)+(BOND(3,N3)-BOND(3,N1))*TT2 GO TO 31 52 ZZZZ(NFOR)=BOND(3,N3) GO TO 31 53 ZZZZ(NFOR)=BOND(3,N3)+(BOND(3,N1)-BOND(3,N3))*TT2 GO TO 31 54 ZZZZ(NFOR)=BOND(3,N1) 31 CONTINUE C GENERALLY NFOR.EQ.0 OR NFOR.GE.2 . IF(NFOR.LT.2) GO TO 30 IF(NFOR.EQ.2.AND.TTT(1).LE.TTT(2)) GO TO 33 JM=NFOR-1 DO 32 J=1,JM JP=J+1 DO 32 JJ=JP,NFOR IF(TTT(J).LE.TTT(JJ)) GO TO 32 OLDD=TTT(J) TTT(J)=TTT(JJ) TTT(JJ)=OLDD OLDD=XXXX(J) XXXX(J)=XXXX(JJ) XXXX(JJ)=OLDD OLDD=YYYY(J) YYYY(J)=YYYY(JJ) YYYY(JJ)=OLDD OLDD=ZZZZ(J) ZZZZ(J)=ZZZZ(JJ) ZZZZ(JJ)=OLDD 32 CONTINUE 33 CONTINUE TTI=TTT(1) TTF=TTT(NFOR) IF(TTI.GT.1.0 .OR. TTF.LT.0.0) GO TO 30 IF(TTI.LT.0.01.AND.TTF.GT.0.99) GO TO 10 C THE PROJECTIVE FIGURE ON X-Y PLANE OF THE LINE NO1-NO2 IS C PARTIALLY OR WHOLLY INCLUDED IN THAT OF THE BOND-NN. ZI2=ZZZZ(1) ZF2=ZZZZ(NFOR) IF( ABS(XF1XI1).LT. ABS(YF1YI1)) GO TO 34 C PROJECTION ON X-Z PLANE CALL NALILI(XI1,ZI1,XF1,ZF1,XXXX(1),ZI2,XXXX(NFOR),ZF2,TT3,D,L,0) AI=XXXX(1) AF=XXXX(NFOR) B1=XF1XI1*TTI+XI1 B2=XF1XI1*TTF+XI1 GO TO 35 C PROJECTION ON Y-Z PLANE 34 CALL NALILI(YI1,ZI1,YF1,ZF1,YYYY(1),ZI2,YYYY(NFOR),ZF2,TT3,D,L,0) AI=YYYY(1) AF=YYYY(NFOR) B1=YF1YI1*TTI+YI1 B2=YF1YI1*TTF+YI1 35 CONTINUE AFAI=AF-AI ZF2ZI2=ZF2-ZI2 IF( ABS(AFAI).LT.0.001* ABS(ZF2ZI2)) GO TO 30 IF( ABS(AFAI).LT.0.00001) THEN WRITE( DUMMY,300) NO13,N1 CALL DEBUGR( DUMMY ) ENDIF 300 FORMAT(' AFAI UNDER FLOW AT SUB. NALIDI NO13=',I4,' N1=',I4, . ' ]]]]]') SS=ZF2ZI2/AFAI Z1=ZF1ZI1*TTI+ZI1 Z2=ZF1ZI1*TTF+ZI1 VZ1=Z1-ZI2-SS*(B1-AI) VZ2=Z2-ZI2-SS*(B2-AI) IF(VZ1.GE.0.0 .AND. VZ2.GE.0.0) GO TO 30 IF(VZ1.GT.0.0 .AND. VZ2.LT.0.0) GO TO 36 IF(VZ1.LE.0.0 .AND. VZ2.LE.0.0) GO TO 37 IF(TTF.LT.1.00001) TTF=TT3 GO TO 37 36 IF(TTI.GT.-0.00001) TTI=TT3 37 NUFORE=NUFORE+1 IF(NUFORE.GT.50) GO TO 42 FORINI(NUFORE)=TTI FORFIN(NUFORE)=TTF 30 CONTINUE C DRAW THIS LINE 42 IF(NUFORE.EQ.0) GO TO 40 CALL NAPARM(NUFORE,NUALRE,1.0) IF(NUALRE.EQ.0) GO TO 10 DO 41 IBON=1,NUALRE XXXI=XF1XI1*ALLINI(IBON)+XI1 YYYI=YF1YI1*ALLINI(IBON)+YI1 XXXF=XF1XI1*ALLFIN(IBON)+XI1 YYYF=YF1YI1*ALLFIN(IBON)+YI1 CALL NAPLOT(XXXI,YYYI,2) CALL NAPLOT(XXXF,YYYF,3) 41 CONTINUE GO TO 10 40 CALL NAPLOT(XI1,YI1,2) CALL NAPLOT(XF1,YF1,3) IF(NUFORE.GT.MAXNFR) MAXNFR=NUFORE 10 CONTINUE IF(MAXNFR.GT.49) THEN CALL DEBUGR( . ' HIDDEN LINE ELIMINATION IS NOT PERFECTLY PERFORMED ') CALL DEBUGR( . ' BY LACK OF DIMENSION IN SUB. NAPARM-NALIDI ]]]]] ') ENDIF RETURN END SUBROUTINE NALILI(XI1,YI1,XF1,YF1,XI2,YI2,XF2,YF2,T1,T2,IND,NEGL) C CROSS POINT BETWEEN LINE-1 AND LINE-2 IS CALCULATED. IMPLICIT REAL (A-H, O-Z) AA1=XF1-XI1 BB1=YF1-YI1 AA2=XF2-XI2 BB2=YF2-YI2 CC=AA1*BB2-AA2*BB1 IF( ABS(CC).LT.0.0001) GO TO 10 XI2XI1=XI2-XI1 YI2YI1=YI2-YI1 T1=(XI2XI1*BB2-YI2YI1*AA2)/CC IF(NEGL.EQ.0) RETURN T2=(XI2XI1*BB1-YI2YI1*AA1)/CC IF(T2.LT.-0.001.OR.T2.GT.1.001) GO TO 10 IND=1 RETURN 10 IND=0 RETURN END SUBROUTINE NAMODI(CO, IE, R, NNATOM, NUCB,PERS,THICK, . HIDDEN,NUSID,DDLIM, IABMAK,NNMAKE,IABCUT,NNCUT) C CHIEF SUBROUTINE OF NAGOYA MOLECULAR DISPLAY. C ATOMS ARE REPRESENTED BY CIRCLES. C BONDS ARE REPRESENTED BY TWO LINES WHICH ARE IDENTICAL WITH C THE TWO NON-PARALLEL SIDES OF ISOSCELES TRAPEZOIDS. C NUCB IS NUMBER OF COLUMNS OF THE ARRAY BOND ,AND ONE FOURTH OF C NUCB CORRESPONDS TO THE MAXIMUM NUMBER OF BONDS TO BE DRAWN. IMPLICIT REAL (A-H,O-Z) CHARACTER*80 DUMMY INCLUDE 'SIZES' LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI C? COMMON /ATOMS/ CO(3,NUMATM), IE(NUMATM), NNATOM, ATCHG( NUMATM) C? COMMON /GEOM/ COOLD(3,NUMATM), NA(NUMATM), NB(NUMATM), NC(NUMATM) COMMON /PLOTS/ XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX,CMIN,CMAX,SCALE C? DIMENSION R(NNATOM), BOND(3,400) DIMENSION R(NNATOM), CO( 3, NNATOM), IE( NNATOM) DIMENSION IABMAK(2,NNMAKE),IABCUT(2,NNCUT) COMMON /NABOND/ BOND(3,400) COMMON /NAREAL/ FORINI(50),FORFIN(50),ALLINI(30),ALLFIN(30), 1 XREC(5),YREC(5),CT(50),ST(50),DTHETA,CD,SD, 2 A,COEFF1,COEFF2,COEFF3,DLIM,DLIM2 COMMON /NAINTE/ NO,NUBOND,ITABLE,INDCL DATA INDEX/0/ NUATOM=NNATOM MANUPB=NUCB NUMAKE=NNMAKE NUCUT=NNCUT IF (DEBUGN) THEN WRITE( DUMMY, 100) PERS,THICK,HIDDEN,NUSID 100 FORMAT(1X,'PERS=',F8.3,' THICK=',F8.3,' HIDDEN=',F8.3, . ' NUSIDE=',I4 ) CALL DEBUGR( DUMMY(1: 60) ) ENDIF IF(THICK.LT.0.0) GO TO 25 R(1) = ZMIN R(2) = ZMAX DO 20 IA=1,NUATOM CO(3,IA)=CO(3,IA)-ZMIN 20 CONTINUE ZMAX=ZMAX-ZMIN IF( ABS(ZMAX).LT.0.01) ZMAX=0.1 A=0.2*PERS/ZMAX NUSIDE=NUSID CALL NACSCA(NUSIDE) IF(PERS.GT.0.0) CALL NARACA(CO,IE,R,NUATOM,A) COEFF1=1.28*THICK*A COEFF2=0.2*THICK 25 COEFF3=1.55*THICK DLIM=DDLIM DLIM2=DLIM*DLIM IF(INDEX.EQ.0) ITABLE=0 INDEX=1 CALL NAAPSE(R,NUATOM,1,NUATOM, 1 MANUPB,0,NUCAPA,IABMAK,NUMAKE,IABCUT,NUCUT) NUBOND=NUCAPA IF(THICK.LT.0.0) RETURN IF(INT(HIDDEN).EQ.1) GO TO 40 CALL NACLDI(CO,R,NUATOM,1,NUATOM,NUSIDE,BOND,MANUPB,1,NUBOND) GO TO 30 40 CALL NACIDI(CO,R,NUATOM,1,NUATOM,NUSIDE,BOND,MANUPB) CALL NALIDI(CO,R,NUATOM,BOND,MANUPB,1,NUBOND) 30 CONTINUE DO 50 IA=1,NUATOM CO(3,IA)=CO(3,IA)+ZMIN 50 CONTINUE RETURN END SUBROUTINE NAPARM(NUFORE,NUALRE,PARFIN) C BASIC SUBROUTINE FOR HIDDEN LINE ELIMINATION. C USED PARAMETER FOR LINE IS T0 X=(XB-XA)*T+XA,Y=(YB-YA)*T+YA ,0 IMPLICIT REAL (A-H, O-Z) COMMON /NAREAL/ FORINI(50),FORFIN(50),ALLINI(30),ALLFIN(30), 1 XREC(5),YREC(5), CT(50),ST(50),DTHETA,CD,SD, 2 A,COEFF1,COEFF2,COEFF3,DLIM,DLIM2 INOUT=0 AX=X-XREC(1) AY=Y-YREC(1) BX=XREC(2)-XREC(1) BY=YREC(2)-YREC(1) ABZ=AX*BY-BX*AY IF(ABZ.LT.-0.000001) RETURN AX=X-XREC(3) AY=Y-YREC(3) BX=XREC(4)-XREC(3) BY=YREC(4)-YREC(3) ABZ=AX*BY-BX*AY IF(ABZ.LT.-0.000001) RETURN AX=X-XREC(2) AY=Y-YREC(2) BX=XREC(3)-XREC(2) BY=YREC(3)-YREC(2) ABZ=AX*BY-BX*AY IF(ABZ.LT.-0.000001) RETURN AX=X-XREC(4) AY=Y-YREC(4) BX=XREC(5)-XREC(4) BY=YREC(5)-YREC(4) ABZ=AX*BY-BX*AY IF(ABZ.LT.-0.000001) RETURN INOUT=1 RETURN END SUBROUTINE NAXYTH(X,Y,THETA) C ANGLE THETA IS CALCULATED WHEN THE POINT(X,Y) ON A CIRCLE IS GIVEN C THE CIRCLE IS REPRESENTED BY FOLLOWING FORMULA; C X=R*COS(THETA) Y=R*SIN(THETA) IMPLICIT REAL (A-H, O-Z) IF( ABS(X).LT.0.0001) GO TO 10 THETA= ATAN(Y/X) IF(X.GT.0.0) GO TO 20 THETA=THETA+3.141593 RETURN 20 IF(Y.LT.0.0) GO TO 30 RETURN 30 THETA=THETA+6.283185 RETURN 10 IF(Y.LT.0.0) GO TO 40 THETA=1.570796 RETURN 40 THETA=4.712389 RETURN END