X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc-HCD-5D%2Finitialize_p.F;fp=source%2Funres%2Fsrc-HCD-5D%2Finitialize_p.F;h=9b39485868ee2b18d0ce775cdc1c2a09f4824658;hb=58980cd5a21077fd523753ffccc036765ef70d82;hp=710f907f2e690c2dffd55c39b774dd680584f4d4;hpb=d02292725c202ff9c2749beac934bf1630f9017e;p=unres.git diff --git a/source/unres/src-HCD-5D/initialize_p.F b/source/unres/src-HCD-5D/initialize_p.F index 710f907..9b39485 100644 --- a/source/unres/src-HCD-5D/initialize_p.F +++ b/source/unres/src-HCD-5D/initialize_p.F @@ -351,7 +351,7 @@ c------------------------------------------------------------------------- 1 "WSC ","WSCP ","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC", ! 8 9 10 11 12 13 14 8 "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR ","WTORD ", -!  15 16 17 18 19 20 21 +!? 15 16 17 18 19 20 21 5 "WSTRAIN","WVDWPP","WBOND","SCAL14","WDIHC","WUMB","WSCCOR", ! 22 23 24 25 26 27 28 2 "WLT","WAFM","WTHETCNSR","WTUBE","WSAXS","WHOMO","WDFAD", @@ -453,8 +453,13 @@ c--------------------------------------------------------------------------- integer iturn3_start_all,iturn3_end_all,iturn4_start_all, & iturn4_end_all,iatel_s_all, & iatel_e_all,ielstart_all,ielend_all,ntask_cont_from_all, - & itask_cont_from_all,ntask_cont_to_all,itask_cont_to_all, - & n_sc_int_tot,my_sc_inds,my_sc_inde,ind_sctint,ind_scint_old + & itask_cont_from_all,ntask_cont_to_all,itask_cont_to_all + integer*8 n_sc_int_tot,my_sc_inds,my_sc_inde,ind_scint, + & ind_scint_old,nele_int_tot,ind_eleint,my_ele_inds,my_ele_inde, + & ind_eleint_old,nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw, + & ind_eleint_vdw,ind_eleint_vdw_old,nscp_int_tot,my_scp_inds, + & my_scp_inde,ind_scpint,ind_scpint_old,nsumgrad,nlen,ngrad_start, + & ngrad_end common /przechowalnia/ iturn3_start_all(0:max_fg_procs), & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), @@ -466,12 +471,8 @@ c--------------------------------------------------------------------------- & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1) integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP logical scheck,lprint,flag - integer i,j,k,ii,jj,iint,npept,nele_int_tot,ind_eleint,ind_scint, - & my_ele_inds,my_ele_inde,ind_eleint_old,nele_int_tot_vdw, - & my_ele_inds_vdw,my_ele_inde_vdw,ind_eleint_vdw,ijunk, - & ind_eleint_vdw_old,nscp_int_tot,my_scp_inds,my_scp_inde, - & ind_scpint,ind_scpint_old,nsumgrad,nlen,ngrad_start,ngrad_end, - & iaux,ind_typ,ncheck_from,ncheck_to,ichunk + integer i,j,k,ii,jj,iint,npept, + & ijunk,iaux,ind_typ,ncheck_from,ncheck_to,ichunk #ifdef MPI integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs), & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs) @@ -486,14 +487,14 @@ C... to deal with by current processor. lprint=energy_dec if (lprint) &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct - n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss - call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde) + n_sc_int_tot=int(nct-nnt+1,8)*int(nct-nnt,8)/2-nss + call int_bounds8(n_sc_int_tot,my_sc_inds,my_sc_inde) if (lprint) & write (iout,*) 'Processor',fg_rank,' CG group',kolor, & ' absolute rank',MyRank, & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds, & ' my_sc_inde',my_sc_inde - ind_sctint=0 + ind_scint=0 iatsc_s=0 iatsc_e=0 #endif @@ -530,7 +531,7 @@ cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj if (jj.eq.i+1) then #ifdef MPI c write (iout,*) 'jj=i+1' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, + call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i, & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12) #else nint_gr(i)=1 @@ -540,7 +541,7 @@ c write (iout,*) 'jj=i+1' else if (jj.eq.nct) then #ifdef MPI c write (iout,*) 'jj=nct' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, + call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i, & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12) #else nint_gr(i)=1 @@ -549,10 +550,10 @@ c write (iout,*) 'jj=nct' #endif else #ifdef MPI - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, + call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i, & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12) ii=nint_gr(i)+1 - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, + call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i, & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12) #else nint_gr(i)=2 @@ -564,7 +565,7 @@ c write (iout,*) 'jj=nct' endif else #ifdef MPI - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, + call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i, & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12) #else nint_gr(i)=1 @@ -588,9 +589,10 @@ c write (iout,*) 'jj=nct' & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e #endif if (lprint) then + write (iout,*) 'iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e write (iout,'(a)') 'Interaction array:' do i=iatsc_s,iatsc_e - write (iout,'(i3,2(2x,2i3))') + write (iout,'(i7,2(2x,2i7))') & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i)) enddo endif @@ -598,8 +600,8 @@ c write (iout,*) 'jj=nct' #ifdef MPI C Now partition the electrostatic-interaction array npept=nct-nnt - nele_int_tot=(npept-ispp)*(npept-ispp+1)/2 - call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde) + nele_int_tot=int(npept-ispp,8)*int(npept-ispp+1,8)/2 + call int_bounds8(nele_int_tot,my_ele_inds,my_ele_inde) if (lprint) & write (*,*) 'Processor',fg_rank,' CG group',kolor, & ' absolute rank',MyRank, @@ -611,14 +613,14 @@ C Now partition the electrostatic-interaction array ind_eleint_old=0 do i=nnt,nct-3 ijunk=0 - call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i, + call int_partition8(ind_eleint,my_ele_inds,my_ele_inde,i, & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13) enddo ! i 13 continue if (iatel_s.eq.0) iatel_s=1 - nele_int_tot_vdw=(npept-2)*(npept-2+1)/2 + nele_int_tot_vdw=int(npept-2,8)*int(npept-2+1,8)/2 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw - call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw) + call int_bounds8(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw) c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw, c & " my_ele_inde_vdw",my_ele_inde_vdw ind_eleint_vdw=0 @@ -627,7 +629,7 @@ c & " my_ele_inde_vdw",my_ele_inde_vdw iatel_e_vdw=0 do i=nnt,nct-3 ijunk=0 - call int_partition(ind_eleint_vdw,my_ele_inds_vdw, + call int_partition8(ind_eleint_vdw,my_ele_inds_vdw, & my_ele_inde_vdw,i, & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i), & ielend_vdw(i),*15) @@ -655,15 +657,15 @@ c & " ielend_vdw",ielend_vdw(i) & ' absolute rank',MyRank write (iout,*) 'Electrostatic interaction array:' do i=iatel_s,iatel_e - write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i) + write (iout,'(i7,2(2x,2i7))') i,ielstart(i),ielend(i) enddo endif ! lprint c iscp=3 iscp=2 C Partition the SC-p interaction array #ifdef MPI - nscp_int_tot=(npept-iscp+1)*(npept-iscp+1) - call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde) + nscp_int_tot=int(npept-iscp+1,8)*int(npept-iscp+1,8) + call int_bounds8(nscp_int_tot,my_scp_inds,my_scp_inde) if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor, & ' absolute rank',myrank, & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds, @@ -675,20 +677,20 @@ C Partition the SC-p interaction array do i=nnt,nct-1 if (i.lt.nnt+iscp) then cd write (iout,*) 'i.le.nnt+iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, + call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i, & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1), & iscpend(i,1),*14) else if (i.gt.nct-iscp) then cd write (iout,*) 'i.gt.nct-iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, + call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i, & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), & iscpend(i,1),*14) else - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, + call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i, & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), & iscpend(i,1),*14) ii=nscp_gr(i)+1 - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, + call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i, & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii), & iscpend(i,ii),*14) endif @@ -719,7 +721,7 @@ cd write (iout,*) 'i.gt.nct-iscp' if (lprint) then write (iout,'(a)') 'SC-p interaction array:' do i=iatscp_s,iatscp_e - write (iout,'(i3,2(2x,2i3))') + write (iout,'(i7,2(2x,2i7))') & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) enddo endif ! lprint @@ -782,24 +784,24 @@ c & " ivec_start",ivec_start," ivec_end",ivec_end endif c nsumgrad=(nres-nnt)*(nres-nnt+1)/2 c nlen=nres-nnt+1 - nsumgrad=(nres-nnt)*(nres-nnt+1)/2 - nlen=nres-nnt+1 - call int_bounds(nsumgrad,ngrad_start,ngrad_end) - igrad_start=((2*nlen+1) - & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2 - jgrad_start(igrad_start)= - & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2 - & +igrad_start - jgrad_end(igrad_start)=nres - igrad_end=((2*nlen+1) - & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2 - if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1 - jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2 - & +igrad_end - do i=igrad_start+1,igrad_end-1 - jgrad_start(i)=i+1 - jgrad_end(i)=nres - enddo +c nsumgrad=(nres-nnt)*(nres-nnt+1)/2 +c nlen=nres-nnt+1 +c call int_bounds(nsumgrad,ngrad_start,ngrad_end) +c igrad_start=((2*nlen+1) +c & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2 +c jgrad_start(igrad_start)= +c & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2 +c & +igrad_start +c jgrad_end(igrad_start)=nres +c igrad_end=((2*nlen+1) +c & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2 +c if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1 +c jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2 +c & +igrad_end +c do i=igrad_start+1,igrad_end-1 +c jgrad_start(i)=i+1 +c jgrad_end(i)=nres +c enddo if (lprint) then write (*,*) 'Processor:',fg_rank,' CG group',kolor, & ' absolute rank',myrank, @@ -818,13 +820,13 @@ c nlen=nres-nnt+1 & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end', & ithetaconstr_end - write (*,*) 'Processor:',fg_rank,myrank,' igrad_start', - & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start, - & ' ngrad_end',ngrad_end - do i=igrad_start,igrad_end - write(*,*) 'Processor:',fg_rank,myrank,i, - & jgrad_start(i),jgrad_end(i) - enddo +c write (*,*) 'Processor:',fg_rank,myrank,' igrad_start', +c & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start, +c & ' ngrad_end',ngrad_end +c do i=igrad_start,igrad_end +c write(*,*) 'Processor:',fg_rank,myrank,i, +c & jgrad_start(i),jgrad_end(i) +c enddo endif if (nfgtasks.gt.1) then call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1, @@ -1502,6 +1504,31 @@ c--------------------------------------------------------------------------- return end c--------------------------------------------------------------------------- + subroutine int_bounds8(total_ints,lower_bound,upper_bound) + implicit none + include 'DIMENSIONS' + include 'mpif.h' + include 'COMMON.SETUP' + integer*8 total_ints,lower_bound,upper_bound,nint + integer*8 int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs) + integer i,nexcess + nint=total_ints/nfgtasks + do i=1,nfgtasks + int4proc(i-1)=nint + enddo + nexcess=total_ints-nint*nfgtasks + do i=1,nexcess + int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1 + enddo + lower_bound=0 + do i=0,fg_rank-1 + lower_bound=lower_bound+int4proc(i) + enddo + upper_bound=lower_bound+int4proc(fg_rank) + lower_bound=lower_bound+1 + return + end +c--------------------------------------------------------------------------- subroutine int_bounds1(total_ints,lower_bound,upper_bound) implicit none include 'DIMENSIONS' @@ -1566,6 +1593,47 @@ c--------------------------------------------------------------------------- endif return end +c--------------------------------------------------------------------------- + subroutine int_partition8(int_index,lower_index,upper_index,atom, + & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*) + implicit none + include 'DIMENSIONS' + include 'COMMON.IOUNITS' + integer*8 int_index,lower_index,upper_index + integer atom,at_start,at_end, + & first_atom,last_atom,int_gr,jat_start,jat_end,int_index_old + logical lprn + lprn=.false. + if (lprn) write (iout,*) 'int_index=',int_index + int_index_old=int_index + int_index=int_index+last_atom-first_atom+1 + if (lprn) + & write (iout,*) 'int_index=',int_index, + & ' int_index_old',int_index_old, + & ' lower_index=',lower_index, + & ' upper_index=',upper_index, + & ' atom=',atom,' first_atom=',first_atom, + & ' last_atom=',last_atom + if (int_index.ge.lower_index) then + int_gr=int_gr+1 + if (at_start.eq.0) then + at_start=atom + jat_start=first_atom-1+lower_index-int_index_old + else + jat_start=first_atom + endif + if (lprn) write (iout,*) 'jat_start',jat_start + if (int_index.ge.upper_index) then + at_end=atom + jat_end=first_atom-1+upper_index-int_index_old + return1 + else + jat_end=last_atom + endif + if (lprn) write (iout,*) 'jat_end',jat_end + endif + return + end #endif c------------------------------------------------------------------------------ subroutine hpb_partition