*** ./g03.org/utilam.F	2004-05-12 23:49:54.000000000 +0900
--- ./g03/utilam.F	2005-02-22 12:30:25.000000000 +0900
***************
*** 27556,27563 ****
        else
          NPrtSt = NPSMem - 1
          endIf
! C$OMP Parallel If(ThrOK) Default(Shared)
! C$OMP+ Private(IP1,IStat,IPartT,IPartX)
        Do 100 IPartX = NPrtSt, 0, -1
          If(ThrOK) then
            IP1 = MDPart(0)
--- 27556,27563 ----
        else
          NPrtSt = NPSMem - 1
          endIf
! CTNK Parallel If(ThrOK) Default(Shared)
! CTNK+ Private(IP1,IStat,IPartT,IPartX)
        Do 100 IPartX = NPrtSt, 0, -1
          If(ThrOK) then
            IP1 = MDPart(0)
***************
*** 27588,27594 ****
            Call GauErr('Consistency failure in CalDEv.')
            endIf
    100   Continue
! C$OMP END PARALLEL
        IP1 = NProc(-1)
  C     Call LinInt(.True.)
  C
--- 27588,27594 ----
            Call GauErr('Consistency failure in CalDEv.')
            endIf
    100   Continue
! CTNK END PARALLEL
        IP1 = NProc(-1)
  C     Call LinInt(.True.)
  C
***************
*** 28017,28026 ****
          endIf
        ICBat = 0
        ICAtom = 0
! C$OMP CRITICAL
        NxtVal = NxtVal + NPrtUL
        MyTask = NxtVal
! C$OMP END CRITICAL
        Do 200 IAtom = IPDiv(1,IPart), IPDiv(2,IPart)
  C       Skip this atom if dictated by symmetry...
          IAtomR = MapAtm(IAtom)
--- 28017,28026 ----
          endIf
        ICBat = 0
        ICAtom = 0
! CTNK CRITICAL
        NxtVal = NxtVal + NPrtUL
        MyTask = NxtVal
! CTNK END CRITICAL
        Do 200 IAtom = IPDiv(1,IPart), IPDiv(2,IPart)
  C       Skip this atom if dictated by symmetry...
          IAtomR = MapAtm(IAtom)
***************
*** 28232,28241 ****
       $        IGWInf(12),RRdBtD)
              endIf
    110     If(DynPar) then
! C$OMP CRITICAL
              NxtVal = NxtVal + NPrtUL
              MyTask = NxtVal
! C$OMP END CRITICAL
              endIf
    120     Continue
  C       Apply translational invariance...
--- 28232,28241 ----
       $        IGWInf(12),RRdBtD)
              endIf
    110     If(DynPar) then
! CTNK CRITICAL
              NxtVal = NxtVal + NPrtUL
              MyTask = NxtVal
! CTNK END CRITICAL
              endIf
    120     Continue
  C       Apply translational invariance...
***************
*** 28904,28913 ****
              endIf
            If(IPrint.gt.0) Write(IOut,1080) NPrtUS, ThrOK
  #ifdef _OPENMP_
! C$OMP Parallel If(ThrOK) Default(Shared)
! C$OMP+ Private(ID1E,ID2E,IEC,IElSum,IEX,IndV,IPart,LenVAB,LenVX,IBNorm)
! C$OMP+ Private(IStat,IVA,IVB,IVXA,IVXB,IVxAI,IVxBI,LenD1E,LenD2E,LenEXC)
! C$OMP+ Private(IPartX,LStat,LenVxI,RJunk,FName,IOutD,IPrinD)
  #endif
            Do 200 IPartX = NPrtSt, 0, -1
              If(ThrOK) then
--- 28904,28913 ----
              endIf
            If(IPrint.gt.0) Write(IOut,1080) NPrtUS, ThrOK
  #ifdef _OPENMP_
! CTNK Parallel If(ThrOK) Default(Shared)
! CTNK+ Private(ID1E,ID2E,IEC,IElSum,IEX,IndV,IPart,LenVAB,LenVX,IBNorm)
! CTNK+ Private(IStat,IVA,IVB,IVXA,IVXB,IVxAI,IVxBI,LenD1E,LenD2E,LenEXC)
! CTNK+ Private(IPartX,LStat,LenVxI,RJunk,FName,IOutD,IPrinD)
  #endif
            Do 200 IPartX = NPrtSt, 0, -1
              If(ThrOK) then
***************
*** 28981,28987 ****
                endIf
              If(DoDump.ne.0) Close(Unit=IOutD)
    200       Continue
