From 05283f438be84bc574c0d6aad77f39de1303d679 Mon Sep 17 00:00:00 2001 From: Bartlomiej Zaborowski Date: Sat, 17 Nov 2012 11:40:38 +0100 Subject: [PATCH] The same modifications like in @matrix, but there are problem with that server to push changes --- source/unres/src_CSA_DiL/gen_rand_conf.F | 62 +++++++++++++++++++----------- source/unres/src_CSA_DiL/together.F | 2 + 2 files changed, 41 insertions(+), 23 deletions(-) diff --git a/source/unres/src_CSA_DiL/gen_rand_conf.F b/source/unres/src_CSA_DiL/gen_rand_conf.F index 78d4cca..f212780 100644 --- a/source/unres/src_CSA_DiL/gen_rand_conf.F +++ b/source/unres/src_CSA_DiL/gen_rand_conf.F @@ -12,14 +12,18 @@ C Generate random conformation or chain cut and regrowth. include 'COMMON.CONTROL' logical overlap,back,fail cd print *,' CG Processor',me,' maxgen=',maxgen +c write(iout,*) "czy kurwa wogole wchodze" maxsi=100 cd write (iout,*) 'Gen_Rand_conf: nstart=',nstart if (nstart.lt.5) then it1=iabs(itype(2)) phi(4)=gen_phi(4,iabs(itype(2)),abs(itype(3))) -c write(iout,*)'phi(4)=',rad2deg*phi(4) - if (nstart.lt.3) theta(3)=gen_theta(itype(2),pi,phi(4)) -c write(iout,*)'theta(3)=',rad2deg*theta(3) +c write(iout,*)'phi(4)=',rad2deg*phi(4) + ichir1=isign(1,itype(1)) + ichir2=isign(1,itype(3)) + if (nstart.lt.3) theta(3)=gen_theta(itype(2),ichir1,ichir2, + & pi,phi(4)) + write(iout,*)'theta(3)=',rad2deg*theta(3) if (it1.ne.10) then nsi=0 fail=.true. @@ -38,10 +42,10 @@ c write(iout,*)'theta(3)=',rad2deg*theta(3) endif maxnit=0 - + iprint=10 nit=0 niter=0 - back=.false. + back=.true. do while (i.le.nres .and. niter.lt.maxgen) if (i.lt.nstart) then if(iprint.gt.1) then @@ -54,16 +58,20 @@ c write(iout,*)'theta(3)=',rad2deg*theta(3) endif return1 endif - it1=abs(itype(i-1)) - it2=abs(itype(i-2)) - it=abs(itype(i)) + it1=itype(i-1) + it2=itype(i-2) + it=itype(i) + ichir3=isign(1,itype(i)) + ichir2=isign(1,itype(i-1)) + ichir0=isign(1,itype(i-3)) + ichir1=isign(1,itype(i-2)) c print *,'Gen_Rand_Conf: i=',i,' it=',it,' it1=',it1,' it2=',it2, c & ' nit=',nit,' niter=',niter,' maxgen=',maxgen phi(i+1)=gen_phi(i+1,it1,it) if (back) then phi(i)=gen_phi(i+1,it2,it1) print *,'phi(',i,')=',phi(i) - theta(i-1)=gen_theta(it2,phi(i-1),phi(i)) + theta(i-1)=gen_theta(it2,ichir0,ichir2,phi(i-1),phi(i)) if (it2.ne.10) then nsi=0 fail=.true. @@ -75,7 +83,7 @@ c & ' nit=',nit,' niter=',niter,' maxgen=',maxgen endif call locate_next_res(i-1) endif - theta(i)=gen_theta(it1,phi(i),phi(i+1)) + theta(i)=gen_theta(it1,ichir1,ichir3,phi(i),phi(i+1)) if (it1.ne.10) then nsi=0 fail=.true. @@ -212,14 +220,14 @@ C 8/13/98 Generate phi using pre-defined boundaries return end c--------------------------------------------------------------------------- - double precision function gen_theta(it,gama,gama1) + double precision function gen_theta(it,ichir1,ichir2,gama,gama1) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.LOCAL' include 'COMMON.GEO' double precision y(2),z(2) double precision theta_max,theta_min -c print *,'gen_theta: it=',it + print *,'gen_theta: it=',it theta_min=0.05D0*pi theta_max=0.95D0*pi if (dabs(gama).gt.dwapi) then @@ -238,8 +246,8 @@ c print *,'gen_theta: it=',it endif thet_pred_mean=a0thet(it) do k=1,2 - thet_pred_mean=thet_pred_mean+athet(k,it,1,1)*y(k) - & +bthet(k,it,1,1)*z(k) + thet_pred_mean=thet_pred_mean+athet(k,it,ichir1,ichir2) + & *y(k)+bthet(k,it,ichir1,ichir2)*z(k) enddo sig=polthet(3,it) do j=2,0,-1 @@ -247,14 +255,16 @@ c print *,'gen_theta: it=',it enddo sig=0.5D0/(sig*sig+sigc0(it)) ak=dexp(gthet(1,it)- - &0.5D0*((gthet(2,it)-thet_pred_mean)/gthet(3,it))**2) -c print '(i5,5(1pe14.4))',it,(gthet(j,it),j=1,3) -c print '(5(1pe14.4))',thet_pred_mean,theta0(it),sig,sig0(it),ak - theta_temp=binorm(thet_pred_mean,theta0(it),sig,sig0(it),ak) + &0.5D0*((gthet(2,it)-thet_pred_mean) + &/gthet(3,it))**2) + print '(i5,5(1pe14.4))',it,(gthet(j,it),j=1,3) + print '(5(1pe14.4))',thet_pred_mean,theta0(it),sig,sig0(it),ak + theta_temp=binorm(thet_pred_mean,theta0(it),sig + &,sig0(it),ak) if (theta_temp.lt.theta_min) theta_temp=theta_min if (theta_temp.gt.theta_max) theta_temp=theta_max gen_theta=theta_temp -c print '(a)','Exiting GENTHETA.' + print '(a)','Exiting GENTHETA.' return end c------------------------------------------------------------------------- @@ -287,7 +297,7 @@ cd & 'Error in GenSide: it=',it,' theta=',the return endif tant=dtan(the-pipol) - nlobit=nlob(it) + nlobit=nlob(iabs(it)) if (lprint) then #ifdef MPI print '(a,i4,a)','CG Processor:',me,' Enter Gen_Side.' @@ -324,7 +334,7 @@ cd & 'Error in GenSide: it=',it,' theta=',the enddo enddo W1i=a(1,1)-W1i - W1(i)=dexp(bsc(i,it)-0.5D0*W1i*zz1*zz1) + W1(i)=dexp(bsc(i,iabs(it))-0.5D0*W1i*zz1*zz1) c if (lprint) write(*,'(a,3(1pe15.5)/)') c & 'detAp, W1, anormi',detApi,W1i,anormi do k=2,3 @@ -576,17 +586,22 @@ C Calculate a random integer number from the range (n1,n2). c-------------------------------------------------------------------------- double precision function binorm(x1,x2,sigma1,sigma2,ak) implicit real*8 (a-h,o-z) -c print '(a)','Enter BINORM.' + print *,'Enter BINORM.',x1,x2,sigma1,sigma2,ak alowb=dmin1(x1-3.0D0*sigma1,x2-3.0D0*sigma2) aupb=dmax1(x1+3.0D0*sigma1,x2+3.0D0*sigma2) seg=sigma1/(sigma1+ak*sigma2) alen=ran_number(0.0D0,1.0D0) if (alen.lt.seg) then +c print *,'przed anorm',x1,sigma1,alowb,aupb +c print *, 'anorm',anorm_distr(x1,sigma1,alowb,aupb) binorm=anorm_distr(x1,sigma1,alowb,aupb) + else +c print *,'przed anorm',x2,sigma2,alowb,aupb +c print *, 'anorm',anorm_distr(x2,sigma2,alowb,aupb) binorm=anorm_distr(x2,sigma2,alowb,aupb) endif -c print '(a)','Exiting BINORM.' + print '(a)','Exiting BINORM.' return end c----------------------------------------------------------------------- @@ -613,6 +628,7 @@ c if(iset.eq.0) then 1 v1=2.0d0*ran_number(0.0d0,1.0d0)-1.0d0 v2=2.0d0*ran_number(0.0d0,1.0d0)-1.0d0 +c print *,"anorm: iset",iset," v1",v1," v2",v2," rsq",rsq rsq=v1**2+v2**2 if(rsq.ge.1.d0.or.rsq.eq.0.0d0) goto 1 fac=sqrt(-2.0d0*log(rsq)/rsq) diff --git a/source/unres/src_CSA_DiL/together.F b/source/unres/src_CSA_DiL/together.F index 8bc9d7a..e4c042a 100644 --- a/source/unres/src_CSA_DiL/together.F +++ b/source/unres/src_CSA_DiL/together.F @@ -756,6 +756,7 @@ cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc call mpi_abort(mpi_comm_world,ierror,ierrcode) endif do n=1,nconf + print*,"n=",n c pull out external and internal variables for next start call putx(xin,n,rad) ! write (iout,*) 'XIN from FEEDIN N=',n @@ -813,6 +814,7 @@ c retrieve latest results if(iw_pdb.gt.0) & call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb) endif + print *,"koniec petli n=",n enddo cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c no more input -- 1.7.9.5