SUBROUTINE WRTCLUST(NCON,ICUT,PRINTANG,PRINTPDB,printmol2) include 'DIMENSIONS' include 'sizesclu.dat' parameter (num_in_line=5) LOGICAL PRINTANG(max_cut),linsight integer PRINTPDB(max_cut),printmol2(max_cut) include 'COMMON.CONTROL' include 'COMMON.HEADER' include 'COMMON.CHAIN' include 'COMMON.VAR' include 'COMMON.CLUSTER' include 'COMMON.IOUNITS' include 'COMMON.GEO' double precision totfree_gr(maxconf) CHARACTER*64 prefixp,CFNAME,CFNAME1,CFF,NUMM,MUMM,EXTEN,UCASE, & extmol DATA EXTEN /'.pdb'/,extmol /'.mol2'/,NUMM /'000'/,MUMM /'000'/ external ilen logical insight_cmd_out c print *,"calling WRTCLUST",ncon c ICANT(I,J)=((NCON+NCON-J)*(J-1))/2+I-J insight_cmd_out = .false. C C PRINT OUT THE RESULTS OF CLUSTER ANALYSIS C ii1= index(intinname,'/') ii2=ii1 ii1=ii1+1 do while (ii2.gt.0) ii1=ii1+ii2 ii2=index(intinname(ii1:),'/') enddo ii = ii1+index(intinname(ii1:),'.')-1 if (ii.eq.0) then ii=ilen(intinname) else ii=ii-1 endif prefixp=intinname(ii1:ii) cd print *,icut,printang(icut),printpdb(icut),printmol2(icut) cd print *,'ecut=',ecut WRITE (iout,100) NGR DO 19 IGR=1,NGR WRITE (iout,200) IGR,LICZ(IGR) NRECORD=LICZ(IGR)/num_in_line IND1=1 DO 63 IRECORD=1,NRECORD IND2=IND1+num_in_line-1 WRITE (iout,300) (NCONF(IGR,ICO),ENERGY(NCONF(IGR,ICO)), 1 ICO=IND1,IND2) IND1=IND2+1 63 CONTINUE WRITE (iout,300) (NCONF(IGR,ICO),ENERGY(NCONF(IGR,ICO)), 1 ICO=IND1,LICZ(IGR)) IND1=1 ICON=NCONF(IGR,1) WRITE (iout,'(16F5.0)') (rad2deg*phiall(IND,icon),IND=4,nphi+3) C 12/8/93 Estimation of "diameters" of the subsequent families. emin=totfree(nconf(igr,1)) if (efree) then totfree_gr(igr)=1.0d0 do i=2,licz(igr) ii=nconf(igr,i) totfree_gr(igr)=totfree_gr(igr) & +dexp(-betaT*(totfree(ii)-emin)) enddo write (iout,*) "igr",igr," totfree",emin, & " totfree_gr",totfree_gr(igr) totfree_gr(igr)=emin-dlog(totfree_gr(igr))/betaT write (iout,*) "efree",totfree_gr(igr) endif ave_dim=0.0 amax_dim=0.0 do i=2,licz(igr) ii=nconf(igr,i) if (totfree(ii)-emin .gt. ecut) goto 10 do j=1,i-1 jj=nconf(igr,j) if (ii.lt.jj) then ind=ioffset(ncon,ii,jj) else ind=ioffset(ncon,jj,ii) endif curr_dist=dabs(attalums(ind)) cd print '(3i4,f12.4)',ind,ii,jj,curr_dist if (curr_dist .gt. amax_dim) amax_dim=curr_dist ave_dim=ave_dim+curr_dist**2 enddo enddo 10 if (licz(igr) .gt. 1) & ave_dim=sqrt(ave_dim/(licz(igr)*(licz(igr)-1)/2)) write (iout,'(/A,F8.1,A,F8.1)') & 'Max. distance in the family:',amax_dim, & '; average distance in the family:',ave_dim if (refstr .or. pdbref) write (iout,'(a,i5,f8.3)') & "RMSD of the lowest-energy conformation #",nconf(igr,1), & rmsnat(nconf(igr,1)) 19 CONTINUE WRITE (iout,400) WRITE (iout,500) (I,IASS(I),I=1,NCON) c print *,icut,printang(icut) IF (PRINTANG(ICUT)) then emin=totfree(nconf(1,1)) c print *,'emin',emin,' ngr',ngr do igr=1,ngr icon=nconf(igr,1) if (totfree(icon)-emin.le.ecut) then do i=1,nres phi(i)=phiall(i,icon) theta(i)=thetall(i,icon) alph(i)=alphall(i,icon) omeg(i)=omall(i,icon) enddo if (lprint_cart) then call cartout(igr,icon,energy(icon),totfree_gr(igr), & rmstab(icon),intname) else c print '(a)','calling briefout' call briefout(igr,iscore(icon),energy(icon), & totfree_gr(igr),nss_all(icon),ihpb_all(1,icon), & jhpb_all(1,icon),intname) c print '(a)','exit briefout' endif endif enddo ENDIF IF (PRINTPDB(ICUT).gt.0) THEN c Write out a number of conformations from each family in PDB format and c create InsightII command file for their displaying in different colors I=1 ICON=NCONF(1,1) EMIN=ENERGY(ICON) DO WHILE(I.LE.NGR .AND. ENERGY(ICON)-EMIN.LE.ECUT) c CALL NUMSTR(I,NUMM) write (NUMM,'(bz,i4.4)') i ncon_lim=min0(licz(i),printpdb(icut)) linsight= & printpdb(icut).gt.0 .and. ncon_lim.gt.1 if (linsight) then icon=nconf(i,1) emini=energy(icon) k=1 do while (k.le.ncon_lim .and. & energy(nconf(i,k))-emini.le.ecut) k=k+1 enddo ncon_out=min0(k-1,ncon_lim) linsight=ncon_out.gt.1 endif if (linsight) then c c A "bunch of structures" of the family that lie within ECUT above the c lowest-energy conformation in the family will be outputed along with the c InsightII command file --- AL 1/1/95. c if (insight_cmd_out) then open (22,file= & 'insight_'//prefixp(:ilen(prefixp))//numm(:ilen(numm))//'.cmd', & status='unknown') c c Write InsightII command file c cfname=prefixp(:ilen(prefixp))//numm(:ilen(numm))//'_001' cff=ucase(cfname) write (22,'(5a)') 'get molecule pdb user ', & cfname(:ilen(cfname)),'.pdb ', & cff(:ilen(cff)), & ' -heteroatom -reference_object' cfname=ucase(cfname) write (22,'(3a,i3,2(1h,,i3))') 'color molecule atoms ', & cfname(:ilen(cfname)),' specified specification ', & 0,0,255 write (22,'(2a)') 'display molecule only atoms heavy ', & cfname(:ilen(cfname)) cfname1=cfname deltae_max=energy(nconf(i,ncon_out))-emini do j=2,ncon_out deltae=energy(nconf(i,j))-emini icolor=aint(255*deltae/deltae_max) call numstr(j,mumm) cfname=prefixp(:ilen(prefixp))//numm(:ilen(numm))//'_' & //mumm(:ilen(mumm)) cff=ucase(cfname) write (22,'(5a)') 'get molecule pdb user ', & cfname(:ilen(cfname)),'.pdb ', & cff(:ilen(cff)),' -heteroatom' cfname=ucase(cfname) do k=1,nct-nnt+1 if (k.lt.10) then write (22,'(3a,i1,3a,i1)') & 'superimpose -end_definition backbone "label mode" ', & cfname(:ilen(cfname)),':',k,' ',cfname1(:ilen(cfname1)), & ':',k elseif (k.lt.100) then write (22,'(3a,i2,3a,i2)') & 'superimpose -end_definition backbone "label mode" ', & cfname(:ilen(cfname)),':',k,' ',cfname1(:ilen(cfname1)), & ':',k else write (22,'(3a,i3,3a,i3)') & 'superimpose -end_definition backbone "label mode" ', & cfname(:ilen(cfname)),':',k,' ',cfname1(:ilen(cfname1)), & ':',k endif enddo write (22,'(3a,i3,2(1h,,i3))') 'color molecule atoms ', & cfname(:ilen(cfname)),' specified specification ', & icolor,icolor,255-icolor write (22,'(2a)') 'display molecule only atoms heavy ', & cfname(:ilen(cfname)) close(22) enddo endif c Write conformations of the family i to PDB files do j=1,ncon_out call numstr(j,mumm) icon=nconf(i,j) cfname=prefixp(:ilen(prefixp))//numm(:ilen(numm))//'_' & //mumm(:ilen(mumm))//exten do ii=1,nres phi(ii)=phiall(ii,icon) theta(ii)=thetall(ii,icon) alph(ii)=alphall(ii,icon) omeg(ii)=omall(ii,icon) enddo call chainbuild if (refstr.or.pdbref) rmsd=rmsnat(icon) open(ipdb,file=cfname,status='unknown',form='formatted') call pdbout(energy(icon),rmsd,titel) close(ipdb) enddo else c Produce only a single PDB file for the leading member of the family write (iout,*) 'Writing pdb file: icon=',icon do ii=1,nres phi(ii)=phiall(ii,icon) theta(ii)=thetall(ii,icon) alph(ii)=alphall(ii,icon) omeg(ii)=omall(ii,icon) enddo call chainbuild cfname=prefixp(:ilen(prefixp))//numm(:ilen(numm))//exten OPEN(ipdb,FILE=CFNAME,STATUS='UNKNOWN',FORM='FORMATTED') c print *,'Calling pdbout' if (refstr.or.pdbref) rmsd=rmsnat(icon) CALL PDBOUT(energy(icon),rmsd,titel) CLOSE(ipdb) endif I=I+1 ICON=NCONF(I,1) ENDDO ENDIF IF (printmol2(icut).gt.0) THEN c Write out a number of conformations from each family in PDB format and c create InsightII command file for their displaying in different colors I=1 ICON=NCONF(1,1) EMIN=ENERGY(ICON) DO WHILE(I.LE.NGR .AND. ENERGY(ICON)-EMIN.LE.ECUT) c CALL NUMSTR(I,NUMM) write (NUMM,'(bz,i4.4)') i ncon_lim=min0(licz(i),printpdb(icut)) write (iout,*) 'Writing mol2 file: icon=',icon do ii=1,nres phi(ii)=phiall(ii,icon) theta(ii)=thetall(ii,icon) alph(ii)=alphall(ii,icon) omeg(ii)=omall(ii,icon) enddo call chainbuild cfname=prefixp(:ilen(prefixp))//numm(:ilen(numm))//extmol OPEN(imol2,FILE=CFNAME,STATUS='UNKNOWN',FORM='FORMATTED') c print *,'Calling pdbout' CALL MOL2OUT(energy(icon),'STRUCTURE'//numm) CLOSE(imol2) I=I+1 ICON=NCONF(I,1) ENDDO ENDIF 100 FORMAT (//'THERE ARE ',I4,' FAMILIES OF CONFORMATIONS') 200 FORMAT (/'FAMILY ',I4,' CONTAINS ',I4,' CONFORMATION(S): ') c 300 FORMAT ( 8(I4,F6.1)) 300 FORMAT (5(I4,1pe12.4)) 400 FORMAT (//'ASSIGNMENT OF CONSECUTIVE CONFORMATIONS TO FAMILIES:') 500 FORMAT (8(2I4,2X)) 600 FORMAT ('REMARK FAMILY',I4,' CONFORMATION',I4,' ENERGY ',E15.6) RETURN END