! C$OMP END PARALLEL
  #ifdef GAUSS_LINDA
            IPart = NProc(-1)
  C         Call LinInt(.True.)
--- 28981,28987 ----
                endIf
              If(DoDump.ne.0) Close(Unit=IOutD)
    200       Continue
! CTNK END PARALLEL
  #ifdef GAUSS_LINDA
            IPart = NProc(-1)
  C         Call LinInt(.True.)
***************
*** 46453,46459 ****
        Call AClear(LClr*LD1,SD1Rho)
        Call AClear(LClr*LD2,SD2Rho)
        Call DoChiM(IOpt,NPt,NBasis,Chi,D1Chi,D2Chi,ChiMax)
! C$OMP Parallel Do Schedule(Static,1) Default(Shared) Private(IP1,IP)
        Do 20 IP1 = 0, (NP-1)
          IP = IP1
          If(IP.eq.0) then
--- 46453,46459 ----
        Call AClear(LClr*LD1,SD1Rho)
        Call AClear(LClr*LD2,SD2Rho)
        Call DoChiM(IOpt,NPt,NBasis,Chi,D1Chi,D2Chi,ChiMax)
! CTNK Parallel Do Schedule(Static,1) Default(Shared) Private(IP1,IP)
        Do 20 IP1 = 0, (NP-1)
          IP = IP1
          If(IP.eq.0) then
***************
*** 68779,68786 ****
  C
  C     Now compute dn/dPmn and contract dE/dn with it into Fock matrix.
  C
! C$OMP Parallel Do Schedule(Static,1) Default(Shared)
! C$OMP+ Private(Mu,Nu,K,KDid,IP,tempx,tempy,tempz,tdot,tmpx,tmpy,tmpz)
        Do 20 Mu = 1, NBasis
          Do 20 Nu = 1, Mu
            Do 20 K = 1, NDo
--- 68779,68786 ----
  C
  C     Now compute dn/dPmn and contract dE/dn with it into Fock matrix.
  C
! CTNK Parallel Do Schedule(Static,1) Default(Shared)
! CTNK+ Private(Mu,Nu,K,KDid,IP,tempx,tempy,tempz,tdot,tmpx,tmpy,tmpz)
        Do 20 Mu = 1, NBasis
          Do 20 Nu = 1, Mu
            Do 20 K = 1, NDo
***************
*** 68812,68818 ****
  C
        Call AClear(6*NDo,dxyz)
        Call AClear(4*NDo,DcXYZ)
! C$OMP Parallel Do Schedule(Static,1) Default(Shared) Private(K,K1,KK1)
        Do 30 K = 1, NDo
          K1 = K + IDid
          KK1 = ISlMap(K1)
--- 68812,68818 ----
  C
        Call AClear(6*NDo,dxyz)
        Call AClear(4*NDo,DcXYZ)
! CTNK Parallel Do Schedule(Static,1) Default(Shared) Private(K,K1,KK1)
        Do 30 K = 1, NDo
          K1 = K + IDid
          KK1 = ISlMap(K1)
***************
*** 69762,69769 ****
          If(Iop.eq.0) then
  C         Aqe = be, omega A = V
  C
! C$OMP Parallel Do Schedule(Dynamic) Default(Shared)
! C$OMP+ Private(I,J,DistX,DistY,DistZ,D3,Aji,Aij,IVec,KOff)
            Do 30 I = 2, MSz
              Do 30 J = 1, (I-1)
                Distx = XYZ(i,1) - XYZ(j,1)
--- 69762,69769 ----
          If(Iop.eq.0) then
  C         Aqe = be, omega A = V
  C
! CTNK Parallel Do Schedule(Dynamic) Default(Shared)
! CTNK+ Private(I,J,DistX,DistY,DistZ,D3,Aji,Aij,IVec,KOff)
            Do 30 I = 2, MSz
              Do 30 J = 1, (I-1)
                Distx = XYZ(i,1) - XYZ(j,1)
***************
*** 69802,69809 ****
          else if(Iop.eq.1) then
  C         Aqe = be, Aqn = bn, A'q'e = be, A'q'n = bn
  C
! C$OMP Parallel Do Schedule(Dynamic) Default(Shared)
! C$OMP+ Private(I,J,DistX,DistY,DistZ,D3,Aji,Aij,IVec,ISub,KOff)
            Do 120 I = 2, MSz
              Do 115 J = 1, (I-1)
                Distx = XYZ(i,1) - XYZ(j,1)
--- 69802,69809 ----
          else if(Iop.eq.1) then
  C         Aqe = be, Aqn = bn, A'q'e = be, A'q'n = bn
  C
