      subroutine pot(symb,x,y,z,v,dvdx,dvdy,dvdz,natom,maxatom)
c      subroutine pot(symb,x,y,z,v,dvdx,dvdy,dvdz,natom,maxatom,ccc)

      implicit real*8(a-h,o-z)
      dimension x(maxatom),y(maxatom),z(maxatom)
      dimension x2(maxatom),y2(maxatom),z2(maxatom)
      dimension x3(maxatom),y3(maxatom),z3(maxatom)
      dimension dvdx(maxatom),dvdy(maxatom),dvdz(maxatom)
      dimension dvdx2(maxatom),dvdy2(maxatom),dvdz2(maxatom)
      dimension dvdx3(maxatom),dvdy3(maxatom),dvdz3(maxatom)
      parameter(autoev=27.2113961d0)
      parameter(autocmi=219474.63067d0)
      parameter(autoang=0.529177249d0)
      character*2 symb(maxatom),symb2(maxatom),symb3(maxatom)
      integer at(maxatom),at2(maxatom),at3(maxatom)

      dimension tmpprint(50)
      common/tmp/tmpprint

c TMP
      dimension ccc(15)
c TMP

      v=0.d0
      v2=0.d0
      v3=0.d0
      do i=1,natom
      symb2(i)="xx"
      symb3(i)="xx"
      x2(i)=0.d0
      y2(i)=0.d0
      z2(i)=0.d0
      x3(i)=0.d0
      y3(i)=0.d0
      z3(i)=0.d0
      dvdz2(i)=0.d0
      dvdy2(i)=0.d0
      dvdx2(i)=0.d0
      dvdz3(i)=0.d0
      dvdy3(i)=0.d0
      dvdx3(i)=0.d0
      dvdz(i)=0.d0
      dvdy(i)=0.d0
      dvdx(i)=0.d0
      enddo

      do i=1,natom
      at(i)=0
      if ((symb(i).eq."H").or.
     &    (symb(i).eq."h"))  at(i)=1       ! hydrogen
      if ((symb(i).eq."C").or.
     &    (symb(i).eq."c"))  at(i)=2       ! carbon
      if ((symb(i).eq."N").or.
     &    (symb(i).eq."n"))  at(i)=3       ! nitrogen
      if ((symb(i).eq."O").or.
     &    (symb(i).eq."o"))  at(i)=4       ! oxygen
      if ((symb(i).eq."He").or.
     &    (symb(i).eq."he").or.
     &    (symb(i).eq."HE")) at(i)=21      ! helium
      if ((symb(i).eq."Ne").or.
     &    (symb(i).eq."ne").or.
     &    (symb(i).eq."NE")) at(i)=22      ! neon
      if ((symb(i).eq."Ar").or.
     &    (symb(i).eq."ar").or.
     &    (symb(i).eq."AR")) at(i)=23      ! argon
      if ((symb(i).eq."Kr").or.
     &    (symb(i).eq."kr").or.
     &    (symb(i).eq."KR")) at(i)=24      ! krypton
      if ((symb(i).eq."H2").or.
     &    (symb(i).eq."h2")) at(i)=25      ! H2  ! label your bath atoms H2, not H
      if ((symb(i).eq."N2").or.
     &    (symb(i).eq."n2")) at(i)=26      ! N2  ! label your bath atoms N2, not N
      if ((symb(i).eq."C2").or.
     &    (symb(i).eq."c2")) at(i)=27      ! CO bath ! label atoms C2 and O2
      if ((symb(i).eq."O2").or.
     &    (symb(i).eq."c2")) at(i)=28      ! CO bath ! label atoms C2 and O2
      if ((symb(i).eq."O3").or.
     &    (symb(i).eq."o3")) at(i)=29      ! O2 bath ! label atoms O3, not O (the numbers are just labels; yes, it is confusing)
      if (at(i).eq.0) then ! atom not found
           write(6,*)"Atom # ",i," (",symb(i),") not found"
           stop
      endif
      enddo

      natom2=0
      natom3=0
      do i=1,natom
        if (at(i).le.20) then ! collect target atoms
          natom2=natom2+1
          x2(natom2)=x(i)
          y2(natom2)=y(i)
          z2(natom2)=z(i)
          symb2(natom2)=symb(i)
          at2(natom2)=at(i)
        else ! collect bath atoms
          natom3=natom3+1
          x3(natom3)=x(i)
          y3(natom3)=y(i)
          z3(natom3)=z(i)
          symb3(natom3)=symb(i)
          at3(natom3)=at(i)
        endif
      enddo
c      print *,natom,natom2,natom3
      if (natom3.ne.0) then
c        call bath(at3,x3,y3,z3,v3,dvdx3,dvdy3,dvdz3,natom3,maxatom)
c        call rgexp(at,x,y,z,v,dvdx,dvdy,dvdz,natom,maxatom,ccc)
        call lsbath(at,x,y,z,v,dvdx,dvdy,dvdz,natom,maxatom,ccc)
      endif
      if (natom2.ne.0) then
        call ho2(symb2,x2,y2,z2,v2,dvdx2,dvdy2,dvdz2,natom2,maxatom)
      endif

      tmpprint(1)=v

c      print *,v,v2,v3

      v=v+v2+v3

      natom2=0
      natom3=0
      do i=1,natom
        if (at(i).le.20) then
        natom2=natom2+1
        dvdx(i)=dvdx(i)+dvdx2(natom2)
        dvdy(i)=dvdy(i)+dvdy2(natom2)
        dvdz(i)=dvdz(i)+dvdz2(natom2)
        else
        natom3=natom3+1
        dvdx(i)=dvdx(i)+dvdx3(natom3)
        dvdy(i)=dvdy(i)+dvdy3(natom3)
        dvdz(i)=dvdz(i)+dvdz3(natom3)
        endif
      enddo

      return

      end

      subroutine rgexp(at,x,y,z,v,dvdx,dvdy,dvdz,natom,maxatom,ccc)
c Rare Gas exp6 potential subroutine
c loops over geometry and looks for Rg-X interactions
c returns the full Rg-target intermolecular potential and its derivatives

      implicit real*8(a-h,o-z)
      dimension x(maxatom),y(maxatom),z(maxatom)
      dimension dvdx(maxatom),dvdy(maxatom),dvdz(maxatom)
      parameter(autoev=27.2113961d0)
      parameter(autocmi=219474.63067d0)
      parameter(autokcal=627.509d0)
      parameter(autoang=0.529177249d0)
      integer at(maxatom)
      logical troya,cutoff

c TMP
      dimension ccc(15)
c TMP

      v1=0.d0
      v=0.d0
      do i=1,natom
      dvdz(i)=0.d0
      dvdy(i)=0.d0
      dvdx(i)=0.d0
      enddo

      do 1 i=1,natom
      do 2 j=i+1,natom

      m1=min(at(i),at(j))
      m2=max(at(i),at(j))
      troya=.false.   ! do or don't use Troya's form
      cutoff=.false.   ! do or don't use cutoff

      if (m1.ge.21) then ! two rare gases, skip this pair
         go to 2
      endif
      if (m2.le.20) then ! no rare gas, skip this pair
         go to 2
      endif

       if (m2.eq.21) then
        ccc(1) =   6.2813196203497421
        ccc(2) =  0.18875026703695791
        ccc(3) =   4.8749046296578875
        ccc(4) =   2.5312967314676351
        ccc(5) =   6.7499313333536790
        ccc(6) =  0.25311593981749930
        ccc(7) =   5.4999542222357860
        ccc(8) =   2.0362865077669605
       elseif(m2.eq.23) then
        ccc(1)=   7.1964476454969937
        ccc(2)=  0.19953154087954345
        ccc(3)=   6.4964751121555224
        ccc(4)=   2.3697012237922301
        ccc(5)=   7.4057130649739067
        ccc(6)=  0.27445326090273753
        ccc(7)=   7.9421979430524612
        ccc(8)=   2.5391094698934902
       else
        print *,'bad bath in ho2he.f'
        stop
       endif

      if (m2.eq.21.or.m2.eq.23) then  ! He-
        if (m1.eq.1) then !    H
        aa=ccc(1)
        bb=ccc(2)
        cc=ccc(3)
        rrc=ccc(4)
        cutoff=.true.
        aa=10.d0**aa
        elseif (m1.eq.4) then !    O
        aa=ccc(5)
        bb=ccc(6)
        cc=ccc(7)
        rrc=ccc(8)
        cutoff=.true.
        aa=10.d0**aa
        else
          write(6,*)"Cant find a Ar-? interaction"
          stop
        endif
      else
          write(6,*)"Cant find a ?-? interaction"
          stop
      endif
      dx=x(i)-x(j)
      dy=y(i)-y(j)
      dz=z(i)-z(j)
      rr=dsqrt(dx*dx+dy*dy+dz*dz)
      rra=rr*autoang

! NOTE CANNOT HAVE BOTH TROYA FORM AND CUTOFF FORM

      if (troya) then   ! Troya uses different form & units
        v=aa*dexp(-rra*bb)+cc/rra**6
        v=v/autokcal
        dvdr = -aa*bb*dexp(-rra*bb)-6.d0*cc/rra**7
        dvdr=dvdr/autokcal*autoang
      elseif (cutoff) then  ! cutoff 1/R**-6 at short distances
        v=aa*dexp(-rra/bb)-(cc**6/(rra**6+rrc**6))
        v=v/autocmi
        dvdr = -aa/bb*dexp(-rra/bb)
     &      +6.d0*(cc**6)*(rra**5)/(rra**6+rrc**6)**2
        dvdr=dvdr/autocmi*autoang
      else
        v=aa*dexp(-rra/bb)-(cc/rra)**6
        v=v/autocmi
        dvdr = -aa/bb*dexp(-rra/bb)+(6.d0/rra)*(cc/rra)**6
        dvdr=dvdr/autocmi*autoang
      endif
        v1=v1+v

c      print *,m1,m2,rra,v*autocmi,v1*autocmi

c derivs = sum over all bonds (DV/DRij * DRij/DXi = DV/DRij * (Xi-Xj)/Rij)
      dvdx(i) = dvdx(i) + dvdr*dx/rr
      dvdx(j) = dvdx(j) - dvdr*dx/rr
      dvdy(i) = dvdy(i) + dvdr*dy/rr
      dvdy(j) = dvdy(j) - dvdr*dy/rr
      dvdz(i) = dvdz(i) + dvdr*dz/rr
      dvdz(j) = dvdz(j) - dvdr*dz/rr

    2 continue
    1 continue
      v=v1
c      print *,'rgexp',v1
      return
      end

!-----------------------------------------------------------------------
      subroutine ho2(symb,x,y,z,v,dvdx,dvdy,dvdz,natom,maxatom)

! O O H

      implicit real*8(a-h,o-z)
      dimension x(maxatom),y(maxatom),z(maxatom),r(3)
      dimension dvdx(maxatom),xx(3,maxatom)
      dimension dvdy(maxatom)
      dimension dvdz(maxatom)
      parameter(autoang=0.52917706d0)
      parameter(autoev=27.2113961d0)
      parameter(autocmi=219474.63067d0)
      character*2 symb(maxatom)

      v1=0.d0
      do i=1,natom
      dvdx(i)=0.d0
      dvdy(i)=0.d0
      dvdz(i)=0.d0
      enddo

      dx=x(1)-x(2)
      dy=y(1)-y(2)
      dz=z(1)-z(2)
      r(1)=dsqrt(dx*dx+dy*dy+dz*dz)   ! oo
      r(1)=r(1)*autoang

      dx=x(2)-x(3)
      dy=y(2)-y(3)
      dz=z(2)-z(3)
      r(2)=dsqrt(dx*dx+dy*dy+dz*dz)   ! oh1
      r(2)=r(2)*autoang

      dx=x(3)-x(1)
      dy=y(3)-y(1)
      dz=z(3)-z(1)
      r(3)=dsqrt(dx*dx+dy*dy+dz*dz)   ! oh2
      r(3)=r(3)*autoang

      call ho2fit(r,v)
      v=v/autocmi

      resp=0.0001d0

      do i1=1,3
      if (i1.eq.1) i=1
      if (i1.eq.1) j=2
      if (i1.eq.2) i=2
      if (i1.eq.2) j=3
      if (i1.eq.3) i=3
      if (i1.eq.3) j=1
      dx=x(i)-x(j)
      dy=y(i)-y(j)
      dz=z(i)-z(j)
      dx=dx*autoang
      dy=dy*autoang
      dz=dz*autoang
      r(i1)=r(i1)+resp
      call ho2fit(r,vp)
      r(i1)=r(i1)-2.d0*resp
      call ho2fit(r,vm)
      r(i1)=r(i1)+resp
      dtmpdrr=(vp-vm)/(2.d0*resp)/autocmi*autoang
      dvdx(i) = dvdx(i) + dtmpdrr*dx/r(i1)
      dvdx(j) = dvdx(j) - dtmpdrr*dx/r(i1)
      dvdy(i) = dvdy(i) + dtmpdrr*dy/r(i1)
      dvdy(j) = dvdy(j) - dtmpdrr*dy/r(i1)
      dvdz(i) = dvdz(i) + dtmpdrr*dz/r(i1)
      dvdz(j) = dvdz(j) - dtmpdrr*dz/r(i1)
      enddo

      return

      end

