source/maxlik/src-Fmatch_safe/cutoff_violation.F

   1       subroutine cutoff_violation
   2       implicit none
   3       include "DIMENSIONS"
   4       include "DIMENSIONS.ZSCOPT"
   5 #ifdef MPI
   6       include "mpif.h"
   7       integer IERROR
   8       include "COMMON.MPI"
   9 #endif
  10       include "COMMON.WEIGHTS"
  11       include "COMMON.WEIGHTDER"
  12       include "COMMON.ENERGIES"
  13       include "COMMON.CLASSES"
  14       include "COMMON.VMCPAR"
  15       include "COMMON.IOUNITS"
  16       include "COMMON.COMPAR"
  17 C Define local variables
  18       include "COMMON.TIME1"
  19       integer i,j,k,iprot,ibatch,ib
  20       double precision Evar_aux(maxT,maxbatch,maxprot),
  21      &  Esum_aux(maxT,maxbatch,maxprot),Elowp(maxT,maxbatch,maxprot),
  22      &  Esum(maxT,maxbatch,maxprot),aux,etot_rel,etot_rel_orig
  23       logical lprn
  24       lprn=.true.
  25 #ifdef DEBUG
  26       write (iout,*) "Processor",me,me1," calling CUTOFF_VIOLATION"
  27 #endif
  28       cutoffviol=.false.
  29       do iprot=1,nprot
  30         do ibatch=1,natlike(iprot)+2
  31           do ib=1,nbeta(ibatch,iprot)
  32             Evar_aux(ib,ibatch,iprot)=0.0d0
  33             Esum_aux(ib,ibatch,iprot)=0.0d0
  34           enddo
  35         enddo
  36       enddo
  37       do iprot=1,nprot
  38 #ifdef DEBUG
  39         write (iout,*) "Protein",iprot," E_TOTAL ETOT_ORIG EMIN_ORIG"
  40 #endif
  41         call restore_molinfo(iprot)
  42 #ifdef MPI
  43         do j=indstart(me1,iprot),indend(me1,iprot)
  44 #else
  45         do j=1,ntot_work(iprot)
  46 #endif
  47           do ibatch=1,natlike(iprot)+2
  48           do ib=1,nbeta(ibatch,iprot)
  49           aux = betaT(ib,ibatch,iprot)
  50      &      *(etot_orig(j,iprot)-emin_orig(ib,ibatch,iprot))+
  51      &       entfac(j,iprot)
  52           if (aux .gt. 50.0d0) then
  53             aux=0.0d0
  54           else
  55             aux=dexp(-aux)
  56           endif
  57           etot_rel = e_total(j,iprot)+entfac(j,iprot)/
  58      &       betaT(ib,ibatch,iprot)-elowp(ib,ibatch,iprot)
  59           etot_rel_orig = etot_orig(j,iprot)+entfac(j,iprot)/
  60      &       betaT(ib,ibatch,iprot)-emin_orig(ib,ibatch,iprot)
  61           Evar_aux(ib,ibatch,iprot)=Evar_aux(ib,ibatch,iprot)+
  62      &      aux*(etot_rel-etot_rel_orig)**2
  63           Esum_aux(ib,ibatch,iprot) = Esum_aux(ib,ibatch,iprot) + aux
  64 #ifdef DEBUG
  65           write (iout,'(i7,i3,4e15.5)') j,ibatch,e_total(j,iprot),
  66      &     etot_orig(j,iprot),emin_orig(ib,ibatch,iprot),aux
  67           call flush(iout)
  68 #endif
  69           enddo
  70           enddo
  71         enddo
  72 #ifdef MPI
  73 #ifdef DEBUG
  74         write (iout,*) "Processor",me,me1," before MPI_REDUCE"
  75         write (iout,*) "Evar_aux",
  76      &    ((Evar_aux(ib,k,iprot),ib=1,nbeta(ibatch,iprot)),
  77      &    k=1,nbatch(iprot))
  78         call flush(iout)
  79 #endif
  80         call MPI_Reduce(Evar_aux(1,1,iprot), Evar(1,1,iprot),
  81      &    (natlike(iprot)+2)*MaxT, MPI_DOUBLE_PRECISION,
  82      &    MPI_SUM, Master, Comm1, IERROR)
  83         call MPI_Reduce(Esum_aux(1,1,iprot), Esum(1,1,iprot),
  84      &    (natlike(iprot)+2)*MaxT, MPI_DOUBLE_PRECISION,
  85      &    MPI_SUM, Master, Comm1, IERROR)
  86 #ifdef DEBUG
  87         write (iout,*) "Processor",me,me1," after MPI_REDUCE"
  88         write (iout,*) "Evar_aux",
  89      &    ((Evar_aux(ib,k,iprot),ib=1,nbeta(ibatch,iprot)),
  90      &    k=1,nbatch(iprot))
  91         call flush(iout)
  92 #endif
  93 #endif
  94       enddo
  95       do iprot=1,nprot
  96         do ibatch=1,natlike(iprot)+2
  97          do ib=1,nbeta(ibatch,iprot)
  98 #ifdef DEBUG
  99          write (iout,*) "ib",ib," ibatch",ibatch," iprot",iprot,
 100      &    " Evar",Evar(ib,ibatch,iprot)," Esum",Esum(ib,ibatch,iprot)
 101          call flush(iout)
 102 #endif
 103          if (Esum(ib,ibatch,iprot) .gt. 0.0d0) then
 104          Evar(ib,ibatch,iprot)=dsqrt(Evar(ib,ibatch,iprot)/
 105      &     Esum(ib,ibatch,iprot))
 106          else
 107          Evar(ib,ibatch,iprot)=0.0d0
 108          endif
 109           if (Evar(ib,ibatch,iprot)*betaT(ib,ibatch,iprot)
 110      &      .gt.enecut(iprot)-0.5d0*enecut_min(iprot)+1.0D-3)
 111      &      cutoffviol=.true.
 112 #ifdef DEBUG
 113           write (iout,*) "iprot",iprot," ibatch",ibatch," beta",
 114      &      betaT(ib,ibatch,iprot),
 115      &      " Evar",Evar(ib,ibatch,iprot)," enecut",enecut(iprot),
 116      &      " cutoffviol",cutoffviol
 117           call flush(iout)
 118 #endif
 119           enddo
 120         enddo
 121       enddo
 122       return
 123       end