! CTNK Parallel Do Schedule(Dynamic) Default(Shared)
! CTNK+ Private(I,J,DistX,DistY,DistZ,D3,Aji,Aij,IVec,ISub,KOff)
            Do 120 I = 2, MSz
              Do 115 J = 1, (I-1)
                Distx = XYZ(i,1) - XYZ(j,1)
***************
*** 69837,69844 ****
          else if(Iop.eq.2) then
  C         Cg = -Ve, beta C = qe Ve
  C
! C$OMP Parallel Do Schedule(Dynamic) Default(Shared)
! C$OMP+ Private(I,J,DistX,DistY,DistZ,D1,ISub,IVec,KOff)
            Do 230 I = 2, MSz
              Do 230 J = 1, (I-1)
                Distx = XYZ(I,1) - XYZ(J,1)
--- 69837,69844 ----
          else if(Iop.eq.2) then
  C         Cg = -Ve, beta C = qe Ve
  C
! CTNK Parallel Do Schedule(Dynamic) Default(Shared)
! CTNK+ Private(I,J,DistX,DistY,DistZ,D1,ISub,IVec,KOff)
            Do 230 I = 2, MSz
              Do 230 J = 1, (I-1)
                Distx = XYZ(I,1) - XYZ(J,1)
***************
*** 69873,69880 ****
          else if(Iop.eq.3) then
  C         omega A = gV, omegau A = V, alpha0 A' = g Gamma0, alpha1 A' = Gamma1
  C
! C$OMP Parallel Do Schedule(Dynamic) Default(Shared)
! C$OMP+ Private(I,J,DistX,DistY,DistZ,D3,Aji,Aij,IVec,ISub,KOff)
            Do 320 I = 2, MSz
              Do 320 J = 1, (I-1)
                Distx = XYZ(i,1) - XYZ(j,1)
--- 69873,69880 ----
          else if(Iop.eq.3) then
  C         omega A = gV, omegau A = V, alpha0 A' = g Gamma0, alpha1 A' = Gamma1
  C
! CTNK Parallel Do Schedule(Dynamic) Default(Shared)
! CTNK+ Private(I,J,DistX,DistY,DistZ,D3,Aji,Aij,IVec,ISub,KOff)
            Do 320 I = 2, MSz
              Do 320 J = 1, (I-1)
                Distx = XYZ(i,1) - XYZ(j,1)
***************
*** 69914,69921 ****
          If(Iop.eq.0) then
  C         Aqe = be, omega A = V
  C
! C$OMP Parallel Do Schedule(Dynamic) Default(Shared)
! C$OMP+ Private(I,J,DistX,DistY,DistZ,D3,Aji,Aij,IVec,Indx,KOff)
            Do 1030 I = 2, MSz
              Indx = (i-1)*(i-2)/2
              Do 1030 J = 1, (I-1)
--- 69914,69921 ----
          If(Iop.eq.0) then
  C         Aqe = be, omega A = V
  C
! CTNK Parallel Do Schedule(Dynamic) Default(Shared)
! CTNK+ Private(I,J,DistX,DistY,DistZ,D3,Aji,Aij,IVec,Indx,KOff)
            Do 1030 I = 2, MSz
              Indx = (i-1)*(i-2)/2
              Do 1030 J = 1, (I-1)
***************
*** 69955,69962 ****
          else if(Iop.eq.1) then
  C         Aqe = be, Aqn = bn, A'q'e = be, A'q'n = bn
  C
! C$OMP Parallel Do Schedule(Dynamic) Default(Shared)
! C$OMP+ Private(I,J,DistX,DistY,DistZ,D3,Aji,Aij,IVec,ISub,Indx,KOff)
            Do 1120 I = 2, MSz
              Indx = (i-1)*(i-2)/2
              Do 1120 J = 1, (I-1)
--- 69955,69962 ----
          else if(Iop.eq.1) then
  C         Aqe = be, Aqn = bn, A'q'e = be, A'q'n = bn
  C
! CTNK Parallel Do Schedule(Dynamic) Default(Shared)
! CTNK+ Private(I,J,DistX,DistY,DistZ,D3,Aji,Aij,IVec,ISub,Indx,KOff)
            Do 1120 I = 2, MSz
              Indx = (i-1)*(i-2)/2
              Do 1120 J = 1, (I-1)
***************
*** 69989,69996 ****
          else if(Iop.eq.2) then
  C         Cg = -Ve, beta C = qe Ve
  C
