diff -u -N -r cyana-1.0.5/auto cyanaccr/auto --- cyana-1.0.5/auto 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/auto 2003-12-16 21:45:43.000000000 +0100 @@ -0,0 +1,7 @@ +make +make install << EOF +/home_n05/strutture/cyanaccr/bin +/home_n05/strutture/cyanaccr/data +y +EOF +vi ../bin/* diff -u -N -r cyana-1.0.5/etc/abspath cyanaccr/etc/abspath --- cyana-1.0.5/etc/abspath 2003-12-16 21:44:51.000000000 +0100 +++ cyanaccr/etc/abspath 2003-12-16 21:45:41.000000000 +0100 @@ -1,4 +1,4 @@ -#!/bin/bash +#!/bin/sh # Copyright (c) 2002 Peter Guntert. All rights reserved. # Return absolute path diff -u -N -r cyana-1.0.5/etc/adapt cyanaccr/etc/adapt --- cyana-1.0.5/etc/adapt 2003-12-16 21:44:51.000000000 +0100 +++ cyanaccr/etc/adapt 2003-12-16 21:45:40.000000000 +0100 @@ -1,4 +1,4 @@ -#!/bin/bash +#!/bin/sh # Copyright (c) 2002 Peter Guntert. All rights reserved. # Adapt source files. diff -u -N -r cyana-1.0.5/etc/config cyanaccr/etc/config --- cyana-1.0.5/etc/config 2003-12-16 21:44:51.000000000 +0100 +++ cyanaccr/etc/config 2003-12-16 21:45:41.000000000 +0100 @@ -19,10 +19,11 @@ # LDFLAGS: Linker flags for Fortran programs # LIBS: Libraries for Fortran programs -# Portland (Linux) ................................................ +# GNU (Linux) ..................................................... -SYSTEM = pgi -FC = pgf77 +SYSTEM = gnu +FC = g77 FFLAGS = -O0 FFLAGS2 = -DEFS = -Dpgi +FORK = g77fork.o +DEFS = -Dgnu diff -u -N -r cyana-1.0.5/etc/config.in cyanaccr/etc/config.in --- cyana-1.0.5/etc/config.in 2003-12-16 21:44:51.000000000 +0100 +++ cyanaccr/etc/config.in 2003-12-16 21:45:41.000000000 +0100 @@ -119,7 +119,7 @@ #SYSTEM = gnu #FC = g77 -#FFLAGS = -O +#FFLAGS = -O0 #FFLAGS2 = #FORK = g77fork.o @@ -134,7 +134,7 @@ #DEFS = -Dmpi #FC = mpif77 #FC_NOMPI = g77 -#FFLAGS = -O +#FFLAGS = -O0 #FFLAGS2 = #FORK = g77fork.o diff -u -N -r cyana-1.0.5/help/cyana/topics cyanaccr/help/cyana/topics --- cyana-1.0.5/help/cyana/topics 2003-12-16 21:44:53.000000000 +0100 +++ cyanaccr/help/cyana/topics 2003-12-16 21:45:42.000000000 +0100 @@ -194,12 +194,12 @@ 7MACROS: watsoncrick - CYANA macro|../../macro/watsoncrick.cya 7MACROS: write_all - CYANA macro|../../macro/write_all.cya 7MACROS: writedata - write data files|../../macro/writedata.cya -8FUNCTIONS: Angle(n) - CYANA function|Angle -8FUNCTIONS: Atom(n) - CYANA function|Atom 8FUNCTIONS: acoviol(n,r) - CYANA function|acoviol 8FUNCTIONS: anam(n) - CYANA function|anam 8FUNCTIONS: angle(n) - CYANA function|angle +8FUNCTIONS: Angle(n) - CYANA function|Angle 8FUNCTIONS: atom(n) - CYANA function|atom +8FUNCTIONS: Atom(n) - CYANA function|Atom 8FUNCTIONS: calscale(s,r1,r2) - CYANA function|calscale 8FUNCTIONS: cco(n) - CYANA function|cco 8FUNCTIONS: coord(m,n) - CYANA function|coord @@ -238,27 +238,27 @@ 8FUNCTIONS: libdir - CYANA function|libdir 8FUNCTIONS: maxang - CYANA function|maxang 8FUNCTIONS: maxcor - CYANA function|maxcor -8FUNCTIONS: na - CYANA function|na 8FUNCTIONS: naco - CYANA function|naco +8FUNCTIONS: na - CYANA function|na 8FUNCTIONS: nassign - CYANA function|nassign 8FUNCTIONS: nbond(n) - CYANA function|nbond 8FUNCTIONS: ncco - CYANA function|ncco 8FUNCTIONS: nconf - CYANA function|nconf -8FUNCTIONS: nd - CYANA function|nd 8FUNCTIONS: ndcdis(n) - CYANA function|ndcdis 8FUNCTIONS: ndco - CYANA function|ndco 8FUNCTIONS: ndcres(n,m) - CYANA function|ndcres +8FUNCTIONS: nd - CYANA function|nd 8FUNCTIONS: ndfree - CYANA function|ndfree 8FUNCTIONS: nlevel - CYANA function|nlevel 8FUNCTIONS: nlol - CYANA function|nlol 8FUNCTIONS: np_ass - CYANA function|np_ass 8FUNCTIONS: np_corr - CYANA function|np_corr +8FUNCTIONS: npeaks - CYANA function|npeaks 8FUNCTIONS: np_inc - CYANA function|np_inc +8FUNCTIONS: nplist - CYANA function|nplist 8FUNCTIONS: np_new - CYANA function|np_new 8FUNCTIONS: np_out - CYANA function|np_out 8FUNCTIONS: np_wrg - CYANA function|np_wrg -8FUNCTIONS: npeaks - CYANA function|npeaks -8FUNCTIONS: nplist - CYANA function|nplist 8FUNCTIONS: nr - CYANA function|nr 8FUNCTIONS: nseldis - CYANA function|nseldis 8FUNCTIONS: nstruct - CYANA function|nstruct @@ -277,10 +277,10 @@ 8FUNCTIONS: selected(n) - CYANA function|selected 8FUNCTIONS: shift(n) - CYANA function|shift 8FUNCTIONS: stereopartner(n) - CYANA function|stereopartner -8FUNCTIONS: tf(n) - CYANA function|tf 8FUNCTIONS: tfcalc - CYANA function|tfcalc 8FUNCTIONS: tfmax - CYANA function|tfmax 8FUNCTIONS: tfmin - CYANA function|tfmin +8FUNCTIONS: tf(n) - CYANA function|tf 8FUNCTIONS: tfres(n) - CYANA function|tfres 8FUNCTIONS: timestep - CYANA function|timestep 8FUNCTIONS: tolcco(n) - CYANA function|tolcco @@ -309,9 +309,9 @@ 9VARIABLES: soft_vdw - CYANA variable|soft_vdw 9VARIABLES: tf_beta - CYANA variable|tf_beta 9VARIABLES: tf_type - CYANA variable|tf_type +9VARIABLES: tolerance - CYANA variable|tolerance 9VARIABLES: tol_transp - CYANA variable|tol_transp 9VARIABLES: tol_una - CYANA variable|tol_una -9VARIABLES: tolerance - CYANA variable|tolerance 9VARIABLES: weight_aco - CYANA variable|weight_aco 9VARIABLES: weight_cco - CYANA variable|weight_cco 9VARIABLES: weight_lol - CYANA variable|weight_lol diff -u -N -r cyana-1.0.5/src/cyana/Makefile cyanaccr/src/cyana/Makefile --- cyana-1.0.5/src/cyana/Makefile 2003-12-16 21:44:51.000000000 +0100 +++ cyanaccr/src/cyana/Makefile 2003-12-16 21:45:41.000000000 +0100 @@ -18,7 +18,10 @@ setdco.o setlev.o setlvw.o setsvw.o stable.o struct.o strcal.o \ sysfun.o \ sysvar.o setswa.o tfadd.o tree.o vdwatm.o veloc.o violat.o \ - viosta.o vtable.o writef.o + viosta.o vtable.o writef.o pseudoglomsa.o pseovw.o orjovw.o \ + findzerocoords.o getdip.o getorj.o kmet.o findfe.o \ + pseviol.o psegrad.o ccrgrad.o ccrviol.o getccr.o getcpr.o \ + getmet.o all: cyana diff -u -N -r cyana-1.0.5/src/cyana/ccr.incl cyanaccr/src/cyana/ccr.incl --- cyana-1.0.5/src/cyana/ccr.incl 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/ccr.incl 2003-12-16 21:45:41.000000000 +0100 @@ -0,0 +1,47 @@ +c +c ---------------------------------------------- ccr constraints +c +c ccrflg are ccr constraints on? +c nccrmt number of different metal atoms +c ccrwei weight for ccr constraints +c ccrtos() specific tolerance for ccr violation +c iccrmr() indices of metal-containing residues +c iccrm() indices of metal atoms +c nccr() numbers of ccr constraints +c ccrfac() proportionality constants +c iccrvr() indices of NH-containing residues +c ccrobs() observed values for ccr +c ccrwsp() weights of the j-th(s) ccr constraints +c iccrn() indices of N atoms +c iccrh() indices of H atoms +c ccrn() 3D matrix containing N coordinates +c ccrh() 3D matrix containing H coordinates +c ccrm() matrix containing M coordinates +c ccrb() 3D matrix containing rM-rH coordinates(B vectors) +c ccrvnh() 3D matrix containing rN-rH coordinates +c ccrdis() matrix containing M-H distances +c ccrcos() matrix containing cos values +c ccrcal() calculated values for ccr +c ccrdev() deviation of calculated values from observed +c iccryn() is the j-th constraint violated? +c ccrvio total ccr violation +c +c -------------------------------------------------------------- +c + parameter (maxccr=100) + parameter (maxcmt=5) + logical ccrflg + common /ccrdat/ccrflg,nccrmt,ccrwei,ccrvio + common /ccrdat2/ccrtos(maxccr,maxcmt), + * iccrvr(maxccr,maxcmt), + * ccrobs(maxccr,maxcmt),ccrwsp(maxccr,maxcmt), + * iccrn(maxccr,maxcmt),iccrh(maxccr,maxcmt), + * ccrdis(maxccr,maxcmt),ccrcos(maxccr,maxcmt), + * ccrcal(maxccr,maxcmt),ccrdev(maxccr,maxcmt), + * iccryn(maxccr,maxcmt), + * ccrm(3,maxcmt) + common/ccrdat3/iccrmr(maxcmt),iccrm(maxcmt), + * nccr(maxcmt) + common /ccrdat4/ ccrn(3,maxccr,maxcmt),ccrh(3,maxccr,maxcmt), + * ccrb(3,maxccr,maxcmt),ccrvnh(3,maxccr,maxcmt) + common/ccrdat5/ccrfac(maxcmt) diff -u -N -r cyana-1.0.5/src/cyana/ccrgrad.f cyanaccr/src/cyana/ccrgrad.f --- cyana-1.0.5/src/cyana/ccrgrad.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/ccrgrad.f 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,204 @@ +c ================================================================== +c | | +c | CCRGRAD: Calculates the ccr constraints part of the gradient | +c | | +c ================================================================== + + subroutine ccrgrad (n,g) + implicit double precision (a-h,o-z) + + + include 'cyana.incl' + include 'ccr.incl' + + dimension g(n) + real ccrak,ccra(3),ccrbk,ccrc(3),ccrd(3) + real ccre(3),ccrf(3) + real ccret(3,-1:maxd) + real ccrft(3,-1:maxd) + +c +c Inizializzazione delle matrici Etot e Ftot +c + + do i=1,3 + do l=-1,maxd + ccret(i,l)=0. + ccrft(i,l)=0. + end do + end do + +c +c Ciclo sui metalli +c + + do k=1,nccrmt + +c +c Ciclo sulle violazioni +c + + do j=1,nccr(k) + +c +c Il vincolo j-esimo viola? +c + + if (iccryn(j,k).eq.1) then + +c +c Calcolo del coefficiente a, ccrak +c + + ccrak=0. + + ccrak=( 6.*ccrcos(j,k)*ccrdis(j,k) + 3.*(1.-5.*ccrcos(j,k)**2) ) + + / ccrdis(j,k)**5 + +c +c Calcolo del vettore A, ccra, prodotto vettoriale di rM e rH +c + + do i=1,3 + ccra(i)=0. + end do + + ccra(1)=ccrm(2,k)*ccrh(3,j,k)-ccrm(3,k)*ccrh(2,j,k) + ccra(2)=ccrm(3,k)*ccrh(1,j,k)-ccrm(1,k)*ccrh(3,j,k) + ccra(3)=ccrm(1,k)*ccrh(2,j,k)-ccrm(2,k)*ccrh(1,j,k) + +c +c Calcolo del coefficiente b, ccrbk +c + + ccrbk=0. + + ccrbk=(-6.)*ccrcos(j,k) / ccrdis(j,k)**4 + +c +c Calcolo del vettore C, ccrc, prodotto vettoriale di rM e rN +c + + do i=1,3 + ccrc(i)=0. + end do + + ccrc(1)=ccrm(2,k)*ccrn(3,j,k)-ccrm(3,k)*ccrn(2,j,k) + ccrc(2)=ccrm(3,k)*ccrn(1,j,k)-ccrm(1,k)*ccrn(3,j,k) + ccrc(3)=ccrm(1,k)*ccrn(2,j,k)-ccrm(2,k)*ccrn(1,j,k) + +c +c Calcolo del vettore D, ccrd, dato da rM - rN +c + + do i=1,3 + ccrd(i)=0. + end do + + do i=1,3 + ccrd(i)=ccrm(i,k)-ccrn(i,j,k) + end do + +c +c Calcolo del vettore E, ccre, aA + bC +c + + do i=1,3 + ccre(i)=0. + end do + + do i=1,3 + ccre(i)=ccrak*ccra(i)+ccrbk*ccrc(i) + ccre(i)=ccrwsp(j,k)*ccrdev(j,k)*ccre(i) + ccre(i)=ccrfac(k)*ccre(i) + end do + +c +c Calcolo del vettore F, ccrf, aB + bD +c + + do i=1,3 + ccrf(i)=0. + end do + + do i=1,3 + ccrf(i)=ccrak*ccrb(i,j,k)+ccrbk*ccrd(i) + ccrf(i)=ccrwsp(j,k)*ccrdev(j,k)*ccrf(i) + ccrf(i)=ccrfac(k)*ccrf(i) + end do + +c +c Si individua la posizione del metallo e del j-esimo vettore N-H +c + + iwherm=iaunit(iccrm(k)) + iwherv=iaunit(iccrh(j,k)) + +c +c Si somma la derivata positiva e quella negativa in Etot e Ftot +c + + do i=1,3 + ccret(i,iwherm)=ccret(i,iwherm)+ccre(i) + ccret(i,iwherv)=ccret(i,iwherv)-ccre(i) + + ccrft(i,iwherm)=ccrft(i,iwherm)+ccrf(i) + ccrft(i,iwherv)=ccrft(i,iwherv)-ccrf(i) + end do + +c +c Se il diedro j-esimo non viola, non succede nulla +c e le matrici Etot e Ftot non vengono aggiornate +c + + else + end if + +c +c Fine del ciclo sulle violazioni +c + + end do + +c +c Fine del ciclo sui metalli +c + + end do + +c +c Somma a ritroso sulle colonne di Etot e Ftot +c + + do i=n,1,-1 + j=iprev(i) + do l=1,3 + ccret(l,j)=ccret(l,j)+ccret(l,i) + ccrft(l,j)=ccrft(l,j)+ccrft(l,i) + end do + end do + +c +c Calcolo del contributo al gradiente per tutti i diedri +c + + do i=1,n + + i2ccr=ida(2,i) + i3ccr=ida(3,i) + c1=coo(1,i3ccr) + c2=coo(2,i3ccr) + c3=coo(3,i3ccr) + s1=coo(1,i2ccr)-c1 + s2=coo(2,i2ccr)-c2 + s3=coo(3,i2ccr)-c3 + + g(i) = g(i) + 2. * ccrwei * dinvbl(i) * + + ( s1*ccret(1,i) + s2*ccret(2,i) + s3*ccret(3,i) + + + (s2*c3-s3*c2)*ccrft(1,i) + (s3*c1-s1*c3)*ccrft(2,i) + + + (s1*c2-s2*c1)*ccrft(3,i) ) + + end do + + return + end diff -u -N -r cyana-1.0.5/src/cyana/ccrviol.f cyanaccr/src/cyana/ccrviol.f --- cyana-1.0.5/src/cyana/ccrviol.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/ccrviol.f 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,200 @@ +c ================================================================== +c | | +c | CCRVIOL: Calculates the violation of ccr constraints | +c | | +c ================================================================== + + subroutine ccrviol(indice) + implicit double precision (a-h,o-z) + + + include 'cyana.incl' + include 'ccr.incl' + + real fccr,cprec + character*10 uno + character*10 due + + open(28,file='cviol.out',status='old',err=50) + 5 read(28,'(A10,1X,I4,1X,A10,1X,F8.3)',end=10) + goto 5 + 10 backspace 28 + backspace 28 + read(28,'(A10,1X,I4,1X,A10,1X,F8.3)') + *uno,iprec,due,cprec + + if(indice.gt.iprec) then + 15 read(28,'(A10,1X,I4,1X,A10,1X,F8.3)',end=20) + goto 15 + 20 backspace 28 + backspace 28 + write(28,'(A10,1X,I4,1X,A10,1X,F8.3)') + * 'Structure:',indice-1,'Violation:',recorc + write(28,'(A10,1X,I4,1X,A10,1X,F8.3)') + * 'Structure:',indice,'Last one!!',cprec + endfile 28 + close(28) + goto 60 + else + goto 60 + end if + + 50 open(28,file='cviol.out',status='new') + write(28,'(A10,1X,I4,1X,A10,1X,F8.3)') + *'Structure:',indice,'Last one!!',ccrvio + endfile 28 + close(28) + + 60 continue + +c +c Costruzione della matrice 3D delle coordinate di N e H +c + + + do k=1,maxcmt + do j=1,maxccr + do i=1,3 + ccrn(i,j,k)=0. + ccrh(i,j,k)=0. + end do + end do + end do + + do k=1,nccrmt + do j=1,nccr(k) + do i=1,3 + ccrn(i,j,k)=coo(i,iccrn(j,k)) + ccrh(i,j,k)=coo(i,iccrh(j,k)) + end do + end do + end do + +c +c Costruzione della matrice delle coordinate di M +c + + do k=1,maxcmt + do i=1,3 + ccrm(i,k)=0. + end do + end do + + do k=1,nccrmt + do i=1,3 + ccrm(i,k)=coo(i,iccrm(k)) + end do + end do + + +c +c Costruzione delle matrici 3D delle differenze rM-rH e rN-rH +c + + do k=1,maxcmt + do j=1,maxccr + do i=1,3 + ccrb(i,j,k)=0. + ccrvnh(i,j,k)=0. + end do + end do + end do + + do k=1,nccrmt + do j=1,nccr(k) + do i=1,3 + ccrb(i,j,k)=ccrm(i,k)-ccrh(i,j,k) + ccrvnh(i,j,k)=ccrn(i,j,k)-ccrh(i,j,k) + end do + end do + end do + +c +c Costruzione del vettore delle distanze M-H +c + + do k=1,maxcmt + do j=1,maxccr + ccrdis(j,k)=0. + end do + end do + + do k=1,nccrmt + do j=1,nccr(k) + do i=1,3 + ccrdis(j,k)=ccrdis(j,k)+ccrb(i,j,k)*ccrb(i,j,k) + end do + ccrdis(j,k)=abs(sqrt(ccrdis(j,k))) + end do + end do + +c +c Costruzione del vettore dei coseni di theta +c + + do k=1,maxcmt + do j=1,maxccr + ccrcos(j,k)=0. + end do + end do + + do k=1,nccrmt + do j=1,nccr(k) + do i=1,3 + ccrcos(j,k)=ccrcos(j,k)+ccrvnh(i,j,k)*ccrb(i,j,k) + end do + ccrcos(j,k)=ccrcos(j,k)/ccrdis(j,k) + end do + end do + +c +c Calcolo dei deltanu +c + + do k=1,maxcmt + do j=1,maxccr + ccrcal(j,k)=0. + end do + end do + + do k=1,nccrmt + do j=1,nccr(k) + ccrcal(j,k)=ccrfac(k)*(3.*ccrcos(j,k)**2-1.)/ccrdis(j,k)**3 + end do + end do + +c +c Calcolo della deviazione dai valori osservati e scelta: +c Se la deviazione e' minore della tolleranza, la violazione e' zero +c Altrimenti, la violazione viene calcolata e una flag viene attaccata +c + + do k=1,maxcmt + do j=1,maxccr + ccrdev(j,k)=0. + iccryn(j,k)=0 + end do + end do + + fccr=0. + + do k=1,nccrmt + do j=1,nccr(k) + + ccrdev(j,k)=ccrcal(j,k)-ccrobs(j,k) + + if (abs(ccrdev(j,k)).gt.ccrtos(j,k)) then + iccryn(j,k)=1 + fccr=fccr+ccrwei*ccrwsp(j,k)*ccrdev(j,k)**2 + else + iccryn(j,k)=0 + end if + + end do + end do + + ccrvio=fccr + recorc=fccr + + return + end diff -u -N -r cyana-1.0.5/src/cyana/cyana.F cyanaccr/src/cyana/cyana.F --- cyana-1.0.5/src/cyana/cyana.F 2003-12-16 21:44:51.000000000 +0100 +++ cyanaccr/src/cyana/cyana.F 2003-12-16 21:45:41.000000000 +0100 @@ -7,6 +7,10 @@ parameter (vers='VERSION',macext='.cya', * sys='SYSTEM') include 'cyana.incl' + include 'pse.incl' + include 'orj.incl' + include 'ccr.incl' +! include 't1.incl' #IF mpi THEN include 'mpif.h' #END IF @@ -14,7 +18,7 @@ parameter (maxp=50) character param(maxp)*200,cmd*100,inifil*200,hlpdir*200 c --------------------------------------------------------- commands - parameter (ncmd=17) + parameter (ncmd=31) dimension idtyp(ncmd) character comand(ncmd)*20 data (comand(i),idtyp(i),i=1,ncmd)/ @@ -23,7 +27,13 @@ * 'minimize' ,1, 'peaks' ,1, 'randomize' ,1, * 'read' ,0, 'rmsd' ,1, * 'structures' ,1, 'write' ,1, 'md' ,1, - * 'assign' ,1, 'couplings' ,1, 'gradient' ,1/ + * 'assign' ,1, 'couplings' ,1, 'gradient' ,1, + * 'include_pse' ,0, 'exclude_pse' ,0, 'exclude_t1' ,1, + * 'include_ccr' ,0, 'exclude_ccr' ,0, + * 'rec_pse_vio' ,0, 'out_pse_vio' ,0, + * 'rec_orj_vio' ,0, 'out_orj_vio' ,0, 'pseorj' ,0, + * 'pseudoglomsa_init' ,0, 'pseudoglomsa_data', 0, + * 'pseudoglomsa_out' ,0, 'generate_cvo', 0/ #IF mpi THEN c --------------------------------------------------- initialize MPI cp print *,'MPI_INIT' @@ -70,6 +80,7 @@ if (epsmac().gt.1.0E-10 ) * call wrnmsg ('Using low precision arithmetics.') c ----------------------------------------------------- command loop + indstr=0 10 continue call inclan (mode,cmd,param,nparam,maxp, * macext,libdir,inifil,hlpdir) @@ -98,6 +109,7 @@ call moldyn (param,nparam) else if (comand(icmd).eq.'randomize') then call ranstr (param,nparam) + indstr=indstr+1 else if (comand(icmd).eq.'angstat') then call acostt (param,nparam) else if (comand(icmd).eq.'rmsd') then @@ -119,6 +131,106 @@ else if (comand(icmd).eq.'gradient') then call chkgrd (param,nparam) end if + +C -------------------------------------------- +C PARAMAGNETIC COMMANDS START HERE +C -------------------------------------------- + if (comand(icmd).eq.'include_pse') then + dipflag=.true. + call putlin(2,'Pseudocontact toggled ON') + elseif (comand(icmd).eq.'exclude_pse') then + dipflag=.false. + call putlin(2,'Pseudocontact toggled OFF') + elseif (comand(icmd).eq.'exclude_t1') then + jdt1=0. + call putlin(2,'T1 toggled OFF') + elseif (comand(icmd).eq.'pseudoglomsa_init') then + call pseudoglomsa(0,0) + call putlin(2,'Ready to perform pseudoglomsa') + elseif (comand(icmd).eq.'pseudoglomsa_data') then + call pseudoglomsa(1,0) + elseif (comand(icmd).eq.'pseudoglomsa_out') then + call params (param,nparam,'structures=1<=@i + * append') + npsestr=iparam('structures') + if (.not.haverr()) then + call pseudoglomsa(2,npsestr) + endif + elseif (comand(icmd).eq.'generate_cvo') then + call pseudoglomsa(3,0) + elseif (comand(icmd).eq.'rec_pse_vio') then + call params (param,nparam,'structure=@i + * append') + npsestr=iparam('structure') + if (.not.haverr().and.npsestr.le.maxstrpse) then + do iq=1,ndip + totvio(iq,npsestr)=pviol(iq) + enddo + elseif (npsestr.gt.maxstrpse) then + call putlin(2,'Structure number too big') + endif + elseif (comand(icmd).eq.'out_pse_vio') then + call params (param,nparam,'structures=@i + * append') + npsestr=iparam('structures') + if (.not.haverr().and.npsestr.le.maxstrpse) then +c call putlin(2,'hai chiamato out_pse_vio') +c print *, npsestr + call pseovw(npsestr) + elseif (npsestr.gt.maxstrpse) then + call putlin(2,'Structure number too big') + endif +c write(6,*)'dipflag=',dipflag !ATTENZIONE +c +c go for orientation violations +c + elseif (comand(icmd).eq.'pesorj') then + call params (param,nparam,'weight=@r=1.0 append') + weiorj=weiorj*rparam('weight') + write (TMPORJ,'(a19,f11.6,a4,2x,f11.6)') + * 'WEIORJ changed from:',weiorj/rparam('weight'), + * ' to ', weiorj + call putlin(2,TMPORJ) + elseif (comand(icmd).eq.'rec_orj_vio') then + call params (param,nparam,'structure=@i + * append') + norjstr=iparam('structure') + if (.not.haverr().and.norjstr.le.maxstrorj) then + do iq=1,jorj + jjj=iorjviol(iq) + totvioj(jjj,norjstr)=orjviol(iq) + yorjviol(jjj)=.true. + enddo + elseif (npsestr.gt.maxstrpse) then + call putlin(2,'Too many structures') + endif + elseif (comand(icmd).eq.'out_orj_vio') then + call params (param,nparam,'structures=@i + * append') + norjstr=iparam('structures') + if (.not.haverr().and.norjstr.le.maxstrorj) then + call orjovw(norjstr) + elseif (norjstr.gt.maxstrorj) then + call putlin(2,'Too many structures') + endif + endif +C ------------------------------------------------- + +C ------------------------------------------------- +C CCR COMMANDS START HERE +C ------------------------------------------------- + if (comand(icmd).eq.'include_ccr') then + ccrflg=.true. + call putlin(2,'Ccr constraints toggled ON') + elseif (comand(icmd).eq.'exclude_ccr') then + ccrflg=.false. + call putlin(2,'Ccr constraints toggled OFF') + endif +C ------------------------------------------------- +C END CCR COMMANDS +C ------------------------------------------------- + + if (mode.ge.0 .and. cmd.ne.'quit') go to 10 call stopit (0) end diff -u -N -r cyana-1.0.5/src/cyana/cyana.f cyanaccr/src/cyana/cyana.f --- cyana-1.0.5/src/cyana/cyana.f 2003-12-16 21:44:52.000000000 +0100 +++ cyanaccr/src/cyana/cyana.f 1970-01-01 01:00:00.000000000 +0100 @@ -1,101 +0,0 @@ -c Automatically generated from cyana.F. -c ****** DO NOT EDIT! ****** -Copyright (c) 2002 Peter Guntert. All rights reserved. -c ================================================================== - program cyana -c - implicit double precision (a-h,o-z) - character*(*) vers,sys,macext - parameter (vers='1.0.5',macext='.cya', - * sys='pgi') - include 'cyana.incl' -c - parameter (maxp=50) - character param(maxp)*200,cmd*100,inifil*200,hlpdir*200 -c --------------------------------------------------------- commands - parameter (ncmd=17) - dimension idtyp(ncmd) - character comand(ncmd)*20 - data (comand(i),idtyp(i),i=1,ncmd)/ - * 'angles' ,1, 'angstat' ,1, 'atoms' ,1, - * 'calibrate' ,1, 'distance' ,1, 'grid' ,1, - * 'minimize' ,1, 'peaks' ,1, 'randomize' ,1, - * 'read' ,0, 'rmsd' ,1, - * 'structures' ,1, 'write' ,1, 'md' ,1, - * 'assign' ,1, 'couplings' ,1, 'gradient' ,1/ -c ------------------------------------------- find library directory - call ugtenv ('CYANALIB',libdir) - if (libdir.eq.' ') libdir= - *'LIBDIR' -c ------------------------------------------------ initialize INCLAN - hlpdir=libdir(1:lenstr(libdir))//'/help/cyana' - inifil=libdir(1:lenstr(libdir))//'/macro/init' - mode=0 - call inclan (mode,cmd,param,nparam,maxp, - * macext,libdir,inifil,hlpdir) -c --------------------------------------------- initialize variables - call inivar -c ------------------------------------------------------ print title - call putlin (12,'______________________________________________'// - * '_____________________@/') - call putlin (12,'CYANA '//vers//' ('//sys//')') - call putlin (12,'@/Copyright (c) 2002 Peter Guntert@/Contains '// - * 'CANDID, copyright (c) 2002 Peter Guntert, '// - * 'Torsten Herrmann@/All rights reserved.') - call putlin (12,'______________________________________________'// - * '_____________________@/') - if (epsmac().gt.1.0E-10 ) - * call wrnmsg ('Using low precision arithmetics.') -c ----------------------------------------------------- command loop - 10 continue - call inclan (mode,cmd,param,nparam,maxp, - * macext,libdir,inifil,hlpdir) - icmd=icoman(cmd,comand,ncmd) -c ---------------------------------------------------- error check - if (icmd.eq.0) then - mode=1 - else if (icmd.lt.0) then - call errmsg ('Ambiguous command '//strq(cmd)//'.') - else if (idtyp(icmd).gt.0 .and. nr.le.0) then - call errmsg ('No data present.') - else if (idtyp(icmd).eq.2 .and. npeaks.le.0) then - call errmsg ('No peaks present.') -c ------------------------------------------------------- commands - else if (comand(icmd).eq.'read') then - call readf (param,nparam) - else if (comand(icmd).eq.'structures') then - call struct (param,nparam) - else if (comand(icmd).eq.'atoms') then - call atoms (param,nparam) - else if (comand(icmd).eq.'angles') then - call angles (param,nparam) - else if (comand(icmd).eq.'minimize') then - call minim (param,nparam) - else if (comand(icmd).eq.'md') then - call moldyn (param,nparam) - else if (comand(icmd).eq.'randomize') then - call ranstr (param,nparam) - else if (comand(icmd).eq.'angstat') then - call acostt (param,nparam) - else if (comand(icmd).eq.'rmsd') then - call mean (param,nparam) - else if (comand(icmd).eq.'peaks') then - call peaks (param,nparam) - else if (comand(icmd).eq.'calibrate') then - call caliba (param,nparam) - else if (comand(icmd).eq.'grid') then - call grid (param,nparam) - else if (comand(icmd).eq.'distance') then - call discon (param,nparam) - else if (comand(icmd).eq.'write') then - call writef (param,nparam,vers) - else if (comand(icmd).eq.'assign') then - call assnoe (param,nparam) - else if (comand(icmd).eq.'couplings') then - call jcoupl (param,nparam) - else if (comand(icmd).eq.'gradient') then - call chkgrd (param,nparam) - end if - if (mode.ge.0 .and. cmd.ne.'quit') go to 10 - call stopit (0) - end diff -u -N -r cyana-1.0.5/src/cyana/cyana.incl cyanaccr/src/cyana/cyana.incl --- cyana-1.0.5/src/cyana/cyana.incl 2003-12-16 21:44:51.000000000 +0100 +++ cyanaccr/src/cyana/cyana.incl 2003-12-16 21:45:41.000000000 +0100 @@ -147,6 +147,7 @@ c anam() atom name c anamr() external atom name, if renaming is on c anams() saved external atom name +c indstr index of the structure c c parameter (maxr=400,maxd=2200,maxa=7200,maxqa=10,maxlik=3, c parameter (maxr=40,maxd=199,maxa=630,maxqa=10,maxlik=3, @@ -165,7 +166,7 @@ * totmas,tinert(0:6,0:maxd),com(3,0:maxd),masmod common /dihch/ dnam(maxd),dnamr(maxd),dnams(maxd) common /atdat/ na,nswa,iar(maxa),iaunit(0:maxa), - * iatyp(maxa),iael(maxa),iduma,coo(3,0:maxam), + * iatyp(maxa),iael(maxa),iduma,coo(3,0:maxam+1), * coo0(3,0:maxa),ias(maxam),ibond(4,maxa), * nbond(maxa),arad(maxa),arad0(maxa),ihbond(maxa), * malik,iadum,nalik(maxa),isbond(maxlik,maxa), @@ -174,7 +175,7 @@ * nqa1(maxa),iqa(maxqa,maxa),numpro(maxa), * pacorr(maxa),amass(maxa),asel(maxa), * joffst(maxat,maxr),iap1(maxa),tottmp(maxr,maxr) - common /atch/ anam(maxa),anamr(maxa),anams(maxa) + common /atch/ anam(maxa),anamr(maxa),anams(maxa),indstr c c --------------------------------------------- distance constraints c @@ -191,8 +192,7 @@ c idcflg() corresponds to ipaflg() c dcosel() is the distance constraint selected? c -c parameter (maxdco=80000,maxind=1000) ORIGINALE - parameter (maxdco=160000,maxind=1000) + parameter (maxdco=80000,maxind=1000) logical dcosel common /dcodat/ndco,idumdc,idcoa(2,maxdco),dco(maxdco), * indco(maxdco),weidco(maxdco),supdco(maxdco), @@ -284,7 +284,7 @@ c psel() is the peak selected? c intmod() integration mode c - parameter (maxdim=4,maxpik=225000) + parameter (maxdim=4,maxpik=150000) logical psel character intmod common /pikdat/npeaks,idumpk,npk(maxpik),ipkl(maxpik), @@ -354,7 +354,7 @@ c iviol() index of a violated constraint c weight() weight of the pair interaction c - parameter (maxiac=600000,maxbd2=3*maxiac/5,maxvio=120000) + parameter (maxiac=400000,maxbd2=3*maxiac/5,maxvio=80000) common /iaclst/nupl,nlol,nvdw,nvdws,mupl,mupl1,mlol,mlol1, * jupl,jupl1,jlol,jlol1,jvdw,idumia,wupl,wlol,wvdw, * ia1(maxiac),ia2(maxiac),iac(maxdco), diff -u -N -r cyana-1.0.5/src/cyana/fcn.f cyanaccr/src/cyana/fcn.f --- cyana-1.0.5/src/cyana/fcn.f 2003-12-16 21:44:52.000000000 +0100 +++ cyanaccr/src/cyana/fcn.f 2003-12-16 21:45:41.000000000 +0100 @@ -9,12 +9,17 @@ c implicit double precision (a-h,o-z) include 'cyana.incl' + include 'pse.incl' + include 'orj.incl' + include 'ccr.incl' +! include 't1.incl' c nfcn=nfcn+1 c ----------------------------------- generate Cartesian coordinates if (jaswap.le.0) call gener c -------------------------------------------------- find violations - 40 call violat + 40 call violat !ATTENZIONE +! call violt1 !ATTENZIONE c --------------------------------------------- distance constraints vu=0.0 vl=0.0 @@ -94,6 +99,38 @@ end do c f=vu*wupl+vl*wlol+vv*wvdw+va*waco+vc*wcco+vo*wori +c Orientation constraints (Antonio's way) +c + VORJ=0.0 + DO I=1,JORJ + VORJ=VORJ+WORJ(IORJVIOL(I))*ORJVIOL(I)**npower + END DO + f = f + VORJ * WEIORJ + +C ----------------------------------------------- +C ADD PSEUDOCONTACT CONTRIBUTION +C ----------------------------------------------- +c write(6,*)'dipflag=',dipflag !ATTENZIONE + if (dipflag) f=f+wdip*pseviol() !ATTENZIONE + +C ----------------------------------------------- +C END PSEUDOCONTACT CONTRIBUTION +C ----------------------------------------------- + +C ----------------------------------------------- +C ADD CCR CONSTRAINTS CONTRIBUTION +C ----------------------------------------------- + + ccrvio=0. + if (ccrflg) call ccrviol(indstr) + f=f+ccrvio + +C ----------------------------------------------- +C END CCR CONSTRAINTS CONTRIBUTION +C ----------------------------------------------- + + + tf=f c print '(1p,i4,8e12.4)',nfcn,f,vu*wupl,vl*wlol,vv*wvdw,va*waco end diff -u -N -r cyana-1.0.5/src/cyana/findfe.f cyanaccr/src/cyana/findfe.f --- cyana-1.0.5/src/cyana/findfe.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/findfe.f 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,20 @@ + SUBROUTINE FINDFE(metal) + + include 'cyana.incl' + include 't1.incl' + + character*(*) metal + logical match + JFE=0 + DO 10 J=1, NA + IF (match(anam(j),metal)) THEN + JFE = JFE + 1 + IFEA(JFE) = J + NRFE(JFE)=IAR(J) + KFE(JFE) = 1.0 + END IF +10 CONTINUE + NUFE = JFE + RETURN + END + diff -u -N -r cyana-1.0.5/src/cyana/findzerocoords.f cyanaccr/src/cyana/findzerocoords.f --- cyana-1.0.5/src/cyana/findzerocoords.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/findzerocoords.f 2003-12-16 21:45:41.000000000 +0100 @@ -0,0 +1,136 @@ +C --------------------------------------------------------------------- +C FINDZEROCOORDS: finds the coordinates of the +C pseudoatoms AX, AY and AZ given the coordinates +C of tensor center and the ones of PX, PY, PZ and +C PCN (the center of the P-reference system). +C +C It reads direction cosines from a file called +C filenam.cos where filnam is the same as the +C name given to the coordinate set. +C +C After calling this subroutine it is necessary +C to call GENER to obtain the actual coordinates +C CX, CY and CZ. +C N.B. All the A- and the P- pseudoatoms have a +C lenght of 1.0 A from the corresponding center. +C +C Mauro A. Cremonini 07.02.96 +C +C Now modified to use multiple tensors. See just the +C addiction of the index running from 1 to NTENSO +C (the number of different tensors). +C +C Mauro A. Cremonini 06/06/96 +C +C DYANA version. Mauro A. Cremonini 06.12.96 +C +C --------------------------------------------------------------------- + SUBROUTINE FINDZEROCOORDS (iunit,mode) +C + implicit double precision (a-h,o-z) + INCLUDE 'cyana.incl' + INCLUDE 'orj.incl' + INCLUDE 'pse.incl' + + + DO I=1,NTENSO*NDTENSO + IPCN1=IPCN(I) + IMET1=IMET(I) + IPX1= IPX(I) + IPY1= IPY(I) + IPZ1= IPZ(I) + IAX1= IAX(I) + IAY1= IAY(I) + IAZ1= IAZ(I) + + PCNX0=coo0(1,IPCN1) + PCNY0=coo0(2,IPCN1) + PCNZ0=coo0(3,IPCN1) + + CMEX0=coo0(1,IMET1) + CMEY0=coo0(2,IMET1) + CMEZ0=coo0(3,IMET1) + + + PXX0=coo0(1,IPX1)-PCNX0 + PXY0=coo0(2,IPX1)-PCNY0 + PXZ0=coo0(3,IPX1)-PCNZ0 + PYX0=coo0(1,IPY1)-PCNX0 + PYY0=coo0(2,IPY1)-PCNY0 + PYZ0=coo0(3,IPY1)-PCNZ0 + PZX0=coo0(1,IPZ1)-PCNX0 + PZY0=coo0(2,IPZ1)-PCNY0 + PZZ0=coo0(3,IPZ1)-PCNZ0 + + + read (iunit,'(3e15.5)') txx,txy,txz + read (iunit,'(3e15.5)') tyx,tyy,tyz + read (iunit,'(3e15.5)') tzx,tzy,tzz + read (iunit,'(2e15.5)') a1dip(i),a2dip(i) + + coo0(1,IAX1) = PXX0*TXX+PYX0*TXY+PZX0*TXZ+CMEX0 + coo0(2,IAX1) = PXY0*TXX+PYY0*TXY+PZY0*TXZ+CMEY0 + coo0(3,IAX1) = PXZ0*TXX+PYZ0*TXY+PZZ0*TXZ+CMEZ0 + coo0(1,IAY1) = PXX0*TYX+PYX0*TYY+PZX0*TYZ+CMEX0 + coo0(2,IAY1) = PXY0*TYX+PYY0*TYY+PZY0*TYZ+CMEY0 + coo0(3,IAY1) = PXZ0*TYX+PYZ0*TYY+PZZ0*TYZ+CMEZ0 + coo0(1,IAZ1) = PXX0*TZX+PYX0*TZY+PZX0*TZZ+CMEX0 + coo0(2,IAZ1) = PXY0*TZX+PYY0*TZY+PZY0*TZZ+CMEY0 + coo0(3,IAZ1) = PXZ0*TZX+PYZ0*TZY+PZZ0*TZZ+CMEZ0 + ENDDO +C Always calculates inertia with coo0(). +c +c Now go for orientation tensor(s) +c + + DO J=1,NDTENSORJ + I=J+MAXTENS/2 + IPCN1=IPCN(I) + IMET1=IMET(I) + IPX1= IPX(I) + IPY1= IPY(I) + IPZ1= IPZ(I) + IAX1= IAX(I) + IAY1= IAY(I) + IAZ1= IAZ(I) + + PCNX0=coo0(1,IPCN1) + PCNY0=coo0(2,IPCN1) + PCNZ0=coo0(3,IPCN1) + + CMEX0=coo0(1,IMET1) + CMEY0=coo0(2,IMET1) + CMEZ0=coo0(3,IMET1) + + + PXX0=coo0(1,IPX1)-PCNX0 + PXY0=coo0(2,IPX1)-PCNY0 + PXZ0=coo0(3,IPX1)-PCNZ0 + PYX0=coo0(1,IPY1)-PCNX0 + PYY0=coo0(2,IPY1)-PCNY0 + PYZ0=coo0(3,IPY1)-PCNZ0 + PZX0=coo0(1,IPZ1)-PCNX0 + PZY0=coo0(2,IPZ1)-PCNY0 + PZZ0=coo0(3,IPZ1)-PCNZ0 + + + read (iunit,'(3e15.5)') txx,txy,txz + read (iunit,'(3e15.5)') tyx,tyy,tyz + read (iunit,'(3e15.5)') tzx,tzy,tzz + read (iunit,'(2e15.5)') a1dip(i),a2dip(i) + + coo0(1,IAX1) = PXX0*TXX+PYX0*TXY+PZX0*TXZ+CMEX0 + coo0(2,IAX1) = PXY0*TXX+PYY0*TXY+PZY0*TXZ+CMEY0 + coo0(3,IAX1) = PXZ0*TXX+PYZ0*TXY+PZZ0*TXZ+CMEZ0 + coo0(1,IAY1) = PXX0*TYX+PYX0*TYY+PZX0*TYZ+CMEX0 + coo0(2,IAY1) = PXY0*TYX+PYY0*TYY+PZY0*TYZ+CMEY0 + coo0(3,IAY1) = PXZ0*TYX+PYZ0*TYY+PZZ0*TYZ+CMEZ0 + coo0(1,IAZ1) = PXX0*TZX+PYX0*TZY+PZX0*TZZ+CMEX0 + coo0(2,IAZ1) = PXY0*TZX+PYY0*TZY+PZY0*TZZ+CMEY0 + coo0(3,IAZ1) = PXZ0*TZX+PYZ0*TZY+PZZ0*TZZ+CMEZ0 + ENDDO + call gener + call inerta + RETURN + END + diff -u -N -r cyana-1.0.5/src/cyana/getccr.f cyanaccr/src/cyana/getccr.f --- cyana-1.0.5/src/cyana/getccr.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/getccr.f 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,71 @@ + +Copyright (c) 1996-97 ETH Zurich +c ================================================================== +c GETCCR: Read observed ccr values file from unit IUNIT. +c +c ------------------------------------------------------------------ + subroutine getccr (iunit,mode) + implicit double precision (a-h,o-z) + + + include 'cyana.incl' + include 'ccr.incl' + + integer ntotcc,councc(maxcmt) + integer inpcc1(maxccr*maxcmt),inpcc2(maxccr*maxcmt) + character*4 inpcc3(maxccr*maxcmt) + real inpcc4(maxccr*maxcmt),inpcc5(maxccr*maxcmt) + real inpcc6(maxccr*maxcmt) + +c +c ntotcc e' il numero totale di vincoli ccr +c councc(j) e' il contatore di vincoli per il metallo j-esimo +c inpcc1(1) e' l'indice che contraddistingue il metallo +c inpcc1(2) e' il numero del residuo cui si riferisce il vincolo +c inpcc1(3) e' il nome del residuo cui si riferisce il vincolo +c inpcc1(4) e' il valore osservato di ccr per quel vincolo +c inpcc1(5) e' il peso specifico per quel vincolo +c inpcc1(6) e' la tolleranza specifica per quel vincolo +c + + ntotcc=0 + do j=1,nccrmt + ntotcc=ntotcc+nccr(j) + councc(j)=0 + end do + + do i=1,ntotcc + + read (iunit,'(I2,1X,I3,1X,A4,1X,F8.3,1X,F8.3,1X,F8.3)') + + inpcc1(i),inpcc2(i),inpcc3(i), + + inpcc4(i),inpcc5(i),inpcc6(i) + + councc(inpcc1(i))=councc(inpcc1(i))+1 + + iccrvr(councc(inpcc1(i)),inpcc1(i))= + + iresid(inpcc2(i),inpcc3(i),mode) + if (haverr()) return + + ccrobs(councc(inpcc1(i)),inpcc1(i))=inpcc4(i) + + ccrwsp(councc(inpcc1(i)),inpcc1(i))=inpcc5(i) + + ccrtos(councc(inpcc1(i)),inpcc1(i))=inpcc6(i) + + end do + + do k=1,nccrmt + + do i=1,nccr(k) + + iccrn(i,k)=iatom('N',iccrvr(i,k),mode) + if (haverr()) return + iccrh(i,k)=iatom('HN',iccrvr(i,k),mode) + if (haverr()) return + + end do + + end do + + return + end diff -u -N -r cyana-1.0.5/src/cyana/getcpr.f cyanaccr/src/cyana/getcpr.f --- cyana-1.0.5/src/cyana/getcpr.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/getcpr.f 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,30 @@ + +Copyright (c) 1996-97 ETH Zurich +c ================================================================== +c GETCPR: Read ccr parameters file from unit IUNIT. +c +c ------------------------------------------------------------------ + subroutine getcpr (iunit,mode) + implicit double precision (a-h,o-z) + + include 'cyana.incl' + include 'ccr.incl' + +c +c inpcpr(1) e' il numero di metalli +c inpcpr(2) e' il peso relativo del vincolo ccr +c + + real inpcpr(2) + + do i=1,2 + + read (iunit,*) inpcpr(i) + + end do + + nccrmt=int(inpcpr(1)) + ccrwei=inpcpr(2) + + return + end diff -u -N -r cyana-1.0.5/src/cyana/getdip.f cyanaccr/src/cyana/getdip.f --- cyana-1.0.5/src/cyana/getdip.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/getdip.f 2003-12-16 21:45:41.000000000 +0100 @@ -0,0 +1,190 @@ +C ------------------------------------------------------------------ +C GETDIP: reads a file containing the pseudocontact shift +C constraints. +C Format is: +C +C I3,1X,2A5,1X,F7.2,1X,I1,A1,f5.2,1x,f5.2,1x,I2 +C +C that corresponds to: +C +C IRESDIP() residue number; +C NAMRESDIP() residue name; +C NAMATDIP() atom name; +C PSHIFTOR() pseudocontact shift (original); +C QQDIA if letter 'd' the averaged experimental shift is compared +C to the averaged experimental shift (in this case weight +C is doubled); +C NPROT() number of atoms whose calculated shifts must be averaged; +C TOLPROT() tolerance on calculated shift; +C WPROT() weight of the individual contraints (multiplies wdip). +C +C +C Mauro A. Cremonini 24/01/95 +C Mauro A. Cremonini 07/02/96 +C +C +C NUTE() index counting the different tensors +C +C +C A new modification has been done: the pseudocontact input now contains +C N entry more than the number of shifts to be used. These correspond to the +C PCN center of the residue bearing the Nth tensor. It is assumed that the residue +C has PX, PY and PZ attached to PCN. It is also assumed that a ME +C atom attached to AX, AY and AZ exist. If they all do not, the program stops +C complaining about the residue. +C +C Mauro A. Cremonini 06/06/96 +C +C DYANA version: MAuro A. Cremonini 06.12.96 + + +C ------------------------------------------------------------------ + + SUBROUTINE GETDIP(IUNIT,mode) +C + implicit double precision (a-h,o-z) + include 'cyana.incl' + include 'pse.incl' +C + CHARACTER LINE*80,qqdia*1 + + NDIP=0 + 10 CONTINUE + READ(iunit,'(A)',END=99) LINE + NDIP=NDIP+1 + if (ndip.gt.maxdip) then + CALL ERRMSG('Too many pseudocontact shifts!') + ndip=0 + return + endif + READ(LINE,'(I3,1X,2A5,1X,F7.2,1X,I1,a1,f5.2,1x,f5.2,1x,I2)') + * IRESDIP(NDIP),NAMRESDIP(NDIP),NAMATDIP(NDIP), + * PSHIFTOR(NDIP),NPROT(NDIP),qqdia, + * TOLPROT(NDIP),WPROT(NDIP),NUTE(NDIP) + if (qqdia.eq.'d') then + psedia(ndip)=.true. + else + psedia(ndip)=.false. + endif + IF (NUTE(NDIP).LT.1) NUTE(NDIP)=1 + IF (NUTE(NDIP).GT.NDTENSO) STOP + IF (NPROT(NDIP).EQ.0) NPROT(NDIP)=1 + IF (TOLPROT(NDIP).EQ.0.0) TOLPROT(NDIP)=TOLDIP + IF (WPROT(NDIP).EQ.0.0) WPROT(NDIP)=1. + if (wprot(ndip).lt.0.) wprot(ndip)=0. + dip2flag(ndip)=.true. + GOTO 10 + + 99 i=1 + do while (i.le.ndip) + if (psedia(i)) then + if (nprot(i).eq.2.and.wprot(i).gt.0.) then + pshiftpse(i)=(pshiftor(i)+pshiftor(i+1))/2 + pshiftpse(i+1)=pshiftpse(i) + wprot(i+1)=4. +C wprot(i+1)=2. + i=i+1 + else + CALL ERRMSG('Only geminal couples!') + ndip=0 + return + endif + else + pshiftpse(i)=pshiftor(i) + endif + i=i+1 + enddo + +C Modifica prof. Luchinat + do i=1,ndip + tolprot(i)=max(tolprot(i),abs(pshiftpse(i)*pseperc)) + enddo + + + mustbezero=8 + DO 20 I=1,NDIP + DO 30 K=1,NR + IF (IRESDIP(I).EQ.IR(K).AND.I.LE.NDIP-NTENSO*NDTENSO) THEN + DO 40 J=IFIRA(K), IFIRA(K+1)-1 + IF (NAMATDIP(I).EQ.ANAM(J)) THEN + INDXDIP(I)=J + GO TO 20 + END IF + 40 CONTINUE + CALL ERRMSG('GETDIP:illegal atom name '//NAMATDIP(I)) + ndip=0 + return + ELSE IF (IRESDIP(I).EQ.IR(K).AND. + * I.GT.NDIP-NTENSO*NDTENSO) THEN + itensprog=i-ndip+ntenso*NDTENSO + DO 41 J=IFIRA(K), IFIRA(K+1)-1 + IF (ANAM(J).EQ.'ME ') THEN + IMET(itensprog)=J + mustbezero=mustbezero-1 + elseif (ANAM(J).EQ.'PX ') then + ipx(itensprog)=j + mustbezero=mustbezero-1 + elseif (ANAM(J).EQ.'PY ') then + ipy(itensprog)=j + mustbezero=mustbezero-1 + elseif (ANAM(J).EQ.'PZ ') then + ipz(itensprog)=j + mustbezero=mustbezero-1 + elseif (ANAM(J).EQ.'AX ') then + iax(itensprog)=j + mustbezero=mustbezero-1 + elseif (ANAM(J).EQ.'AY ') then + iay(itensprog)=j + mustbezero=mustbezero-1 + elseif (ANAM(J).EQ.'AZ ') then + iaz(itensprog)=j + mustbezero=mustbezero-1 + elseif (ANAM(J).EQ.'PCN ') then + ipcn(itensprog)=j + mustbezero=mustbezero-1 + endif + 41 CONTINUE + if (mustbezero.eq.0) then + mustbezero=8 + goto 20 + endif + CALL ERRMSG('GETDIP:illegal tensor stuff! '//namresdip(i)) + ndip=0 + return + ELSE IF (IRESDIP(I).NE.IR(K).AND.K.EQ.NR) THEN +C print *, 'Reside number = ',iresdip(i) + CALL ERRMSG('GETDIP:illegal residue number '//NAMATDIP(I)) + ndip=0 + return + END IF + 30 CONTINUE + 20 CONTINUE + NDIP=NDIP-ntenso*NDTENSO + +C print *, ndip, itensprog +C CLOSE(1) +C PRINT *, 'PSEUDOCONTACT SHIFTS FILE SUCCESFULLY READ' + +C SETTING OTHER STUFF... + + DIPFLAG=.TRUE. + write(6,*)'dipflag=',dipflag !ATTENZIONE + + open (88,file='getdip.out') + do i=1,ndip + if (psedia(i)) then + qqdia='d' + else + qqdia=' ' + endif + WRITE(88,'(I3,1X,2A5,1X,F7.2,1X,I1,a1,f5.2,1x,f5.2,1x, + * f7.2,2x,i5,1x,i5,1x,I2)') + * IRESDIP(i),NAMRESDIP(i),NAMATDIP(i), + * PSHIFTPSE(i),NPROT(i),qqdia, + * TOLPROT(i),WPROT(i),PSHIFTOR(i), + * indxdip(i),iap(indxdip(i)),NUTE(i) + enddo + close(88) + + RETURN + END diff -u -N -r cyana-1.0.5/src/cyana/getmet.f cyanaccr/src/cyana/getmet.f --- cyana-1.0.5/src/cyana/getmet.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/getmet.f 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,47 @@ + +Copyright (c) 1996-97 ETH Zurich +c ================================================================== +c GETMET: Read metal position file from unit IUNIT. +c +c ------------------------------------------------------------------ + subroutine getmet (iunit,mode) + implicit double precision (a-h,o-z) + + + include 'cyana.incl' + include 'ccr.incl' + + integer inpmt1(maxcmt),inpmt4(maxcmt),inpmt5(maxcmt) + character*4 inpmt2(maxcmt) + character*5 inpmt3(maxcmt) + real inpmt6(maxcmt) + +c +c inpmt1(1) e' il numero del residuo che contiene il metallo +c inpmt1(2) e' il nome del residuo che contiene il metallo +c inpmt1(3) e' il nome del metallo +c inpmt1(4) e' l'indice che contraddistingue il metallo +c inpmt1(5) e' il numero di vincoli riferiti a quel metallo +c inpmt1(6) e' la costante di proporzionalita' per quel metallo +c + + do k=1,nccrmt + + read (iunit,'(I3,1X,A4,1X,A5,1X,I2,1X,I3,1X,F9.2)') + + inpmt1(k),inpmt2(k),inpmt3(k),inpmt4(k), + + inpmt5(k),inpmt6(k) + + iccrmr(inpmt4(k))=iresid(inpmt1(k),inpmt2(k),mode) + if (haverr()) return + + iccrm(inpmt4(k))=iatom(inpmt3(k),iccrmr(inpmt4(k)),mode) + if (haverr()) return + + nccr(inpmt4(k))=inpmt5(k) + + ccrfac(inpmt4(k))=inpmt6(k) + + end do + + return + end diff -u -N -r cyana-1.0.5/src/cyana/getorj.f cyanaccr/src/cyana/getorj.f --- cyana-1.0.5/src/cyana/getorj.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/getorj.f 2003-12-16 21:45:41.000000000 +0100 @@ -0,0 +1,154 @@ +Copyright (c) 2002 Peter Guntert. All rights reserved. +C ------------------------------------------------------------------ +C GETORJ: reads a file containing the deltaJ +C constraints. +C Format is: +C +C I3,1X,2A5,1X,F7.2,1X,f5.2,1x,f5.2 +C +C that corresponds to: +C +C IRESORJ() residue number; +C NAMRESORJ() residue name; +C NAMATORJ() atom name; +C ORJ() observed deltaJ; +C TOLORJ() tolerance on calculated deltaJ; +C WORJ() weight of the individual contraints (multiplies weiorj). +C IDORJ() pointer for constrained atoms; +c NUTEORJ() index counting the different tensors +c +C +C +C + +C ------------------------------------------------------------------ + + SUBROUTINE GETORJ(IUNIT,mode) +C + implicit double precision (a-h,o-z) + include 'cyana.incl' + include 'pse.incl' + include 'orj.incl' +C + CHARACTER LINE*80 + INTEGER TMP + + NORJ=0 + BINGO=0 +10 continue + READ(iunit,'(A)',END=11) LINE +c +c Get constraints +c + NORJ=NORJ+1 + if (NORJ.gt.MAXORJ) then + CALL ERRMSG('Too many deltaJ!') + NORJ=0 + return + endif + READ(LINE,'(I3,1X,2A5,1X,F7.2,1X,f5.2,1x,f5.2,1x,I2)') + * IRESORJ(NORJ),NAMRESORJ(NORJ),NAMATORJ(NORJ), + * ORJ(NORJ), + * TOLORJ(NORJ),WORJ(NORJ),NUTEORJ(NORJ) +c +c Set up tolerance, weight and tensor #, if not explicitly given +c + IF (TOLORJ(NORJ).EQ.0.0) TOLORJ(NORJ)=TORJ + IF (WORJ(NORJ).EQ.0.0) WORJ(NORJ)=1. + if (worj(norj).lt.0.) worj(norj)=0. + IF (NUTEORJ(NORJ).LT.1) NUTEORJ(NORJ)=1 + IF (NUTEORJ(NORJ).GT.NDTENSORJ) STOP + goto 10 +c +c get out of the loop! +c + 11 CONTINUE + +c +c Let's get a pointer for the atom constrained +c + do k=1,norj-NDTENSORJ + i=iresid(IRESORJ(k),NAMRESORJ(k),mode) + if (haverr()) return + if (i.le.0) then + CALL ERRMSG('GETORJ:illegal residue number'//NAMATORJ(I)) + end if + j=iatom(NAMATORJ(k),i,mode) + if (haverr()) return + if (j.le.0) then + CALL ERRMSG('GETORJ:illegal atom name'//NAMATORJ(I)) + end if + IDORJ(k)=j + end do +c +c +c +c +c Now, check that the residue representing the tensor is ok +c +c + mustbezero=8 + DO 20 I=NORJ-NDTENSORJ+1,NORJ + DO 30 K=1,NR + IF (IRESORJ(I).EQ.IR(K)) THEN + itensprog=i+maxtens/2-NORJ+NDTENSORJ + DO 41 J=IFIRA(K), IFIRA(K+1)-1 + IF (ANAM(J).EQ.'ME ') THEN + IMET(itensprog)=J + mustbezero=mustbezero-1 + elseif (ANAM(J).EQ.'PX ') then + ipx(itensprog)=j + mustbezero=mustbezero-1 + elseif (ANAM(J).EQ.'PY ') then + ipy(itensprog)=j + mustbezero=mustbezero-1 + elseif (ANAM(J).EQ.'PZ ') then + ipz(itensprog)=j + mustbezero=mustbezero-1 + elseif (ANAM(J).EQ.'AX ') then + iax(itensprog)=j + mustbezero=mustbezero-1 + elseif (ANAM(J).EQ.'AY ') then + iay(itensprog)=j + mustbezero=mustbezero-1 + elseif (ANAM(J).EQ.'AZ ') then + iaz(itensprog)=j + mustbezero=mustbezero-1 + elseif (ANAM(J).EQ.'PCN ') then + ipcn(itensprog)=j + mustbezero=mustbezero-1 + endif + 41 CONTINUE + if (mustbezero.eq.0) then + mustbezero=8 + goto 20 + endif + CALL ERRMSG('GETORJ:illegal orj tensor stuff! '//namresORJ(i)) + nORJ=0 + return + ELSE IF (IRESORJ(I).NE.IR(K).AND.K.EQ.NR) THEN +C print *, 'Reside number = ',iresORJ(i) + CALL ERRMSG('GETORJ:illegal residue number '//NAMATORJ(I)) + nORJ=0 + return + END IF + 30 CONTINUE + 20 CONTINUE + NORJ=NORJ-ndtensorj + +c +C SETTING OTHER STUFF... + + open (88,file='getorj.out') + WRITE(88,'(''WEIORJ: '', f9.4)') WEIORJ + + do i=1,norj + WRITE(88,'(I3,1X,2A5,1X,F7.2,1x,f5.2,1x,f5.2,1x,i2)') + * IRESORJ(i),NAMRESORJ(i),NAMATORJ(i), + * ORJ(i), + * TOLORJ(i),WORJ(i),NUTEORJ(i) + enddo + close(88) + + RETURN + END diff -u -N -r cyana-1.0.5/src/cyana/gett1.f cyanaccr/src/cyana/gett1.f --- cyana-1.0.5/src/cyana/gett1.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/gett1.f 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,66 @@ +Copyright (c) 1996 Institut f. Molekularbiologie & Biophysik, ETH Zurich +c ================================================================== +c GETT1 : Read T1 distance constraints from unit IUNIT. +c +c Peter G"untert, 24-10-1988 +c Modified version, Peter G"untert, 4-07-1994 +c Modified version, Peter G"untert, 8-10-1996 +c ------------------------------------------------------------------ + subroutine gett1 (iunit,ityp,mode) +c + implicit double precision (a-h,o-z) + include 'cyana.incl' + include 't1.incl' +c + character line*200,an*5,rn*5,field(5)*20 +c + rn=' ' + n=ndt1 + l=0 + 10 continue + read (iunit,'(A)',end=200) line + l=l+1 + i=index(line,'#') + if (i.gt.0) line(i:)=' ' + if (line.eq.' ') go to 10 + call split (line,field,nfield,8) +c ---------------------------------- first residue number and name + if (index('-+0123456789',field(1)(1:1)).gt.0) then + if (nfield.lt.2) go to 190 + read (field(1),'(I10)',err=190) ire + rn=field(2) + else + do i=min(nfield,3),1,-1 + field(i+2)=field(i) + end do + nfield=nfield+2 + end if +c ----------------------------------------------------- atom names + if (nfield.gt.2) then + if (nfield.lt.4 .or. rn.eq.' ') go to 190 + an=field(3) + if (n.ge.maxdt1) then + call errmsg ('Too many T1 distance constraints.') + return + end if + i=iresid(ire,rn,mode) + if (haverr()) return + if (i.le.0) go to 10 + j=iatom(an,i,mode) + if (haverr()) return + if (j.le.0) go to 10 + idt1a(n+1)=j + n=n+1 +c ------------------------------------ distance limit and weight + read (field(4),'(F20.0)',err=190) dt1(n) + if (ityp.lt.0) dt1(n)=-dt1(n) + weidt1(n)=1.0 + if (nfield.ge.5) then + read (field(5),'(F20.0)',err=190) weidt1(n) + end if + end if + go to 10 + 190 call errmsg ('Cannot read line '//intp(l)//':@/'//strp(line)) + return + 200 ndt1=n + end diff -u -N -r cyana-1.0.5/src/cyana/grad.f cyanaccr/src/cyana/grad.f --- cyana-1.0.5/src/cyana/grad.f 2003-12-16 21:44:51.000000000 +0100 +++ cyanaccr/src/cyana/grad.f 2003-12-16 21:45:41.000000000 +0100 @@ -10,10 +10,18 @@ c implicit double precision (a-h,o-z) include 'cyana.incl' + include 'pse.incl' + include 'orj.incl' + include 'ccr.incl' +! include 't1.incl' +c + c parameter (npowr1=npower-1) dimension g(ndfree),d(maxvio),r(6,maxvio),a(6,-1:maxd), * iu1(maxvio),iu2(maxvio),o(3,maxori) +! DIMENSION AAciccio(6,MAXFE,MAFEVI) + c --------------------------------------------- distance constraints if (jvdw.gt.0) then if (modetf.eq.1) then @@ -118,6 +126,75 @@ r(5,i)=t*(c21-c22) r(6,i)=t*(c31-c32) end do + +c inizio parte nuova +c DO I=1,6 +c DO IJ=1,JDT1 +c R(I,JVDW+IJ)=0. +c END DO +c END DO +c DO 210 I=1,JDT1 +c J=IFVIO(I) +c I1=IDT1A(J) +c C11=Coo(1,I1) +c C21=Coo(2,I1) +c C31=Coo(3,I1) +c DO 210 IJ=1,NUFE +c I2=IFEA(IJ) +c C12=Coo(1,I2) +c C22=Coo(2,I2) +c C32=Coo(3,I2) +c V=D(I+jvdw)*KFE(IJ)/D2FE(IJ,J)**4. +cc print*, V +c AAciccio(1,IJ,I) = V*(C21*C32-C31*C22) +c AAciccio(2,IJ,I) = V*(C31*C12-C11*C32) +c AAciccio(3,IJ,I) = V*(C11*C22-C21*C12) +c AAciccio(4,IJ,I) = V*(C11-C12) +c AAciccio(5,IJ,I) = V*(C21-C22) +c AAciccio(6,IJ,I) = V*(C31-C32) +c R(1,JVDW+I)=R(1,JVDW+I) + AAciccio(1,IJ,I) +c R(2,JVDW+I)=R(2,JVDW+I) + AAciccio(2,IJ,I) +c R(3,JVDW+I)=R(3,JVDW+I) + AAciccio(3,IJ,I) +c R(4,JVDW+I)=R(4,JVDW+I) + AAciccio(4,IJ,I) +c R(5,JVDW+I)=R(5,JVDW+I) + AAciccio(5,IJ,I) +c 210 R(6,JVDW+I)=R(6,JVDW+I) + AAciccio(6,IJ,I) +cc +c do k=1,6 +c do i=-1,ndfree +c a(k,i)=0.0 +c end do +c end do +c do i=1,jvdw +c j=iviol(i) +c i1=iaunit(ia1(j)) +c i2=iaunit(ia2(j)) +c do k=1,6 +c t=r(k,i) +c a(k,i1)=a(k,i1)+t +c a(k,i2)=a(k,i2)-t +c end do +c DO 232 I=1,JDT1 +c J=IFVIO(I) +c I1=IAUNIT(IDT1A(J)) +c DO 231 K=1,6 +c 231 A(K,I1)=A(K,I1)+R(K,JVDW+I) +c DO 232 IJ=1,NUFE +c JF=IFEA(IJ) +c I2=IAUNIT(JF) +cc print*, A(1,I2) +c A(1,I2)=A(1,I2)-AAciccio(1,IJ,I) +cc print*, A(1,I2) +c A(2,I2)=A(2,I2)-AAciccio(2,IJ,I) +c A(3,I2)=A(3,I2)-AAciccio(3,IJ,I) +c A(4,I2)=A(4,I2)-AAciccio(4,IJ,I) +c A(5,I2)=A(5,I2)-AAciccio(5,IJ,I) +c A(6,I2)=A(6,I2)-AAciccio(6,IJ,I) +c 232 CONTINUE + + +c fine parte nuova + + c do i=jlol+1,jvdw j=iviol(i) @@ -262,4 +339,119 @@ * (coo(3,i3)-coo(3,i2))*a(3,i)) end do end if + +c inizio parte nuova + +c +c Orientation constraint violations (Antonio's way) +c + IF (JORJ.GT.0) THEN + V=WEIORJ*NPOWER + DO I=-1,NDFREE + A(1,I)=0.0 + A(2,I)=0.0 + A(3,I)=0.0 + END DO + do iiq=1,ndtensorj + IQ=MAXTENS/2+iiq + A1ORJ=A1DIP(iq) + A2ORJ=A2DIP(iq) + CMEX=coo(1,IMET(IQ)) + CMEY=coo(2,IMET(IQ)) + CMEZ=coo(3,IMET(IQ)) + AXX=coo(1,IAX(IQ))-CMEX + AXY=coo(2,IAX(IQ))-CMEY + AXZ=coo(3,IAX(IQ))-CMEZ + AYX=coo(1,IAY(IQ))-CMEX + AYY=coo(2,IAY(IQ))-CMEY + AYZ=coo(3,IAY(IQ))-CMEZ + AZX=coo(1,IAZ(IQ))-CMEX + AZY=coo(2,IAZ(IQ))-CMEY + AZZ=coo(3,IAZ(IQ))-CMEZ +c AXX=1.0 +c AYY=1.0 +c AZZ=1.0 +c AXY=0.0 +c AXZ=0.0 +c AYX=0.0 +c AYZ=0.0 +c AZX=0.0 +c AZY=0.0 + + DO I=1,JORJ + K=IORJVIOL(I) +c +c Check it's the appropriate tensor +c + if(nuteorj(K).eq.IIQ) then +c + J=IAUNIT(IDORJ(K)) + JME=IAUNIT(IMET(IQ)) + V1=V*WORJ(K)*ORJVIOL(I)**npowr1*DLORJ(K)**3 + W1=6*A1ORJ*V1*(DORJ(1,K)*AZX+DORJ(2,K)*AZY+DORJ(3,K)*AZZ) + W2=3*A2ORJ*V1*(DORJ(1,K)*AXX+DORJ(2,K)*AXY+DORJ(3,K)*AXZ) + W3=-3*A2ORJ*V1*(DORJ(1,K)*AYX+DORJ(2,K)*AYY+DORJ(3,K)*AYZ) +c + BX=W2*AXX+W3*AYX+W1*AZX + BY=W2*AXY+W3*AYY+W1*AZY + BZ=W2*AXZ+W3*AYZ+W1*AZZ +c +c print*, A(1,J),A(2,J),A(3,J) + A(1,J)=A(1,J)-(BY*DORJ(3,K)-DORJ(2,K)*BZ) + A(2,J)=A(2,J)-(BZ*DORJ(1,K)-DORJ(3,K)*BX) + A(3,J)=A(3,J)-(BX*DORJ(2,K)-DORJ(1,K)*BY) +c print*, A(1,J),A(2,J),A(3,J) + A(1,JME)=A(1,JME)+(BY*DORJ(3,K)-DORJ(2,K)*BZ) + A(2,JME)=A(2,JME)+(BZ*DORJ(1,K)-DORJ(3,K)*BX) + A(3,JME)=A(3,JME)+(BX*DORJ(2,K)-DORJ(1,K)*BY) + + end if +c +c end of the loop on the constraints +c + END DO +c +c end of the loop on the tensors +c + end do + + DO I=NDFREE,1,-1 + J=IPREV(I) + a(1,j)=a(1,j)+a(1,i) + a(2,j)=a(2,j)+a(2,i) + a(3,j)=a(3,j)+a(3,i) + END DO + + do i=1,ndfree + i2=ida(2,i) + i3=ida(3,i) + g(i)=g(i)+dinvbl(i)*((coo(1,i3)-coo(1,i2))*a(1,i)+ + * (coo(2,i3)-coo(2,i2))*a(2,i)+ + * (coo(3,i3)-coo(3,i2))*a(3,i)) + end do + + + 260 CONTINUE + END IF + +c fine parte nuova + +C ------------------------------------------------- +C ADD PSEUDOCONTACT GRADIENT +C ------------------------------------------------- + if (dipflag) call psegrad(ndfree,g) !ATTENZIONE +C ------------------------------------------------- +C END PSEUDOCONTACT GRADIENT +C ------------------------------------------------- + +C ------------------------------------------------- +C ADD CCR CONSTRAINTS GRADIENT +C ------------------------------------------------- + if (ccrflg) call ccrgrad(ndfree,g) +C ------------------------------------------------- +C END CCR CONSTRAINTS GRADIENT +C ------------------------------------------------- + + + end diff -u -N -r cyana-1.0.5/src/cyana/kmet.f cyanaccr/src/cyana/kmet.f --- cyana-1.0.5/src/cyana/kmet.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/kmet.f 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,18 @@ +C ============================================================== +C +C KMET: Read metal constants from file +C +C +C Antonio Rosato 7 MAy 1997 +C -------------------------------------------------------------- + SUBROUTINE KMET(iunit,mode) + + include 'cyana.incl' + include 't1.incl' +c + DO 10 J=1,NUFE + read (iunit,*) KFE(J) +10 CONTINUE + RETURN + END + diff -u -N -r cyana-1.0.5/src/cyana/make.dep cyanaccr/src/cyana/make.dep --- cyana-1.0.5/src/cyana/make.dep 2003-12-16 21:44:51.000000000 +0100 +++ cyanaccr/src/cyana/make.dep 2003-12-16 21:45:41.000000000 +0100 @@ -1,4 +1,4 @@ -cyana.o: cyana.incl +cyana.o: cyana.incl pse.incl orj.incl t1.incl accel.o: cyana.incl moldyn.incl acostt.o: cyana.incl angles.o: cyana.incl @@ -69,7 +69,7 @@ putpro.o: cyana.incl ranges.o: cyana.incl ranstr.o: cyana.incl -readf.o: cyana.incl +readf.o: cyana.incl pse.incl orj.incl t1.incl rotat.o: cyana.incl grid.incl select.o: cyana.incl setdco.o: cyana.incl @@ -90,3 +90,11 @@ viosta.o: cyana.incl vtable.o: cyana.incl writef.o: cyana.incl +getdip.o: cyana.incl pse.incl +findzerocoords.o: cyana.incl pse.incl +pseudoglomsa.o: cyana.incl pse.incl +orjovw.o: orj.incl +pseovw.o: pse.incl +getorj.o: cyana.incl orj.incl +gett1.o: cyana.incl t1.incl + diff -u -N -r cyana-1.0.5/src/cyana/minim.f cyanaccr/src/cyana/minim.f --- cyana-1.0.5/src/cyana/minim.f 2003-12-16 21:44:52.000000000 +0100 +++ cyanaccr/src/cyana/minim.f 2003-12-16 21:45:41.000000000 +0100 @@ -61,8 +61,8 @@ prered=min(prered,f*0.2) n=nfcn fmin=f -c print *,'f,fmin: ',f,fmin -c print '(8F10.3)',(x(j),j=1,ndfree) +! print *,'f,fmin: ',f,fmin +! print '(8F10.3)',(x(j),j=1,ndfree) call cgmin (ndfree,x,g,f,maxitr,prered, * nflat,nfcn.gt.1,istop,wksp) if (nfcn.lt.maxit-1 .and. istop.gt.1 .and. diff -u -N -r cyana-1.0.5/src/cyana/orj.incl cyanaccr/src/cyana/orj.incl --- cyana-1.0.5/src/cyana/orj.incl 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/orj.incl 2003-12-16 21:45:41.000000000 +0100 @@ -0,0 +1,15 @@ + PARAMETER (MAXORJ=1600,maxstrorj=50) + CHARACTER NAMRESORJ*5, NAMATORJ*5, TMPORJ*79 + LOGICAL yorjviol + common /orj1/ NDTENSORJ,norj + common /orj2/ wei1,wei2,weipow + common /orj3/ WEIORJ, TORJ, JORJ + COMMON /orj4/ TOTVIOJ(MAXORJ,MAXSTRORJ),yorjviol(MAXORJ), + * IRESORJ(MAXORJ),NAMRESORJ(MAXORJ), + * NAMATORJ(MAXORJ), + * TOLORJ(MAXORJ),WORJ(MAXORJ), + * ORJ(MAXORJ), + * IDORJ(MAXORJ), + * DORJ(3,MAXORJ), + * IORJVIOL(MAXORJ),ORJVIOL(MAXORJ), + * DLORJ(MAXORJ),NUTEORJ(MAXORJ) diff -u -N -r cyana-1.0.5/src/cyana/orj2.incl cyanaccr/src/cyana/orj2.incl --- cyana-1.0.5/src/cyana/orj2.incl 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/orj2.incl 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,15 @@ + PARAMETER (MAXORJ=1600,maxstrorj=50) + CHARACTER NAMRESORJ*5, NAMATORJ*5, TMPORJ*79 + LOGICAL yorjviol + common wei1,wei2,weipow,NDTENSORJ,norj + COMMON TOTVIOJ(MAXORJ,MAXSTRORJ),yorjviol(MAXORJ), + * IRESORJ(MAXORJ),NAMRESORJ(MAXORJ), + * NAMATORJ(MAXORJ), + * TOLORJ(MAXORJ),WORJ(MAXORJ), + * ORJ(MAXORJ), + * IDORJ(MAXORJ), + * DORJ(3,MAXORJ), + * IORJVIOL(MAXORJ),ORJVIOL(MAXORJ), + * DLORJ(MAXORJ),NUTEORJ(MAXORJ), + * WEIORJ, TORJ, + * JORJ diff -u -N -r cyana-1.0.5/src/cyana/orj3.incl cyanaccr/src/cyana/orj3.incl --- cyana-1.0.5/src/cyana/orj3.incl 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/orj3.incl 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,12 @@ + PARAMETER (MAXORJ=1600,maxstrorj=50) + CHARACTER NAMRESORJ*5, NAMATORJ*5, TMPORJ*79 + LOGICAL yorjviol + dimension TOTVIOJ(MAXORJ,MAXSTRORJ),yorjviol(MAXORJ), + * IRESORJ(MAXORJ),NAMRESORJ(MAXORJ), + * NAMATORJ(MAXORJ), + * TOLORJ(MAXORJ),WORJ(MAXORJ), + * ORJ(MAXORJ), + * IDORJ(MAXORJ), + * DORJ(3,MAXORJ), + * IORJVIOL(MAXORJ),ORJVIOL(MAXORJ), + * DLORJ(MAXORJ),NUTEORJ(MAXORJ) diff -u -N -r cyana-1.0.5/src/cyana/orjovw.f cyanaccr/src/cyana/orjovw.f --- cyana-1.0.5/src/cyana/orjovw.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/orjovw.f 2003-12-16 21:45:41.000000000 +0100 @@ -0,0 +1,47 @@ +Copyright (c) 2002 Peter Guntert. All rights reserved. + subroutine orjovw(norjstr) + implicit double precision (a-h,o-z) + include 'orj.incl' + + character orjvio*(maxstrorj),avestr*3,diast*3,nustring*1, + * outstr*44 + + i=1 + do while (i.le.norj) + avestr=' ' + nustring=' ' + if (worj(i).eq.0.) nustring='N' + indxvio=0 + indxviomin=0 + vioorj=-99. + vioorjmin=99. + orjvio=' ' + + if(yorjviol(i)) then + do j=1,norjstr + ppp=totvioj(i,j) + if (ppp.ne.0.) then + orjvio(j:j)='*' + if (ppp.gt.vioorj) then + vioorj=ppp + indxvio=j + endif + if (ppp.lt.vioorjmin) then + vioorjmin=ppp + indxviomin=j + endif + else + orjvio(j:j)=' ' + endif + enddo + orjvio(indxvio:indxvio)='+' + orjvio(indxviomin:indxviomin)='-' + write(outstr,'(i3,1x,2a5,1x,f7.3,1x,f7.3,1x,a,1x,a,1x,f6.2,1x)') + * iresorj(i),namresorj(i),namatorj(i),vioorjmin,vioorj, + * avestr,nustring,orj(i) + call putlin (2,outstr//orjvio) + endif + i=i+1 + enddo + return + end diff -u -N -r cyana-1.0.5/src/cyana/pse.incl cyanaccr/src/cyana/pse.incl --- cyana-1.0.5/src/cyana/pse.incl 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/pse.incl 2003-12-16 21:45:41.000000000 +0100 @@ -0,0 +1,23 @@ + PARAMETER (MAXDIP=2500,MAXTENS=30,maxstrpse=50) + CHARACTER NAMRESDIP*5, NAMATDIP*5, AXESAVEFILE*30,pstring*50 + LOGICAL DIPFLAG,DIP2FLAG,psedia + common /pse1/ NDIP,NTENSO,NDTENSO + COMMON /pse2/ totvio(maxdip,maxstrpse) + common /pse3/ NUTE(MAXDIP) + common /pse4/ NAMRESDIP(MAXDIP),NAMATDIP(MAXDIP), + * pstring(maxdip), + * A1DIP(MAXTENS),A2DIP(MAXTENS), + * PSHIFTPSE(MAXDIP),TOLPROT(MAXDIP),WPROT(MAXDIP), + * PSHIFTOR(MAXDIP), + * PVIOL(MAXDIP),CALCTOT(MAXDIP),pstringmax(maxdip), + * asitis(maxdip),rever(maxdip),calcsing(maxdip), + * IMET(MAXTENS),IAX(MAXTENS), + * IAY(MAXTENS),IAZ(MAXTENS),IPX(MAXTENS), + * IPY(MAXTENS), + * IPZ(MAXTENS),IPCN(MAXTENS), + * IRESDIP(MAXDIP),INDXDIP(MAXDIP), + * NPROT(MAXDIP),ipstringmax(maxdip), + * nasitis(maxdip),nrever(maxdip), + * DIP2FLAG(MAXDIP), + * psedia(MAXDIP),DIPFLAG + common /pse5/ WDIP,TOLDIP,pseperc diff -u -N -r cyana-1.0.5/src/cyana/pse2.incl cyanaccr/src/cyana/pse2.incl --- cyana-1.0.5/src/cyana/pse2.incl 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/pse2.incl 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,25 @@ + PARAMETER (MAXDIP=2500,MAXTENS=30,maxstrpse=50) + CHARACTER NAMRESDIP*5, NAMATDIP*5, AXESAVEFILE*30,pstring*50 + LOGICAL DIPFLAG,DIP2FLAG,psedia + COMMON totvio(maxdip,maxstrpse) + common NAMRESDIP(MAXDIP),NAMATDIP(MAXDIP), + * pstring(maxdip), + * A1DIP(MAXTENS),A2DIP(MAXTENS), + * PSHIFTPSE(MAXDIP),TOLPROT(MAXDIP),WPROT(MAXDIP), + * PSHIFTOR(MAXDIP), + * PVIOL(MAXDIP),CALCTOT(MAXDIP),pstringmax(maxdip), + * asitis(maxdip),rever(maxdip),calcsing(maxdip), + * IMET(MAXTENS),IAX(MAXTENS), + * IAY(MAXTENS),IAZ(MAXTENS),IPX(MAXTENS), + * IPY(MAXTENS), + * IPZ(MAXTENS),IPCN(MAXTENS), + * IRESDIP(MAXDIP),INDXDIP(MAXDIP), + * NPROT(MAXDIP),ipstringmax(maxdip), + * nasitis(maxdip),nrever(maxdip), + * DIP2FLAG(MAXDIP), + * psedia(MAXDIP), + * NUTE(MAXDIP), + * DIPFLAG, + * NDIP,NTENSO,NDTENSO, + * WDIP, + * TOLDIP,pseperc diff -u -N -r cyana-1.0.5/src/cyana/pse3.incl cyanaccr/src/cyana/pse3.incl --- cyana-1.0.5/src/cyana/pse3.incl 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/pse3.incl 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,21 @@ + PARAMETER (MAXDIP=2500,MAXTENS=30,maxstrpse=50) + CHARACTER NAMRESDIP*5, NAMATDIP*5, AXESAVEFILE*30,pstring*50 + LOGICAL DIPFLAG,DIP2FLAG,psedia + dimension totvio(maxdip,maxstrpse) + dimension NAMRESDIP(MAXDIP),NAMATDIP(MAXDIP), + * pstring(maxdip), + * A1DIP(MAXTENS),A2DIP(MAXTENS), + * PSHIFTPSE(MAXDIP),TOLPROT(MAXDIP),WPROT(MAXDIP), + * PSHIFTOR(MAXDIP), + * PVIOL(MAXDIP),CALCTOT(MAXDIP),pstringmax(maxdip), + * asitis(maxdip),rever(maxdip),calcsing(maxdip), + * IMET(MAXTENS),IAX(MAXTENS), + * IAY(MAXTENS),IAZ(MAXTENS),IPX(MAXTENS), + * IPY(MAXTENS), + * IPZ(MAXTENS),IPCN(MAXTENS), + * IRESDIP(MAXDIP),INDXDIP(MAXDIP), + * NPROT(MAXDIP),ipstringmax(maxdip), + * nasitis(maxdip),nrever(maxdip), + * DIP2FLAG(MAXDIP), + * psedia(MAXDIP), + * NUTE(MAXDIP) diff -u -N -r cyana-1.0.5/src/cyana/psegrad.f cyanaccr/src/cyana/psegrad.f --- cyana-1.0.5/src/cyana/psegrad.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/psegrad.f 2003-12-16 21:45:41.000000000 +0100 @@ -0,0 +1,149 @@ +C DYANA version. Mauro A. Cremonini 06.12.96 + + + SUBROUTINE PSEGRAD (N,G) +C + implicit double precision (a-h,o-z) + INCLUDE 'cyana.incl' + INCLUDE 'pse.incl' +C + DIMENSION G(N), + * RPSE(6,MAXDIP,MAXTENS),APSE(6,-1:MAXD),JPSE(MAXDIP) +C + IGP=0 + DO IQ=1,NTENSO*NDTENSO + CMEX=coo(1,IMET(IQ)) + CMEY=coo(2,IMET(IQ)) + CMEZ=coo(3,IMET(IQ)) + AXX=coo(1,IAX(IQ))-CMEX + AXY=coo(2,IAX(IQ))-CMEY + AXZ=coo(3,IAX(IQ))-CMEZ + AYX=coo(1,IAY(IQ))-CMEX + AYY=coo(2,IAY(IQ))-CMEY + AYZ=coo(3,IAY(IQ))-CMEZ + AZX=coo(1,IAZ(IQ))-CMEX + AZY=coo(2,IAZ(IQ))-CMEY + AZZ=coo(3,IAZ(IQ))-CMEZ + I=1 +c IGP=0 + DO 90 WHILE (I.LE.NDIP) + IF (DIP2FLAG(I)) THEN +c +c Antonio. Check it's the appropriate tensor +c + if(nute(i).eq.iq) then +c +c + NPROT1=NPROT(I) + TMP1=0. + TMP2=0. + TMP3=0. + TMP4=0. + TMP5=0. + TMP6=0. + DO 85 L=1,NPROT1 + J=INDXDIP(I) + HX=coo(1,J) + HY=coo(2,J) + HZ=coo(3,J) + OHX=HX-CMEX + OHY=HY-CMEY + OHZ=HZ-CMEZ + OH2=OHX**2+OHY**2+OHZ**2 + OH=SQRT(OH2) + OH5=OH**5 + AXOH=AXX*OHX+AXY*OHY+AXZ*OHZ + AYOH=AYX*OHX+AYY*OHY+AYZ*OHZ + AZOH=AZX*OHX+AZY*OHY+AZZ*OHZ + AXOH2=AXOH**2 + AYOH2=AYOH**2 + AZOH2=AZOH**2 + QX=2*A2DIP(IQ)*AXOH/OH5 + QY=-2*A2DIP(IQ)*AYOH/OH5 + QZ=6*A1DIP(IQ)*AZOH/OH5 + QI=-(A1DIP(IQ)* (2+5*(3*AZOH2-OH2) /OH2) + + * A2DIP(IQ)* (5*(AXOH2-AYOH2)/OH2) )/OH5 + BX=QX*AXX+QY*AYX+QZ*AZX+QI*OHX + BY=QX*AXY+QY*AYY+QZ*AZY+QI*OHY + BZ=QX*AXZ+QY*AYZ+QZ*AZZ+QI*OHZ + TMP1=TMP1+(BY*HZ-BZ*HY) + TMP2=TMP2+(BZ*HX-BX*HZ) + TMP3=TMP3+(BX*HY-BY*HX) + TMP4=TMP4+BX + TMP5=TMP5+BY + TMP6=TMP6+BZ +C the reversal of sign in the above is due to the (I2-I3) direction +C of the "e(a)" unit vector (see S1-S3 below). + I=I+1 + 85 CONTINUE + IGP=IGP+1 + JPSE(IGP)=J + I1=I-1 + D=2*WDIP*WPROT(I1)*PVIOL(I1)/NPROT1 + RPSE(1,IGP,IQ)=D*TMP1 + RPSE(2,IGP,IQ)=D*TMP2 + RPSE(3,IGP,IQ)=D*TMP3 + RPSE(4,IGP,IQ)=D*TMP4 + RPSE(5,IGP,IQ)=D*TMP5 + RPSE(6,IGP,IQ)=D*TMP6 +c +c Antonio +c + else + i=i+1 + endif +c +c + ELSE + I=I+1 + ENDIF + 90 CONTINUE + ENDDO + + DO 220 K=1,6 + DO 220 I=-1,N + APSE(K,I)=0.0 + 220 CONTINUE + + DO IQ=1,NTENSO*NDTENSO + I2=IAUNIT(IMET(IQ)) + DO I=1,IGP + I1=IAUNIT(JPSE(I)) + DO K=1,6 + T=RPSE(K,I,IQ) + APSE(K,I1)=APSE(K,I1)+T + APSE(K,I2)=APSE(K,I2)-T + ENDDO + ENDDO + ENDDO + + DO 240 I=N,1,-1 + J=IPREV(I) + DO 240 K=1,6 + APSE(K,J)=APSE(K,J)+APSE(K,I) + 240 CONTINUE + + DO 260 I=1,N + I2=IDA(2,I) + I3=IDA(3,I) + C1=coo(1,I3) + C2=coo(2,I3) + C3=coo(3,I3) + S1=coo(1,I2)-C1 + S2=coo(2,I2)-C2 + S3=coo(3,I2)-C3 + + G(I)=G(I)+DINVBL(I)* ( + * S1*APSE(1,I) + + * S2*APSE(2,I) + + * S3*APSE(3,I) + + * (S2*C3-S3*C2)*APSE(4,I) + + * (S3*C1-S1*C3)*APSE(5,I) + + * (S1*C2-S2*C1)*APSE(6,I) + * ) + + + 260 CONTINUE + + RETURN + END diff -u -N -r cyana-1.0.5/src/cyana/pseovw.f cyanaccr/src/cyana/pseovw.f --- cyana-1.0.5/src/cyana/pseovw.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/pseovw.f 2003-12-16 21:45:41.000000000 +0100 @@ -0,0 +1,49 @@ +Copyright (c) 2002 Peter Guntert. All rights reserved. + subroutine pseovw(npsestr) + implicit double precision (a-h,o-z) + include 'pse.incl' + + character psevio*(maxstrpse),avestr*3,diast*3,nustring*1, + * outstr*44 + + i=1 + do while (i.le.ndip) + avestr=' ' + nustring=' ' + if (nprot(i).gt.1) avestr='AVE' + if (nprot(i).eq.2.and.psedia(i)) avestr='dia' + i=i+nprot(i)-1 + if (wprot(i).eq.0.) nustring='N' + + indxvio=0 + indxviomin=0 + viopse=-99. + viopsemin=99. + psevio=' ' + + do j=1,npsestr + ppp=totvio(i,j) + if (ppp.ne.0.) then + psevio(j:j)='*' + if (ppp.gt.viopse) then + viopse=ppp + indxvio=j + endif + if (ppp.lt.viopsemin) then + viopsemin=ppp + indxviomin=j + endif + else + psevio(j:j)=' ' + endif + enddo + psevio(indxvio:indxvio)='+' + psevio(indxviomin:indxviomin)='-' + write(outstr,'(i3,1x,2a5,1x,f7.3,1x,f7.3,1x,a,1x,a,1x,f6.2,1x)') + * iresdip(i),namresdip(i),namatdip(i),viopsemin,viopse, + * avestr,nustring,pshiftpse(i) + call putlin (2,outstr//psevio) + i=i+1 + enddo + return + end diff -u -N -r cyana-1.0.5/src/cyana/pseudoglomsa.f cyanaccr/src/cyana/pseudoglomsa.f --- cyana-1.0.5/src/cyana/pseudoglomsa.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/pseudoglomsa.f 2003-12-16 21:45:41.000000000 +0100 @@ -0,0 +1,88 @@ + subroutine pseudoglomsa (nq,npsestr) + implicit double precision (a-h,o-z) + include 'cyana.incl' + include 'pse.incl' + + character line*80,astr*3 + + dimension asmin(maxdip),remin(maxdip) + + save asmin,remin + + qn=float(npsestr) + + if (nq.eq.0) then + do i=1,ndip + asitis(i)=0. + rever(i)=0. + nasitis(i)=0. + nrever(i)=0. + asmin(i)=1.e5 + remin(i)=1.e5 + enddo + elseif (nq.eq.1) then + i=1 + npd=0 + do while (i.le.ndip) + j=indxdip(i) + if (iap(j).ne.0) then + npd=npd+1 + as=(pshiftor(i)-calcsing(i))**2+ + * (pshiftor(i+1)-calcsing(i+1))**2 + re=(pshiftor(i)-calcsing(i+1))**2+ + * (pshiftor(i+1)-calcsing(i))**2 + if (as.lt.asmin(npd)) asmin(npd)=as + if (re.lt.remin(npd)) remin(npd)=re + asitis(npd)=asitis(npd)+as + rever(npd)=rever(npd)+re + if (as.le.re) then + nasitis(npd)=nasitis(npd)+1 + else + nrever(npd)=nrever(npd)+1 + endif + i=i+1 + endif + i=i+1 + enddo + elseif (nq.eq.2) then + i=1 + npd=0 + do while (i.le.ndip) + j=indxdip(i) + if (iap(j).ne.0) then + npd=npd+1 + write (line,'(i3,1x,2a5,2(4x,f7.2,1x,f7.2,1x,i4))') + * iresdip(i),namresdip(i),namatdip(i), + * asitis(npd)/qn,asmin(npd),nasitis(npd), + * rever(npd)/qn,remin(npd),nrever(npd) + call putlin(2,line) + i=i+1 + endif + i=i+1 + enddo + elseif (nq.eq.3) then + i=1 + do while (i.le.ndip) + if (nprot(i).gt.1.and.psedia(i)) then + astr='dia' + elseif (nprot(i).gt.1) then + astr='AVE' + else + astr=' ' + endif + i=i+nprot(i)-1 + write (line,'(i3,1x,2a5,2x,f7.2,2x,f7.2,2x,a3)') + * iresdip(i),namresdip(i),namatdip(i), + * pshiftpse(i),calctot(i),astr + call putlin(2,line) + i=i+1 + enddo + endif + return + end + + + + + + diff -u -N -r cyana-1.0.5/src/cyana/pseviol.f cyanaccr/src/cyana/pseviol.f --- cyana-1.0.5/src/cyana/pseviol.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/pseviol.f 2003-12-16 21:45:41.000000000 +0100 @@ -0,0 +1,103 @@ +Copyright (c) 2002 Peter Guntert. All rights reserved. +C ----------------------------------------------------------------- +C +C PSEVIOL: calculates and stores in the array PVIOL() the +C violation of the pseudocontact shift constraints. +C It also calculates the pseudocontact target +C function (F). +C M. A. Cremonini 06.12.96 +C +C ------------------------------------------------------------------ + + function PSEVIOL() + + implicit double precision (a-h,o-z) + INCLUDE 'cyana.incl' + INCLUDE 'pse.incl' + + ZNUL=0. + + do i=1,ndip + calcsing(i)=0. + calctot(i)=0. + enddo + + fdip=0.0 + + do iq=1,ntenso*NDTENSO + +c +c ANtonio +c print*, iq,a1dip(iq),a2dip(iq) +c + + + CMEX=coo(1,IMET(iq)) + CMEY=coo(2,IMET(iq)) + CMEZ=coo(3,IMET(iq)) + + AXX=coo(1,IAX(iq))-CMEX + AXY=coo(2,IAX(iq))-CMEY + AXZ=coo(3,IAX(iq))-CMEZ + AYX=coo(1,IAY(iq))-CMEX + AYY=coo(2,IAY(iq))-CMEY + AYZ=coo(3,IAY(iq))-CMEZ + AZX=coo(1,IAZ(iq))-CMEX + AZY=coo(2,IAZ(iq))-CMEY + AZZ=coo(3,IAZ(iq))-CMEZ + + do i=1,ndip + IF(NUTE(I).EQ.IQ) THEN + J=INDXDIP(I) + HX=coo(1,J)-CMEX + HY=coo(2,J)-CMEY + HZ=coo(3,J)-CMEZ + R2=HX**2+HY**2+HZ**2 + R=SQRT(R2) + R5=R**5 + GG1=(3*(HX*AZX+HY*AZY+HZ*AZZ)**2-R2)/R5 + GG2=((HX*AXX+HY*AXY+HZ*AXZ)**2- + * (HX*AYX+HY*AYY+HZ*AYZ)**2)/R5 + calcsing(i)=calcsing(i)+ + * (A1DIP(iq)*GG1+A2DIP(iq)*GG2) + ENDIF + enddo + enddo + + i=1 + do while (i.le.ndip) + if (dip2flag(i)) then + nprot1=nprot(i) + costmult=1./float(nprot1) + calc=calcsing(i) + do j=1,nprot1-1 + i=i+1 + calc=calc+calcsing(i) + enddo + calctot(i)=calc*costmult +c +c modifica 27/6/2000 +c +c if(pshift(i).eq.0)then +c cdiff=(calctot(i)-pshift(i)) +c else +c cdiff=(calctot(i)-pshift(i))/pshift(i)/10. +c endif +cc +c fine modifica + + cdiff=calctot(i)-pshiftpse(i) + + pviol(i)=sign(max(abs(cdiff)-tolprot(i),znul),cdiff) +C The position of the violation in PVIOL() corresponds to +C the last atom whose chemical shift is averaged. + fdip=fdip+wprot(i)*pviol(i)**2 + endif + i=i+1 + enddo + + pseviol=fdip + RETURN + END + + diff -u -N -r cyana-1.0.5/src/cyana/readf.f cyanaccr/src/cyana/readf.f --- cyana-1.0.5/src/cyana/readf.f 2003-12-16 21:44:51.000000000 +0100 +++ cyanaccr/src/cyana/readf.f 2003-12-16 21:45:41.000000000 +0100 @@ -8,14 +8,20 @@ c implicit double precision (a-h,o-z) include 'cyana.incl' + include 'pse.incl' + include 'orj.incl' + include 'ccr.incl' +! include 't1.incl' c logical flag(maxd) character param(nparam)*(*),type*20,typ*20,filnam*80, * filter*200,format*20 + character metal*5 c ----------------------------------------------- general parameters call params (param,nparam, - * 'type=lib|seq|ang|cor|pdb|upl|lol|aco|cco|ori|'// - * 'peaks|prot|bmrb|xplor file=@f.$type ** '// + * 'type=lib|seq|ang|cor|pdb|upl|lol|aco|cco|ori|pse|'// + * 'orj|peaks|prot|bmrb|xplor|cos|T1upl|ccr|cpr|met|'// + * 'T1lol|kme file=@f.$type ** '// * 'unknown=error|warning|skip=error') if (haverr()) return call getpar ('type',type) @@ -355,6 +361,125 @@ end do call putlin (2,'Chemical shift list '//strq(filnam)//' read, '// * plural(n,'chemical shift')//'.') +c ------------------------------------------------ T1 constraints + else if (type.eq.'T1upl'.or.type.eq.'T1lol') then + call params (param,nparam,'metal=*=FE append') + if (haverr()) return + call getpar('metal',metal) + if (.not.option('append')) ndt1=0 + n=ndt1 +! call gett1 (1,iif(type.eq.'T1upl',1,-1),mode) +! if (haverr()) go to 900 +! call putlin (2,'T1 constraint file '//strq(filnam)// +! * ' read, '//plural(ndt1-n,'constraint')//'.') + call findfe(metal) +c ---------------------------------------- metal constants + else if (type.eq.'kme') then + call params (param,nparam,' ') + if (haverr()) return + call kmet(1,mode) + if (haverr()) go to 900 + call putlin (2,'Metal constant file '//strq(filnam)// + * ' successfully read.') +c --------------------------------------------------- ccr parameters + else if (type.eq.'cpr') then + call params (param,nparam,' ') + if (haverr()) return + call getcpr (1,mode) + if (haverr()) go to 900 + call putlin (2,'Ccr parameters file '//strq(filnam)// + * ' succesfully read.') +c --------------------------------------------------- ccr metal site + else if (type.eq.'met') then + call params (param,nparam,' ') + if (haverr()) return + call getmet (1,mode) + if (haverr()) go to 900 + call putlin (2,'Ccr metal site file '//strq(filnam)// + * ' succesfully read.') +c -------------------------------------------------- ccr constraints + else if (type.eq.'ccr') then + call params (param,nparam,'append') + if (haverr()) return + call getccr (1,mode) + if (haverr()) go to 900 + nboh=0 + do l=1,nccrmt + nboh=nboh+nccr(l) + end do + call putlin (2,'Ccr constraints file '//strq(filnam)// + * ' read, '//plural(nboh,'constraint')//'.') + + +C ---------------------------------------------------------------- +C PSEUDOCONTACT INPUT +C ---------------------------------------------------------------- +c ------------------------------------------------ pseudo + else if (type.eq.'pse') then + call params (param,nparam,'tolerance=@r=0.4 '// + * 'weight=@r=1.0 tensors=@i=1 perc=@r=0.1 dtens=@i=1 append') + if (haverr()) return + toldip=rparam('tolerance') + wdip=rparam('weight') + ntenso=iparam('tensors') + pseperc=rparam('perc') + NDTENSO=iparam('dtens') + if (NDTENSO.ne.1.and.ntenso.ne.1) then + write(6,*) 'OPTION NOT YET IMPLEMENTED' + stop + end if + if (NDTENSO*ntenso.gt.maxtens/2) then + CALL ERRMSG('Too many tensors!') + stop + endif + if (.not.option('append')) ndip=0 + n=ndip + call getdip(1,mode) + close(1) + if (haverr()) go to 900 + call putlin (2,'Pseudo contact shifts constraint '// + * 'file '//strq(filnam)// + * ' read, '//plural(ndip-n,'constraint')//'.') +c --------------------------------------- direction cosines + else if (type.eq.'cos') then + call params (param,nparam,' ') + if (haverr()) return + call findzerocoords(1,mode) + if (haverr()) go to 900 + call putlin (2,'Cosine file '//strq(filnam)// + * ' succesfully read.') +C ------------------------------------------------ +C END PSEUDOCONTACT INPUT +C ------------------------------------------------ +C +C Orientation constraints (Antonio's style) +C +C + else if (type.eq.'orj') then + call params (param,nparam,'tolerance=@r=0.1 + * weight=@r=1.0 wei1=@r=1.0 wei2=@r=1.0 + * weipow=@r=1.0 dtens=@i=1 append') + if (haverr()) return + torj=rparam('tolerance') + wei1=rparam('wei1') + wei2=rparam('wei2') + weipow=rparam('weipow') + weiorj=wei2 + ndtensorj=iparam('dtens') + if (.not.option('append')) norj=0 + n=norj + call getorj(1,mode) + close(1) + if (haverr()) go to 900 + call putlin (2,'DeltaJ constraint '// + * 'file '//strq(filnam)// + * ' read, '//plural(norj-n,'constraint')//'.') +C----------------------------------------------------------------- +c END INPUT +c + end if 900 close (1) end + + diff -u -N -r cyana-1.0.5/src/cyana/t1.incl cyanaccr/src/cyana/t1.incl --- cyana-1.0.5/src/cyana/t1.incl 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/t1.incl 2003-12-16 21:45:41.000000000 +0100 @@ -0,0 +1,7 @@ + parameter (maxdt1=2000,maxfe=20,mafevi=2000) + real KFE + common D2FE(maxfe,mafevi),IFVIO(mafevi),D6FE(mafevi), + * VIOFE(mafevi),FEFLAG(mafevi) + common idt1a(maxdt1),dt1(maxdt1),weidt1(maxdt1), + * ndt1,jdt1 + common IFEA(maxfe),NRFE(maxfe),KFE(maxfe),NUFE diff -u -N -r cyana-1.0.5/src/cyana/t2.incl cyanaccr/src/cyana/t2.incl --- cyana-1.0.5/src/cyana/t2.incl 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/t2.incl 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,7 @@ + parameter (maxdt1=2000,maxfe=20,mafevi=2000) + real KFE + common D2FE(maxfe,mafevi),IFVIO(mafevi),D6FE(mafevi), + * VIOFE(mafevi),FEFLAG(mafevi) + common idt1a(maxdt1),dt1(maxdt1),weidt1(maxdt1), + * ndt1,jdt1 + common IFEA(maxfe),NRFE(maxfe),KFE(maxfe),NUFE diff -u -N -r cyana-1.0.5/src/cyana/t3.incl cyanaccr/src/cyana/t3.incl --- cyana-1.0.5/src/cyana/t3.incl 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/t3.incl 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,6 @@ + parameter (maxdt1=2000,maxfe=20,mafevi=2000) + real KFE + dimension D2FE(maxfe,mafevi),IFVIO(mafevi),D6FE(mafevi), + * VIOFE(mafevi),FEFLAG(mafevi) + dimension idt1a(maxdt1),dt1(maxdt1),weidt1(maxdt1) + dimension IFEA(maxfe),NRFE(maxfe),KFE(maxfe) diff -u -N -r cyana-1.0.5/src/cyana/violat.F cyanaccr/src/cyana/violat.F --- cyana-1.0.5/src/cyana/violat.F 2003-12-16 21:44:52.000000000 +0100 +++ cyanaccr/src/cyana/violat.F 2003-12-16 21:45:41.000000000 +0100 @@ -10,6 +10,9 @@ c implicit double precision (a-h,o-z) include 'cyana.incl' + include 'pse.incl' + include 'orj.incl' +! include 't1.incl' c character*14 str1,str2,str3 c #IF cray nec THEN @@ -257,4 +260,77 @@ end if end do end if +c +c Orientation constraint violations (Antonio's way) +c +c +c JORJ number of violated constraints +c DORJ(N,I) (N=1,2,3) is the NH versor +c IORJVIOL() index of the violated constraint +c ORJVIOL() violation value +c +c + JORJ=0 + IF(WEIORJ.GT.0.0) THEN +c +c Go for multiple tensors +c + + do iq=1,NDTENSORJ + iiq=iq+MAXTENS/2 + A1ORJ=A1DIP(iiq) + A2ORJ=A2DIP(iiq) +c +c ANtonio +c + CMEX=coo(1,IMET(iiq)) + CMEY=coo(2,IMET(iiq)) + CMEZ=coo(3,IMET(iiq)) + + AXX=coo(1,IAX(iiq))-CMEX + AXY=coo(2,IAX(iiq))-CMEY + AXZ=coo(3,IAX(iiq))-CMEZ + AYX=coo(1,IAY(iiq))-CMEX + AYY=coo(2,IAY(iiq))-CMEY + AYZ=coo(3,IAY(iiq))-CMEZ + AZX=coo(1,IAZ(iiq))-CMEX + AZY=coo(2,IAZ(iiq))-CMEY + AZZ=coo(3,IAZ(iiq))-CMEZ + DO I =1,NORJ +c +c check we're dealing with the right tensor +c + IF(NUTEORJ(I).eq.IQ) THEN + J=IDORJ(I) + K=IBOND(1,J) + DORJ(1,I)=COO(1,J)-COO(1,K) + DORJ(2,I)=COO(2,J)-COO(2,K) + DORJ(3,I)=COO(3,J)-COO(3,K) + T=1.0/SQRT(DORJ(1,I)**2+DORJ(2,I)**2+DORJ(3,I)**2) + DLORJ(I)=T + DORJ(1,I)=DORJ(1,I)*T + DORJ(2,I)=DORJ(2,I)*T + DORJ(3,I)=DORJ(3,I)*T +c +c +c + D=A1ORJ*(3.0*(DORJ(1,I)*AZX+DORJ(2,I)*AZY+DORJ(3,I)*AZZ)**2-1) + & +1.5*A2ORJ*((DORJ(1,I)*AXX+DORJ(2,I)*AXY+DORJ(3,I)*AXZ)**2- + & (DORJ(1,I)*AYX+DORJ(2,I)*AYY+DORJ(3,I)*AYZ)**2) + D=D*T**3-ORJ(I) + AD=sign(MAX(0.0,ABS(D)-TOLORJ(I)),D) + IF(AD.NE.0.0) THEN + JORJ=JORJ+1 + IORJVIOL(JORJ)=I + ORJVIOL(JORJ)=AD + END IF + END IF + END DO +c +c End multiple tensors +c + end do +c + END IF + end diff -u -N -r cyana-1.0.5/src/cyana/violt1.f cyanaccr/src/cyana/violt1.f --- cyana-1.0.5/src/cyana/violt1.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/cyana/violt1.f 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,44 @@ +c + subroutine violt1 +c + implicit double precision (a-h,o-z) + include 'cyana.incl' + include 't1.incl' +c + JDT1=0 + DO 230 I=1,NDT1 + D6FE(I)=0. + DO 240 J=1,NUFE + JF=IFEA(J) + I1=IDT1A(I) + D2=(Coo(1,I1)-Coo(1,JF))**2+(Coo(2,I1)-Coo(2,JF))**2 + * +(Coo(3,I1)-Coo(3,JF))**2 + D2FE(J,I)=D2 + D6FE(I)=D6FE(I)+KFE(J)/(D2**3.) +240 CONTINUE + IF (DT1(I).GT.0.0) THEN + IF (D6FE(I)**(-1./6.).GT.DT1(I)) THEN + JDT1=JDT1+1 + IF(modetf.eq.2) then + VIOFE(JDT1)=(D6FE(I)**(-1./6.)-DT1(I)) + elseif (modetf.eq.1) then + VIOFE(JDT1)=(D6FE(I)**(-1./3.)-DT1(I)**2.)/ + * (2.*DT1(I)) + end if + IFVIO(JDT1)=I + END IF + ELSE + IF (D6FE(I)**(-1./6.).LT.ABS(DT1(I))) THEN + JDT1=JDT1+1 + IF(modetf.eq.2) then + VIOFE(JDT1)=(D6FE(I)**(-1./6.)+DT1(I)) + elseif (modetf.eq.1) then + VIOFE(JDT1)=(D6FE(I)**(-1./3.)-DT1(I)**2.)/ + * (2.*ABS(DT1(I))) + end if + IFVIO(JDT1)=I + END IF + END IF +230 CONTINUE + RETURN + END Files cyana-1.0.5/src/inclan/array.o and cyanaccr/src/inclan/array.o differ Files cyana-1.0.5/src/inclan/cmdali.o and cyanaccr/src/inclan/cmdali.o differ diff -u -N -r cyana-1.0.5/src/inclan/cmddo.f cyanaccr/src/inclan/cmddo.f --- cyana-1.0.5/src/inclan/cmddo.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/inclan/cmddo.f 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,243 @@ +c Automatically generated from cmddo.F. +c ****** DO NOT EDIT! ****** +Copyright (c) 2002 Peter Guntert. All rights reserved. +c ================================================================== +c CMDDO: Built-in command "do". +c +c Peter Guntert, 12-4-1996 +c ------------------------------------------------------------------ + subroutine cmddo (param,nparam,lp,nloop,mloop,iploop,nif,mif,ipid, + * lnr,yes) +c + implicit double precision (a-h,o-z) + include 'var.incl' +c + dimension lp(*),lnr(minuni:maxuni) + logical yes,illexp + character*(*) param(*),str*10,strq*5 + external strq +c + parameter (maxlop=10) + logical wait + character*(maxid) lopvar + common /lopdat/loopnr(maxlop),lopcnt(maxlop),lopend(maxlop), + * lopinc(maxlop),lopnif(maxlop),lopmif(maxlop), + * iproc,wait + * /lopch/ lopvar(maxlop) +c + wait=.true. + np=nparam + do i=np,4,-1 + if (param(i)(1:lp(i)).eq.'parallel' .and. iploop.le.0) then +c if (iploop.gt.0) then +c call errmsg ('Nested parallel loops.') +c end if + nproc=1 + k=ivar('nproc',var,nvar) + if (k.gt.0) then + nproc=ieva(vardef(k),illexp) + if (illexp .or. nproc.lt.1) then + call errmsg ('Illegal number of processors.') + return + end if + end if + iploop=nloop+1 + nparam=nparam-1 + else if (param(i)(1:lp(i)).eq.'continue') then + wait=.false. + nparam=nparam-1 + end if + end do + if (iunit.le.minuni) then + call errmsg ('Loops are only allowed in macros.') + else if (nloop.ge.maxlop) then + call errmsg ('Too many nested loops.') + else if (nparam.ne.0 .and. nparam.ne.3 .and. nparam.ne.4) then + call errmsg ('Illegal number of parameters.') + else + loopnr(nloop+1)=lnr(iunit) + lopnif(nloop+1)=nif + lopmif(nloop+1)=mif +c --------------------------------------------- unconditional loop + if (nparam.eq.0) then + nloop=nloop+1 + lopcnt(nloop)=0 + lopend(nloop)=1 + lopinc(nloop)=0 +c ------------------------------------------- loop with loop count + else + n1=nloop+1 + lopvar(n1)=param(1)(1:lp(1)) + lopinc(n1)=1 + do k=2,nparam + l=ieva(param(k)(1:lp(k)),illexp) + if (illexp .or. (k.eq.4 .and. l.eq.0)) then + call errmsg ('Illegal expression '// + * strq(param(k)(1:lp(k)))//'.') + return + else if (k.eq.2) then + lopcnt(n1)=l + else if (k.eq.3) then + lopend(n1)=l + else if (k.eq.4) then + lopinc(n1)=l + end if + end do + call intstr (lopcnt(n1),str(1:10)) + call setvar (lopvar(n1),str(1:10),0) + lopend(n1)=(lopend(n1)-lopcnt(n1)+lopinc(n1))/lopinc(n1) + if (iploop.eq.n1 .and. + * (lopend(n1).lt.2 .or. nproc.lt.2)) iploop=0 +c --------------------------------------------- loop is executed + if (lopend(n1).gt.0) then + nloop=nloop+1 + if (iploop.eq.nloop) then + iret=iwait(istat) + iproc=0 + l=lopend(nloop) + if (wait) then + l=l-1 + else + call uflush (0) + ipid=ifork() + if (ipid.lt.0) then + call errmsg ('Cannot start subprocess.') + return + else if (ipid.gt.0) then + lopcnt(nloop)=lopcnt(nloop)+l*lopinc(nloop) + lopend(nloop)=0 + call intstr (lopcnt(nloop),str(1:10)) + call setvar (lopvar(nloop),str(1:10),0) + nloop=nloop-1 + iploop=0 + mloop=1 + yes=.true. + return + end if + end if + do it=1,l + call uflush (0) + ipid=ifork() + yes=ipid.eq.0 + if (yes) return +c print *,'ITERATION: ',it,l,iproc,nproc,ipid,igtpid() +c print *,'g77fork.o: ',ipid + if (ipid.lt.0) then + call errmsg ('Cannot start subprocess.') + return + end if + lopcnt(nloop)=lopcnt(nloop)+lopinc(nloop) + lopend(nloop)=lopend(nloop)-1 + call intstr (lopcnt(nloop),str(1:10)) + call setvar (lopvar(nloop),str(1:10),0) + iproc=iproc+1 +c if (it.eq.nproc .and. .not.wait) iproc=iproc-1 + if (iproc.ge.nproc) then +c print *,'WAITING (do)',it,iproc + iret=iwait(istat) +c print *,'CHILD FINISHED (do): ',iret + iproc=iproc-1 + end if + end do + if (.not.wait) call uexit (0) + end if +c ---------- loop is not executed, search corresponding "end do" + else + mloop=1 + end if + end if + end if + end +c ================================================================== +c CMDEDO: Built-in command "end do". +c +c Peter Guntert, 12-4-1996 +c ------------------------------------------------------------------ + subroutine cmdedo (nloop,mloop,iploop,ipid,lnr,loaded) +c + implicit double precision (a-h,o-z) + include 'var.incl' +c + dimension lnr(minuni:maxuni) + logical loaded(minuni+1:maxuni) + character str*10,strq*5 + external strq +c + parameter (maxlop=10) + logical wait + character*(maxid) lopvar + common /lopdat/loopnr(maxlop),lopcnt(maxlop),lopend(maxlop), + * lopinc(maxlop),lopnif(maxlop),lopmif(maxlop), + * iproc,wait + * /lopch/ lopvar(maxlop) +c + if (nloop.le.0 .and. mloop.le.0) then + call errmsg ('"end do" out of place.') + else if (mloop.gt.0) then + mloop=mloop-1 + else + if (iploop.eq.nloop .and. ipid.eq.0) call uexit (0) + if (lopinc(nloop).ne.0) then + lopcnt(nloop)=lopcnt(nloop)+lopinc(nloop) + lopend(nloop)=lopend(nloop)-1 + call intstr (lopcnt(nloop),str(1:10)) + call setvar (lopvar(nloop),str(1:10),0) + end if +c --------------------------------------- loop is not yet finished + if (lopend(nloop).gt.0) then + if (.not.loaded(iunit)) then + rewind (iunit) + do k=1,loopnr(nloop) + read (iunit,'()') + end do + end if + lnr(iunit)=loopnr(nloop) +c ----------------------------------------------- loop is finished + else + if (iploop.eq.nloop) then + if (wait) then + do k=1,iproc +c print *,'WAITING (end do)' + iret=iwait(istat) +c print *,'CHILD FINISHED (end do): ',iret + end do + end if + iploop=0 + end if + nloop=nloop-1 + end if + end if + end +c ================================================================== +c CMDBRK: Built-in command "break". +c +c Peter Guntert, 12-4-1996 +c ------------------------------------------------------------------ + subroutine cmdbrk (nparam,nloop,mloop,iploop,nif,mif,ipid) +c + implicit double precision (a-h,o-z) + parameter (maxid=32,maxlop=10) + logical wait + character*(maxid) lopvar + common /lopdat/loopnr(maxlop),lopcnt(maxlop),lopend(maxlop), + * lopinc(maxlop),lopnif(maxlop),lopmif(maxlop), + * iproc,wait + * /lopch/ lopvar(maxlop) +c + if (nparam.ne.0) then + call errmsg ('"break" must not have parameters.') + else if (nloop.le.0) then + call errmsg ('"break" can only stand within a loop.') + else if (nloop.eq.iploop) then + call errmsg ('"break" is not allowed in a parallel loop.') + else + nif=lopnif(nloop) + mif=lopmif(nloop) +c if (iploop.eq.nloop) then +c if (ipid.eq.0) call uexit (0) +c iploop=0 +c end if + nloop=nloop-1 + mloop=1 + end if + end Files cyana-1.0.5/src/inclan/cmddo.o and cyanaccr/src/inclan/cmddo.o differ Files cyana-1.0.5/src/inclan/cmdhlp.o and cyanaccr/src/inclan/cmdhlp.o differ Files cyana-1.0.5/src/inclan/cmdif.o and cyanaccr/src/inclan/cmdif.o differ Files cyana-1.0.5/src/inclan/cmdlic.o and cyanaccr/src/inclan/cmdlic.o differ Files cyana-1.0.5/src/inclan/cmdplo.o and cyanaccr/src/inclan/cmdplo.o differ Files cyana-1.0.5/src/inclan/cmdpri.o and cyanaccr/src/inclan/cmdpri.o differ Files cyana-1.0.5/src/inclan/cmdrem.o and cyanaccr/src/inclan/cmdrem.o differ Files cyana-1.0.5/src/inclan/cmdrln.o and cyanaccr/src/inclan/cmdrln.o differ Files cyana-1.0.5/src/inclan/cmdset.o and cyanaccr/src/inclan/cmdset.o differ Files cyana-1.0.5/src/inclan/cmdslp.o and cyanaccr/src/inclan/cmdslp.o differ Files cyana-1.0.5/src/inclan/cmdsub.o and cyanaccr/src/inclan/cmdsub.o differ Files cyana-1.0.5/src/inclan/cmdsyn.o and cyanaccr/src/inclan/cmdsyn.o differ Files cyana-1.0.5/src/inclan/cmdsys.o and cyanaccr/src/inclan/cmdsys.o differ Files cyana-1.0.5/src/inclan/cmdtyp.o and cyanaccr/src/inclan/cmdtyp.o differ Files cyana-1.0.5/src/inclan/doecho.o and cyanaccr/src/inclan/doecho.o differ Files cyana-1.0.5/src/inclan/eva.o and cyanaccr/src/inclan/eva.o differ Files cyana-1.0.5/src/inclan/fmtstr.o and cyanaccr/src/inclan/fmtstr.o differ Files cyana-1.0.5/src/inclan/g77fork.o and cyanaccr/src/inclan/g77fork.o differ Files cyana-1.0.5/src/inclan/getgrf.o and cyanaccr/src/inclan/getgrf.o differ diff -u -N -r cyana-1.0.5/src/inclan/getlin.f cyanaccr/src/inclan/getlin.f --- cyana-1.0.5/src/inclan/getlin.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/inclan/getlin.f 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,30 @@ +c Automatically generated from getlin.F. +c ****** DO NOT EDIT! ****** +c ================================================================== + subroutine getlin (line) +c + implicit double precision (a-h,o-z) + include 'inclan.incl' +c + character*(*) line + logical hadint + external handlr +c + logical erflag,intrpt + common /errdat/erflag,intrpt +c + hadint=.false. + 10 if (prompt.ne.' ' .and. iploop.ne.0 .or. icrank.eq.0) + * print '(A,$)',prompt(1:lenstr(prompt)+1) + read (*,'(A)',iostat=ios) line + if (ios.ne.0 .or. intrpt) then + if (intrpt) then + print '(A)',' ignored' + intrpt=.false. + hadint=.true. + go to 10 + end if + call fatmsg ('Cannot read line from standard input.') + end if + if (hadint) call usignl (2,handlr) + end Files cyana-1.0.5/src/inclan/getlin.o and cyanaccr/src/inclan/getlin.o differ Files cyana-1.0.5/src/inclan/getval.o and cyanaccr/src/inclan/getval.o differ Files cyana-1.0.5/src/inclan/gfit.o and cyanaccr/src/inclan/gfit.o differ Files cyana-1.0.5/src/inclan/gline.o and cyanaccr/src/inclan/gline.o differ Files cyana-1.0.5/src/inclan/graf.o and cyanaccr/src/inclan/graf.o differ Files cyana-1.0.5/src/inclan/gtext.o and cyanaccr/src/inclan/gtext.o differ Files cyana-1.0.5/src/inclan/gutil.o and cyanaccr/src/inclan/gutil.o differ Files cyana-1.0.5/src/inclan/impexp.o and cyanaccr/src/inclan/impexp.o differ diff -u -N -r cyana-1.0.5/src/inclan/inclan.F cyanaccr/src/inclan/inclan.F --- cyana-1.0.5/src/inclan/inclan.F 2003-12-16 21:44:52.000000000 +0100 +++ cyanaccr/src/inclan/inclan.F 2003-12-16 21:45:42.000000000 +0100 @@ -140,7 +140,11 @@ * call fatmsg ('CPU time limit exceeded.') c ----------------------------------------------------- command loop 10 line=' ' +! print*,'Valore di mcmd:',mcmd +! print*,'Valore di havlic:',havlic +! havlic=.true. if (mcmd.gt.3 .and. .not.havlic) call fatmsg ('No license.') +! print*,'Ho passato il punto.' line=' ' if (intrpt) call errmsg ('Interrupt.') call usignl (2,handlr) @@ -207,6 +211,9 @@ loadin=.false. call errmsg ('Missing "end".') else if (nif.ne.nifbeg(iunit) .or. mif.gt.0) then +! print*,'Valore di nif:',nif +! print*,'Valore di nifbeg:',nifbeg(iunit) +! print*,'Valore di mif:',mif call errmsg ('Missing "end if".') else if (nloop.ne.lopbeg(iunit) .or. mloop.gt.0) then call errmsg ('Missing "end do".') Files cyana-1.0.5/src/inclan/inclan.a and cyanaccr/src/inclan/inclan.a differ diff -u -N -r cyana-1.0.5/src/inclan/inclan.f cyanaccr/src/inclan/inclan.f --- cyana-1.0.5/src/inclan/inclan.f 2003-12-16 21:44:52.000000000 +0100 +++ cyanaccr/src/inclan/inclan.f 2003-12-16 21:45:42.000000000 +0100 @@ -125,7 +125,11 @@ * call fatmsg ('CPU time limit exceeded.') c ----------------------------------------------------- command loop 10 line=' ' +! print*,'Valore di mcmd:',mcmd +! print*,'Valore di havlic:',havlic +! havlic=.true. if (mcmd.gt.3 .and. .not.havlic) call fatmsg ('No license.') +! print*,'Ho passato il punto.' line=' ' if (intrpt) call errmsg ('Interrupt.') call usignl (2,handlr) @@ -192,6 +196,9 @@ loadin=.false. call errmsg ('Missing "end".') else if (nif.ne.nifbeg(iunit) .or. mif.gt.0) then +! print*,'Valore di nif:',nif +! print*,'Valore di nifbeg:',nifbeg(iunit) +! print*,'Valore di mif:',mif call errmsg ('Missing "end if".') else if (nloop.ne.lopbeg(iunit) .or. mloop.gt.0) then call errmsg ('Missing "end do".') Files cyana-1.0.5/src/inclan/inclan.o and cyanaccr/src/inclan/inclan.o differ Files cyana-1.0.5/src/inclan/intrin.o and cyanaccr/src/inclan/intrin.o differ diff -u -N -r cyana-1.0.5/src/inclan/iutil.f cyanaccr/src/inclan/iutil.f --- cyana-1.0.5/src/inclan/iutil.f 2003-12-16 21:44:52.000000000 +0100 +++ cyanaccr/src/inclan/iutil.f 2003-12-16 21:45:42.000000000 +0100 @@ -145,7 +145,6 @@ character*(*) s,str*21,fmt*8 c write (str,'(1PE20.6)') r -c print *,'Mio output r=',r,' s= ',s, 'ndigit = ', ndigit, ' str = ',str read (str(18:20),'(I3)') nexp m=max(1,ndigit-nexp-1) if (m+3.le.ndigit+6 .and. nexp.lt.10) then Files cyana-1.0.5/src/inclan/iutil.o and cyanaccr/src/inclan/iutil.o differ Files cyana-1.0.5/src/inclan/loadln.o and cyanaccr/src/inclan/loadln.o differ Files cyana-1.0.5/src/inclan/macbeg.o and cyanaccr/src/inclan/macbeg.o differ Files cyana-1.0.5/src/inclan/macend.o and cyanaccr/src/inclan/macend.o differ Files cyana-1.0.5/src/inclan/meva.o and cyanaccr/src/inclan/meva.o differ Files cyana-1.0.5/src/inclan/params.o and cyanaccr/src/inclan/params.o differ Files cyana-1.0.5/src/inclan/putlin.o and cyanaccr/src/inclan/putlin.o differ Files cyana-1.0.5/src/inclan/recall.o and cyanaccr/src/inclan/recall.o differ Files cyana-1.0.5/src/inclan/redir.o and cyanaccr/src/inclan/redir.o differ Files cyana-1.0.5/src/inclan/repvar.o and cyanaccr/src/inclan/repvar.o differ Files cyana-1.0.5/src/inclan/result.o and cyanaccr/src/inclan/result.o differ Files cyana-1.0.5/src/inclan/setvar.o and cyanaccr/src/inclan/setvar.o differ Files cyana-1.0.5/src/inclan/svdcmp.o and cyanaccr/src/inclan/svdcmp.o differ diff -u -N -r cyana-1.0.5/src/inclan/unix.f cyanaccr/src/inclan/unix.f --- cyana-1.0.5/src/inclan/unix.f 1970-01-01 01:00:00.000000000 +0100 +++ cyanaccr/src/inclan/unix.f 2003-12-16 21:45:42.000000000 +0100 @@ -0,0 +1,149 @@ +c Automatically generated from unix.F. +c ****** DO NOT EDIT! ****** +Copyright (c) 2002 Peter Guntert. All rights reserved. +c ================================================================== +c UNIX: Interface to the Unix operating system. +c +c Peter Guntert, 6-11-1995 +c ================================================================== + function ifork() + implicit double precision (a-h,o-z) + integer fork,getpid + external fork,getpid + ifork=fork() +c print *,'ifork=',ifork,getpid() + end +c ================================================================== + subroutine uflush (iunit) + implicit double precision (a-h,o-z) + integer*4 iu + iu=iunit + call flush (iu) + end +c ================================================================== + function iwait(istat) + implicit double precision (a-h,o-z) + integer wait + external wait + iwait=wait(istat) + end +c ================================================================== + subroutine usleep (isec) + implicit double precision (a-h,o-z) + call sleep (isec) + end +c ================================================================== + subroutine uexit (iexit) + implicit double precision (a-h,o-z) + call exit (iexit) + end +c ================================================================== + function isystm(cmd) + implicit double precision (a-h,o-z) + character*(*) cmd + integer system + external system + isystm=system(cmd) + end +c ================================================================== + function igtpid() + implicit double precision (a-h,o-z) + integer getpid + external getpid + igtpid=getpid() + end +c ================================================================== + subroutine ugtenv (ename,evalue) + implicit double precision (a-h,o-z) + character*(*) ename,evalue + call getenv (ename,evalue) + end +c ================================================================== + function timnow() + implicit double precision (a-h,o-z) + real*4 etime + external etime + dimension tarray(2) + save timbeg + data timbeg/-1.0/ + gettim()=etime(tarray) + if (timbeg.lt.0.0) timbeg=gettim() + timnow=gettim()-timbeg +c print *,'timnow = ',timnow + end +c ================================================================== + function iwall() + implicit double precision (a-h,o-z) + integer*4 time + external time + character*7 plural + external plural + save iwbeg + data iwbeg/-1/ + igttim()=time() + if (iwbeg.lt.0) then + iwbeg=igttim() +c iexpir=865081220 (31-05-97) + iexpir=0 + if (iexpir.gt.0) then + if (iwbeg.gt.iexpir) call fatmsg ('License expired.') + call wrnmsg ('License expires in '// + * plural((iexpir-iwbeg)/(24*3600),'day')//'.') + end if + end if + iwall=igttim()-iwbeg +c print *,'iwall = ',iwall,iwbeg,idat,itim + end +c ================================================================== + subroutine uxtime (s) + implicit double precision (a-h,o-z) + character*(*) s + integer*4 time,it(9) + external time + call ltime (time(),it) + write (s,'(I2,'':'',I2.2,'':'',I2.2)') it(3),it(2),it(1) + end +c ================================================================== + subroutine uxdate (s) + implicit double precision (a-h,o-z) + character*(*) s + integer*4 time,it(9) + external time + call ltime (time(),it) + j=it(6) + if (j.lt.50) then + j=j+2000 + else if (j.lt.1000) then + j=j+1900 + end if + write (s,'(I2.2,''-'',I2.2,''-'',I4)') + * it(4),it(5)+1,j + end +c ================================================================== + subroutine usignl (isignl,handlr) + implicit double precision (a-h,o-z) + logical erflag,intrpt + common /errdat/erflag,intrpt +c turned off!!! +c external handlr +c integer signal +c external signal +c iret=signal(isignl,handlr,-1) + intrpt=.false. + end +c ================================================================== + function istamp(filnam) + implicit double precision (a-h,o-z) + character*(*) filnam + integer*4 stat,istat(50) + external stat +c print *,'BEFORE "',filnam,'"' + iret=stat(filnam,istat) +c print *,'AFTER' +c print '(I3,I20)',(i,istat(i),i=1,50) + if (iret.eq.0) then + istamp=istat(10) + else + istamp=-1 + end if + end Files cyana-1.0.5/src/inclan/unix.o and cyanaccr/src/inclan/unix.o differ Files cyana-1.0.5/src/inclan/update.o and cyanaccr/src/inclan/update.o differ Files cyana-1.0.5/src/inclan/util.o and cyanaccr/src/inclan/util.o differ