c **************************************************
c zero at NO2
c r1 = oo
c r2 = ho1
c r3 = ho2
c A and cm-1

      subroutine ho2fit(r,v)

      implicit double precision(a-h,o-z)
      dimension r(3),basis(1000),coef(1000)

       r1=r(1)
       r2=r(2)
       r3=r(3)

       coef(    1) =     0.2885755880E+07
       coef(    2) =    -0.5187870513E+08
       coef(    3) =     0.3913454355E+09
       coef(    4) =    -0.1565117811E+10
       coef(    5) =     0.3485101857E+10
       coef(    6) =    -0.4096488749E+10
       coef(    7) =     0.1990397144E+10
       coef(    8) =    -0.5187501892E+08
       coef(    9) =     0.1038949244E+10
       coef(   10) =    -0.8485105642E+10
       coef(   11) =     0.3608041911E+11
       coef(   12) =    -0.8424083243E+11
       coef(   13) =     0.1024915854E+12
       coef(   14) =    -0.5083830889E+11
       coef(   15) =     0.3912897735E+09
       coef(   16) =    -0.8484890012E+10
       coef(   17) =     0.7567156007E+11
       coef(   18) =    -0.3537875717E+12
       coef(   19) =     0.9124059122E+12
       coef(   20) =    -0.1233830930E+13
       coef(   21) =     0.6867787126E+12
       coef(   22) =    -0.1564785372E+10
       coef(   23) =     0.3608030860E+11
       coef(   24) =    -0.3538188152E+12
       coef(   25) =     0.1858845657E+13
       coef(   26) =    -0.5436257680E+13
       coef(   27) =     0.8425218741E+13
       coef(   28) =    -0.5440821210E+13
       coef(   29) =     0.3484120106E+10
       coef(   30) =    -0.8424611841E+11
       coef(   31) =     0.9126420581E+12
       coef(   32) =    -0.5437150914E+13
       coef(   33) =     0.1808696302E+14
       coef(   34) =    -0.3198733745E+14
       coef(   35) =     0.2365337013E+14
       coef(   36) =    -0.4095055159E+10
       coef(   37) =     0.1025087128E+12
       coef(   38) =    -0.1234410751E+13
       coef(   39) =     0.8427842898E+13
       coef(   40) =    -0.3199071923E+14
       coef(   41) =     0.6404172242E+14
       coef(   42) =    -0.5360346252E+14
       coef(   43) =     0.1989569008E+10
       coef(   44) =    -0.5085387177E+11
       coef(   45) =     0.6872486139E+12
       coef(   46) =    -0.5442966401E+13
       coef(   47) =     0.2365643909E+14
       coef(   48) =    -0.5360446417E+14
       coef(   49) =     0.5131882408E+14
       coef(   50) =    -0.6299627645E+08
       coef(   51) =     0.1080106688E+10
       coef(   52) =    -0.7745801965E+10
       coef(   53) =     0.2970615520E+11
       coef(   54) =    -0.6408633613E+11
       coef(   55) =     0.7355745552E+11
       coef(   56) =    -0.3503807167E+11
       coef(   57) =     0.1079988181E+10
       coef(   58) =    -0.1775566904E+11
       coef(   59) =     0.1230595352E+12
       coef(   60) =    -0.4404332763E+12
       coef(   61) =     0.8270964012E+12
       coef(   62) =    -0.7263202999E+12
       coef(   63) =     0.1933461150E+12
       coef(   64) =    -0.7743630753E+10
       coef(   65) =     0.1230391319E+12
       coef(   66) =    -0.8729146678E+12
       coef(   67) =     0.3218662189E+13
       coef(   68) =    -0.6039384311E+13
       coef(   69) =     0.4755381922E+13
       coef(   70) =    -0.4943945698E+12
       coef(   71) =     0.2969065771E+11
       coef(   72) =    -0.4402545713E+12
       coef(   73) =     0.3218514175E+13
       coef(   74) =    -0.1280249256E+14
       coef(   75) =     0.2621026888E+14
       coef(   76) =    -0.2422298382E+14
       coef(   77) =     0.6366899469E+13
       coef(   78) =    -0.6403275868E+11
       coef(   79) =     0.8264377134E+12
       coef(   80) =    -0.6039890284E+13
       coef(   81) =     0.2621811452E+14
       coef(   82) =    -0.6003961523E+14
       coef(   83) =     0.7387266913E+14
       coef(   84) =    -0.4378871279E+14
       coef(   85) =     0.7346776534E+11
       coef(   86) =    -0.7251902913E+12
       coef(   87) =     0.4758258363E+13
       coef(   88) =    -0.2424826077E+14
       coef(   89) =     0.7390622207E+14
       coef(   90) =    -0.1466172707E+15
       coef(   91) =     0.1473719204E+15
       coef(   92) =    -0.3497979472E+11
       coef(   93) =     0.1926099445E+12
       coef(   94) =    -0.4974867034E+12
       coef(   95) =     0.6388237713E+13
       coef(   96) =    -0.4381736105E+14
       coef(   97) =     0.1473776345E+15
       coef(   98) =    -0.2074958409E+15
       coef(   99) =     0.5800278032E+09
       coef(  100) =    -0.9329047338E+10
       coef(  101) =     0.6575012449E+11
       coef(  102) =    -0.2624346026E+12
       coef(  103) =     0.6156815904E+12
       coef(  104) =    -0.7906648391E+12
       coef(  105) =     0.4299032162E+12
       coef(  106) =    -0.9328528213E+10
       coef(  107) =     0.1210615235E+12
       coef(  108) =    -0.7064634557E+12
       coef(  109) =     0.2256831494E+13
       coef(  110) =    -0.3948542170E+13
       coef(  111) =     0.3357944004E+13
       coef(  112) =    -0.9530402922E+12
       coef(  113) =     0.6573814051E+11
       coef(  114) =    -0.7063122994E+12
       coef(  115) =     0.3769605575E+13
       coef(  116) =    -0.1097989210E+14
       coef(  117) =     0.1506848602E+14
       coef(  118) =    -0.1755316979E+13
       coef(  119) =    -0.1099782788E+14
       coef(  120) =    -0.2623313858E+12
       coef(  121) =     0.2255099854E+13
       coef(  122) =    -0.1097697048E+14
       coef(  123) =     0.3305619386E+14
       coef(  124) =    -0.4621926909E+14
       coef(  125) =    -0.5179611767E+13
       coef(  126) =     0.4980137306E+14
       coef(  127) =     0.6152766137E+12
       coef(  128) =    -0.3940708057E+13
       coef(  129) =     0.1505788294E+14
       coef(  130) =    -0.4623742528E+14
       coef(  131) =     0.4393558985E+14
       coef(  132) =     0.7675493552E+14
       coef(  133) =    -0.1066172476E+15
       coef(  134) =    -0.7899252952E+12
       coef(  135) =     0.3342394771E+13
       coef(  136) =    -0.1741184038E+13
       coef(  137) =    -0.5115695035E+13
       coef(  138) =     0.7667170223E+14
       coef(  139) =    -0.2039492167E+15
       coef(  140) =     0.8976746701E+14
       coef(  141) =     0.4293911666E+12
       coef(  142) =    -0.9417862195E+12
       coef(  143) =    -0.1100292004E+14
       coef(  144) =     0.4974879181E+14
       coef(  145) =    -0.1065681306E+15
       coef(  146) =     0.8978815222E+14
       coef(  147) =     0.1836124186E+15
       coef(  148) =    -0.2840444893E+10
       coef(  149) =     0.4265799645E+11
       coef(  150) =    -0.3043826020E+12
       coef(  151) =     0.1329893125E+13
       coef(  152) =    -0.3440430819E+13
       coef(  153) =     0.4723703176E+13
       coef(  154) =    -0.2676487825E+13
       coef(  155) =     0.4266271618E+11
       coef(  156) =    -0.3989172259E+12
       coef(  157) =     0.1855415280E+13
       coef(  158) =    -0.6159583199E+13
       coef(  159) =     0.1368777062E+14
       coef(  160) =    -0.1707469643E+14
       coef(  161) =     0.9304597067E+13
       coef(  162) =    -0.3044410397E+12
       coef(  163) =     0.1855526083E+13
       coef(  164) =    -0.5309612110E+13
       coef(  165) =     0.1045160931E+14
       coef(  166) =    -0.1424280220E+14
       coef(  167) =    -0.2895227641E+13
       coef(  168) =     0.2438823608E+14
       coef(  169) =     0.1330116137E+13
       coef(  170) =    -0.6156135065E+13
       coef(  171) =     0.1044792201E+14
       coef(  172) =    -0.9790798343E+13
       coef(  173) =     0.2988117173E+14
       coef(  174) =    -0.1240816315E+13
       coef(  175) =    -0.7785469466E+14
       coef(  176) =    -0.3440730689E+13
       coef(  177) =     0.1366054595E+14
       coef(  178) =    -0.1420714642E+14
       coef(  179) =     0.2989879467E+14
       coef(  180) =    -0.1268350522E+15
       coef(  181) =     0.1077000011E+15
       coef(  182) =    -0.2855188574E+14
       coef(  183) =     0.4723650074E+13
       coef(  184) =    -0.1700807976E+14
       coef(  185) =    -0.2976087112E+13
       coef(  186) =    -0.1269567100E+13
       coef(  187) =     0.1077236890E+15
       coef(  188) =    -0.2127941123E+14
       coef(  189) =    -0.3100240455E+14
       coef(  190) =    -0.2676175787E+13
       coef(  191) =     0.9251164799E+13
       coef(  192) =     0.2443666963E+14
       coef(  193) =    -0.7784872242E+14
       coef(  194) =    -0.2849143148E+14
       coef(  195) =    -0.3107928142E+14
       coef(  196) =    -0.5358522920E+14
       coef(  197) =     0.7758652059E+10
       coef(  198) =    -0.1085001335E+12
       coef(  199) =     0.7964588772E+12
       coef(  200) =    -0.3786954287E+13
       coef(  201) =     0.1003498132E+14
       coef(  202) =    -0.1282628934E+14
       coef(  203) =     0.6441317325E+13
       coef(  204) =    -0.1085444794E+12
       coef(  205) =     0.5816102562E+12
       coef(  206) =    -0.1547406925E+13
       coef(  207) =     0.8677643066E+13
       coef(  208) =    -0.2958212176E+14
       coef(  209) =     0.3954116675E+14
       coef(  210) =    -0.2300780301E+14
       coef(  211) =     0.7971279379E+12
       coef(  212) =    -0.1551049041E+13
       coef(  213) =    -0.6375456772E+13
       coef(  214) =     0.1541953334E+14
       coef(  215) =     0.1167591359E+14
       coef(  216) =    -0.1202794960E+14
       coef(  217) =    -0.1623867393E+14
       coef(  218) =    -0.3790840769E+13
       coef(  219) =     0.8688916725E+13
       coef(  220) =     0.1539372814E+14
       coef(  221) =    -0.1011717662E+15
       coef(  222) =     0.9301569060E+14
       coef(  223) =    -0.5225037392E+14
       coef(  224) =     0.1192797668E+15
       coef(  225) =     0.1004663008E+14
       coef(  226) =    -0.2956521114E+14
       coef(  227) =     0.1168904457E+14
       coef(  228) =     0.9297446324E+14
       coef(  229) =    -0.4310817190E+14
       coef(  230) =    -0.4891520413E+13
       coef(  231) =     0.7577271690E+14
       coef(  232) =    -0.1284388760E+14
       coef(  233) =     0.3943760247E+14
       coef(  234) =    -0.1197684873E+14
       coef(  235) =    -0.5225682763E+14
       coef(  236) =    -0.4894435872E+13
       coef(  237) =    -0.9187642408E+14
       coef(  238) =    -0.4603851749E+14
       coef(  239) =     0.6451748734E+13
       coef(  240) =    -0.2290438263E+14
       coef(  241) =    -0.1624829948E+14
       coef(  242) =     0.1193009698E+15
       coef(  243) =     0.7575914764E+14
       coef(  244) =    -0.4612207290E+14
       coef(  245) =    -0.6796529482E+14
       coef(  246) =    -0.1121292927E+11
       coef(  247) =     0.1448601620E+12
       coef(  248) =    -0.1093171788E+13
       coef(  249) =     0.5409505681E+13
       coef(  250) =    -0.1268539338E+14
       coef(  251) =     0.9538003778E+13
       coef(  252) =     0.3886786968E+12
       coef(  253) =     0.1449853812E+12
       coef(  254) =    -0.1049358110E+12
       coef(  255) =    -0.2236229495E+13
       coef(  256) =    -0.3779134094E+13
       coef(  257) =     0.2439675907E+14
       coef(  258) =     0.1170680909E+14
       coef(  259) =    -0.3199933755E+14
       coef(  260) =    -0.1095109649E+13
       coef(  261) =    -0.2225878334E+13
       coef(  262) =     0.2585569250E+14
       coef(  263) =    -0.1896817929E+14
       coef(  264) =    -0.1055770422E+15
       coef(  265) =     0.5462131890E+14
       coef(  266) =     0.7360365528E+13
       coef(  267) =     0.5421429778E+13
       coef(  268) =    -0.3824196121E+13
       coef(  269) =    -0.1892366523E+14
       coef(  270) =     0.9084602852E+14
       coef(  271) =     0.3694532578E+14
       coef(  272) =    -0.7339420729E+14
       coef(  273) =     0.2637316409E+14
       coef(  274) =    -0.1272363422E+14
       coef(  275) =     0.2445666055E+14
       coef(  276) =    -0.1056328884E+15
       coef(  277) =     0.3694447014E+14
       coef(  278) =    -0.5354465236E+14
       coef(  279) =    -0.1252590700E+14
       coef(  280) =     0.5528976920E+14
       coef(  281) =     0.9598936259E+13
       coef(  282) =     0.1173352538E+14
       coef(  283) =     0.5467462754E+14
       coef(  284) =    -0.7334352714E+14
       coef(  285) =    -0.1252716552E+14
       coef(  286) =     0.3307742222E+13
       coef(  287) =     0.2755978025E+14
       coef(  288) =     0.3512359718E+12
       coef(  289) =    -0.3208200634E+14
       coef(  290) =     0.7241072695E+13
       coef(  291) =     0.2638026379E+14
       coef(  292) =     0.5525696945E+14
       coef(  293) =     0.2750482317E+14
       coef(  294) =     0.1133597241E+14
       coef(  295) =     0.6728522777E+10
       coef(  296) =    -0.7884579248E+11
       coef(  297) =     0.6009183039E+12
       coef(  298) =    -0.2872782016E+13
       coef(  299) =     0.3918911423E+13
       coef(  300) =     0.7991960432E+13
       coef(  301) =    -0.1395512644E+14
       coef(  302) =    -0.7896567352E+11
       coef(  303) =    -0.3980782704E+12
       coef(  304) =     0.4072253370E+13
       coef(  305) =    -0.3555893516E+13
       coef(  306) =     0.7779564972E+13
       coef(  307) =    -0.1071672439E+15
       coef(  308) =     0.1180192909E+15
       coef(  309) =     0.6027717067E+12
       coef(  310) =     0.4063511218E+13
       coef(  311) =    -0.2504524927E+14
       coef(  312) =     0.9382231514E+13
       coef(  313) =     0.1242182663E+15
       coef(  314) =     0.4380269384E+14
       coef(  315) =    -0.8280241315E+14
       coef(  316) =    -0.2884434781E+13
       coef(  317) =    -0.3517810428E+13
       coef(  318) =     0.9396945706E+13
       coef(  319) =    -0.1033234024E+15
       coef(  320) =     0.4180202567E+13
       coef(  321) =    -0.1175448305E+15
       coef(  322) =    -0.1254519005E+15
       coef(  323) =     0.3957361841E+13
       coef(  324) =     0.7709797372E+13
       coef(  325) =     0.1241486997E+15
       coef(  326) =     0.4172806469E+13
       coef(  327) =     0.5700487477E+14
       coef(  328) =     0.4655506031E+14
       coef(  329) =     0.2529933821E+14
       coef(  330) =     0.7930028835E+13
       coef(  331) =    -0.1071392895E+15
       coef(  332) =     0.4388428195E+14
       coef(  333) =    -0.1175078399E+15
       coef(  334) =     0.4654701086E+14
       coef(  335) =     0.8483517390E+14
       coef(  336) =     0.6305474245E+14
       coef(  337) =    -0.1391745862E+14
       coef(  338) =     0.1180581082E+15
       coef(  339) =    -0.8280683684E+14
       coef(  340) =    -0.1254445313E+15
       coef(  341) =     0.2526975674E+14
       coef(  342) =     0.6302423885E+14
       coef(  343) =     0.4606668298E+14

       call getbasis(r,basis,ncoef)

       v=0.d0
       do j=1,ncoef
       v=v+coef(j)*basis(j)
       enddo

       end

