X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Funres.f90;h=12368afea108b761ce882aac5adb8c153de38910;hb=a5189f6bb38b0708d043a694919b39f8f4a820a6;hp=870036997349c568aa55e2d9126b44165e719005;hpb=a01e4f4abfd7680ce30209afd6cab5d52532a55f;p=unres4.git diff --git a/source/unres/unres.f90 b/source/unres/unres.f90 index 8700369..12368af 100644 --- a/source/unres/unres.f90 +++ b/source/unres/unres.f90 @@ -105,11 +105,7 @@ else #endif if (modecalc.eq.0) then -!write(iout,*)"!!!!!!!!!!!!!!!!! in unres" - call exec_eeval_or_minim -!write(iout,*)"!!!!!!!!!!!!!!!!! in unres" - else if (modecalc.eq.1) then call exec_regularize else if (modecalc.eq.2) then @@ -120,8 +116,6 @@ call exec_mult_eeval_or_minim else if (modecalc.eq.5) then call exec_checkgrad -!write(iout,*) "check grad dwa razy" -!el call exec_checkgrad else if (ModeCalc.eq.7) then call exec_map else if (ModeCalc.eq.8) then @@ -136,7 +130,6 @@ write (iout,'(a)') 'This calculation type is not supported',& ModeCalc endif -!elwrite(iout,*)"!!!!!!!!!!!!!!!!!" #ifdef MPI endif @@ -169,7 +162,9 @@ #ifdef MPI include "mpif.h" #endif + print *,'Start MD' call alloc_MD_arrays + print *,'After MD alloc' if (me.eq.king .or. .not. out1file) & write (iout,*) "Calling chainbuild" call chainbuild @@ -196,11 +191,11 @@ call alloc_MD_arrays call alloc_MREMD_arrays +! if (me.eq.king .or. .not. out1file) & +! write (iout,*) "Calling chainbuild" +! call chainbuild if (me.eq.king .or. .not. out1file) & - write (iout,*) "Calling chainbuild" - call chainbuild - if (me.eq.king .or. .not. out1file) & - write (iout,*) "Calling REMD" + write (iout,*) "Calling REMD",remd_mlist,nrep if (remd_mlist) then call MREMD else @@ -250,7 +245,10 @@ integer :: j,k call alloc_compare_arrays - if (indpdb.eq.0) call chainbuild + if ((indpdb.eq.0).and.(.not.read_cart)) then + call chainbuild + write(iout,*) 'Warning: Calling chainbuild' + endif #ifdef MPI time00=MPI_Wtime() #endif @@ -265,12 +263,10 @@ print *,"Processor",myrank," after chainbuild" icall=1 -!elwrite(iout,*)"in exec_eeval or minimim" call etotal_long(energy_long) write (iout,*) "Printing long range energy" call enerprint(energy_long) -!elwrite(iout,*)"in exec_eeval or minimim" call etotal_short(energy_short) write (iout,*) "Printing short range energy" @@ -284,7 +280,6 @@ endif call etotal(energy_) -!elwrite(iout,*)"after etotal in exec_eev" #ifdef MPI time_ene=MPI_Wtime()-time00 #endif @@ -293,19 +288,13 @@ etota = energy_(0) etot = etota call enerprint(energy_) -!write(iout,*)"after enerprint" call hairpin(.true.,nharp,iharp) -!write(iout,*) "after hairpin"!,hfrag(1,1) call secondary2(.true.) -!write(iout,*) "after secondary2" if (minim) then !rc overlap test -!elwrite(iout,*) "after secondary2 minim",minim if (overlapsc) then print *, 'Calling OVERLAP_SC' -!write(iout,*) 'Calling OVERLAP_SC' call overlap_sc(fail) -!write(iout,*) 'after Calling OVERLAP_SC' endif if (searchsc) then @@ -315,7 +304,6 @@ endif if (dccart) then -!write(iout,*) 'CART calling minim_dc', nvar print *, 'Calling MINIM_DC' #ifdef MPI time1=MPI_WTIME() @@ -324,14 +312,12 @@ call minim_dc(etot,iretcode,nfun) ! call check_ecartint !el else -!write(iout,*) "indpdb",indpdb if (indpdb.ne.0) then -!write(iout,*) 'if indpdb', indpdb call bond_regular + write(iout,*) 'Warning: Calling chainbuild' call chainbuild endif call geom_to_var(nvar,varia) -!write(iout,*) 'po geom to var; calling minimize', nvar print *,'Calling MINIMIZE.' #ifdef MPI time1=MPI_WTIME() @@ -361,17 +347,14 @@ write (iout,'(a,i20)') '# of energy evaluations:',nfun+1 write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals else -!elwrite(iout,*) "after secondary2 minim",minim - print *,'refstr=',refstr + print *,'refstr=',refstr,frac,frac_nn,co if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) -!elwrite(iout,*) "rms_nac" -!elwrite(iout,*) "before briefout" + print *,"after rms_nac_ncc" call briefout(0,etot) -!elwrite(iout,*) "after briefout" endif if (outpdb) call pdbout(etot,titel(:32),ipdb) if (outmol2) call mol2out(etot,titel(:32)) -!elwrite(iout,*) "after exec_eeval_or_minim" + write(iout,*) "after exec_eeval_or_minim" return end subroutine exec_eeval_or_minim !----------------------------------------------------------------------------- @@ -535,6 +518,7 @@ read (intin,'(i5)',end=1100,err=1100) iconf call read_angles(intin,*11) call geom_to_var(nvar,varia) + write(iout,*) 'Warning: Calling chainbuild1' call chainbuild endif write (iout,'(a,i7)') 'Conformation #',iconf @@ -580,6 +564,7 @@ read (intin,'(i5)',end=11,err=11) iconf call read_angles(intin,*11) call geom_to_var(nvar,varia) + write(iout,*) 'Warning: Calling chainbuild2' call chainbuild endif write (iout,'(a,i7)') 'Conformation #',iconf @@ -615,6 +600,7 @@ ! print *,'result received from worker ',man,' sending now' call var_to_geom(nvar,varia) + write(iout,*) 'Warning: Calling chainbuild3' call chainbuild call etotal(energy_) iconf=ind(2) @@ -650,6 +636,7 @@ read (intin,'(i5)',end=1101,err=1101) iconf call read_angles(intin,*11) call geom_to_var(nvar,varia) + write(iout,*) 'Warning: Calling chainbuild4' call chainbuild endif n=n+1 @@ -685,6 +672,7 @@ CG_COMM,muster,ierr) call var_to_geom(nvar,varia) + write(iout,*) 'Warning: Calling chainbuild5' call chainbuild call etotal(energy_) iconf=ind(2) @@ -746,6 +734,7 @@ read (intin,'(i5)',end=11,err=11) iconf call read_angles(intin,*11) call geom_to_var(nvar,varia) + write(iout,*) 'Warning: Calling chainbuild5' call chainbuild endif write (iout,'(a,i7)') 'Conformation #',iconf @@ -800,7 +789,10 @@ ! if (itype(i).ne.10) ! & vbld(i+nres)=vbld(i+nres)+ran_number(-0.001d0,0.001d0) ! enddo - if (indpdb.eq.0) call chainbuild + if (indpdb.eq.0) then + write(iout,*) 'Warning: Calling chainbuild' + call chainbuild + endif ! do i=0,nres ! do j=1,3 ! dc(j,i)=dc(j,i)+ran_number(-0.2d0,0.2d0) @@ -886,6 +878,7 @@ logical :: debug call alloc_compare_arrays + write(iout,*) 'Warning: Calling chainbuild' call chainbuild call etotal(energy_) call enerprint(energy_)