! C$OMP Parallel Do Schedule(Dynamic) Default(Shared)
! C$OMP+ Private(I,J,D1,ISub,IVec,Indx,KOff)
            Do 1230 I = 2, MSz
              Indx = (I-1)*(I-2)/2
              Do 1230 J = 1, (I-1)
--- 69989,69996 ----
          else if(Iop.eq.2) then
  C         Cg = -Ve, beta C = qe Ve
  C
! CTNK Parallel Do Schedule(Dynamic) Default(Shared)
! CTNK+ Private(I,J,D1,ISub,IVec,Indx,KOff)
            Do 1230 I = 2, MSz
              Indx = (I-1)*(I-2)/2
              Do 1230 J = 1, (I-1)
***************
*** 70023,70030 ****
          else if(Iop.eq.3) then
  C         omega A = gV, omegau A = V, alpha0 A' = g Gamma0, alpha1 A' = Gamma1
  C
! C$OMP Parallel Do Schedule(Dynamic) Default(Shared)
! C$OMP+ Private(I,J,DistX,DistY,DistZ,D3,Aji,Aij,IVec,ISub,Indx,KOff)
            Do 1320 I = 2, MSz
              Indx = (i-1)*(i-2)/2
              Do 1320 J = 1, (I-1)
--- 70023,70030 ----
          else if(Iop.eq.3) then
  C         omega A = gV, omegau A = V, alpha0 A' = g Gamma0, alpha1 A' = Gamma1
  C
! CTNK Parallel Do Schedule(Dynamic) Default(Shared)
! CTNK+ Private(I,J,DistX,DistY,DistZ,D3,Aji,Aij,IVec,ISub,Indx,KOff)
            Do 1320 I = 2, MSz
              Indx = (i-1)*(i-2)/2
              Do 1320 J = 1, (I-1)
***************
*** 73858,73866 ****
        NWait = 0
  #ifdef _OPENMP_
        IP = NProc(-NPartU)
! C$OMP Parallel Do Schedule(Static,1) Default(Shared)
! C$OMP+ Private(IATEN,IATST,IMDV,IP,ISTAT,LCNBEG,LCNEND,LEFT,LIP,LNP)
! C$OMP+ Private(NAT,NATPB,IFlag,IH,IHD,IFXYZ,IFFXYZ,IV1,Flag)
  #endif
        Do 200 IP = NPartU, 1, -1
          If(IP.eq.1) then
--- 73858,73866 ----
        NWait = 0
  #ifdef _OPENMP_
        IP = NProc(-NPartU)
! CTNK Parallel Do Schedule(Static,1) Default(Shared)
! CTNK+ Private(IATEN,IATST,IMDV,IP,ISTAT,LCNBEG,LCNEND,LEFT,LIP,LNP)
! CTNK+ Private(NAT,NATPB,IFlag,IH,IHD,IFXYZ,IFFXYZ,IV1,Flag)
  #endif
        Do 200 IP = NPartU, 1, -1
          If(IP.eq.1) then
***************
*** 98106,98112 ****
  C
        If(Init) Call AClear(((NBasis*(NBasis+1))/2),P)
        If(NE.lt.1.or.NBasis.lt.1) Return
! C$OMP Parallel Do Schedule(Static,1) Default(Shared) Private(I,II)
        Do 10 I = 1, NBasis
          II = (I*(I-1))/2 + 1
          Call SProdN(NDim,NE,I,One,A,A(1,I),P(II))
--- 98106,98112 ----
  C
        If(Init) Call AClear(((NBasis*(NBasis+1))/2),P)
        If(NE.lt.1.or.NBasis.lt.1) Return
! CTNK Parallel Do Schedule(Static,1) Default(Shared) Private(I,II)
        Do 10 I = 1, NBasis
          II = (I*(I-1))/2 + 1
          Call SProdN(NDim,NE,I,One,A,A(1,I),P(II))
***************
*** 98164,98170 ****
  C
        If(Init) Call AClear(((NBasis*(NBasis+1))/2),P)
        If(NE.lt.1) Return
! C$OMP Parallel Do Schedule(Dynamic) Default(Shared) Private(I,II,K,AIK)
        Do 20 I = 1, NBasis
          II = (I*(I-1))/2
          Do 10 K = 1, NE
--- 98164,98170 ----
  C
        If(Init) Call AClear(((NBasis*(NBasis+1))/2),P)
        If(NE.lt.1) Return
! CTNK Parallel Do Schedule(Dynamic) Default(Shared) Private(I,II,K,AIK)
        Do 20 I = 1, NBasis
          II = (I*(I-1))/2
          Do 10 K = 1, NE