********************************************

      subroutine getbasis(r,basis,ncoef)

      implicit double precision(a-h,o-z)
      dimension r(3),basis(1000)

      norder=6
      norder2=6

      r1=r(1)
      r2=r(2)
      r3=r(3)

      b1=1.d0
      b3=1.d0

      e1=dexp(-r1/b1)
      e2=dexp(-r2/b3)
      e3=dexp(-r3/b3)

      ii=0
      e=0.d0
      do i1=0,norder
      x1=e1**i1
      do i2=0,norder2
      x2=x1*(e2**i2)
      do i3=0,norder2
      x3=x2*(e3**i3)
      ii=ii+1
      basis(ii)=1.d0
      if (i1+i2+i3.ne.0) basis(ii)=x3
      enddo
      enddo
      enddo

      ncoef=ii

      return
      end

***************************************************
      subroutine prepot
      return
      end

***************************************************

      subroutine lsbath(at,x,y,z,v,dvdx,dvdy,dvdz,natom,maxatom,ccc)

      implicit real*8(a-h,o-z)
      dimension x(maxatom),y(maxatom),z(maxatom)
      dimension dvdx(maxatom),dvdy(maxatom),dvdz(maxatom)
      parameter(autoev=27.2113961d0)
      parameter(autocmi=219474.63067d0)
      parameter(autokcal=627.509d0)
      parameter(autoang=0.529177249d0)
      integer at(maxatom)

      dimension r(3)

      do i=1,3
      r(i)=dsqrt((x(4-i)-x(4))**2+(y(4-i)-y(4))**2+(z(4-i)-z(4))**2)
      enddo

      call lsbathfit(r,v)

      resp=0.0001d0

      do i1=1,3
      if (i1.eq.1) i=3
      if (i1.eq.1) j=4
      if (i1.eq.2) i=2
      if (i1.eq.2) j=4
      if (i1.eq.3) i=1
      if (i1.eq.3) j=4
      dx=x(i)-x(j)
      dy=y(i)-y(j)
      dz=z(i)-z(j)
      r(i1)=r(i1)+resp
      call lsbathfit(r,vp)
      r(i1)=r(i1)-2.d0*resp
      call lsbathfit(r,vm)
      r(i1)=r(i1)+resp
      dtmpdrr=(vp-vm)/(2.d0*resp)
      dvdx(i) = dvdx(i) + dtmpdrr*dx/r(i1)
      dvdx(j) = dvdx(j) - dtmpdrr*dx/r(i1)
      dvdy(i) = dvdy(i) + dtmpdrr*dy/r(i1)
      dvdy(j) = dvdy(j) - dtmpdrr*dy/r(i1)
      dvdz(i) = dvdz(i) + dtmpdrr*dz/r(i1)
      dvdz(j) = dvdz(j) - dtmpdrr*dz/r(i1)
      enddo

      return
      end

      subroutine lsbathfit(r,v)

      implicit real*8(a-h,o-z)

      parameter(autoang=0.529177249d0)
      parameter(autocmi=219474.63067d0)

      dimension r(3)
      dimension coef(100),basis(100)

       ncoef=40
       coef(    1) =    -0.464757998764909974198640000000D+00
       coef(    2) =     0.538942544409489201484580000000D+02
       coef(    3) =     0.652369869894362273043950000000D+04
       coef(    4) =    -0.834006367983523872680960000000D+06
       coef(    5) =    -0.930546848197179497219620000000D+05
       coef(    6) =     0.559062488552359677851200000000D+07
       coef(    7) =     0.141651764407755788415670000000D+08
       coef(    8) =    -0.130960754009762242436410000000D+09
       coef(    9) =     0.126665514944389867782590000000D+10
       coef(   10) =    -0.445426048154711151123050000000D+10
       coef(   11) =    -0.133551461626341819055600000000D+03
       coef(   12) =     0.579615182808444806141780000000D+05
       coef(   13) =    -0.258321383100420003756880000000D+07
       coef(   14) =     0.435766305849508270621300000000D+08
       coef(   15) =    -0.869217003001766628585760000000D+06
       coef(   16) =     0.318832173185541108250620000000D+08
       coef(   17) =    -0.834427743450622677803040000000D+09
       coef(   18) =     0.867147304526925086975100000000D+09
       coef(   19) =    -0.125238445295380249023440000000D+11
       coef(   20) =     0.699377056196376190185550000000D+11
       coef(   21) =    -0.114920624099322922120340000000D+05
       coef(   22) =     0.181003890398600953631100000000D+06
       coef(   23) =     0.154371663787761647254230000000D+08
       coef(   24) =    -0.524897171944757223129270000000D+09
       coef(   25) =    -0.120616921126364730298520000000D+08
       coef(   26) =     0.438904431814877986907960000000D+08
       coef(   27) =     0.139223232866024742126460000000D+11
       coef(   28) =    -0.830921943602408027648930000000D+10
       coef(   29) =     0.255918997567857666015620000000D+11
       coef(   30) =    -0.324728577908249267578120000000D+12
       coef(   31) =     0.611603627191489649703730000000D+05
       coef(   32) =     0.241261272369973734021190000000D+07
       coef(   33) =    -0.277840401652745753526690000000D+08
       coef(   34) =     0.105637575705000460147860000000D+10
       coef(   35) =    -0.209888622180819392204280000000D+09
       coef(   36) =     0.806421553286840724945070000000D+10
       coef(   37) =    -0.726923697337541961669920000000D+11
       coef(   38) =    -0.776736022605715026855470000000D+11
       coef(   39) =     0.102537465731236645507810000000D+13
       coef(   40) =    -0.237816712272046923828120000000D+13

       coef(    1) =    -0.562611190091877877428320000000D+00
       coef(    2) =     0.183575928795167442331150000000D+01
       coef(    3) =     0.209229617741687397938220000000D+05
       coef(    4) =    -0.117325504546364583075050000000D+07
       coef(    5) =    -0.707251033742605795850980000000D+05
       coef(    6) =     0.320258377974820043891670000000D+07
       coef(    7) =     0.511357253318274170160290000000D+08
       coef(    8) =    -0.905308730740959644317630000000D+08
       coef(    9) =     0.383429681432454466819760000000D+09
       coef(   10) =    -0.141496815572794866561890000000D+10
       coef(   11) =     0.861095564563635775812140000000D+02
       coef(   12) =    -0.566662184688228662707840000000D+05
       coef(   13) =     0.750059799875783501192930000000D+06
       coef(   14) =     0.212419417851993925869460000000D+08
       coef(   15) =     0.420362613539539463818070000000D+07
       coef(   16) =    -0.192083855681970357894900000000D+09
       coef(   17) =     0.185497761117293715476990000000D+09
       coef(   18) =     0.279482470780695962905880000000D+10
       coef(   19) =    -0.247977309126192245483400000000D+11
       coef(   20) =     0.840460533267185058593750000000D+11
       coef(   21) =    -0.260432067081322384183300000000D+04
       coef(   22) =     0.243062970532601838931440000000D+07
       coef(   23) =    -0.652310911211301460862160000000D+08
       coef(   24) =     0.538947624965441226959230000000D+08
       coef(   25) =    -0.150935581207371234893800000000D+09
       coef(   26) =     0.698490004863877677917480000000D+10
       coef(   27) =    -0.270012063462429885864260000000D+11
       coef(   28) =    -0.804364623474482116699220000000D+11
       coef(   29) =     0.774096663327155761718750000000D+12
       coef(   30) =    -0.217038569947691552734380000000D+13
       coef(   31) =    -0.346289809069637907668950000000D+06
       coef(   32) =     0.205908972805955484509470000000D+08
       coef(   33) =    -0.246704353809078335762020000000D+08
       coef(   34) =     0.787697825625734329223630000000D+08
       coef(   35) =    -0.122421287928506374359130000000D+09
       coef(   36) =    -0.108447963710124855041500000000D+11
       coef(   37) =     0.657152728810255737304690000000D+11
       coef(   38) =     0.195563447341763732910160000000D+12
       coef(   39) =    -0.218969864119722119140620000000D+13
       coef(   40) =     0.645355940838639062500000000000D+13

      r1=r(1)*autoang
      r2=r(2)*autoang
      r3=r(3)*autoang

      b1=1.d0
      b2=1.d0

      e1=dexp(-r1/b1)
      e2=dexp(-r2/b2)
      e3=dexp(-r3/b2)

      norder=3
      norder2=3

      ii=0
      do i1=0,norder
      x1=e1**i1
      do i2=0,norder2
      do i3=i2,norder2
      x2=x1*(e2**i2*e3**i3+e3**i2*e2**i3)
      ii=ii+1
      basis(ii)=1.d0
      if (i1+i2+i3.ne.0) basis(ii)=x2
      enddo
      enddo
      enddo

      v=0.d0
      do j=1,ncoef
        v=v+coef(j)*basis(j)
      enddo
      v=v/autocmi

      return

      end


