+++ /dev/null
- block data
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MCM'
-c include 'COMMON.MD'
- data MovTypID
- & /'pool','chain regrow','multi-bond','phi','theta','side chain',
- & 'total'/
-c Conversion from poises to molecular unit and the gas constant
-c data cPoise /2.9361d0/, Rb /0.001986d0/
- end
-c--------------------------------------------------------------------------
- subroutine initialize
-C
-C Define constants and zero out tables.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-cMS$ATTRIBUTES C :: proc_proc
-#endif
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.TORSION'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.MCM'
- include 'COMMON.MINIM'
- include 'COMMON.DERIV'
- include 'COMMON.SPLITELE'
-c Common blocks from the diagonalization routines
- COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
- COMMON /MACHSW/ KDIAG,ICORFL,IXDR
- logical mask_r
-c real*8 text1 /'initial_i'/
-
- mask_r=.false.
-#ifndef ISNAN
-c NaNQ initialization
- i=-1
- arg=100.0d0
- rr=dacos(arg)
-#ifdef WINPGI
- idumm=proc_proc(rr,i)
-#else
- call proc_proc(rr,i)
-#endif
-#endif
-
- kdiag=0
- icorfl=0
- iw=2
-C
-C The following is just to define auxiliary variables used in angle conversion
-C
- pi=4.0D0*datan(1.0D0)
- dwapi=2.0D0*pi
- dwapi3=dwapi/3.0D0
- pipol=0.5D0*pi
- deg2rad=pi/180.0D0
- rad2deg=1.0D0/deg2rad
- angmin=10.0D0*deg2rad
-C
-C Define I/O units.
-C
- inp= 1
- iout= 2
- ipdbin= 3
- ipdb= 7
- icart = 30
- imol2= 4
- igeom= 8
- intin= 9
- ithep= 11
- ithep_pdb=51
- irotam=12
- irotam_pdb=52
- itorp= 13
- itordp= 23
- ielep= 14
- isidep=15
- iscpp=25
- icbase=16
- ifourier=20
- istat= 17
- irest1=55
- irest2=56
- iifrag=57
- ientin=18
- ientout=19
- ibond = 28
- isccor = 29
-crc for write_rmsbank1
- izs1=21
-cdr include secondary structure prediction bias
- isecpred=27
-C
-C CSA I/O units (separated from others especially for Jooyoung)
-C
- icsa_rbank=30
- icsa_seed=31
- icsa_history=32
- icsa_bank=33
- icsa_bank1=34
- icsa_alpha=35
- icsa_alpha1=36
- icsa_bankt=37
- icsa_int=39
- icsa_bank_reminimized=38
- icsa_native_int=41
- icsa_in=40
-crc for ifc error 118
- icsa_pdb=42
-C
-C Set default weights of the energy terms.
-C
- wlong=1.0D0
- welec=1.0D0
- wtor =1.0D0
- wang =1.0D0
- wscloc=1.0D0
- wstrain=1.0D0
-C
-C Zero out tables.
-C
- print '(a,$)','Inside initialize'
-c call memmon_print_usage()
- do i=1,maxres2
- do j=1,3
- c(j,i)=0.0D0
- dc(j,i)=0.0D0
- enddo
- enddo
- do i=1,maxres
- do j=1,3
- xloc(j,i)=0.0D0
- enddo
- enddo
- do i=1,ntyp
- do j=1,ntyp
- aa(i,j)=0.0D0
- bb(i,j)=0.0D0
- augm(i,j)=0.0D0
- sigma(i,j)=0.0D0
- r0(i,j)=0.0D0
- chi(i,j)=0.0D0
- enddo
- do j=1,2
- bad(i,j)=0.0D0
- enddo
- chip(i)=0.0D0
- alp(i)=0.0D0
- sigma0(i)=0.0D0
- sigii(i)=0.0D0
- rr0(i)=0.0D0
- a0thet(i)=0.0D0
- do j=1,2
- do ichir1=-1,1
- do ichir2=-1,1
- athet(j,i,ichir1,ichir2)=0.0D0
- bthet(j,i,ichir1,ichir2)=0.0D0
- enddo
- enddo
- enddo
- do j=0,3
- polthet(j,i)=0.0D0
- enddo
- do j=1,3
- gthet(j,i)=0.0D0
- enddo
- theta0(i)=0.0D0
- sig0(i)=0.0D0
- sigc0(i)=0.0D0
- do j=1,maxlob
- bsc(j,i)=0.0D0
- do k=1,3
- censc(k,j,i)=0.0D0
- enddo
- do k=1,3
- do l=1,3
- gaussc(l,k,j,i)=0.0D0
- enddo
- enddo
- nlob(i)=0
- enddo
- enddo
- nlob(ntyp1)=0
- dsc(ntyp1)=0.0D0
- do i=-maxtor,maxtor
- itortyp(i)=0
- do iblock=1,2
- do j=-maxtor,maxtor
- do k=1,maxterm
- v1(k,j,i,iblock)=0.0D0
- v2(k,j,i,iblock)=0.0D0
- enddo
- enddo
- enddo
- enddo
- do iblock=1,2
- do i=-maxtor,maxtor
- do j=-maxtor,maxtor
- do k=-maxtor,maxtor
- do l=1,maxtermd_1
- v1c(1,l,i,j,k,iblock)=0.0D0
- v1s(1,l,i,j,k,iblock)=0.0D0
- v1c(2,l,i,j,k,iblock)=0.0D0
- v1s(2,l,i,j,k,iblock)=0.0D0
- enddo !l
- do l=1,maxtermd_2
- do m=1,maxtermd_2
- v2c(m,l,i,j,k,iblock)=0.0D0
- v2s(m,l,i,j,k,iblock)=0.0D0
- enddo !m
- enddo !l
- enddo !k
- enddo !j
- enddo !i
- enddo !i
- do i=1,maxres
- itype(i)=0
- itel(i)=0
- enddo
-C Initialize the bridge arrays
- ns=0
- nss=0
- nhpb=0
- do i=1,maxss
- iss(i)=0
- enddo
- do i=1,maxdim
- dhpb(i)=0.0D0
- enddo
- do i=1,maxres
- ihpb(i)=0
- jhpb(i)=0
- enddo
-C
-C Initialize timing.
-C
- call set_timers
-C
-C Initialize variables used in minimization.
-C
-c maxfun=5000
-c maxit=2000
- maxfun=500
- maxit=200
- tolf=1.0D-2
- rtolf=5.0D-4
-C
-C Initialize the variables responsible for the mode of gradient storage.
-C
- nfl=0
- icg=1
-C
-C Initialize constants used to split the energy into long- and short-range
-C components
-C
- r_cut=2.0d0
- rlamb=0.3d0
-#ifndef SPLITELE
- nprint_ene=nprint_ene-1
-#endif
- return
- end
-c-------------------------------------------------------------------------
- block data nazwy
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- data restyp /
- &'DD' ,'DPR','DLY','DAR','DHI','DAS','DGL','DSG','DGN','DSN','DTH',
- &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
- &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
- &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
- data onelet /
- &'z','p','k','r','h','d','e','n','q','s','t','g',
- &'a','y','w','v','l','i','f','m','c','x',
- &'C','M','F','I','L','V','W','Y','A','G','T',
- &'S','Q','N','E','D','H','R','K','P','X'/
- data potname /'LJ','LJK','BP','GB','GBV'/
- data ename /
- & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
- & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
- & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
- & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," ",
- & "DFA DIS","DFA TOR","DFA NEI","DFA BET"/
- data wname /
- & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
- & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
- & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
- & " "," ","WDFAD","WDFAT","WDFAN","WDFAB"/
- data nprint_ene /24/
- data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
- & 21,24,25,26,27,0,0,0/
- end
-c---------------------------------------------------------------------------
- subroutine init_int_table
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
- integer blocklengths(15),displs(15)
-#endif
- include 'COMMON.CONTROL'
- include 'COMMON.SETUP'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.LOCAL'
- include 'COMMON.SBRIDGE'
- include 'COMMON.TORCNSTR'
- include 'COMMON.IOUNITS'
- include 'COMMON.DERIV'
- include 'COMMON.CONTACTS'
- 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),
- &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
- & ielend_all(maxres,0:max_fg_procs-1),
- & ntask_cont_from_all(0:max_fg_procs-1),
- & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
- & ntask_cont_to_all(0:max_fg_procs-1),
- & 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
-#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)
-C... Determine the numbers of start and end SC-SC interaction
-C... to deal with by current processor.
- do i=0,nfgtasks-1
- itask_cont_from(i)=fg_rank
- itask_cont_to(i)=fg_rank
- enddo
- lprint=.false.
- 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)
- 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
- iatsc_s=0
- iatsc_e=0
-#endif
-c lprint=.false.
- do i=1,maxres
- nint_gr(i)=0
- nscp_gr(i)=0
- do j=1,maxint_gr
- istart(i,1)=0
- iend(i,1)=0
- ielstart(i)=0
- ielend(i)=0
- iscpstart(i,1)=0
- iscpend(i,1)=0
- enddo
- enddo
- ind_scint=0
- ind_scint_old=0
-cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
-cd & (ihpb(i),jhpb(i),i=1,nss)
- do i=nnt,nct-1
- scheck=.false.
- do ii=1,nss
- if (ihpb(ii).eq.i+nres) then
- scheck=.true.
- jj=jhpb(ii)-nres
- goto 10
- endif
- enddo
- 10 continue
-cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
- if (scheck) then
- 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,
- & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
-#else
- nint_gr(i)=1
- istart(i,1)=i+2
- iend(i,1)=nct
-#endif
- 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,
- & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
-#else
- nint_gr(i)=1
- istart(i,1)=i+1
- iend(i,1)=nct-1
-#endif
- else
-#ifdef MPI
- call int_partition(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,
- & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
-#else
- nint_gr(i)=2
- istart(i,1)=i+1
- iend(i,1)=jj-1
- istart(i,2)=jj+1
- iend(i,2)=nct
-#endif
- endif
- else
-#ifdef MPI
- call int_partition(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
- istart(i,1)=i+1
- iend(i,1)=nct
- ind_scint=ind_scint+nct-i
-#endif
- endif
-#ifdef MPI
- ind_scint_old=ind_scint
-#endif
- enddo
- 12 continue
-#ifndef MPI
- iatsc_s=nnt
- iatsc_e=nct-1
-#endif
-#ifdef MPI
- if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
- & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
-#endif
- if (lprint) then
- write (iout,'(a)') 'Interaction array:'
- do i=iatsc_s,iatsc_e
- write (iout,'(i3,2(2x,2i3))')
- & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
- enddo
- endif
- ispp=4
-#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)
- if (lprint)
- & write (*,*) 'Processor',fg_rank,' CG group',kolor,
- & ' absolute rank',MyRank,
- & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
- & ' my_ele_inde',my_ele_inde
- iatel_s=0
- iatel_e=0
- ind_eleint=0
- ind_eleint_old=0
- do i=nnt,nct-3
- ijunk=0
- call int_partition(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
-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)
-c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
-c & " my_ele_inde_vdw",my_ele_inde_vdw
- ind_eleint_vdw=0
- ind_eleint_vdw_old=0
- iatel_s_vdw=0
- iatel_e_vdw=0
- do i=nnt,nct-3
- ijunk=0
- call int_partition(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)
-c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
-c & " ielend_vdw",ielend_vdw(i)
- enddo ! i
- if (iatel_s_vdw.eq.0) iatel_s_vdw=1
- 15 continue
-#else
- iatel_s=nnt
- iatel_e=nct-5
- do i=iatel_s,iatel_e
- ielstart(i)=i+4
- ielend(i)=nct-1
- enddo
- iatel_s_vdw=nnt
- iatel_e_vdw=nct-3
- do i=iatel_s_vdw,iatel_e_vdw
- ielstart_vdw(i)=i+2
- ielend_vdw(i)=nct-1
- enddo
-#endif
- if (lprint) then
- write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
- & ' 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)
- 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)
- 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,
- & ' my_scp_inde',my_scp_inde
- iatscp_s=0
- iatscp_e=0
- ind_scpint=0
- ind_scpint_old=0
- 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,
- & 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,
- & 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,
- & 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,
- & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
- & iscpend(i,ii),*14)
- endif
- enddo ! i
- 14 continue
-#else
- iatscp_s=nnt
- iatscp_e=nct-1
- do i=nnt,nct-1
- if (i.lt.nnt+iscp) then
- nscp_gr(i)=1
- iscpstart(i,1)=i+iscp
- iscpend(i,1)=nct
- elseif (i.gt.nct-iscp) then
- nscp_gr(i)=1
- iscpstart(i,1)=nnt
- iscpend(i,1)=i-iscp
- else
- nscp_gr(i)=2
- iscpstart(i,1)=nnt
- iscpend(i,1)=i-iscp
- iscpstart(i,2)=i+iscp
- iscpend(i,2)=nct
- endif
- enddo ! i
-#endif
- if (lprint) then
- write (iout,'(a)') 'SC-p interaction array:'
- do i=iatscp_s,iatscp_e
- write (iout,'(i3,2(2x,2i3))')
- & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
- enddo
- endif ! lprint
-C Partition local interactions
-#ifdef MPI
- call int_bounds(nres-2,loc_start,loc_end)
- loc_start=loc_start+1
- loc_end=loc_end+1
- call int_bounds(nres-2,ithet_start,ithet_end)
- ithet_start=ithet_start+2
- ithet_end=ithet_end+2
- call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
- iturn3_start=iturn3_start+nnt
- iphi_start=iturn3_start+2
- iturn3_end=iturn3_end+nnt
- iphi_end=iturn3_end+2
- iturn3_start=iturn3_start-1
- iturn3_end=iturn3_end-1
- call int_bounds(nres-3,iphi1_start,iphi1_end)
- iphi1_start=iphi1_start+3
- iphi1_end=iphi1_end+3
- call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
- iturn4_start=iturn4_start+nnt
- iphid_start=iturn4_start+2
- iturn4_end=iturn4_end+nnt
- iphid_end=iturn4_end+2
- iturn4_start=iturn4_start-1
- iturn4_end=iturn4_end-1
- call int_bounds(nres-2,ibond_start,ibond_end)
- ibond_start=ibond_start+1
- ibond_end=ibond_end+1
- call int_bounds(nct-nnt,ibondp_start,ibondp_end)
- ibondp_start=ibondp_start+nnt
- ibondp_end=ibondp_end+nnt
- call int_bounds1(nres-1,ivec_start,ivec_end)
- print *,"Processor",myrank,fg_rank,fg_rank1,
- & " ivec_start",ivec_start," ivec_end",ivec_end
- iset_start=loc_start+2
- iset_end=loc_end+2
- if (ndih_constr.eq.0) then
- idihconstr_start=1
- idihconstr_end=0
- else
- call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
- endif
- 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
- if (lprint) then
- write (*,*) 'Processor:',fg_rank,' CG group',kolor,
- & ' absolute rank',myrank,
- & ' loc_start',loc_start,' loc_end',loc_end,
- & ' ithet_start',ithet_start,' ithet_end',ithet_end,
- & ' iphi_start',iphi_start,' iphi_end',iphi_end,
- & ' iphid_start',iphid_start,' iphid_end',iphid_end,
- & ' ibond_start',ibond_start,' ibond_end',ibond_end,
- & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
- & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
- & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
- & ' ivec_start',ivec_start,' ivec_end',ivec_end,
- & ' iset_start',iset_start,' iset_end',iset_end,
- & ' idihconstr_start',idihconstr_start,' idihconstr_end',
- & idihconstr_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
- endif
- if (nfgtasks.gt.1) then
- call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
- & MPI_INTEGER,FG_COMM1,IERROR)
- iaux=ivec_end-ivec_start+1
- call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
- & MPI_INTEGER,FG_COMM1,IERROR)
- call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- iaux=iset_end-iset_start+1
- call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- iaux=ibond_end-ibond_start+1
- call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- iaux=ithet_end-ithet_start+1
- call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- iaux=iphi_end-iphi_start+1
- call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- iaux=iphi1_end-iphi1_start+1
- call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- do i=0,maxprocs-1
- do j=1,maxres
- ielstart_all(j,i)=0
- ielend_all(j,i)=0
- enddo
- enddo
- call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
- & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
- & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
- & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
- & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(iatel_s,1,MPI_INTEGER,
- & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(iatel_e,1,MPI_INTEGER,
- & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
- & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
- & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
- if (lprint) then
- write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
- write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
- write (iout,*) "iturn3_start_all",
- & (iturn3_start_all(i),i=0,nfgtasks-1)
- write (iout,*) "iturn3_end_all",
- & (iturn3_end_all(i),i=0,nfgtasks-1)
- write (iout,*) "iturn4_start_all",
- & (iturn4_start_all(i),i=0,nfgtasks-1)
- write (iout,*) "iturn4_end_all",
- & (iturn4_end_all(i),i=0,nfgtasks-1)
- write (iout,*) "The ielstart_all array"
- do i=nnt,nct
- write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
- enddo
- write (iout,*) "The ielend_all array"
- do i=nnt,nct
- write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
- enddo
- call flush(iout)
- endif
- ntask_cont_from=0
- ntask_cont_to=0
- itask_cont_from(0)=fg_rank
- itask_cont_to(0)=fg_rank
- flag=.false.
- do ii=iturn3_start,iturn3_end
- call add_int(ii,ii+2,iturn3_sent(1,ii),
- & ntask_cont_to,itask_cont_to,flag)
- enddo
- do ii=iturn4_start,iturn4_end
- call add_int(ii,ii+3,iturn4_sent(1,ii),
- & ntask_cont_to,itask_cont_to,flag)
- enddo
- do ii=iturn3_start,iturn3_end
- call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
- enddo
- do ii=iturn4_start,iturn4_end
- call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
- enddo
- if (lprint) then
- write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
- & " ntask_cont_to",ntask_cont_to
- write (iout,*) "itask_cont_from",
- & (itask_cont_from(i),i=1,ntask_cont_from)
- write (iout,*) "itask_cont_to",
- & (itask_cont_to(i),i=1,ntask_cont_to)
- call flush(iout)
- endif
-c write (iout,*) "Loop forward"
-c call flush(iout)
- do i=iatel_s,iatel_e
-c write (iout,*) "from loop i=",i
-c call flush(iout)
- do j=ielstart(i),ielend(i)
- call add_int_from(i,j,ntask_cont_from,itask_cont_from)
- enddo
- enddo
-c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
-c & " iatel_e",iatel_e
-c call flush(iout)
- nat_sent=0
- do i=iatel_s,iatel_e
-c write (iout,*) "i",i," ielstart",ielstart(i),
-c & " ielend",ielend(i)
-c call flush(iout)
- flag=.false.
- do j=ielstart(i),ielend(i)
- call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
- & itask_cont_to,flag)
- enddo
- if (flag) then
- nat_sent=nat_sent+1
- iat_sent(nat_sent)=i
- endif
- enddo
- if (lprint) then
- write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
- & " ntask_cont_to",ntask_cont_to
- write (iout,*) "itask_cont_from",
- & (itask_cont_from(i),i=1,ntask_cont_from)
- write (iout,*) "itask_cont_to",
- & (itask_cont_to(i),i=1,ntask_cont_to)
- call flush(iout)
- write (iout,*) "iint_sent"
- do i=1,nat_sent
- ii=iat_sent(i)
- write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
- & j=ielstart(ii),ielend(ii))
- enddo
- write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
- & " iturn3_end",iturn3_end
- write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
- & i=iturn3_start,iturn3_end)
- write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
- & " iturn4_end",iturn4_end
- write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
- & i=iturn4_start,iturn4_end)
- call flush(iout)
- endif
- call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
- & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
-c write (iout,*) "Gather ntask_cont_from ended"
-c call flush(iout)
- call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
- & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
- & FG_COMM,IERR)
-c write (iout,*) "Gather itask_cont_from ended"
-c call flush(iout)
- call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
- & 1,MPI_INTEGER,king,FG_COMM,IERR)
-c write (iout,*) "Gather ntask_cont_to ended"
-c call flush(iout)
- call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
- & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
-c write (iout,*) "Gather itask_cont_to ended"
-c call flush(iout)
- if (fg_rank.eq.king) then
- write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
- do i=0,nfgtasks-1
- write (iout,'(20i4)') i,ntask_cont_from_all(i),
- & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
- enddo
- write (iout,*)
- call flush(iout)
- write (iout,*) "Contact send task map (proc, #tasks, tasks)"
- do i=0,nfgtasks-1
- write (iout,'(20i4)') i,ntask_cont_to_all(i),
- & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
- enddo
- write (iout,*)
- call flush(iout)
-C Check if every send will have a matching receive
- ncheck_to=0
- ncheck_from=0
- do i=0,nfgtasks-1
- ncheck_to=ncheck_to+ntask_cont_to_all(i)
- ncheck_from=ncheck_from+ntask_cont_from_all(i)
- enddo
- write (iout,*) "Control sums",ncheck_from,ncheck_to
- if (ncheck_from.ne.ncheck_to) then
- write (iout,*) "Error: #receive differs from #send."
- write (iout,*) "Terminating program...!"
- call flush(iout)
- flag=.false.
- else
- flag=.true.
- do i=0,nfgtasks-1
- do j=1,ntask_cont_to_all(i)
- ii=itask_cont_to_all(j,i)
- do k=1,ntask_cont_from_all(ii)
- if (itask_cont_from_all(k,ii).eq.i) then
- if(lprint)write(iout,*)"Matching send/receive",i,ii
- exit
- endif
- enddo
- if (k.eq.ntask_cont_from_all(ii)+1) then
- flag=.false.
- write (iout,*) "Error: send by",j," to",ii,
- & " would have no matching receive"
- endif
- enddo
- enddo
- endif
- if (.not.flag) then
- write (iout,*) "Unmatched sends; terminating program"
- call flush(iout)
- endif
- endif
- call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
-c write (iout,*) "flag broadcast ended flag=",flag
-c call flush(iout)
- if (.not.flag) then
- call MPI_Finalize(IERROR)
- stop "Error in INIT_INT_TABLE: unmatched send/receive."
- endif
- call MPI_Comm_group(FG_COMM,fg_group,IERR)
-c write (iout,*) "MPI_Comm_group ended"
-c call flush(iout)
- call MPI_Group_incl(fg_group,ntask_cont_from+1,
- & itask_cont_from(0),CONT_FROM_GROUP,IERR)
- call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
- & CONT_TO_GROUP,IERR)
- do i=1,nat_sent
- ii=iat_sent(i)
- iaux=4*(ielend(ii)-ielstart(ii)+1)
- call MPI_Group_translate_ranks(fg_group,iaux,
- & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
- & iint_sent_local(1,ielstart(ii),i),IERR )
-c write (iout,*) "Ranks translated i=",i
-c call flush(iout)
- enddo
- iaux=4*(iturn3_end-iturn3_start+1)
- call MPI_Group_translate_ranks(fg_group,iaux,
- & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
- & iturn3_sent_local(1,iturn3_start),IERR)
- iaux=4*(iturn4_end-iturn4_start+1)
- call MPI_Group_translate_ranks(fg_group,iaux,
- & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
- & iturn4_sent_local(1,iturn4_start),IERR)
- if (lprint) then
- write (iout,*) "iint_sent_local"
- do i=1,nat_sent
- ii=iat_sent(i)
- write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
- & j=ielstart(ii),ielend(ii))
- call flush(iout)
- enddo
- write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
- & " iturn3_end",iturn3_end
- write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
- & i=iturn3_start,iturn3_end)
- write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
- & " iturn4_end",iturn4_end
- write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
- & i=iturn4_start,iturn4_end)
- call flush(iout)
- endif
- call MPI_Group_free(fg_group,ierr)
- call MPI_Group_free(cont_from_group,ierr)
- call MPI_Group_free(cont_to_group,ierr)
- call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
- call MPI_Type_commit(MPI_UYZ,IERROR)
- call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
- & IERROR)
- call MPI_Type_commit(MPI_UYZGRAD,IERROR)
- 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)
- call MPI_Type_commit(MPI_MAT1,IERROR)
- call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
- call MPI_Type_commit(MPI_MAT2,IERROR)
- call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
- call MPI_Type_commit(MPI_THET,IERROR)
- call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
- call MPI_Type_commit(MPI_GAM,IERROR)
-#ifndef MATGATHER
-c 9/22/08 Derived types to send matrices which appear in correlation terms
- do i=0,nfgtasks-1
- if (ivec_count(i).eq.ivec_count(0)) then
- lentyp(i)=0
- else
- lentyp(i)=1
- endif
- enddo
- do ind_typ=lentyp(0),lentyp(nfgtasks-1)
- if (ind_typ.eq.0) then
- ichunk=ivec_count(0)
- else
- ichunk=ivec_count(1)
- endif
-c do i=1,4
-c blocklengths(i)=4
-c enddo
-c displs(1)=0
-c do i=2,4
-c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
-c enddo
-c do i=1,4
-c blocklengths(i)=blocklengths(i)*ichunk
-c enddo
-c write (iout,*) "blocklengths and displs"
-c do i=1,4
-c write (iout,*) i,blocklengths(i),displs(i)
-c enddo
-c call flush(iout)
-c call MPI_Type_indexed(4,blocklengths(1),displs(1),
-c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
-c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
-c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
-c do i=1,4
-c blocklengths(i)=2
-c enddo
-c displs(1)=0
-c do i=2,4
-c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
-c enddo
-c do i=1,4
-c blocklengths(i)=blocklengths(i)*ichunk
-c enddo
-c write (iout,*) "blocklengths and displs"
-c do i=1,4
-c write (iout,*) i,blocklengths(i),displs(i)
-c enddo
-c call flush(iout)
-c call MPI_Type_indexed(4,blocklengths(1),displs(1),
-c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
-c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
-c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
- do i=1,8
- blocklengths(i)=2
- enddo
- displs(1)=0
- do i=2,8
- displs(i)=displs(i-1)+blocklengths(i-1)*maxres
- enddo
- do i=1,15
- blocklengths(i)=blocklengths(i)*ichunk
- enddo
- call MPI_Type_indexed(8,blocklengths,displs,
- & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
- call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
- do i=1,8
- blocklengths(i)=4
- enddo
- displs(1)=0
- do i=2,8
- displs(i)=displs(i-1)+blocklengths(i-1)*maxres
- enddo
- do i=1,15
- blocklengths(i)=blocklengths(i)*ichunk
- enddo
- call MPI_Type_indexed(8,blocklengths,displs,
- & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
- call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
- do i=1,6
- blocklengths(i)=4
- enddo
- displs(1)=0
- do i=2,6
- displs(i)=displs(i-1)+blocklengths(i-1)*maxres
- enddo
- do i=1,6
- blocklengths(i)=blocklengths(i)*ichunk
- enddo
- call MPI_Type_indexed(6,blocklengths,displs,
- & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
- call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
- do i=1,2
- blocklengths(i)=8
- enddo
- displs(1)=0
- do i=2,2
- displs(i)=displs(i-1)+blocklengths(i-1)*maxres
- enddo
- do i=1,2
- blocklengths(i)=blocklengths(i)*ichunk
- enddo
- call MPI_Type_indexed(2,blocklengths,displs,
- & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
- call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
- do i=1,4
- blocklengths(i)=1
- enddo
- displs(1)=0
- do i=2,4
- displs(i)=displs(i-1)+blocklengths(i-1)*maxres
- enddo
- do i=1,4
- blocklengths(i)=blocklengths(i)*ichunk
- enddo
- call MPI_Type_indexed(4,blocklengths,displs,
- & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
- call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
- enddo
-#endif
- endif
- iint_start=ivec_start+1
- iint_end=ivec_end+1
- do i=0,nfgtasks-1
- iint_count(i)=ivec_count(i)
- iint_displ(i)=ivec_displ(i)
- ivec_displ(i)=ivec_displ(i)-1
- iset_displ(i)=iset_displ(i)-1
- ithet_displ(i)=ithet_displ(i)-1
- iphi_displ(i)=iphi_displ(i)-1
- iphi1_displ(i)=iphi1_displ(i)-1
- ibond_displ(i)=ibond_displ(i)-1
- enddo
- if (nfgtasks.gt.1 .and. fg_rank.eq.king
- & .and. (me.eq.0 .or. out1file)) then
- write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
- do i=0,nfgtasks-1
- write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
- & iset_count(i)
- enddo
- write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
- & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
- write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
- do i=0,nfgtasks-1
- write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
- & iphi1_displ(i)
- enddo
- write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
- & nele_int_tot,' electrostatic and ',nscp_int_tot,
- & ' SC-p interactions','were distributed among',nfgtasks,
- & ' fine-grain processors.'
- endif
-#else
- loc_start=2
- loc_end=nres-1
- ithet_start=3
- ithet_end=nres
- iturn3_start=nnt
- iturn3_end=nct-3
- iturn4_start=nnt
- iturn4_end=nct-4
- iphi_start=nnt+3
- iphi_end=nct
- iphi1_start=4
- iphi1_end=nres
- idihconstr_start=1
- idihconstr_end=ndih_constr
- iphid_start=iphi_start
- iphid_end=iphi_end-1
- ibond_start=2
- ibond_end=nres-1
- ibondp_start=nnt+1
- ibondp_end=nct
- ivec_start=1
- ivec_end=nres-1
- iset_start=3
- iset_end=nres+1
- iint_start=2
- iint_end=nres-1
-#endif
- return
- end
-#ifdef MPI
-c---------------------------------------------------------------------------
- subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
- implicit none
- include "DIMENSIONS"
- include "COMMON.INTERACT"
- include "COMMON.SETUP"
- include "COMMON.IOUNITS"
- integer ii,jj,itask(4),ntask_cont_to,
- & itask_cont_to(0:max_fg_procs-1)
- logical flag
- integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
- & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
- 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),
- &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
- & ielend_all(maxres,0:max_fg_procs-1)
- integer iproc,isent,k,l
-c Determines whether to send interaction ii,jj to other processors; a given
-c interaction can be sent to at most 2 processors.
-c Sets flag=.true. if interaction ii,jj needs to be sent to at least
-c one processor, otherwise flag is unchanged from the input value.
- isent=0
- itask(1)=fg_rank
- itask(2)=fg_rank
- itask(3)=fg_rank
- itask(4)=fg_rank
-c write (iout,*) "ii",ii," jj",jj
-c Loop over processors to check if anybody could need interaction ii,jj
- do iproc=0,fg_rank-1
-c Check if the interaction matches any turn3 at iproc
- do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
- l=k+2
- if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
- & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
- & then
-c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
-c call flush(iout)
- flag=.true.
- if (iproc.ne.itask(1).and.iproc.ne.itask(2)
- & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
- isent=isent+1
- itask(isent)=iproc
- call add_task(iproc,ntask_cont_to,itask_cont_to)
- endif
- endif
- enddo
-C Check if the interaction matches any turn4 at iproc
- do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
- l=k+3
- if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
- & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
- & then
-c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
-c call flush(iout)
- flag=.true.
- if (iproc.ne.itask(1).and.iproc.ne.itask(2)
- & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
- isent=isent+1
- itask(isent)=iproc
- call add_task(iproc,ntask_cont_to,itask_cont_to)
- endif
- endif
- enddo
- if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
- & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
- if (ielstart_all(ii-1,iproc).le.jj-1.and.
- & ielend_all(ii-1,iproc).ge.jj-1) then
- flag=.true.
- if (iproc.ne.itask(1).and.iproc.ne.itask(2)
- & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
- isent=isent+1
- itask(isent)=iproc
- call add_task(iproc,ntask_cont_to,itask_cont_to)
- endif
- endif
- if (ielstart_all(ii-1,iproc).le.jj+1.and.
- & ielend_all(ii-1,iproc).ge.jj+1) then
- flag=.true.
- if (iproc.ne.itask(1).and.iproc.ne.itask(2)
- & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
- isent=isent+1
- itask(isent)=iproc
- call add_task(iproc,ntask_cont_to,itask_cont_to)
- endif
- endif
- endif
- enddo
- return
- end
-c---------------------------------------------------------------------------
- subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
- implicit none
- include "DIMENSIONS"
- include "COMMON.INTERACT"
- include "COMMON.SETUP"
- include "COMMON.IOUNITS"
- integer ii,jj,itask(2),ntask_cont_from,
- & itask_cont_from(0:max_fg_procs-1)
- logical flag
- integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
- & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
- 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),
- &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
- & ielend_all(maxres,0:max_fg_procs-1)
- integer iproc,k,l
- do iproc=fg_rank+1,nfgtasks-1
- do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
- l=k+2
- if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
- & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
- & then
-c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
- call add_task(iproc,ntask_cont_from,itask_cont_from)
- endif
- enddo
- do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
- l=k+3
- if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
- & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
- & then
-c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
- call add_task(iproc,ntask_cont_from,itask_cont_from)
- endif
- enddo
- if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
- if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
- & then
- if (jj+1.ge.ielstart_all(ii+1,iproc).and.
- & jj+1.le.ielend_all(ii+1,iproc)) then
- call add_task(iproc,ntask_cont_from,itask_cont_from)
- endif
- if (jj-1.ge.ielstart_all(ii+1,iproc).and.
- & jj-1.le.ielend_all(ii+1,iproc)) then
- call add_task(iproc,ntask_cont_from,itask_cont_from)
- endif
- endif
- if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
- & then
- if (jj-1.ge.ielstart_all(ii-1,iproc).and.
- & jj-1.le.ielend_all(ii-1,iproc)) then
- call add_task(iproc,ntask_cont_from,itask_cont_from)
- endif
- if (jj+1.ge.ielstart_all(ii-1,iproc).and.
- & jj+1.le.ielend_all(ii-1,iproc)) then
- call add_task(iproc,ntask_cont_from,itask_cont_from)
- endif
- endif
- endif
- enddo
- return
- end
-c---------------------------------------------------------------------------
- subroutine add_task(iproc,ntask_cont,itask_cont)
- implicit none
- include "DIMENSIONS"
- integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
- integer ii
- do ii=1,ntask_cont
- if (itask_cont(ii).eq.iproc) return
- enddo
- ntask_cont=ntask_cont+1
- itask_cont(ntask_cont)=iproc
- return
- end
-c---------------------------------------------------------------------------
- subroutine int_bounds(total_ints,lower_bound,upper_bound)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.SETUP'
- integer total_ints,lower_bound,upper_bound
- integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
- 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 real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.SETUP'
- integer total_ints,lower_bound,upper_bound
- integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
- nint=total_ints/nfgtasks1
- do i=1,nfgtasks1
- int4proc(i-1)=nint
- enddo
- nexcess=total_ints-nint*nfgtasks1
- do i=1,nexcess
- int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
- enddo
- lower_bound=0
- do i=0,fg_rank1-1
- lower_bound=lower_bound+int4proc(i)
- enddo
- upper_bound=lower_bound+int4proc(fg_rank1)
- lower_bound=lower_bound+1
- return
- end
-c---------------------------------------------------------------------------
- subroutine int_partition(int_index,lower_index,upper_index,atom,
- & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- integer int_index,lower_index,upper_index,atom,at_start,at_end,
- & first_atom,last_atom,int_gr,jat_start,jat_end
- 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
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SBRIDGE'
- include 'COMMON.IOUNITS'
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
-#ifdef MPI
- call int_bounds(nhpb,link_start,link_end)
- if (.not. out1file)
- & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
- & ' absolute rank',MyRank,
- & ' nhpb',nhpb,' link_start=',link_start,
- & ' link_end',link_end
-#else
- link_start=1
- link_end=nhpb
-#endif
- return
- end
projects / unres.git / blobdiff