***************
*** 100794,100801 ****
          endif
  c load balancing
        Call CostMtt(IRowNo,NRow,IROWA,N,NP)
! C$OMP Parallel Do Default(Shared) Schedule(Static,1)
! C$OMP+ Private(lpar,i,ii,DoNum1,NRA,NRB,NZSAV,isc,NZ,inc)
        do 100 lpar=1,NP
          do 200 ii=NRow(lpar),NRow(lpar+1)-1
            i = IRowNo(ii)
--- 100794,100801 ----
          endif
  c load balancing
        Call CostMtt(IRowNo,NRow,IROWA,N,NP)
! CTNK Parallel Do Default(Shared) Schedule(Static,1)
! CTNK+ Private(lpar,i,ii,DoNum1,NRA,NRB,NZSAV,isc,NZ,inc)
        do 100 lpar=1,NP
          do 200 ii=NRow(lpar),NRow(lpar+1)-1
            i = IRowNo(ii)
***************
*** 102905,102912 ****
        Call AClear(N*NP,B)
        Call AClear(N*NP,C)
        Call CostFx(NP,N,X,NRow,IMAP,IP,IROW,2)
! C$OMP Parallel Do Schedule(Static,1) Default(Shared)
! C$OMP+ Private(LPar,i,is,ie,NI,js,je,NJ,NR,jj,j,AA,Sum,kk,CC,Sum1,Sum2)
        Do 80 LPar = 1, NP
          Do 70 I = NRow(LPar),NRow(LPar+1)-1
            is = IP(I,1)
--- 102905,102912 ----
        Call AClear(N*NP,B)
        Call AClear(N*NP,C)
        Call CostFx(NP,N,X,NRow,IMAP,IP,IROW,2)
! CTNK Parallel Do Schedule(Static,1) Default(Shared)
! CTNK+ Private(LPar,i,is,ie,NI,js,je,NJ,NR,jj,j,AA,Sum,kk,CC,Sum1,Sum2)
        Do 80 LPar = 1, NP
          Do 70 I = NRow(LPar),NRow(LPar+1)-1
            is = IP(I,1)
***************
*** 103450,103458 ****
        Call AClear(NP,DFF1)
        Call AClear(NP,DFF2)
        call CostFx(NP,N,X,NRow,IMAP,IP,IROW,1)
! C$OMP Parallel Do Schedule(Static,1) Default(Shared)
! C$OMP+ Private(Lpar,i,is,ie,NI,js,je,NJ,jj,j,AA,BB,Sum1,Sum2,kk,Diag)
! C$OMP+ Private(CC,DD,Sum,NR)
        Do 110 LPar = 1, NP
          Do 100 I=NRow(LPar),NRow(LPar+1)-1
            is = IP(i,1)
--- 103450,103458 ----
        Call AClear(NP,DFF1)
        Call AClear(NP,DFF2)
        call CostFx(NP,N,X,NRow,IMAP,IP,IROW,1)
! CTNK Parallel Do Schedule(Static,1) Default(Shared)
! CTNK+ Private(Lpar,i,is,ie,NI,js,je,NJ,jj,j,AA,BB,Sum1,Sum2,kk,Diag)
! CTNK+ Private(CC,DD,Sum,NR)
        Do 110 LPar = 1, NP
          Do 100 I=NRow(LPar),NRow(LPar+1)-1
            is = IP(i,1)
***************
*** 103677,103684 ****
        Call AClear(N*NP,X)
        Call AClear(N*NP,Y)
        call CostFx(NP,N,X,NRow,IMAP,IP,IROW,3)
! C$OMP Parallel Do Schedule(Static,1) Default(Shared)
! C$OMP+ Private(LPar,i,is,ie,NI,js,je,NJ,NR,jj,j,AA,Sum,kk,Diag,BB)
        Do 80 LPar=1,NP
          Do 70 I=NRow(LPar),NRow(LPar+1)-1
            is = IP(I,1)
--- 103677,103684 ----
        Call AClear(N*NP,X)
        Call AClear(N*NP,Y)
        call CostFx(NP,N,X,NRow,IMAP,IP,IROW,3)
! CTNK Parallel Do Schedule(Static,1) Default(Shared)
! CTNK+ Private(LPar,i,is,ie,NI,js,je,NJ,NR,jj,j,AA,Sum,kk,Diag,BB)
        Do 80 LPar=1,NP
          Do 70 I=NRow(LPar),NRow(LPar+1)-1
            is = IP(I,1)