!
!  Copyright 2019-2020 SALMON developers
!
!  Licensed under the Apache License, Version 2.0 (the "License");
!  you may not use this file except in compliance with the License.
!  You may obtain a copy of the License at
!
!      http://www.apache.org/licenses/LICENSE-2.0
!
!  Unless required by applicable law or agreed to in writing, software
!  distributed under the License is distributed on an "AS IS" BASIS,
!  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
!  See the License for the specific language governing permissions and
!  limitations under the License.
!

#include "config.h"

module initialization_sub
  implicit none
  integer,parameter,private :: Nd=4

contains

!===================================================================================================================================

subroutine init_dft(comm,info,lg,mg,system,stencil,fg,poisson,srg,srg_scalar,ofile)
  use structures
  use salmon_global, only: iperiodic,layout_multipole, &
                           nproc_k,nproc_ob,nproc_rgrid,method_poisson
  use sendrecv_grid
  use init_communicator
  use init_poisson_sub
  use checkpoint_restart_sub, only: init_dir_out_restart
  use sym_rho_sub, only: init_sym_rho
  implicit none
  integer      ,intent(in) :: comm
  type(s_parallel_info)    :: info
  type(s_rgrid)            :: lg,mg
  type(s_dft_system)       :: system
  type(s_stencil)          :: stencil
  type(s_reciprocal_grid)  :: fg
  type(s_poisson)          :: poisson
  type(s_sendrecv_grid)    :: srg,srg_scalar
  type(s_ofile)            :: ofile
  !
  integer,dimension(2,3) :: neig

! electron system
  call init_dft_system(lg,system,stencil)

! process distribution
  info%npk       = nproc_k
  info%nporbital = nproc_ob
  info%nprgrid   = nproc_rgrid
  call init_process_distribution(system,comm,info)
  call init_communicator_dft(comm,info)

! parallelization
  call check_ffte_condition(info,lg)
  call init_grid_parallel(info,lg,mg) ! lg --> mg
  call init_parallel_dft(system,info)
  call create_sendrecv_neig(neig, info) ! neighboring node array
  ! sendrecv_grid object for wavefunction updates
  call init_sendrecv_grid(srg, mg, info%numo*info%numk*system%nspin, info%icomm_rko, neig)
  ! sendrecv_grid object for scalar field updates
  call init_sendrecv_grid(srg_scalar, mg, 1, info%icomm_rko, neig)

! symmetry

  call init_sym_rho( lg%num, mg%is, mg%ie, info%icomm_r )

! for Poisson equation

  poisson%iterVh = 0 ! Iteration counter
  select case(iperiodic)
  case(0)
    if(layout_multipole==2.or.layout_multipole==3) call make_corr_pole(lg,mg,system,poisson)
    if(method_poisson=='ft') then
      call init_reciprocal_grid_isolated_ft(lg,mg,fg,system,info,poisson)
    end if
  case(3)
    call init_reciprocal_grid(lg,mg,fg,system,info,poisson)
  end select
  call set_ig_bound(lg,mg,poisson)

! output files

  call init_dir_out_restart(ofile)

end subroutine init_dft

!===================================================================================================================================

subroutine init_dft_system(lg,system,stencil)
  use structures
  use lattice
  use salmon_global, only: al_vec1,al_vec2,al_vec3,al,spin,natom,nelem,nstate,iperiodic,num_kgrid,num_rgrid,dl, &
  & nproc_rgrid,Rion,Rion_red,nelec,calc_mode,temperature,nelec_spin,yn_spinorbit, &
  & iflag_atom_coor,ntype_atom_coor_reduced,quiet
  use sym_sub, only: init_sym_sub
  use communication, only: comm_is_root
  use parallelization, only: nproc_id_global
  implicit none
  type(s_rgrid)      :: lg
  type(s_dft_system) :: system
  type(s_stencil)    :: stencil
  !
  integer :: ii,jj
  real(8) :: rsize(3),hgs(3),cnmat(0:12,12),bnmat(4,4)

  if(al_vec1(2)==0d0 .and. al_vec1(3)==0d0 .and. al_vec2(1)==0d0 .and. &
     al_vec2(3)==0d0 .and. al_vec3(1)==0d0 .and. al_vec3(2)==0d0) then
    stencil%if_orthogonal = .true.
    if(al(1)*al(2)*al(3)==0d0) then
      if(num_rgrid(1)*num_rgrid(2)*num_rgrid(3)==0 .or. dl(1)*dl(2)*dl(3)==0d0) then
        stop "error: invalid cell"
      end if
      al = dl * dble(num_rgrid)
    end if
    system%primitive_a = 0d0
    system%primitive_a(1,1) = al(1)
    system%primitive_a(2,2) = al(2)
    system%primitive_a(3,3) = al(3)
    rsize = al
  else
    stencil%if_orthogonal = .false.
    system%primitive_a(1:3,1) = al_vec1
    system%primitive_a(1:3,2) = al_vec2
    system%primitive_a(1:3,3) = al_vec3
    rsize(1) = sqrt(sum(al_vec1**2))
    rsize(2) = sqrt(sum(al_vec2**2))
    rsize(3) = sqrt(sum(al_vec3**2))
  end if

  if(sum(abs(dl)) == 0d0) then
    hgs(1:3) = rsize(1:3) / dble(num_rgrid(1:3))
  else
    hgs(1:3) = dl(1:3)
  end if
  call init_grid_whole(rsize,hgs,lg)
  system%hgs = hgs
  system%ngrid = lg%num(1) * lg%num(2) * lg%num(3)

  call init_lattice(system,stencil)
  call init_sym_sub( system%primitive_a, system%primitive_b )
  call init_kvector(num_kgrid,system)

  if(calc_mode=='RT') then
    system%if_real_orbital = .false.
  else if(calc_mode=='GS') then
    select case(iperiodic)
    case(0)
      system%if_real_orbital = .true.
    case(3)
      if(num_kgrid(1)*num_kgrid(2)*num_kgrid(3)==1 .and. stencil%if_orthogonal) then
        system%if_real_orbital = .true.
      else
        system%if_real_orbital = .false.
      end if
      if ( yn_spinorbit=='y' ) system%if_real_orbital=.false.
    end select
  end if
  if ((.not. quiet) .and. comm_is_root(nproc_id_global)) then
     write(*,*) "  use of real value orbitals = ", system%if_real_orbital
  endif

  system%nion = natom

  if(spin=='unpolarized') then
    system%nspin=1
  else if(spin=='polarized') then
    system%nspin=2
  end if

  if(calc_mode=='RT'.and. temperature<-1.d-12)then
    if( yn_spinorbit=='y' )then
       system%no = nelec
    else if(system%nspin==2.and.sum(nelec_spin(:))>0)then
       system%no = maxval(nelec_spin(:))
    else
       if(mod(nelec,2)==0)then
          system%no = nelec/2
       else
          system%no = (nelec+1)/2
       end if
    end if
  else
    system%no = nstate
  end if

  allocate(system%mass(1:nelem))
  if ( allocated(system%Rion) ) deallocate(system%Rion)
  if ( allocated(system%rocc) ) deallocate(system%rocc)
  if ( allocated(system%Velocity) ) deallocate(system%Velocity)
  if ( allocated(system%Force) ) deallocate(system%Force)
  allocate(system%Rion(3,system%nion),system%rocc(system%no,system%nk,system%nspin))
  allocate(system%Velocity(3,system%nion),system%Force(3,system%nion))
  system%Velocity(:,:) =0d0

  if(iflag_atom_coor==ntype_atom_coor_reduced) then
    Rion = matmul(system%primitive_a,Rion_red) ! [ a1, a2, a3 ] * R_ion
  end if
  system%Rion = Rion

! initial value of occupation
  system%rocc = 0d0
  if ( yn_spinorbit=='y' ) then
    system%rocc(1:nelec,:,:) = 1.0d0
  else
    select case(system%nspin)
    case(1)
      system%rocc(1:nelec/2,:,1) = 2d0
    case(2)
      if ( nelec > 0 ) then
        if ( mod(nelec,2) == 0 ) then
          system%rocc(1:nelec/2,:,1:2) = 1d0
        else
          system%rocc(1:(nelec-1)/2,:,1:2) = 1d0
          system%rocc((nelec-1)/2+1,:,1  ) = 1d0
        end if
      else if ( any(nelec_spin>0) ) then
        system%rocc(1:nelec_spin(1),:,1) = 1d0
        system%rocc(1:nelec_spin(2),:,2) = 1d0
      else
        write(*,*) "nelect or nelec_spin should be specified in input"
      end if
    end select
  end if

  call set_bn(bnmat)
  call set_cn(cnmat)
  if(stencil%if_orthogonal) then
    stencil%coef_lap0 = -0.5d0*cNmat(0,Nd)*(1.d0/Hgs(1)**2+1.d0/Hgs(2)**2+1.d0/Hgs(3)**2)
  else
    if(nproc_rgrid(1)*nproc_rgrid(2)*nproc_rgrid(3)/=1) &
      stop "error: nonorthogonal lattice and r-space parallelization"
    stencil%coef_lap0 = -0.5d0*cNmat(0,Nd)*  &
                      & ( stencil%coef_F(1)/Hgs(1)**2 + stencil%coef_F(2)/Hgs(2)**2 + stencil%coef_F(3)/Hgs(3)**2 )
  end if
  do jj=1,3
    do ii=1,4
      stencil%coef_lap(ii,jj) = cnmat(ii,4)/hgs(jj)**2
      stencil%coef_nab(ii,jj) = bnmat(ii,4)/hgs(jj)
    end do
  end do

  call set_gridcoordinate(lg,system)

  system%vec_Ac = 0d0 ! initial value

  system%vec_Ac_ext = 0d0 ! initial value for output
  system%vec_E = 0d0     ! initial value for output
  system%vec_E_ext = 0d0 ! initial value for output

  return
end subroutine init_dft_system

!===================================================================================================================================

