+++ /dev/null
- program wham_multparm
-! program WHAM_multparm
-! Creation/update of the database of conformations
- use wham_data
- use io_wham
- use io_database
- use wham_calc
- use ene_calc
- use conform_compar
- use work_part
-!
- use io_units
- use control_data, only:indpdb
-#ifdef MPI
- use mpi_data
-! use mpi_
-#endif
- use control, only:initialize
-!el use io_config, only:parmread
-!
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-!MS$ATTRIBUTES C :: proc_proc
-#endif
-#endif
-!
-!el#ifndef ISNAN
-!el external proc_proc
-!el#endif
-!el#ifdef WINPGI
-!elcMS$ATTRIBUTES C :: proc_proc
-!el#endif
-! include "DIMENSIONS"
-! include "DIMENSIONS.ZSCOPT"
-! include "DIMENSIONS.FREE"
-! implicit none
-#ifdef MPI
-! include "COMMON.MPI"
-! use mpi_data
- include "mpif.h"
- integer :: IERROR,ERRCODE
-#endif
-! include "COMMON.IOUNITS"
-! include "COMMON.FREE"
-! include "COMMON.CONTROL"
-! include "COMMON.ALLPARM"
-! include "COMMON.PROT"
- real(kind=8) :: rr !,x(max_paropt)
- integer :: idumm
- integer :: i,ipar,islice
-
-!el run_wham=.true.
-!#define WHAM_RUN
-! call alloc_wham_arrays
-!write(iout,*) "after alloc wham"
-#ifdef MPI
- call MPI_Init( IERROR )
- call MPI_Comm_rank( MPI_COMM_WORLD, me, IERROR )
- call MPI_Comm_size( MPI_COMM_WORLD, nprocs, IERROR )
- Master = 0
- if (ierror.gt.0) then
- write(iout,*) "SEVERE ERROR - Can't initialize MPI."
- call mpi_finalize(ierror)
- stop
- endif
-!el if (nprocs.gt.MaxProcs+1) then
-!el write (2,*) "Error - too many processors",&
-!el nprocs,MaxProcs+1
-!el write (2,*) "Increase MaxProcs and recompile"
-!el call MPI_Finalize(IERROR)
-!el stop
-!el endif
-#endif
-! NaNQ initialization
-#ifndef ISNAN
- i=-1
- rr=dacos(100.0d0)
-#ifdef WINPGI
- idumm=proc_proc(rr,i)
-#else
- call proc_proc(rr,i)
-#endif
-#endif
-!write(iout,*) "before init"
- call initialize
-!write(iout,*)"after init"
- call openunits
-!write(iout,*)"after open ui"
- call cinfo
-!write(iout,*)"after cinfo"
- call read_general_data(*10)
-!write(iout,*)"after read_gen"
- call flush(iout)
- call molread(*10)
-!write(iout,*)"after molread"
- call flush(iout)
-#ifdef MPI
- write (iout,*) "Calling proc_groups"
- call proc_groups
- write (iout,*) "proc_groups exited"
- call flush(iout)
-#endif
-!el----------
- call alloc_wham_arrays
-!el----------
- do ipar=1,nParmSet
- write (iout,*) "Calling parmread",ipar
- call parmread(ipar,*10)
- if (.not.separate_parset) then
- call store_parm(ipar)
- write (iout,*) "Finished storing parameters",ipar
- else if (ipar.eq.myparm) then
- call store_parm(1)
- write (iout,*) "Finished storing parameters",ipar
- endif
- call flush(iout)
- enddo
- call read_efree(*10)
- write (iout,*) "Finished READ_EFREE"
- call flush(iout)
- call read_protein_data(*10)
- write (iout,*) "Finished READ_PROTEIN_DATA"
- call flush(iout)
- if (indpdb.gt.0) then
- call promienie
- call read_compar
- call read_ref_structure(*10)
-!write(iout,*)"before proc_cont, define frag"
- call proc_cont
- call fragment_list
- if (constr_dist.gt.0) call read_dist_constr
- endif
- write (iout,*) "Begin read_database"
- call flush(iout)
- call read_database(*10)
- write (iout,*) "Finished read_database"
- call flush(iout)
- if (separate_parset) nparmset=1
- do islice=1,nslice
- if (ntot(islice).gt.0) then
-#ifdef MPI
- call work_partition(islice,.true.)
- write (iout,*) "work_partition OK"
- call flush(iout)
-#endif
- write (iout,*) "call enecalc",islice,nslice
- call enecalc(islice,*10)
- write (iout,*) "enecalc OK"
- call flush(iout)
- call WHAMCALC(islice,*10)
- write (iout,*) "wham_calc OK"
- call flush(iout)
- call write_dbase(islice,*10)
- write (iout,*) "write_dbase OK"
- call flush(iout)
- if (ensembles.gt.0) then
- call make_ensembles(islice,*10)
- write (iout,*) "make_ensembles OK"
- call flush(iout)
- endif
- endif
- enddo
-#ifdef MPI
- call MPI_Finalize( IERROR )
-#endif
- stop
- 10 write (iout,*) "Error termination of the program"
-#ifdef MPI
- call MPI_Finalize( IERROR )
-#endif
- stop
- end program wham_multparm
-!------------------------------------------------------------------------------
-!
-!------------------------------------------------------------------------------
-#ifdef MPI
- subroutine proc_groups
-! Split the processors into the Master and Workers group, if needed.
- use io_units
- use MPI_data
- use wham_data
-
- implicit none
-! include "DIMENSIONS"
-! include "DIMENSIONS.ZSCOPT"
-! include "DIMENSIONS.FREE"
-! include "COMMON.IOUNITS"
-! include "COMMON.MPI"
-! include "COMMON.FREE"
- include "mpif.h"
- integer :: n,chunk,i,j,ii,remainder
- integer :: kolorW,key,ierror,errcode
- logical :: lprint
- lprint=.true.
-!
-! Split the communicator if independent runs for different parameter
-! sets will be performed.
-!
- if (nparmset.eq.1 .or. .not.separate_parset) then
- WHAM_COMM = MPI_COMM_WORLD
- else if (separate_parset) then
- if (nprocs.lt.nparmset) then
- write (iout,*) &
- "*** Cannot split parameter sets for fewer processors than sets",&
- nprocs,nparmset
- call MPI_Finalize(ierror)
- stop
- endif
- write (iout,*) "nparmset",nparmset
- nprocs = nprocs/nparmset
- kolorW = me/nprocs
- key = mod(me,nprocs)
- write (iout,*) "My old rank",me," kolor",kolorW," key",key
- call MPI_Comm_split(MPI_COMM_WORLD,kolorW,key,WHAM_COMM,ierror)
- call MPI_Comm_size(WHAM_COMM,nprocs,ierror)
- call MPI_Comm_rank(WHAM_COMM,me,ierror)
- write (iout,*) "My new rank",me," comm size",nprocs
- write (iout,*) "MPI_COMM_WORLD",MPI_COMM_WORLD,&
- " WHAM_COMM",WHAM_COMM
- myparm=kolorW+1
- write (iout,*) "My parameter set is",myparm
- call flush(iout)
- else
- myparm=nparmset
- endif
- Me1 = Me
- Nprocs1 = Nprocs
- return
- end subroutine proc_groups
-#endif
-!------------------------------------------------------------------------------
-#ifdef AIX
- subroutine flush(iu)
- call flush_(iu)
- return
- end subroutine flush
-#endif
-!-----------------------------------------------------------------------------
- subroutine promienie(*)
-
- use io_units
- use names
- use io_base, only:ucase
- use energy_data, only:sigma0,dsc,dsc_inv
- use wham_data
- use w_compar_data
- implicit none
-! include 'DIMENSIONS'
-! include 'COMMON.CONTROL'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CONTPAR'
-! include 'COMMON.LOCAL'
- integer ::i,j
- real(kind=8) :: facont=1.569D0 ! facont = (2/(1-sqrt(1-1/4)))**(1/6)
- character(len=8) :: contfunc
- character(len=8) :: contfuncid(5)=reshape((/'GB ',&
- 'DIST ','CEN ','ODC ','SIG '/),shape(contfuncid))
-!el character(len=8) ucase
- call getenv("CONTFUNC",contfunc)
- contfunc=ucase(contfunc)
- do icomparfunc=1,5
- if (contfunc.eq.contfuncid(icomparfunc)) goto 10
- enddo
- 10 continue
- write (iout,*) "Sidechain contact function is ",contfunc,&
- "icomparfunc",icomparfunc
- do i=1,ntyp
- do j=1,ntyp
- if (icomparfunc.lt.3) then
- read(isidep1,*) chi_comp(i,j),chip_comp(i,j),sig_comp(i,j),&
- sc_cutoff(i,j)
- else if (icomparfunc.lt.5) then
- read(isidep1,*) sc_cutoff(i,j)
- else if (icomparfunc.eq.5) then
- sc_cutoff(i,j)=dsqrt(sigma0(i)**2+sigma0(j)**2)*facont
- else
- write (iout,*) "Error - Unknown contact function"
- return 1
- endif
- enddo
- enddo
- close (isidep1)
- do i=1,ntyp1
- if (i.eq.10 .or. i.eq.ntyp1) then
- dsc_inv(i)=0.0d0
- else
- dsc_inv(i)=1.0d0/dsc(i)
- endif
- enddo
- return
- end subroutine promienie
-!-----------------------------------------------------------------------------
- subroutine alloc_wham_arrays
-
- use names
- use geometry_data, only:nres
- use energy_data, only:maxcont
- use wham_data
- use w_compar_data
- integer :: i,j,k,l
-!-------------------------
-! COMMON.FREE
-! common /wham/
- allocate(stot(nslice)) !(maxslice)
- do i=1,nslice
- stot(i)=0
- enddo
- allocate(Kh(nQ,MaxR,MaxT_h,nParmSet),q0(nQ,MaxR,MaxT_h,nParmSet))!(MaxQ,MaxR,MaxT_h,max_parm)
- allocate(f(maxR,maxT_h,nParmSet)) !(maxR,maxT_h,max_parm)
- allocate(beta_h(maxT_h,nParmSet)) !(MaxT_h,max_parm)
- allocate(nR(maxT_h,nParmSet),nRR(maxT_h,nParmSet)) !(maxT_h,max_parm)
- allocate(snk(MaxR,MaxT_h,nParmSet,nSlice)) !(MaxR,MaxT_h,max_parm,MaxSlice)
-! do i=1,MaxR
-! do j=1,MaxT_h
-! do k=1,nParmSet
-! do l=1,nSlice
-! snk(i,j,k,l)=0
-! enddo
-! enddo
-! enddo
-! enddo
-
- allocate(totraj(maxR,nParmSet)) !(maxR,max_parm)
-
- allocate(nT_h(nParmSet))!(max_parm)
- allocate(replica(nParmSet))
- allocate(umbrella(nParmSet))
- allocate(read_iset(nParmSet))
-! allocate(nT_h(nParmSet))
-!-------------------------
-! COMMON.PROT
-! common /protein/
- allocate(ntot(nslice)) !(maxslice)
-! allocatable :: isampl !(max_parm)
-!-------------------------
-! COMMON.PROTFILES
-! common /protfil/
- allocate(protfiles(maxfile_prot,2,MaxR,MaxT_h,nParmSet)) !(maxfile_prot,2,MaxR,MaxT_h,Max_Parm)
- allocate(nfile_bin(MaxR,MaxT_h,nParmSet))
- allocate(nfile_asc(MaxR,MaxT_h,nParmSet))
- allocate(nfile_cx(MaxR,MaxT_h,nParmSet))
- allocate(rec_start(MaxR,MaxT_h,nParmSet))
- allocate(rec_end(MaxR,MaxT_h,nParmSet)) !(MaxR,MaxT_h,Max_Parm)
-!-------------------------
-! COMMON.OBCINKA
-! common /obcinka/
- allocate(time_start_collect(maxR,MaxT_h,nParmSet))
- allocate(time_end_collect(maxR,MaxT_h,nParmSet)) !(maxR,MaxT_h,Max_Parm)
-!-------------------------
-! COMMON.CONTPAR
-! common /contpar/
- allocate(sig_comp(ntyp,ntyp),chi_comp(ntyp,ntyp),&
- chip_comp(ntyp,ntyp),sc_cutoff(ntyp,ntyp)) !(ntyp,ntyp)
-!-------------------------
-! COMMON.PEPTCONT
-! common /peptcont/
- allocate(icont_pept_ref(2,maxcont)) !(2,maxcont)
-! allocate(ncont_frag_ref()) !(mmaxfrag)
-! allocate(icont_frag_ref(2,maxcont)) !(2,maxcont,mmaxfrag)
- allocate(isec_ref(nres)) !(maxres)
-!-------------------------
-! COMMON.VAR
-! Angles from experimental structure
-! common /varref/
- allocate(vbld_ref(nres),theta_ref(nres),&
- phi_ref(nres),alph_ref(nres),omeg_ref(nres)) !(maxres)
-!-------------------------
- end subroutine alloc_wham_arrays
-!-----------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
projects / unres4.git / blobdiff