***************
*** 106327,106333 ****
        If(NP.lt.1) Call GauErr('Logic error in DenCnt.')
        Call AClear(3*(NP-1)*NPt,SCur)
        Call DoChiM(IOpt,NPt,NBasis,Chi,D1Chi,XX,ChiMax)
! C$OMP Parallel Do Schedule(Static,1) Default(Shared) Private(IP1,IP)
        Do 100 IP1 = 0, (NP-1)
          IP = IP1
          If(IP.eq.0) then
--- 106327,106333 ----
        If(NP.lt.1) Call GauErr('Logic error in DenCnt.')
        Call AClear(3*(NP-1)*NPt,SCur)
        Call DoChiM(IOpt,NPt,NBasis,Chi,D1Chi,XX,ChiMax)
! CTNK Parallel Do Schedule(Static,1) Default(Shared) Private(IP1,IP)
        Do 100 IP1 = 0, (NP-1)
          IP = IP1
          If(IP.eq.0) then
***************
*** 111271,111278 ****
          If(DoFFac) then
            Do 5 I = 1, NTotR
              FFact(I) = TwoPi
! C$OMP Parallel Do Schedule(Dynamic) Default(Shared)
! C$OMP+ Private(J,DistX,DistY,DistZ,D3)
              Do 5 J = 1, (I-1)
                Distx = XYZ(I,1) - XYZ(J,1)
                Disty = XYZ(I,2) - XYZ(J,2)
--- 111271,111278 ----
          If(DoFFac) then
            Do 5 I = 1, NTotR
              FFact(I) = TwoPi
! CTNK Parallel Do Schedule(Dynamic) Default(Shared)
! CTNK+ Private(J,DistX,DistY,DistZ,D3)
              Do 5 J = 1, (I-1)
                Distx = XYZ(I,1) - XYZ(J,1)
                Disty = XYZ(I,2) - XYZ(J,2)
***************
*** 111293,111300 ****
          Do 10 I = 1, NTotR
            Indx = (I-1)*(I-2)/2
            If(DoFFac) FFact(I) = TwoPi
! C$OMP Parallel Do If(.not.DoFFac) Schedule(Dynamic) Default(Shared)
! C$OMP+ Private(J,Indx1,DistX,DistY,DistZ,D1,D3)
            Do 10 J = 1, (I-1)
              Indx1=Indx+j
              Distx = XYZ(i,1) - XYZ(j,1)
--- 111293,111300 ----
          Do 10 I = 1, NTotR
            Indx = (I-1)*(I-2)/2
            If(DoFFac) FFact(I) = TwoPi
! CTNK Parallel Do If(.not.DoFFac) Schedule(Dynamic) Default(Shared)
! CTNK+ Private(J,Indx1,DistX,DistY,DistZ,D1,D3)
            Do 10 J = 1, (I-1)
              Indx1=Indx+j
              Distx = XYZ(i,1) - XYZ(j,1)
***************
*** 111320,111327 ****
            Do 20 I = 1, NTotR
              A(I+(I-1)*NTotR) = Zero
              If(DoFFac) FFact(I) = TwoPi
! C$OMP Parallel Do If(.not.DoFFac) Schedule(Dynamic) Default(Shared)
! C$OMP+ Private(J,DistX,DistY,DistZ,D3)
              Do 20 J = 1, (I-1)
                Distx = XYZ(I,1) - XYZ(J,1)
                Disty = XYZ(I,2) - XYZ(J,2)
--- 111320,111327 ----
            Do 20 I = 1, NTotR
              A(I+(I-1)*NTotR) = Zero
              If(DoFFac) FFact(I) = TwoPi
! CTNK Parallel Do If(.not.DoFFac) Schedule(Dynamic) Default(Shared)
! CTNK+ Private(J,DistX,DistY,DistZ,D3)
              Do 20 J = 1, (I-1)
                Distx = XYZ(I,1) - XYZ(J,1)
                Disty = XYZ(I,2) - XYZ(J,2)
***************
*** 111346,111353 ****
  C
  C         This is C. C is also square (NTotR,NTotR)
  C
! C$OMP Parallel Do Schedule(Dynamic) Default(Shared)
! C$OMP+ Private(II,JJ,DistX,DistY,DistZ,D1)
            Do 40 II = 1, NTotR
              A(II+(II-1)*NTotR) = Zero
              Do 30 JJ = 1, (II-1)
--- 111346,111353 ----
  C
  C         This is C. C is also square (NTotR,NTotR)
  C