subroutine init_process_distribution(system,icomm1,info)
  use structures, only: s_parallel_info,s_dft_system
  use parallelization, only: nproc_id_global, nproc_group_global
  use salmon_global, only: theory
  use communication, only: comm_is_root,comm_bcast
  use set_numcpu
  implicit none
  type(s_dft_system),intent(in)       :: system
  integer, intent(in)                 :: icomm1 ! Communicator for single DFT system.
  type(s_parallel_info),intent(inout) :: info
  logical :: if_stop

  if((info%nporbital + sum(info%nprgrid)) == 0) then
    ! Process distribution is automatically decided by SALMON.
    if (system%ngrid > 16**3) then
      call set_numcpu_general(iprefer_domain_distribution,system%nk,system%no,icomm1,info)
    else
      select case(theory)
      case('dft','dft_band','dft_md','dft2tddft')
        call set_numcpu_general(iprefer_k_distribution,system%nk,system%no,icomm1,info)
      case('tddft_response','tddft_pulse','single_scale_maxwell_tddft','multi_scale_maxwell_tddft')
        call set_numcpu_general(iprefer_orbital_distribution,system%nk,system%no,icomm1,info)
      case default
        stop 'invalid theory @ initialization'
      end select
    end if
  else
    ! Process distribution is explicitly specified by user.
  end if

  if (comm_is_root(nproc_id_global)) then
    if_stop = .not. check_numcpu(icomm1, info)
  end if
  call comm_bcast(if_stop, nproc_group_global)
  if (if_stop) stop 'fail: check_numcpu'

#ifdef USE_SCALAPACK
  info%flag_blacs_gridinit = .false.
#endif
#ifdef USE_EIGENEXA
  info%flag_eigenexa_init = .false.
#endif
end subroutine init_process_distribution

!===================================================================================================================================

subroutine init_parallel_dft(system,info)
  use structures
  implicit none
  type(s_dft_system),intent(in) :: system
  type(s_parallel_info)         :: info
  !
  integer :: io,nproc_k,nproc_ob,nproc_domain_orbital(3),m,na

  nproc_k              = info%npk
  nproc_ob             = info%nporbital
  nproc_domain_orbital = info%nprgrid

! for single-cell calculations
  info%im_s = 1
  info%im_e = 1
  info%numm = 1

! # of k points
  info%ik_s = (info%id_k * system%nk) / nproc_k + 1
  info%ik_e = ((info%id_k+1) * system%nk) / nproc_k
  info%numk = info%ik_e - info%ik_s + 1

! # of orbitals
  info%io_s = (info%id_o * system%no) / nproc_ob + 1
  info%io_e = ((info%id_o+1) * system%no) / nproc_ob
  info%numo = info%io_e - info%io_s + 1

  allocate(info%io_s_all(0:nproc_ob-1))
  allocate(info%io_e_all(0:nproc_ob-1))
  allocate(info%numo_all(0:nproc_ob-1))
  do m=0,nproc_ob-1
    info%io_s_all(m) = m * system%no / nproc_ob + 1
    info%io_e_all(m) = (m+1) * system%no / nproc_ob
    info%numo_all(m) = info%io_e_all(m) - info%io_s_all(m) + 1
  end do
  info%numo_max=maxval(info%numo_all(0:nproc_ob-1))

! flags
  info%if_divide_rspace = nproc_domain_orbital(1)*nproc_domain_orbital(2)*nproc_domain_orbital(3).ne.1
  info%if_divide_orbit  = nproc_ob.ne.1

! process ID corresponding to the orbital index io
  if ( allocated(info%irank_io) ) deallocate(info%irank_io)
  allocate(info%irank_io(1:system%no))
  do io=1, system%no
    if(mod(io*nproc_ob,system%no)==0)then
      info%irank_io(io) = io*nproc_ob/system%no - 1
    else
      info%irank_io(io) = io*nproc_ob/system%no
    end if
  end do

! #ia: atom index (communicator=info%icomm_ko)
  info%ia_s = int((system%nion * info%id_ko) / info%isize_ko) + 1
  info%ia_e = int((system%nion * (info%id_ko + 1)) / info%isize_ko)
  na = info%ia_e - info%ia_s + 1
  if (info%id_ko == info%isize_ko-1) info%ia_e = system%nion

end subroutine init_parallel_dft

!===================================================================================================================================

subroutine init_grid_whole(rsize,hgs,lg)
  use structures, only: s_rgrid
  use salmon_global, only: iperiodic,dl,num_rgrid,theory,al_em,dl_em
  implicit none
  real(8),intent(in) :: rsize(3),hgs(3)
  type(s_rgrid)      :: lg
  !
  real(8),parameter :: epsilon=1.d-10
  integer :: j

  lg%ndir = 3 ! high symmetry nonorthogonal lattice is not implemented
  lg%nd = Nd

  select case(iperiodic)
    case(0)
      lg%ie(:)=int((rsize(:)+epsilon)/2.d0/Hgs(:))
      do j=1,3
        if(mod(int(rsize(j)/Hgs(j)+1.d-12),2)==1)then
          lg%is(j)=-(int((rsize(j)+epsilon)/2.d0/Hgs(j)))
        else
          lg%is(j)=-(int((rsize(j)+epsilon)/2.d0/Hgs(j)))+1
        end if
      end do
    case(3)
      lg%is(:)=1
      lg%ie(:)=int((rsize(:)+epsilon)/Hgs(:))
  end select
  lg%num(:)=lg%ie(:)-lg%is(:)+1

  lg%is_overlap(1:3) = lg%is(1:3) - Nd
  lg%ie_overlap(1:3) = lg%ie(1:3) + Nd
  lg%is_array(1:3)   = lg%is_overlap(1:3)
  lg%ie_array(1:3)   = lg%ie_overlap(1:3)

  if ( allocated(lg%idx) ) deallocate(lg%idx)
  if ( allocated(lg%idy) ) deallocate(lg%idy)
  if ( allocated(lg%idz) ) deallocate(lg%idz)
  allocate(lg%idx(lg%is_overlap(1):lg%ie_overlap(1)) &
          ,lg%idy(lg%is_overlap(2):lg%ie_overlap(2)) &
          ,lg%idz(lg%is_overlap(3):lg%ie_overlap(3)))

  do j=lg%is_overlap(1),lg%ie_overlap(1)
    lg%idx(j) = j
  end do
  do j=lg%is_overlap(2),lg%ie_overlap(2)
    lg%idy(j) = j
  end do
  do j=lg%is_overlap(3),lg%ie_overlap(3)
    lg%idz(j) = j
  end do

  select case(theory)
  case('maxwell')
    if( maxval(abs((al_em/dl_em)-dble(lg%num))) > 1d-4 ) stop "error: abs((al_em/dl_em)-dble(lg%num)) is too large"
  case default
    if(sum(abs(dl)) <= 1d-12) then
      if( maxval(abs(num_rgrid-lg%num)) > 0) stop "error: num_rgrid /= lg%num"
    else
      if( maxval(abs((rsize/dl)-dble(lg%num))) > 1d-4 ) stop "error: abs((rsize/dl)-dble(lg%num)) is too large"
    end if
  end select

  return
end subroutine init_grid_whole

!===================================================================================================================================

subroutine check_ffte_condition(info,lg)
  use structures
  use salmon_global, only: yn_ffte
  implicit none
  type(s_parallel_info),intent(in) :: info
  type(s_rgrid),        intent(in) :: lg
  integer :: mx,my,mz
  integer :: j,lg_num_tmp,ii

  if (yn_ffte == 'y') then
    mx = mod(lg%num(1), info%nprgrid(2))
    my = mod(lg%num(2), info%nprgrid(2))
    if (mx /= 0 .or. my /= 0) stop 'Both lg%num(1) and lg%num(2) must be divisible by nproc_domain_orbital(2)'

    my = mod(lg%num(2), info%nprgrid(3))
    mz = mod(lg%num(3), info%nprgrid(3))
    if (my /= 0 .or. mz /= 0) stop 'Both lg%num(2) and lg%num(3) must be divisible by nproc_domain_orbital(3)'

    ! this code treats the situation that lg%num(1:3) is less than or equal to 48,828,125
    do j=1,3
      lg_num_tmp=lg%num(j)
      do ii=1,26
        if(mod(lg_num_tmp,2)==0)then
          lg_num_tmp=lg_num_tmp/2
        end if
      end do

      do ii=1,17
        if(mod(lg_num_tmp,3)==0)then
          lg_num_tmp=lg_num_tmp/3
        end if
      end do

      do ii=1,11
        if(mod(lg_num_tmp,5)==0)then
          lg_num_tmp=lg_num_tmp/5
        end if
      end do

      if(lg_num_tmp/=1) stop "When using FFTE, prime factors for number of grids must be combination of 2, 3 or 5."
    end do
  end if
end subroutine check_ffte_condition

!===================================================================================================================================

subroutine init_grid_parallel(info,lg,mg)
  use communication, only: comm_is_root
  use salmon_global, only: yn_periodic, quiet
  use structures, only: s_rgrid,s_parallel_info
  implicit none
  type(s_parallel_info),intent(in)    :: info
  type(s_rgrid),        intent(inout) :: lg
  type(s_rgrid),        intent(inout) :: mg
  !
  integer :: myrank,nproc,nproc_domain_orbital(3),nproc_k,nproc_ob
  integer :: i1,i2,i3,i4,i5,ibox,j,nsize,npo(3)

  myrank = info%id_rko
  nproc  = info%isize_rko

  nproc_k              = info%npk
  nproc_ob             = info%nporbital
  nproc_domain_orbital = info%nprgrid

  if ( allocated(mg%is_all) ) deallocate(mg%is_all)
  if ( allocated(mg%ie_all) ) deallocate(mg%ie_all)
  allocate(mg%is_all(3,0:nproc-1),mg%ie_all(3,0:nproc-1))

! +-------------------------------+
! | mg: r-space grid for orbitals |
! +-------------------------------+

  mg%ndir = 3 ! high symmetry nonorthogonal lattice is not implemented
  mg%nd = Nd

  do i5=0,nproc_k-1
  do i4=0,nproc_ob-1
  do i3=0,nproc_domain_orbital(3)-1
  do i2=0,nproc_domain_orbital(2)-1
  do i1=0,nproc_domain_orbital(1)-1
    ibox = info%imap(i1,i2,i3,i4,i5)
    npo = [i1,i2,i3]
    do j=1,3
      nsize = (lg%num(j) + nproc_domain_orbital(j) - 1) / nproc_domain_orbital(j)
      mg%is_all(j,ibox) = lg%is(j) + nsize * npo(j)
      mg%ie_all(j,ibox) = mg%is_all(j,ibox) + nsize - 1
      if (mg%ie_all(j,ibox) > lg%ie(j)) then
        mg%ie_all(j,ibox) = lg%ie(j)
      end if
    end do
  end do
  end do
  end do
  end do
  end do

  mg%is(:) = mg%is_all(:,myrank)
  mg%ie(:) = mg%ie_all(:,myrank)

  mg%num(:) = mg%ie(:)-mg%is(:)+1

  mg%is_overlap(1:3) = mg%is(1:3)-nd
  mg%ie_overlap(1:3) = mg%ie(1:3)+nd

  if ( allocated(mg%idx) ) deallocate(mg%idx)
  if ( allocated(mg%idy) ) deallocate(mg%idy)
  if ( allocated(mg%idz) ) deallocate(mg%idz)
  allocate(mg%idx(mg%is_overlap(1):mg%ie_overlap(1)) &
          ,mg%idy(mg%is_overlap(2):mg%ie_overlap(2)) &
          ,mg%idz(mg%is_overlap(3):mg%ie_overlap(3)))

  if(yn_periodic=='y' .and. product(nproc_domain_orbital)==1) then
    if((.not. quiet) .and. comm_is_root(myrank)) &
      & write(*,*) "r-space parallelization: off"
    mg%is_array(1:3) = mg%is(1:3)
    mg%ie_array(1:3) = mg%ie(1:3)
    do j=mg%is_overlap(1),mg%ie_overlap(1)
      mg%idx(j) = mod(j+mg%num(1)-1,mg%num(1))+1
    end do
    do j=mg%is_overlap(2),mg%ie_overlap(2)
      mg%idy(j) = mod(j+mg%num(2)-1,mg%num(2))+1
    end do
    do j=mg%is_overlap(3),mg%ie_overlap(3)
      mg%idz(j) = mod(j+mg%num(3)-1,mg%num(3))+1
    end do
  else
    mg%is_array(1:3) = mg%is(1:3)-nd
    mg%ie_array(1:3) = mg%ie(1:3)+nd
    do j=mg%is_overlap(1),mg%ie_overlap(1)
      mg%idx(j) = j
    end do
    do j=mg%is_overlap(2),mg%ie_overlap(2)
      mg%idy(j) = j
    end do
    do j=mg%is_overlap(3),mg%ie_overlap(3)
      mg%idz(j) = j
    end do
  end if

  if(mg%num(1)<nd .or.mg%num(2)<nd .or.mg%num(3)<nd)then
    stop "The system is small. Please use less number of processors."
  end if

