source/wham/src-NEWSC/wham_multparm.F

   1       program WHAM_multparm
   2 c Creation/update of the database of conformations
   3       implicit none
   4 #ifndef ISNAN
   5       external proc_proc
   6 #endif
   7 #ifdef WINPGI
   8 cMS$ATTRIBUTES C ::  proc_proc
   9 #endif
  10       include "DIMENSIONS"
  11       include "DIMENSIONS.ZSCOPT"
  12       include "DIMENSIONS.FREE"
  13 #ifdef MPI
  14       include "mpif.h"
  15       integer IERROR,ERRCODE
  16       include "COMMON.MPI"
  17 #endif
  18       include "COMMON.IOUNITS"
  19       include "COMMON.FREE"
  20       include "COMMON.CONTROL"
  21       include "COMMON.ALLPARM"
  22       include "COMMON.PROT"
  23       double precision rr,x(max_paropt)
  24       integer idumm
  25       integer i,ipar,islice
  26 #ifdef MPI
  27       call MPI_Init( IERROR )
  28       call MPI_Comm_rank( MPI_COMM_WORLD, me, IERROR )
  29       call MPI_Comm_size( MPI_COMM_WORLD, nprocs, IERROR )
  30       Master = 0
  31       if (ierror.gt.0) then
  32         write(iout,*) "SEVERE ERROR - Can't initialize MPI."
  33         call mpi_finalize(ierror)
  34         stop
  35       endif
  36       if (nprocs.gt.MaxProcs+1) then
  37         write (2,*) "Error - too many processors",
  38      &   nprocs,MaxProcs+1
  39         write (2,*) "Increase MaxProcs and recompile"
  40         call MPI_Finalize(IERROR)
  41         stop
  42       endif
  43 #endif
  44 c NaNQ initialization
  45 #ifndef ISNAN
  46       i=-1
  47       rr=dacos(100.0d0)
  48 #ifdef WINPGI
  49       idumm=proc_proc(rr,i)
  50 #else
  51       call proc_proc(rr,i)
  52 #endif
  53 #endif
  54       call initialize
  55       call openunits
  56       call cinfo
  57       call read_general_data(*10)
  58       call flush(iout)
  59       call molread(*10)
  60       call flush(iout)
  61 #ifdef MPI
  62       write (iout,*) "Calling proc_groups"
  63       call proc_groups
  64       write (iout,*) "proc_groups exited"
  65       call flush(iout)
  66 #endif
  67 <<<<<<< HEAD
  68 =======
  69 #ifdef SCALREP
  70       write (iout,*) "1,4 SCSC repulsive interactions sacled down by 10"
  71 #endif
  72 >>>>>>> e183793... Added src_MD-M-newcorr (Adasko's source) and src-NEWSC of WHAM (with Momo's SCSC potentials)
  73       do ipar=1,nParmSet
  74         write (iout,*) "Calling parmread",ipar
  75         call parmread(ipar,*10)
  76         if (.not.separate_parset) then
  77           call store_parm(ipar)
  78           write (iout,*) "Finished storing parameters",ipar
  79         else if (ipar.eq.myparm) then
  80           call store_parm(1)
  81           write (iout,*) "Finished storing parameters",ipar
  82         endif
  83         call flush(iout)
  84       enddo
  85       call read_efree(*10)
  86       write (iout,*) "Finished READ_EFREE"
  87       call flush(iout)
  88       call read_protein_data(*10)
  89       write (iout,*) "Finished READ_PROTEIN_DATA"
  90       call flush(iout)
  91       if (indpdb.gt.0) then
  92         call promienie
  93         call read_compar
  94         call read_ref_structure(*10)
  95         call proc_cont
  96         call fragment_list
  97       endif
  98       write (iout,*) "Begin read_database"
  99       call flush(iout)
 100       call read_database(*10)
 101       write (iout,*) "Finished read_database"
 102       call flush(iout)
 103       if (separate_parset) nparmset=1
 104       do islice=1,nslice
 105         if (ntot(islice).gt.0) then
 106 #ifdef MPI
 107           call work_partition(islice,.true.)
 108           write (iout,*) "work_partition OK"
 109           call flush(iout)
 110 #endif
 111           call enecalc(islice,*10)
 112           write (iout,*) "enecalc OK"
 113           call flush(iout)
 114 <<<<<<< HEAD
 115 =======
 116           write (iout,*) "Calling WHAM_calc"
 117           call flush(iout)
 118 >>>>>>> e183793... Added src_MD-M-newcorr (Adasko's source) and src-NEWSC of WHAM (with Momo's SCSC potentials)
 119           call WHAM_CALC(islice,*10)
 120           write (iout,*) "wham_calc OK"
 121           call flush(iout)
 122           call write_dbase(islice,*10)
 123           write (iout,*) "write_dbase OK"
 124           call flush(iout)
 125           if (ensembles.gt.0) then
 126             call make_ensembles(islice,*10)
 127             write (iout,*) "make_ensembles OK"
 128             call flush(iout)
 129           endif
 130         endif
 131       enddo
 132 #ifdef MPI
 133       call MPI_Finalize( IERROR )
 134 #endif
 135       stop
 136    10 write (iout,*) "Error termination of the program"
 137       call MPI_Finalize( IERROR )
 138       stop
 139       end
 140 c------------------------------------------------------------------------------
 141 #ifdef MPI
 142       subroutine proc_groups
 143 C Split the processors into the Master and Workers group, if needed.
 144       implicit none
 145       include "DIMENSIONS"
 146       include "DIMENSIONS.ZSCOPT"
 147       include "DIMENSIONS.FREE"
 148       include "mpif.h"
 149       include "COMMON.IOUNITS"
 150       include "COMMON.MPI"
 151       include "COMMON.FREE"
 152       integer n,chunk,i,j,ii,remainder
 153       integer kolor,key,ierror,errcode
 154       logical lprint
 155       lprint=.true.
 156 C
 157 C Split the communicator if independent runs for different parameter
 158 C sets will be performed.
 159 C
 160       if (nparmset.eq.1 .or. .not.separate_parset) then
 161         WHAM_COMM = MPI_COMM_WORLD
 162       else if (separate_parset) then
 163         if (nprocs.lt.nparmset) then
 164           write (iout,*)
 165      & "*** Cannot split parameter sets for fewer processors than sets",
 166      &  nprocs,nparmset
 167           call MPI_Finalize(ierror)
 168           stop
 169         endif
 170         write (iout,*) "nparmset",nparmset
 171         nprocs = nprocs/nparmset
 172         kolor = me/nprocs
 173         key = mod(me,nprocs)
 174         write (iout,*) "My old rank",me," kolor",kolor," key",key
 175         call MPI_Comm_split(MPI_COMM_WORLD,kolor,key,WHAM_COMM,ierror)
 176         call MPI_Comm_size(WHAM_COMM,nprocs,ierror)
 177         call MPI_Comm_rank(WHAM_COMM,me,ierror)
 178         write (iout,*) "My new rank",me," comm size",nprocs
 179         write (iout,*) "MPI_COMM_WORLD",MPI_COMM_WORLD,
 180      &   " WHAM_COMM",WHAM_COMM
 181         myparm=kolor+1
 182         write (iout,*) "My parameter set is",myparm
 183         call flush(iout)
 184       else
 185         myparm=nparmset
 186       endif
 187       Me1 = Me
 188       Nprocs1 = Nprocs
 189       return
 190       end
 191 c------------------------------------------------------------------------------
 192       subroutine work_partition(islice,lprint)
 193 c Split the conformations between processors
 194       implicit none
 195       include "DIMENSIONS"
 196       include "DIMENSIONS.ZSCOPT"
 197       include "DIMENSIONS.FREE"
 198       include "mpif.h"
 199       include "COMMON.IOUNITS"
 200       include "COMMON.MPI"
 201       include "COMMON.PROT"
 202       integer islice
 203       integer n,chunk,i,j,ii,remainder
 204       integer kolor,key,ierror,errcode
 205       logical lprint
 206 C
 207 C Divide conformations between processors; the first and
 208 C the last conformation to handle by ith processor is stored in
 209 C indstart(i) and indend(i), respectively.
 210 C
 211 C First try to assign equal number of conformations to each processor.
 212 C
 213         n=ntot(islice)
 214         write (iout,*) "n=",n
 215         indstart(0)=1
 216         chunk = N/nprocs1
 217         scount(0) = chunk
 218 c        print *,"i",0," indstart",indstart(0)," scount",
 219 c     &     scount(0)
 220         do i=1,nprocs1-1
 221           indstart(i)=chunk+indstart(i-1)
 222           scount(i)=scount(i-1)
 223 c          print *,"i",i," indstart",indstart(i)," scount",
 224 c     &     scount(i)
 225         enddo
 226 C
 227 C Determine how many conformations remained yet unassigned.
 228 C
 229         remainder=N-(indstart(nprocs1-1)
 230      &    +scount(nprocs1-1)-1)
 231 c        print *,"remainder",remainder
 232 C
 233 C Assign the remainder conformations to consecutive processors, starting
 234 C from the lowest rank; this continues until the list is exhausted.
 235 C
 236         if (remainder .gt. 0) then
 237           do i=1,remainder
 238             scount(i-1) = scount(i-1) + 1
 239             indstart(i) = indstart(i) + i
 240           enddo
 241           do i=remainder+1,nprocs1-1
 242             indstart(i) = indstart(i) + remainder
 243           enddo
 244         endif
 245
 246         indstart(nprocs1)=N+1
 247         scount(nprocs1)=0
 248
 249         do i=0,NProcs1
 250           indend(i)=indstart(i)+scount(i)-1
 251           idispl(i)=indstart(i)-1
 252         enddo
 253
 254         N=0
 255         do i=0,Nprocs1-1
 256           N=N+indend(i)-indstart(i)+1
 257         enddo
 258
 259 c        print *,"N",n," NTOT",ntot(islice)
 260         if (N.ne.ntot(islice)) then
 261           write (iout,*) "!!! Checksum error on processor",me,
 262      &     " slice",islice
 263           call flush(iout)
 264           call MPI_Abort( MPI_COMM_WORLD, Ierror, Errcode )
 265         endif
 266
 267       if (lprint) then
 268         write (iout,*) "Partition of work between processors"
 269           do i=0,nprocs1-1
 270             write (iout,'(a,i5,a,i7,a,i7,a,i7)')
 271      &        "Processor",i," indstart",indstart(i),
 272      &        " indend",indend(i)," count",scount(i)
 273           enddo
 274       endif
 275       return
 276       end
 277 #endif
 278 #ifdef AIX
 279       subroutine flush(iu)
 280       call flush_(iu)
 281       return
 282       end
 283 #endif