! CTNK Parallel Do Schedule(Dynamic) Default(Shared)
! CTNK+ Private(II,JJ,DistX,DistY,DistZ,D1)
            Do 40 II = 1, NTotR
              A(II+(II-1)*NTotR) = Zero
              Do 30 JJ = 1, (II-1)
***************
*** 131788,131796 ****
        NPart = Min(NProc(0),NALoop,MaxNP)
        NAChnk = (NALoop+NPart-1)/NPart
        MDVP = MDV1 / NPart
! C$OMP Parallel Do Schedule(Static,1) Default(Shared)
! C$OMP+ Private(IPart,IAtSt,IAtEnd,NRdTot,NGWTot,IV2,MDV2,jGW)
! C$OMP+ Private(jIR,jRR,MaxRBt,MaxSA1,MaxSA2)
        Do 100 IPart = 1, NPart
          IAtSt = 1 + (IPart-1)*NAChnk
          IAtEnd = Min(IAtSt+NAChnk-1,NALoop)
--- 131788,131796 ----
        NPart = Min(NProc(0),NALoop,MaxNP)
        NAChnk = (NALoop+NPart-1)/NPart
        MDVP = MDV1 / NPart
! CTNK Parallel Do Schedule(Static,1) Default(Shared)
! CTNK+ Private(IPart,IAtSt,IAtEnd,NRdTot,NGWTot,IV2,MDV2,jGW)
! CTNK+ Private(jIR,jRR,MaxRBt,MaxSA1,MaxSA2)
        Do 100 IPart = 1, NPart
          IAtSt = 1 + (IPart-1)*NAChnk
          IAtEnd = Min(IAtSt+NAChnk-1,NALoop)
***************
*** 135757,135775 ****
            endIf
    200   Continue
  C     This will go across several processors
! C$OMP Parallel Do If(ThrOK) Schedule(Static,1) Default(Shared)
! C$OMP+ Private(DontSq,dx,dxa,dy,dya,dz,dza)
! C$OMP+ Private(FactL,fcda,fcdb,fpda,fpdb,fshx,fshy)
! C$OMP+ Private(fshz,FWSC,FWSP,FWSP1,fxcb,fxpa,fxpb)
! C$OMP+ Private(fycb,fypa,fypb,fzcb,fzpa,fzpb,Iadr1)
! C$OMP+ Private(iapnt1,iapnt2,icda,ICel,ich1,ich2,idim1)
! C$OMP+ Private(idim2,ij,IntTr,IntTrC,IP,IPar1,ipar2)
! C$OMP+ Private(ipda,iran1,iran2,irn1,irn2,ishxc,ishxp)
! C$OMP+ Private(ishyc,ishyp,ishzc,ishzp,it0,it1,it1a)
! C$OMP+ Private(it2,it2a,IWS1,IWS2,iWSp,ixcd,ixcda)
! C$OMP+ Private(iycd,iycda,izcd,izcda,jWSc,jWSp,LocB)
! C$OMP+ Private(LocE,lp2st,lp2st2,MaxL,MulB,MulE,Precomp)
! C$OMP+ Private(r2,Single)
        Do 100 IP = 1, NPMax
          ishxp = 0
          ishyp = 0
--- 135757,135775 ----
            endIf
    200   Continue
  C     This will go across several processors
! CTNK Parallel Do If(ThrOK) Schedule(Static,1) Default(Shared)
! CTNK+ Private(DontSq,dx,dxa,dy,dya,dz,dza)
! CTNK+ Private(FactL,fcda,fcdb,fpda,fpdb,fshx,fshy)
! CTNK+ Private(fshz,FWSC,FWSP,FWSP1,fxcb,fxpa,fxpb)
! CTNK+ Private(fycb,fypa,fypb,fzcb,fzpa,fzpb,Iadr1)
! CTNK+ Private(iapnt1,iapnt2,icda,ICel,ich1,ich2,idim1)
! CTNK+ Private(idim2,ij,IntTr,IntTrC,IP,IPar1,ipar2)
! CTNK+ Private(ipda,iran1,iran2,irn1,irn2,ishxc,ishxp)
! CTNK+ Private(ishyc,ishyp,ishzc,ishzp,it0,it1,it1a)
! CTNK+ Private(it2,it2a,IWS1,IWS2,iWSp,ixcd,ixcda)
! CTNK+ Private(iycd,iycda,izcd,izcda,jWSc,jWSp,LocB)
! CTNK+ Private(LocE,lp2st,lp2st2,MaxL,MulB,MulE,Precomp)
! CTNK+ Private(r2,Single)
        Do 100 IP = 1, NPMax
          ishxp = 0
          ishyp = 0