#ifdef USE_OPT_ARRAY_PADDING
  lg%ie_array(2)=lg%ie_array(2) + 1
  mg%ie_array(2)=mg%ie_array(2) + 1
#endif

end subroutine init_grid_parallel

!===================================================================================================================================

subroutine init_reciprocal_grid(lg,mg,fg,system,info,poisson)
  use structures
  use math_constants,  only : pi,zi
  use phys_constants, only: cspeed_au
  use salmon_global, only: dt,yn_ffte,aEwald,theory,cutoff_G2_emfield
  implicit none
  type(s_rgrid)          ,intent(in)    :: lg
  type(s_rgrid)          ,intent(in)    :: mg
  type(s_reciprocal_grid),intent(inout) :: fg
  type(s_dft_system)     ,intent(in)    :: system
  type(s_parallel_info)  ,intent(in)    :: info
  type(s_poisson)        ,intent(inout) :: poisson
  !
  real(8) :: brl(3,3)
  integer :: ix,iy,iz,kx,ky,kz
  integer :: iix,iiy,iiz
  real(8) :: G2,g(3)
  complex(8) :: tmp

  brl(:,:)=system%primitive_b(:,:)

  allocate(fg%if_Gzero (lg%is(1):lg%ie(1),mg%is(2):mg%ie(2),mg%is(3):mg%ie(3)))
  allocate(fg%vec_G(1:3,lg%is(1):lg%ie(1),mg%is(2):mg%ie(2),mg%is(3):mg%ie(3)))
  allocate(fg%coef     (lg%is(1):lg%ie(1),mg%is(2):mg%ie(2),mg%is(3):mg%ie(3)))
  allocate(fg%exp_ewald(lg%is(1):lg%ie(1),mg%is(2):mg%ie(2),mg%is(3):mg%ie(3)))
  fg%if_Gzero = .false.
  fg%vec_G = 0d0
  fg%coef = 0d0
  fg%exp_ewald = 0d0

  if(theory=='single_scale_maxwell_tddft' .and. yn_ffte=='y') then
  ! for single-scale Maxwell-TDDFT
    allocate(fg%coef_nabla(lg%is(1):lg%ie(1),mg%is(2):mg%ie(2),mg%is(3):mg%ie(3),3))
    allocate(fg%coef_gxgy0(lg%is(1):lg%ie(1),mg%is(2):mg%ie(2),mg%is(3):mg%ie(3)))
    allocate(fg%cos_cGdt  (lg%is(1):lg%ie(1),mg%is(2):mg%ie(2),mg%is(3):mg%ie(3)))
    allocate(fg%sin_cGdt  (lg%is(1):lg%ie(1),mg%is(2):mg%ie(2),mg%is(3):mg%ie(3)))
    fg%coef_nabla = 0d0
    fg%coef_gxgy0 = 1d0
    fg%cos_cGdt   = 0d0
    fg%sin_cGdt   = 0d0
  end if

  do iz=mg%is(3),mg%ie(3)
  do iy=mg%is(2),mg%ie(2)
  do ix=lg%is(1),lg%ie(1)

    if((ix-1)**2+(iy-1)**2+(iz-1)**2 == 0) fg%if_Gzero(ix,iy,iz) = .true.
    iix=ix-1-lg%num(1)*(1+sign(1,(ix-1-(lg%num(1)+1)/2)))/2
    iiy=iy-1-lg%num(2)*(1+sign(1,(iy-1-(lg%num(2)+1)/2)))/2
    iiz=iz-1-lg%num(3)*(1+sign(1,(iz-1-(lg%num(3)+1)/2)))/2
    g(1) = dble(iix)*brl(1,1) + dble(iiy)*brl(1,2) + dble(iiz)*brl(1,3)
    g(2) = dble(iix)*brl(2,1) + dble(iiy)*brl(2,2) + dble(iiz)*brl(2,3)
    g(3) = dble(iix)*brl(3,1) + dble(iiy)*brl(3,2) + dble(iiz)*brl(3,3)
    fg%vec_G(1,ix,iy,iz) = g(1)
    fg%vec_G(2,ix,iy,iz) = g(2)
    fg%vec_G(3,ix,iy,iz) = g(3)
    G2 = g(1)**2+g(2)**2+g(3)**2
    if(fg%if_Gzero(ix,iy,iz)) then
      fg%coef(ix,iy,iz) = 0.d0
    else
      fg%coef(ix,iy,iz) = 4.d0*pi/G2
    end if
    fg%exp_ewald(ix,iy,iz) = exp(-G2/(4d0*aEwald))
    if(theory=='single_scale_maxwell_tddft' .and. yn_ffte=='y') then
    ! for single-scale Maxwell-TDDFT
      fg%coef_nabla(ix,iy,iz,1) = -zi*g(1)
      fg%coef_nabla(ix,iy,iz,2) = -zi*g(2)
      fg%coef_nabla(ix,iy,iz,3) = -zi*g(3)
      if(ix==1.and.iy==1) fg%coef_gxgy0(ix,iy,iz) = 0d0
      if(cutoff_G2_emfield > 0d0 .and. G2 > cutoff_G2_emfield) fg%coef_gxgy0(ix,iy,iz) = 0d0
      fg%cos_cGdt(ix,iy,iz) = cos(cspeed_au*sqrt(G2)*dt)
      fg%sin_cGdt(ix,iy,iz) = sin(cspeed_au*sqrt(G2)*dt)
    end if

  enddo
  enddo
  enddo

  if(yn_ffte=='n') then
  ! discrete Fourier transform (general)

    allocate(fg%egx(lg%is(1):lg%ie(1),lg%is(1):lg%ie(1)))
    allocate(fg%egxc(lg%is(1):lg%ie(1),lg%is(1):lg%ie(1)))
    allocate(fg%egy(lg%is(2):lg%ie(2),lg%is(2):lg%ie(2)))
    allocate(fg%egyc(lg%is(2):lg%ie(2),lg%is(2):lg%ie(2)))
    allocate(fg%egz(lg%is(3):lg%ie(3),lg%is(3):lg%ie(3)))
    allocate(fg%egzc(lg%is(3):lg%ie(3),lg%is(3):lg%ie(3)))

    allocate(poisson%ff1x(lg%is(1):lg%ie(1),mg%is(2):mg%ie(2),mg%is(3):mg%ie(3)))
    allocate(poisson%ff1y(mg%is(1):mg%ie(1),lg%is(2):lg%ie(2),mg%is(3):mg%ie(3)))
    allocate(poisson%ff1z(mg%is(1):mg%ie(1),mg%is(2):mg%ie(2),lg%is(3):lg%ie(3)))
    allocate(poisson%ff2x(lg%is(1):lg%ie(1),mg%is(2):mg%ie(2),mg%is(3):mg%ie(3)))
    allocate(poisson%ff2y(mg%is(1):mg%ie(1),lg%is(2):lg%ie(2),mg%is(3):mg%ie(3)))
    allocate(poisson%ff2z(mg%is(1):mg%ie(1),mg%is(2):mg%ie(2),lg%is(3):lg%ie(3)))

  !$OMP parallel do private(ix,kx,tmp)
    do ix=lg%is(1),lg%ie(1)
      do kx=lg%is(1),lg%ie(1)
        tmp = exp(zI*(2.d0*Pi*dble((ix-1)*(kx-1))/dble(lg%num(1))))
        fg%egx(kx,ix)  = tmp
        fg%egxc(kx,ix) = conjg(tmp)
      end do
    end do
  !$OMP parallel do private(iy,ky,tmp)
    do iy=lg%is(2),lg%ie(2)
      do ky=lg%is(2),lg%ie(2)
        tmp = exp(zI*(2.d0*Pi*dble((iy-1)*(ky-1))/dble(lg%num(2))))
        fg%egy(ky,iy)  = tmp
        fg%egyc(ky,iy) = conjg(tmp)
      end do
    end do
  !$OMP parallel do private(iz,kz,tmp)
    do iz=lg%is(3),lg%ie(3)
      do kz=lg%is(3),lg%ie(3)
        tmp = exp(zI*(2.d0*Pi*dble((iz-1)*(kz-1))/dble(lg%num(3))))
        fg%egz(kz,iz)  = tmp
        fg%egzc(kz,iz) = conjg(tmp)
      end do
    end do

  else
  ! FFTE

    allocate(poisson%a_ffte(lg%num(1),mg%num(2),mg%num(3)))
    allocate(poisson%b_ffte(lg%num(1),mg%num(2),mg%num(3)))

  ! FFTE initialization step
    call PZFFT3DV_MOD(poisson%a_ffte,poisson%b_ffte,lg%num(1),lg%num(2),lg%num(3), &
                      info%isize_y,info%isize_z,0, &
                      info%icomm_y,info%icomm_z)

  end if

  allocate(poisson%zrhoG_ele(mg%is(1):mg%ie(1),mg%is(2):mg%ie(2),mg%is(3):mg%ie(3)))

  return
end subroutine init_reciprocal_grid

!===================================================================================================================================

