X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fcontrol.F90;h=06dfe8c87c77b30407b11c30495f91a1fe57fd2a;hb=bc23440fbe68672d430f71f22f46b11265f003db;hp=413fe236160864f2f5c4d7513250aea4c7f6f6e1;hpb=9b36766b4b62536253dcc78a6591c620f27b46fb;p=unres4.git diff --git a/source/unres/control.F90 b/source/unres/control.F90 index 413fe23..06dfe8c 100644 --- a/source/unres/control.F90 +++ b/source/unres/control.F90 @@ -148,6 +148,7 @@ ! ! The following is just to define auxiliary variables used in angle conversion ! +! ifirstrun=0 pi=4.0D0*datan(1.0D0) dwapi=2.0D0*pi dwapi3=dwapi/3.0D0 @@ -246,6 +247,7 @@ itube=61 ! IONS iion=401 + iionnucl=402 #if defined(WHAM_RUN) || defined(CLUSTER) ! ! setting the mpi variables for WHAM @@ -512,7 +514,7 @@ ind_eleint_old_nucl,ind_eleint_nucl,nele_int_tot_vdw_nucl,& my_ele_inds_vdw_nucl,my_ele_inde_vdw_nucl,ind_eleint_vdw_nucl,& ind_eleint_vdw_old_nucl,nscp_int_tot_nucl,my_scp_inds_nucl,& - my_scp_inde_nucl,ind_scpint_nucl,ind_scpint_old_nucl + my_scp_inde_nucl,ind_scpint_nucl,ind_scpint_old_nucl,impishi ! integer,dimension(5) :: nct_molec,nnt_molec !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1) !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1) @@ -563,6 +565,7 @@ iatsc_s=0 iatsc_e=0 #endif + if(.not.allocated(ielstart_all)) then !el common /przechowalnia/ allocate(iturn3_start_all(0:nfgtasks)) allocate(iturn3_end_all(0:nfgtasks)) @@ -578,6 +581,7 @@ allocate(itask_cont_from_all(0:nfgtasks-1,0:nfgtasks-1)) allocate(itask_cont_to_all(0:nfgtasks-1,0:nfgtasks-1)) !el---------- + endif ! lprint=.false. print *,"NCT",nct_molec(1),nct do i=1,nres !el !maxres @@ -1383,6 +1387,16 @@ call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,& IERROR) call MPI_Type_commit(MPI_UYZGRAD,IERROR) + call MPI_Type_contiguous(maxcontsshi,MPI_INTEGER,MPI_I50,IERROR) + call MPI_Type_commit(MPI_I50,IERROR) + call MPI_Type_contiguous(maxcontsshi,MPI_DOUBLE_PRECISION,MPI_D50,IERROR) + call MPI_Type_commit(MPI_D50,IERROR) + + impishi=maxcontsshi*3 +! call MPI_Type_contiguous(impishi,MPI_DOUBLE_PRECISION, & +! MPI_SHI,IERROR) +! call MPI_Type_commit(MPI_SHI,IERROR) +! print *,MPI_SHI,"MPI_SHI",MPI_D50 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR) call MPI_Type_commit(MPI_MU,IERROR) call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR) @@ -1949,83 +1963,6 @@ return end subroutine setup_var !----------------------------------------------------------------------------- -! rescode.f -!----------------------------------------------------------------------------- - integer function rescode(iseq,nam,itype,molecule) - - use io_base, only: ucase -! implicit real*8 (a-h,o-z) -! include 'DIMENSIONS' -! include 'COMMON.NAMES' -! include 'COMMON.IOUNITS' - character(len=3) :: nam !,ucase - integer :: iseq,itype,i - integer :: molecule - print *,molecule,nam - if (molecule.eq.1) then - if (itype.eq.0) then - - do i=-ntyp1_molec(molecule),ntyp1_molec(molecule) - if (ucase(nam).eq.restyp(i,molecule)) then - rescode=i - return - endif - enddo - - else - - do i=-ntyp1_molec(molecule),ntyp1_molec(molecule) - if (nam(1:1).eq.onelet(i)) then - rescode=i - return - endif - enddo - - endif - else if (molecule.eq.2) then - do i=1,ntyp1_molec(molecule) - print *,nam(1:1),restyp(i,molecule)(1:1) - if (nam(2:2).eq.restyp(i,molecule)(1:1)) then - rescode=i - return - endif - enddo - else if (molecule.eq.3) then - write(iout,*) "SUGAR not yet implemented" - stop - else if (molecule.eq.4) then - write(iout,*) "Explicit LIPID not yet implemented" - stop - else if (molecule.eq.5) then - do i=1,ntyp1_molec(molecule) - print *,i,restyp(i,molecule)(1:2) - if (ucase(nam(1:2)).eq.restyp(i,molecule)(1:2)) then - rescode=i - return - endif - enddo - else - write(iout,*) "molecule not defined" - endif - write (iout,10) iseq,nam - stop - 10 format ('**** Error - residue',i4,' has an unresolved name ',a3) - end function rescode - integer function sugarcode(sugar,ires) - character sugar - integer ires - if (sugar.eq.'D') then - sugarcode=1 - else if (sugar.eq.' ') then - sugarcode=2 - else - write (iout,*) 'UNKNOWN sugar type for residue',ires,' ',sugar - stop - endif - return - end function sugarcode - -!----------------------------------------------------------------------------- ! timing.F !----------------------------------------------------------------------------- ! $Date: 1994/10/05 16:41:52 $ @@ -2469,5 +2406,48 @@ end subroutine print_detailed_timing #endif !----------------------------------------------------------------------------- + subroutine homology_partition + implicit none +! include 'DIMENSIONS' +!#ifdef MPI +! include 'mpif.h' +!#endif +! include 'COMMON.SBRIDGE' +! include 'COMMON.IOUNITS' +! include 'COMMON.SETUP' +! include 'COMMON.CONTROL' +! include 'COMMON.INTERACT' +! include 'COMMON.HOMOLOGY' +!d write(iout,*)"homology_partition: lim_odl=",lim_odl, +!d & " lim_dih",lim_dih +#ifdef MPI + if (me.eq.king .or. .not. out1file) write (iout,*) "MPI" + call int_bounds(lim_odl,link_start_homo,link_end_homo) + call int_bounds(lim_dih,idihconstr_start_homo, & + idihconstr_end_homo) + idihconstr_start_homo=idihconstr_start_homo+nnt-1+3 + idihconstr_end_homo=idihconstr_end_homo+nnt-1+3 + if (me.eq.king .or. .not. out1file)& + write (iout,*) 'Processor',fg_rank,' CG group',kolor,& + ' absolute rank',MyRank,& + ' lim_odl',lim_odl,' link_start=',link_start_homo,& + ' link_end',link_end_homo,' lim_dih',lim_dih,& + ' idihconstr_start_homo',idihconstr_start_homo,& + ' idihconstr_end_homo',idihconstr_end_homo +#else + write (iout,*) "Not MPI" + link_start_homo=1 + link_end_homo=lim_odl + idihconstr_start_homo=nnt+3 + idihconstr_end_homo=lim_dih+nnt-1+3 + write (iout,*) & + ' lim_odl',lim_odl,' link_start=',link_start_homo, & + ' link_end',link_end_homo,' lim_dih',lim_dih,& + ' idihconstr_start_homo',idihconstr_start_homo,& + ' idihconstr_end_homo',idihconstr_end_homo +#endif + return + end subroutine homology_partition + !----------------------------------------------------------------------------- end module control