***************
*** 136079,136088 ****
        BalNP(2,1) = NmpC
        If(NPMax.eq.1) Return
        Call MpBal(NPMax,NmpC,BalNP)
! C$OMP Parallel Do Schedule(Static,1) Default(Shared)
! C$OMP+ Private(icda,ich1,ich2,IP,Ipar1,ipar2,ipda,iran1,iran2,iWSp)
! C$OMP+ Private(iWSPm1,iWSPm2,ixc1,ixp1,iyc1,iyp1,izc1,izp1,jWSc,jWSp)
! C$OMP+ Private(WS1,WS2)
         Do 90 IP = 1, NPMax
           Do 80 Ipar1 = 1, NmpP
             If((Par2Ch(ipar1).gt.BalNP(2,IP)).or.
--- 136079,136088 ----
        BalNP(2,1) = NmpC
        If(NPMax.eq.1) Return
        Call MpBal(NPMax,NmpC,BalNP)
! CTNK Parallel Do Schedule(Static,1) Default(Shared)
! CTNK+ Private(icda,ich1,ich2,IP,Ipar1,ipar2,ipda,iran1,iran2,iWSp)
! CTNK+ Private(iWSPm1,iWSPm2,ixc1,ixp1,iyc1,iyp1,izc1,izp1,jWSc,jWSp)
! CTNK+ Private(WS1,WS2)
         Do 90 IP = 1, NPMax
           Do 80 Ipar1 = 1, NmpP
             If((Par2Ch(ipar1).gt.BalNP(2,IP)).or.
***************
*** 144781,144788 ****
  C     Compute the S factors for SCIPCM.
  C
        Negs = 0
! C$OMP Parallel Do Schedule(Dynamic) Default(Shared)
! C$OMP+ Private(II,JJ,distx,disty,distz,d1)
        Do 20 II = 1, NTotR
          SFact(II) = Zero
          Do 10 JJ = 1, (II-1)
--- 144781,144788 ----
  C     Compute the S factors for SCIPCM.
  C
        Negs = 0
! CTNK Parallel Do Schedule(Dynamic) Default(Shared)
! CTNK+ Private(II,JJ,distx,disty,distz,d1)
        Do 20 II = 1, NTotR
          SFact(II) = Zero
          Do 10 JJ = 1, (II-1)
***************
*** 145456,145463 ****
  c set up load balancing
        Call CostMt(IA,IMAP,IA,IMAP,IA,IROW,IROW,X,NRow,N,NP,.true.,
       $      .true.,.true.,IMD,3,.false.)
! C$OMP Parallel Do Schedule(Static,1) Default(Shared)
! C$OMP+ Private(i,is,ie,NI,NR,AA,BB,kk,j,jj,Sum,LPar)
        Do 100 LPar = 1, NP
          Do 90 I = NRow(lpar),NRow(lpar+1)-1
            is = IA(I,1)
--- 145456,145463 ----
  c set up load balancing
        Call CostMt(IA,IMAP,IA,IMAP,IA,IROW,IROW,X,NRow,N,NP,.true.,
       $      .true.,.true.,IMD,3,.false.)
! CTNK Parallel Do Schedule(Static,1) Default(Shared)
! CTNK+ Private(i,is,ie,NI,NR,AA,BB,kk,j,jj,Sum,LPar)
        Do 100 LPar = 1, NP
          Do 90 I = NRow(lpar),NRow(lpar+1)-1
            is = IA(I,1)
***************
*** 153296,153303 ****
          KBMax = NOrb(LBMax)
          IndDF = 1
          If(DoSpar) IndDF = (T2SpSt(IJType)-1)*NMat + 1
! C$OMP Parallel Do If(ThrOK) Schedule(Static,1) Default(Shared)
! C$OMP+ Private(IBox1,IBox2,IJTN,IndCC,Ind,IndP,IP,NDo)
          Do 200 IP = 1, NPMax
            IBox1 = BalNP(1,ijType,IP)
            IBox2 = BalNP(2,ijType,IP)
--- 153296,153303 ----
          KBMax = NOrb(LBMax)
          IndDF = 1
          If(DoSpar) IndDF = (T2SpSt(IJType)-1)*NMat + 1
! CTNK Parallel Do If(ThrOK) Schedule(Static,1) Default(Shared)
! CTNK+ Private(IBox1,IBox2,IJTN,IndCC,Ind,IndP,IP,NDo)
          Do 200 IP = 1, NPMax
            IBox1 = BalNP(1,ijType,IP)
            IBox2 = BalNP(2,ijType,IP)