subroutine init_reciprocal_grid_isolated_ft(lg,mg,fg,system,info,poisson)
  use structures, only: s_rgrid,s_reciprocal_grid,s_dft_system,s_parallel_info,s_poisson
  use math_constants,  only : pi,zi
  use salmon_global, only: yn_ffte,aEwald
  implicit none
  type(s_rgrid)          ,intent(in)    :: lg
  type(s_rgrid)          ,intent(in)    :: mg
  type(s_reciprocal_grid),intent(inout) :: fg
  type(s_dft_system)     ,intent(in)    :: system
  type(s_parallel_info)  ,intent(in)    :: info
  type(s_poisson)        ,intent(inout) :: poisson
  !
  real(8) :: brl(3,3)
  integer :: ix,iy,iz
  integer :: kx,ky,kz
  integer :: iix,iiy,iiz
  real(8) :: G2,g(3)
  integer :: imgx_s,imgx_e
  integer :: imgy_s,imgy_e
  integer :: imgz_s,imgz_e
  integer :: ifgx_s,ifgx_e
  integer :: ifgy_s,ifgy_e
  integer :: ifgz_s,ifgz_e
  complex(8) :: tmp

  if(yn_ffte=='n') then
    ifgx_s = (mg%is(1)-lg%is(1))*2+1
    ifgx_e = (mg%is(1)-lg%is(1))*2+mg%num(1)*2
    ifgy_s = (mg%is(2)-lg%is(2))*2+1
    ifgy_e = (mg%is(2)-lg%is(2))*2+mg%num(2)*2
    ifgz_s = (mg%is(3)-lg%is(3))*2+1
    ifgz_e = (mg%is(3)-lg%is(3))*2+mg%num(3)*2
  else
    if(mod(info%nporbital,4)==0)then
      ! start and end point of reciprocal grids for x, y, z
      ifgx_s = 1
      ifgx_e = 2*lg%num(1)
      if(info%id_y_isolated_ffte >= info%isize_y_isolated_ffte/2) then
        ifgy_s = mg%is(2)-lg%is(2)+1+lg%num(2)
      else
        ifgy_s = mg%is(2)-lg%is(2)+1
      end if
      ifgy_e = ifgy_s+mg%num(2)-1
      if(info%id_z_isolated_ffte >= info%isize_z_isolated_ffte/2) then
        ifgz_s = mg%is(3)-lg%is(3)+1+lg%num(3)
      else
        ifgz_s = mg%is(3)-lg%is(3)+1
      end if
      ifgz_e = ifgz_s+mg%num(3)-1
    else
      ! start and end point of reciprocal grids for x, y, z
      ifgx_s = 1
      ifgx_e = 2*lg%num(1)
      ifgy_s = 1
      ifgy_e = 2*lg%num(2)
      ifgz_s = 1
      ifgz_e = 2*lg%num(3)
    end if
  end if

  if(yn_ffte=='n') then
    imgx_s = mg%is(1)-lg%is(1)+1
    imgx_e = mg%is(1)-lg%is(1)+mg%num(1)
    imgy_s = mg%is(2)-lg%is(2)+1
    imgy_e = mg%is(2)-lg%is(2)+mg%num(2)
    imgz_s = mg%is(3)-lg%is(3)+1
    imgz_e = mg%is(3)-lg%is(3)+mg%num(3)

    allocate(fg%egx(1:2*lg%num(1),1:2*lg%num(1)))  ! (kx, ix)
    allocate(fg%egxc(1:2*lg%num(1),1:2*lg%num(1))) ! (kx, ix)
    allocate(fg%egy(1:2*lg%num(2),1:2*lg%num(2)))  ! (ky, iy)
    allocate(fg%egyc(1:2*lg%num(2),1:2*lg%num(2))) ! (ky, iy)
    allocate(fg%egz(1:2*lg%num(3),1:2*lg%num(3)))  ! (kz, iz)
    allocate(fg%egzc(1:2*lg%num(3),1:2*lg%num(3))) ! (kz, iz)

    allocate(poisson%ff1x(1:2*lg%num(1),ifgy_s:ifgy_e,ifgz_s:ifgz_e)) ! (ix, ky, kz)
    allocate(poisson%ff1y(imgx_s:imgx_e,1:2*lg%num(2),ifgz_s:ifgz_e)) ! (ix, iy, kz)
    allocate(poisson%ff1z(imgx_s:imgx_e,imgy_s:imgy_e,1:2*lg%num(3))) ! (ix, iy, iz)
    allocate(poisson%ff2x(1:2*lg%num(1),ifgy_s:ifgy_e,ifgz_s:ifgz_e)) ! (ix, ky, kz)
    allocate(poisson%ff2y(imgx_s:imgx_e,1:2*lg%num(2),ifgz_s:ifgz_e)) ! (ix, iy, kz)
    allocate(poisson%ff2z(imgx_s:imgx_e,imgy_s:imgy_e,1:2*lg%num(3))) ! (ix, iy, iz)

    allocate(poisson%ff1(1:2*lg%num(1),ifgy_s:ifgy_e,ifgz_s:ifgz_e))  ! (kx, ky, kz)
    allocate(poisson%ff2(1:2*lg%num(1),ifgy_s:ifgy_e,ifgz_s:ifgz_e))  ! (kx, ky, kz)

    allocate(poisson%ff3x(1:2*lg%num(1),imgy_s:imgy_e,imgz_s:imgz_e)) ! (kx, iy, iz)
    allocate(poisson%ff3y(ifgx_s:ifgx_e,1:2*lg%num(2),imgz_s:imgz_e)) ! (kx, ky, iz)
    allocate(poisson%ff3z(ifgx_s:ifgx_e,ifgy_s:ifgy_e,1:2*lg%num(3))) ! (kx, ky, kz)
    allocate(poisson%ff4x(1:2*lg%num(1),imgy_s:imgy_e,imgz_s:imgz_e)) ! (kx, iy, iz)
    allocate(poisson%ff4y(ifgx_s:ifgx_e,1:2*lg%num(2),imgz_s:imgz_e)) ! (kx, ky, iz)
    allocate(poisson%ff4z(ifgx_s:ifgx_e,ifgy_s:ifgy_e,1:2*lg%num(3))) ! (kx, ky, kz)

  !$OMP parallel do private(ix,kx,tmp)
    do ix=1,lg%num(1)
      do kx=1,2*lg%num(1)
        !tmp = exp(zI*(2.d0*Pi*dble(lg%coordinate(ix,1)*system%hgs(1)*(kx-1))/dble(2*lg%num(1))))
        tmp = exp(zI*(2.d0*Pi*dble((ix-1)*(kx-1))/dble(2*lg%num(1))))
        fg%egx(kx,ix)  = tmp
        fg%egxc(kx,ix) = conjg(tmp)
        !tmp = exp(zI*(2.d0*Pi*dble((lg%coordinate(ix,1)*system%hgs(1)+lg%num(1))*(kx-1))/dble(2*lg%num(1))))
        tmp = exp(zI*(2.d0*Pi*dble((ix-1)*(kx-1))/dble(2*lg%num(1))))
        fg%egx(kx,ix+lg%num(1))  = tmp
        fg%egxc(kx,ix+lg%num(1)) = conjg(tmp)
      end do
    end do
  !$OMP parallel do private(iy,ky,tmp)
    do iy=1,lg%num(2)
      do ky=1,2*lg%num(2)
        !tmp = exp(zI*(2.d0*Pi*dble(lg%coordinate(iy,2)*system%hgs(2)*(ky-1))/dble(2*lg%num(2))))
        tmp = exp(zI*(2.d0*Pi*dble((iy-1)*(ky-1))/dble(2*lg%num(2))))
        fg%egy(ky,iy)  = tmp
        fg%egyc(ky,iy) = conjg(tmp)
        !tmp = exp(zI*(2.d0*Pi*dble((lg%coordinate(iy,2)*system%hgs(2)+lg%num(2))*(ky-1))/dble(2*lg%num(2))))
        tmp = exp(zI*(2.d0*Pi*dble((iy-1)*(ky-1))/dble(2*lg%num(2))))
        fg%egy(ky,iy+lg%num(2))  = tmp
        fg%egyc(ky,iy+lg%num(2)) = conjg(tmp)
      end do
    end do
  !$OMP parallel do private(iz,kz,tmp)
    do iz=1,lg%num(3)
      do kz=1,2*lg%num(3)
        !tmp = exp(zI*(2.d0*Pi*dble(lg%coordinate(iz,3)*system%hgs(3)*(kz-1))/dble(2*lg%num(3))))
        tmp = exp(zI*(2.d0*Pi*dble((iz-1)*(kz-1))/dble(2*lg%num(3))))
        fg%egz(kz,iz)  = tmp
        fg%egzc(kz,iz) = conjg(tmp)
        !tmp = exp(zI*(2.d0*Pi*dble((lg%coordinate(iz,3)*system%hgs(3)+lg%num(3))*(kz-1))/dble(2*lg%num(3))))
        tmp = exp(zI*(2.d0*Pi*dble((iz-1)*(kz-1))/dble(2*lg%num(3))))
        fg%egz(kz,iz+lg%num(3))  = tmp
        fg%egzc(kz,iz+lg%num(3)) = conjg(tmp)
      end do
    end do
  else
  ! FFTE
    if(mod(info%nporbital,4)==0)then
      allocate(poisson%a_ffte(2*lg%num(1),mg%num(2),mg%num(3)))
      allocate(poisson%b_ffte(2*lg%num(1),mg%num(2),mg%num(3)))
    else
      allocate(poisson%a_ffte(2*lg%num(1),2*lg%num(2),2*lg%num(3)))
      allocate(poisson%b_ffte(2*lg%num(1),2*lg%num(2),2*lg%num(3)))
    end if
    ! FFTE initialization step
    call PZFFT3DV_MOD(poisson%a_ffte,poisson%b_ffte,2*lg%num(1),2*lg%num(2),2*lg%num(3), &
                      info%isize_y_isolated_ffte,info%isize_z_isolated_ffte,0, &
                      info%icomm_y_isolated_ffte,info%icomm_z_isolated_ffte)
  end if

  allocate(poisson%zrhoG_ele(ifgx_s:ifgx_e,ifgy_s:ifgy_e,ifgz_s:ifgz_e))
  poisson%zrhoG_ele = 0.d0

  brl(:,:)=system%primitive_b(:,:)

  allocate(fg%if_Gzero (ifgx_s:ifgx_e,ifgy_s:ifgy_e,ifgz_s:ifgz_e))
  allocate(fg%vec_G(1:3,ifgx_s:ifgx_e,ifgy_s:ifgy_e,ifgz_s:ifgz_e))
  allocate(fg%coef     (ifgx_s:ifgx_e,ifgy_s:ifgy_e,ifgz_s:ifgz_e))
  allocate(fg%exp_ewald(ifgx_s:ifgx_e,ifgy_s:ifgy_e,ifgz_s:ifgz_e))
  fg%if_Gzero = .false.
  fg%vec_G = 0d0
  fg%coef = 0d0
  fg%exp_ewald = 0d0

  do iz=ifgz_s,ifgz_e
  do iy=ifgy_s,ifgy_e
  do ix=ifgx_s,ifgx_e

    iix=ix-1-2*lg%num(1)*(1+sign(1,(ix-1-(2*lg%num(1)+1)/2)))/2
    iiy=iy-1-2*lg%num(2)*(1+sign(1,(iy-1-(2*lg%num(2)+1)/2)))/2
    iiz=iz-1-2*lg%num(3)*(1+sign(1,(iz-1-(2*lg%num(3)+1)/2)))/2

    if(iix**2+iiy**2+iiz**2 == 0) fg%if_Gzero(ix,iy,iz) = .true.

    g(1) = dble(iix)*brl(1,1)/2.d0
    g(2) = dble(iiy)*brl(2,2)/2.d0
    g(3) = dble(iiz)*brl(3,3)/2.d0
    fg%vec_G(1,ix,iy,iz) = g(1)
    fg%vec_G(2,ix,iy,iz) = g(2)
    fg%vec_G(3,ix,iy,iz) = g(3)
    G2 = g(1)**2+g(2)**2+g(3)**2

    if(fg%if_Gzero(ix,iy,iz)) then
      fg%coef(ix,iy,iz) = 0.d0
    else
      fg%coef(ix,iy,iz) = 4.d0*pi/G2
    end if
    fg%exp_ewald(ix,iy,iz) = exp(-G2/(4d0*aEwald))

  enddo
  enddo
  enddo

  return
end subroutine init_reciprocal_grid_isolated_ft

!===================================================================================================================================

subroutine set_gridcoordinate(lg,system)
  use structures, only: s_rgrid,s_dft_system
  use salmon_global, only: iperiodic
  implicit none
  type(s_rgrid),     intent(inout) :: lg
  type(s_dft_system),intent(in)    :: system
  integer :: ix,iy,iz

  allocate(lg%coordinate(minval(lg%is_overlap(1:3)):maxval(lg%ie_overlap(1:3)),3))

  select case(iperiodic)
  case(0)
    select case(mod(lg%num(1),2))
      case(1)
!$OMP parallel do
        do ix=lg%is_overlap(1),lg%ie_overlap(1)
          lg%coordinate(ix,1)=dble(ix)*system%hgs(1)
        end do
      case(0)
!$OMP parallel do
        do ix=lg%is_overlap(1),lg%ie_overlap(1)
          lg%coordinate(ix,1)=(dble(ix)-0.5d0)*system%hgs(1)
        end do
    end select

    select case(mod(lg%num(2),2))
      case(1)
!$OMP parallel do
        do iy=lg%is_overlap(2),lg%ie_overlap(2)
          lg%coordinate(iy,2)=dble(iy)*system%hgs(2)
        end do
      case(0)
!$OMP parallel do
      do iy=lg%is_overlap(2),lg%ie_overlap(2)
        lg%coordinate(iy,2)=(dble(iy)-0.5d0)*system%hgs(2)
      end do
    end select

    select case(mod(lg%num(3),2))
      case(1)
!$OMP parallel do
        do iz=lg%is_overlap(3),lg%ie_overlap(3)
          lg%coordinate(iz,3)=dble(iz)*system%hgs(3)
        end do
      case(0)
!$OMP parallel do
        do iz=lg%is_overlap(3),lg%ie_overlap(3)
          lg%coordinate(iz,3)=(dble(iz)-0.5d0)*system%hgs(3)
        end do
    end select
  case(3)
!$OMP parallel do
    do ix=lg%is_overlap(1),lg%ie_overlap(1)
      lg%coordinate(ix,1)=dble(ix-1)*system%hgs(1)
    end do
!$OMP parallel do
    do iy=lg%is_overlap(2),lg%ie_overlap(2)
      lg%coordinate(iy,2)=dble(iy-1)*system%hgs(2)
    end do
!$OMP parallel do
    do iz=lg%is_overlap(3),lg%ie_overlap(3)
      lg%coordinate(iz,3)=dble(iz-1)*system%hgs(3)
    end do
  end select

end subroutine set_gridcoordinate

!===================================================================================================================================

