source/maxlik/src-Fmatch/gradient_p.F

   1       subroutine cartgrad
   2       implicit real*8 (a-h,o-z)
   3       include 'DIMENSIONS'
   4       include "DIMENSIONS.ZSCOPT"
   5 #ifdef MPI
   6       include 'mpif.h'
   7 #endif
   8       include 'COMMON.CHAIN'
   9       include 'COMMON.DERIV'
  10       include 'COMMON.VAR'
  11       include 'COMMON.INTERACT'
  12       include 'COMMON.FFIELD'
  13       include 'COMMON.MD'
  14       include 'COMMON.IOUNITS'
  15       include 'COMMON.TIME1'
  16       include "COMMON.NAMES"
  17       include "COMMON.ENERGIES"
  18 c
  19 c This subrouting calculates total Cartesian coordinate gradient.
  20 c The subroutine chainbuild_cart and energy MUST be called beforehand.
  21 #ifdef TIMING
  22       time00=MPI_Wtime()
  23 #endif
  24       icg=1
  25 #ifdef DEBUG
  26       write (iout,*) "gradc, gradx, gloc before sum_gradient"
  27       do i=1,nres-1
  28         write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gradc(j,i,icg),j=1,3),
  29      &    (gradx(j,i,icg),j=1,3),gloc(i,icg)
  30       enddo
  31       write (iout,*) "ghpbc ghpbx"
  32       do i=1,nres-1
  33         write (iout,'(i5,2(3f10.5,5x))') i,(ghpbc(j,i),j=1,3),
  34      &    (ghpbx(j,i),j=1,3)
  35       enddo
  36 #endif
  37       call sum_gradient
  38       call sum_gradient_compon
  39 #ifdef DEBUG
  40       write (iout,*) "gradc, gradx, gloc after sum_gradient"
  41       do i=1,nres-1
  42         write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gradc(j,i,icg),j=1,3),
  43      &    (gradx(j,i,icg),j=1,3),gloc(i,icg)
  44       enddo
  45 #endif
  46 c If performing constraint dynamics, add the gradients of the constraint energy
  47 #ifdef TIMING
  48       time01=MPI_Wtime()
  49 #endif
  50       call intcartderiv
  51 #ifdef TIMING
  52       time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
  53 #endif
  54 cd      call checkintcartgrad
  55 cd      write(iout,*) 'calling int_to_cart'
  56 #ifdef DEBUG
  57       write (iout,*) "gcart, gxcart, gloc before int_to_cart"
  58 #endif
  59       do i=1,nct
  60         do j=1,3
  61           gcart(j,i)=gradc(j,i,icg)
  62           gxcart(j,i)=gradx(j,i,icg)
  63         enddo
  64 #ifdef DEBUG
  65         write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),
  66      &    (gxcart(j,i),j=1,3),gloc(i,icg)
  67 #endif
  68       enddo
  69 #ifdef TIMING
  70       time01=MPI_Wtime()
  71 #endif
  72       call int_to_cart
  73 #ifdef TIMING
  74       time_inttocart=time_inttocart+MPI_Wtime()-time01
  75 #endif
  76 #ifdef DEBUG
  77       write (iout,*) "gcart and gxcart after int_to_cart"
  78       do i=0,nres
  79         write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
  80      &      (gxcart(j,i),j=1,3)
  81       enddo
  82       write (iout,*) "Energy components after int_to_cart"
  83       do iene=1,n_ene
  84
  85         write (iout,'(a,i3,1x,a)') "Component",iene,ename(iene)
  86
  87         do i=1,nres
  88           write (iout,'(a4,i5,3e15.5,5x,e15.5,5x,3e15.5,5x,e15.5)')
  89      &      restyp(itype(i)),i,(gcompon(iene,j,i),j=1,3),
  90      &      gloc_compon(iene,i),(gcomponx(iene,j,i),j=1,3),
  91      &      gloc_compon(iene,nres+i)
  92         enddo
  93
  94       enddo
  95 #endif
  96 #ifdef CARGRAD
  97 #ifdef DEBUG
  98       write (iout,*) "CARGRAD"
  99 #endif
 100       do i=nres,1,-1
 101         do j=1,3
 102           gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
 103           do k=1,n_ene
 104             gcompon(k,j,i)=-gcompon(k,j,i)+gcompon(k,j,i-1)
 105      &          -gcomponx(k,j,i)
 106           enddo
 107 !          gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
 108         enddo
 109 !        write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
 110 !            (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
 111       enddo
 112 ! Correction: dummy residues
 113         if (nnt.gt.1) then
 114           do j=1,3
 115 !            gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
 116             gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
 117             do k=1,n_ene
 118               gcompon(k,j,nnt)=gcompon(k,j,nnt)+gcompon(k,j,1)
 119             enddo
 120           enddo
 121         endif
 122         if (nct.lt.nres) then
 123           do j=1,3
 124 !            gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
 125             gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
 126             do k=1,n_ene
 127               gcompon(k,j,nct)=gcompon(k,j,nct)+gcompon(k,j,nres)
 128             enddo
 129           enddo
 130         endif
 131 #ifdef DEBUG
 132       write (iout,*) "gcart and gxcart after trasformation"
 133       do i=0,nres
 134         write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
 135      &      (gxcart(j,i),j=1,3)
 136       enddo
 137
 138       write (iout,*) "Gradient components after transformation"
 139
 140       do iene=1,n_ene
 141
 142         write (iout,'(a,i3,1x,a)') "Component",iene,ename(iene)
 143
 144         do i=1,nres
 145           write (iout,'(a4,i5,3e15.5,5x,e15.5,5x,3e15.5,5x,e15.5)')
 146      &      restyp(itype(i)),i,(gcompon(iene,j,i),j=1,3),
 147      &      gloc_compon(iene,i),(gcomponx(iene,j,i),j=1,3),
 148      &      gloc_compon(iene,nres+i)
 149         enddo
 150
 151       enddo
 152 #endif
 153 #endif
 154 #ifdef TIMING
 155       time_cartgrad=time_cartgrad+MPI_Wtime()-time00
 156 #endif
 157       return
 158       end
 159 C-------------------------------------------------------------------------
 160       subroutine zerograd
 161       implicit real*8 (a-h,o-z)
 162       include 'DIMENSIONS'
 163       include "DIMENSIONS.ZSCOPT"
 164       include 'COMMON.DERIV'
 165       include 'COMMON.CHAIN'
 166       include 'COMMON.VAR'
 167       include 'COMMON.MD'
 168       include 'COMMON.SCCOR'
 169 C
 170 C Initialize Cartesian-coordinate gradient
 171 C
 172       do i=1,nres
 173         do j=1,3
 174           gvdwx(j,i)=0.0D0
 175           gradx_scp(j,i)=0.0D0
 176           gvdwc(j,i)=0.0D0
 177           gvdwc_scp(j,i)=0.0D0
 178           gvdwc_scpp(j,i)=0.0d0
 179           gelc (j,i)=0.0D0
 180           gelc_long(j,i)=0.0D0
 181           gradb(j,i)=0.0d0
 182           gradbx(j,i)=0.0d0
 183           gvdwpp(j,i)=0.0d0
 184           gel_loc(j,i)=0.0d0
 185           gel_loc_long(j,i)=0.0d0
 186           ghpbc(j,i)=0.0D0
 187           ghpbx(j,i)=0.0D0
 188           gcorr3_turn(j,i)=0.0d0
 189           gcorr4_turn(j,i)=0.0d0
 190           gradcorr(j,i)=0.0d0
 191           gradcorr_long(j,i)=0.0d0
 192           gradcorr5_long(j,i)=0.0d0
 193           gradcorr6_long(j,i)=0.0d0
 194           gcorr6_turn_long(j,i)=0.0d0
 195           gradcorr5(j,i)=0.0d0
 196           gradcorr6(j,i)=0.0d0
 197           gcorr6_turn(j,i)=0.0d0
 198           gsccorc(j,i)=0.0d0
 199           gsccorx(j,i)=0.0d0
 200           gradc(j,i,icg)=0.0d0
 201           gradx(j,i,icg)=0.0d0
 202           gscloc(j,i)=0.0d0
 203           gsclocx(j,i)=0.0d0
 204           gliptranc(j,i)=0.0d0
 205           gshieldc(j,i)=0.0d0
 206           gshieldc_ec(j,i)=0.0d0
 207           gshieldc_t3(j,i)=0.0d0
 208           gshieldc_t4(j,i)=0.0d0
 209           gshieldc_ll(j,i)=0.0d0
 210           gradafm(j,i)=0.0d0
 211           gg_tube_sc(j,i)=0.0d0
 212           gg_tube(j,i)=0.0d0
 213           do intertyp=1,3
 214            gloc_sc(intertyp,i,icg)=0.0d0
 215           enddo
 216         enddo
 217       enddo
 218 C
 219 C Initialize the gradient of local energy terms.
 220 C
 221       do i=1,4*nres
 222         gloc(i,icg)=0.0D0
 223       enddo
 224       do i=1,nres
 225         gel_loc_loc(i)=0.0d0
 226         gcorr_loc(i)=0.0d0
 227         g_corr5_loc(i)=0.0d0
 228         g_corr6_loc(i)=0.0d0
 229         gel_loc_turn3(i)=0.0d0
 230         gel_loc_turn4(i)=0.0d0
 231         gel_loc_turn6(i)=0.0d0
 232         gsccor_loc(i)=0.0d0
 233       enddo
 234 c initialize gcart and gxcart
 235       do i=0,nres
 236         do j=1,3
 237           gcart(j,i)=0.0d0
 238           gxcart(j,i)=0.0d0
 239         enddo
 240       enddo
 241       return
 242       end