subroutine init_nion_div(system,lg,mg,info)
  use structures, only: s_dft_system, s_reciprocal_grid, s_rgrid, s_parallel_info
  use communication, only: comm_summation, comm_get_groupinfo, comm_is_root
 !use parallelization, only: nproc_id_global
  implicit none
  type(s_dft_system),intent(in) :: system
  type(s_rgrid)     ,intent(in) :: lg
  type(s_rgrid)     ,intent(in) :: mg
  type(s_parallel_info)         :: info
  !
  logical :: flag_cuboid
 !integer :: k,irank,nproc
  integer :: ia,j,nc,ix,iy,iz,iia,nion_total
  real(8) :: hgs(3), Rion_tmp(3,system%nion), al0(3,3)
  real(8) :: r_mg_min(3), r_mg_max(3), al_min(3), al_max(3), al_len(3)

  al0(:,:) = system%primitive_a(:,:)
  if( abs(al0(1,2)).ge.1d-10 .or. &
      abs(al0(1,3)).ge.1d-10 .or. &
      abs(al0(2,3)).ge.1d-10 )  then
     flag_cuboid=.false.
  else
     flag_cuboid = .true.
  endif

  if(flag_cuboid) then

  nc = 2
  hgs(:)    = system%hgs(:)

  r_mg_min(:) = (mg%is(:)-1) * hgs(:)
  r_mg_max(:) =  mg%ie(:)    * hgs(:)

  al_min(:) = 0d0
  al_max(:) = system%hgs(:)*dble(lg%num(:))
  al_len(:) = al_max(:) - al_min(:)

  info%nion_mg = 0

  do ia = 1,system%nion
     j=1
     do ix = -nc, nc
        Rion_tmp(j,ia) = system%Rion(j,ia) + ix*al_len(j)
        if( Rion_tmp(j,ia) .ge. al_min(j) .and. Rion_tmp(j,ia) .lt. al_max(j) ) exit
     enddo
     j=2
     do iy = -nc, nc
        Rion_tmp(j,ia) = system%Rion(j,ia) + iy*al_len(j)
        if( Rion_tmp(j,ia) .ge. al_min(j) .and. Rion_tmp(j,ia) .lt. al_max(j) ) exit
     enddo
     j=3
     do iz = -nc, nc
        Rion_tmp(j,ia) = system%Rion(j,ia) + iz*al_len(j)
        if( Rion_tmp(j,ia) .ge. al_min(j) .and. Rion_tmp(j,ia) .lt. al_max(j) ) exit
     enddo

     if( (Rion_tmp(1,ia).ge.r_mg_min(1) .and. Rion_tmp(1,ia).lt.r_mg_max(1)) .and. &
         (Rion_tmp(2,ia).ge.r_mg_min(2) .and. Rion_tmp(2,ia).lt.r_mg_max(2)) .and. &
         (Rion_tmp(3,ia).ge.r_mg_min(3) .and. Rion_tmp(3,ia).lt.r_mg_max(3)) ) then
        info%nion_mg = info%nion_mg + 1
     endif
  enddo

  allocate( info%ia_mg(info%nion_mg) )

  iia = 0
  do ia = 1,system%nion
     if( (Rion_tmp(1,ia).ge.r_mg_min(1) .and. Rion_tmp(1,ia).lt.r_mg_max(1)) .and. &
         (Rion_tmp(2,ia).ge.r_mg_min(2) .and. Rion_tmp(2,ia).lt.r_mg_max(2)) .and. &
         (Rion_tmp(3,ia).ge.r_mg_min(3) .and. Rion_tmp(3,ia).lt.r_mg_max(3)) ) then
        iia = iia + 1
        info%ia_mg(iia) = ia
     endif
  enddo

  if( info%nion_mg .ne. iia ) stop "Error1 in dividing atom in mg domain"

  else !(flag_cuboid=.false.)

     ! assuming r-space parallelization is not available in nonorthogonal lattice cell
     info%nion_mg = system%nion
     allocate( info%ia_mg(info%nion_mg) )
     do ia=1,system%nion
        info%ia_mg(ia) = ia
     enddo

  endif

  !check
  call comm_summation(info%nion_mg, nion_total, info%icomm_r)
  if( nion_total .ne. system%nion ) stop "Error2 in dividing atom in mg domain"

  !write(*,*) "  #nion_mg=", system%nion_mg
  !write(*,*) "  #check nion_total=", nion_total

  !!(divide nion with all processes: not used now)
  !call comm_get_groupinfo(fg%icomm_G,irank,nproc)
  !
  !if(nproc .le. system%nion) then
  !   k = mod(system%nion,nproc)
  !   if(k==0) then
  !      system%nion_r = system%nion / nproc
  !   else
  !      system%nion_r = system%nion / nproc + 1
  !   endif
  !   system%nion_s = system%nion_r * irank + 1
  !   system%nion_e = system%nion_s + system%nion_r - 1
  !   if (irank == nproc-1) system%nion_e = system%nion
  !   if (system%nion_e .gt. system%nion) system%nion_e = -1
  !   if (system%nion_s .gt. system%nion) then
  !      system%nion_s =  0
  !      system%nion_e = -1
  !   endif
  !
  !else
  !   if(irank+1.le.system%nion) then
  !      system%nion_s = irank + 1
  !      system%nion_e = system%nion_s
  !   else
  !      system%nion_s = 0
  !      system%nion_e = -1
  !   endif
  !endif

end subroutine init_nion_div

!===================================================================================================================================

subroutine set_bN(bnmat)
  implicit none
  real(8) :: bnmat(4,4)

  bNmat(1,1)=1.d0/2.d0

  bNmat(1,2)=2.d0/3.d0
  bNmat(2,2)=-1.d0/12.d0

  bNmat(1,3)=3.d0/4.d0
  bNmat(2,3)=-3.d0/20.d0
  bNmat(3,3)=1.d0/60.d0

  bNmat(1,4)=4.d0/5.d0
  bNmat(2,4)=-1.d0/5.d0
  bNmat(3,4)=4.d0/105.d0
  bNmat(4,4)=-1.d0/280.d0

end subroutine set_bN

subroutine set_cN(cnmat)
  implicit none
  real(8) :: cnmat(0:12,12)

  cNmat(0,1)=-2.d0
  cNmat(1,1)=1.d0

  cNmat(0,2)=-5.d0/2.d0
  cNmat(1,2)=4.d0/3.d0
  cNmat(2,2)=-1.d0/12.d0

  cNmat(0,3)=-49.d0/18.d0
  cNmat(1,3)=3.d0/2.d0
  cNmat(2,3)=-3.d0/20.d0
  cNmat(3,3)=1.d0/90.d0

  cNmat(0,5)=-5269.d0/1800.d0
  cNmat(1,5)=5.d0/3.d0
  cNmat(2,5)=-5.d0/21.d0
  cNmat(3,5)=5.d0/126.d0
  cNmat(4,5)=-5.d0/1008.d0
  cNmat(5,5)=1.d0/3150.d0

  cNmat(0,4)=-205.d0/72.d0
  cNmat(1,4)=8.d0/5.d0
  cNmat(2,4)=-1.d0/5.d0
  cNmat(3,4)=8.d0/315.d0
  cNmat(4,4)=-1.d0/560.d0

  cNmat(0,6)=-5369.d0/1800.d0
  cNmat(1,6)=12.d0/7.d0
  cNmat(2,6)=-15.d0/56.d0
  cNmat(3,6)=10.d0/189.d0
  cNmat(4,6)=-1.d0/112.d0
  cNmat(5,6)=2.d0/1925.d0
  cNmat(6,6)=-1.d0/16632.d0

  cNmat(0,7)=-266681.d0/88200.d0
  cNmat(1,7)=7.d0/4.d0
  cNmat(2,7)=-7.d0/24.d0
  cNmat(3,7)=7.d0/108.d0
  cNmat(4,7)=-7.d0/528.d0
  cNmat(5,7)=7.d0/3300.d0
  cNmat(6,7)=-7.d0/30888.d0
  cNmat(7,7)=1.d0/84084.d0

  cNmat(0,8)=-1077749.d0/352800.d0
  cNmat(1,8)=16.d0/9.d0
  cNmat(2,8)=-14.d0/45.d0
  cNmat(3,8)=112.d0/1485.d0
  cNmat(4,8)=-7.d0/396.d0
  cNmat(5,8)=112.d0/32175.d0
  cNmat(6,8)=-2.d0/3861.d0
  cNmat(7,8)=16.d0/315315.d0
  cNmat(8,8)=-1.d0/411840.d0

  cNmat(0,9)=-9778141.d0/3175200.d0
  cNmat(1,9)=9.d0/5.d0
  cNmat(2,9)=-18.d0/55.d0
  cNmat(3,9)=14.d0/165.d0
  cNmat(4,9)=-63.d0/2860.d0
  cNmat(5,9)=18.d0/3575.d0
  cNmat(6,9)=-2.d0/2145.d0
  cNmat(7,9)=9.d0/70070.d0
  cNmat(8,9)=-9.d0/777920.d0
  cNmat(9,9)=1.d0/1969110.d0

  cNmat(0,10)=-1968329.d0/635040.d0
  cNmat(1,10)=20.d0/11.d0
  cNmat(2,10)=-15.d0/44.d0
  cNmat(3,10)=40.d0/429.d0
  cNmat(4,10)=-15.d0/572.d0
  cNmat(5,10)=24.d0/3575.d0
  cNmat(6,10)=-5.d0/3432.d0
  cNmat(7,10)=30.d0/119119.d0
  cNmat(8,10)=-5.d0/155584.d0
  cNmat(9,10)=10.d0/3741309.d0
  cNmat(10,10)=-1.d0/9237800.d0

  cNmat(0,11)=-239437889.d0/76839840.d0
  cNmat(1,11)=11.d0/6.d0
  cNmat(2,11)=-55.d0/156.d0
  cNmat(3,11)=55.d0/546.d0
  cNmat(4,11)=-11.d0/364.d0
  cNmat(5,11)=11.d0/1300.d0
  cNmat(6,11)=-11.d0/5304.d0
  cNmat(7,11)=55.d0/129948.d0
  cNmat(8,11)=-55.d0/806208.d0
  cNmat(9,11)=11.d0/1360476.d0
  cNmat(10,11)=-11.d0/17635800.d0
  cNmat(11,11)=1.d0/42678636.d0

  cNmat(0,12)=-240505109.d0/76839840.d0
  cNmat(1,12)=24.d0/13.d0
  cNmat(2,12)=-33.d0/91.d0
  cNmat(3,12)=88.d0/819.d0
  cNmat(4,12)=-99.d0/2912.d0
  cNmat(5,12)=396.d0/38675.d0
  cNmat(6,12)=-11.d0/3978.d0
  cNmat(7,12)=132.d0/205751.d0
  cNmat(8,12)=-33.d0/268736.d0
  cNmat(9,12)=44.d0/2380833.d0
  cNmat(10,12)=-3.d0/1469650.d0
  cNmat(11,12)=12.d0/81800719.d0
  cNmat(12,12)=-1.d0/194699232.d0

end subroutine set_cN

end module initialization_sub


c--- The variables R and P provide the Regular and Plus pieces associated
c--- with radiation from leg 1 (Q1(a,b,c,is) and leg 2 (Q2(a,b,c,is)
c--- In each case the parton labelling is Using the normal QM notation of putting
c--- everything backward
c---       emitted line after emission =   a
c---       emitter before emission     =    b
c---       spectator                   =    c
c--- There is no label for he or she who is emitted.
c--- Note that in general each piece will be composed of many different
c--- dipole contributions

c--- Additional label (1-8) in this array, to represent the partons
c--- in the final state, according to the look-up parameters
c--- that are also defined here

c--- code is as follows:
c---  g=0, q=1, a=-1, r=2, b=-2 --- "f" for final
      integer gf_gf,qf_af,qf_qf,qf_rf,bf_rf,rf_bf,qf_gf,af_gf
      parameter (gf_gf=1,qf_af=2,qf_qf=3,qf_rf=4,
     . bf_rf=5,rf_bf=6,qf_gf=7,af_gf=8)
      double precision
     . S1(-1:1,-1:1,-1:1,8,0:2,3),S2(-1:1,-1:1,-1:1,8,0:2,3)
      common/SP_twojet/S1,S2
!$omp threadprivate(/SP_twojet/)