      module hfodd_tgrad
C=======================================================================
      USE hfodd_sizes
C=======================================================================
      PARAMETER (mv=NDXHRM*NDYHRM*NDZHRM)
      PARAMETER (mq=4*mv,mnp=1,mw=1)
      private
      public :: ETGRAD,TRADEN,TRAFLD,TRACPL
      contains

C=======================================================================
C
      FUNCTION SSUM_MB(NDIMEN,WORKAR)
C
      COMMON
     *       /DENWEI/ U_HERM(mv)
      COMMON
     *       /NUHERM/ N_HERM
C
      DIMENSION WORKAR(mv)
C
      RESULT=0.0D0
C
      DO I=1,N_HERM
C
         RESULT=RESULT+U_HERM(I)*WORKAR(I)
C
c     if (i.le.18) print *,i,RESULT,U_HERM(I),WORKAR(I)
      END DO
C
c     print *,'mv=',mv,'  N_HERM',N_HERM,'  SSUM_MB=',SSUM_MB
      SSUM_MB=RESULT
C
      RETURN
C
      END
C
C=======================================================================
C
      FUNCTION SDOT_MB(NDIMEN,WORKAR,WORKAS)
C
      COMMON
     *       /DENWEI/ U_HERM(mv)
      COMMON
     *       /NUHERM/ N_HERM
C
      DIMENSION WORKAR(mv),WORKAS(mv)
C
      RESULT=0.0D0
C
      DO I=1,N_HERM
C
         RESULT=RESULT+U_HERM(I)*WORKAR(I)*WORKAS(I)
C
c     if (i.le.18) print *,i,RESULT,U_HERM(I),WORKAR(I),WORKAS(I)
      END DO
C
      SDOT_MB=RESULT
C
c     print *,'mv=',mv,'  N_HERM',N_HERM,'  SDOT_MB=',SDOT_MB
      RETURN
C
      END
C
C=======================================================================
C
      SUBROUTINE SCOPY_MB(NDIMEN,WORKAR,WORKBR)
C
      DIMENSION WORKAR(NDIMEN),WORKBR(NDIMEN)
C
      DO I=1,NDIMEN
C
         WORKBR(I)=WORKAR(I)
C
      END DO
C
      RETURN
C
      END
C
C=======================================================================
C
      SUBROUTINE LAPLA(A1,A2,A3,A4,A5)
C
      DIMENSION A1(1),A2(1)
C
      RETURN
C
      END
C
C=======================================================================
C
      SUBROUTINE STP(A)
C
      CHARACTER (LEN=*) :: A
C
      PRINT*, A
C
      STOP
C
      RETURN
C
      END
C
C=======================================================================
C
      SUBROUTINE ETGRAD(ETGRAF,ETGRAP)
C
C=======================================================================
C
      common /e_f  / e_kin(3),e_cm(2,3),e_ln(3),e_could,e_coulx,e_coulp,
     1               e_r_r         (4),e_t_r         (4),e_sj_sj    (4),
     2               e_Tj_sj       (4),e_nir_nir     (4),e_nisj_nisj(4),
     3               e_ji_ji       (4),e_Jij_Jij     (4),e_r_naJbc  (4),
     4               e_ja_nbsc     (4),e_nisi_njsj   (4),e_Jii_Jjj  (4),
     5               e_Jij_Jji     (4),e_Fj_sj       (4),
     6               e_rp_rp       (4),e_tp_rp       (4),
     7               e_nirp_nirp   (4),e_Jpij_Jpij   (4),
     8               e_Jpii_Jpjj   (4),e_Jpij_Jpji   (4),
     8               e_2body_rr    (4),!2body normal terms (rho rho)
     8               e_2body_kk    (4),!2body pair.  terms (kap kap)
     8               e_2body       (4),!Total 2body
     8               e_r_r_r       (4),e_t_r_r       (4),e_sj_sj_r  (4),
     7               e_t_sj_sj     (4),e_Tj_sj_r     (4),e_nir_nir_r(4),
     6               e_nisj_nisj_r (4),e_nir_nisj_sj (4),
     5               e_ji_ji_r     (4),e_Jij_Jij_r   (4),
     4               e_ji_Jij_sj   (4),e_nisa_Jib_sc (4),
     3               e_rp_rp_r     (4),e_t_rp_rp     (4),e_tp_rp_r  (4),
     2               e_nirp_nirp_r (4),e_nirp_rp_nir (4),
     1               e_Jpij_Jpij_r (4),e_Jpij_rp_Jij (4),
     2               e_nirp_rp_ji  (4),e_nirp_Jpij_sj(4),
     3               e_Jpij_rp_nisj(4),e_Jpia_Jpib_sc(4),
     8               e_3body_rrr   (4),!3body normal terms (rho rho rho)
     8               e_3body_kkr   (4),!3body pair.  terms (kap kap rho)
     8               e_3body       (4),!Total 3body
     5               e_r_r_r_r     (4),e_sj_sj_r_r   (4),
     6               e_si_si_sj_sj (4),e_rp_rp_r_r   (4),
     7               e_rp_rp_sj_sj (4),e_rp_rp_rp_rp (4),
     8               e_4body_rrrr  (4),!4body normal terms (rho rho rho rho)
     8               e_4body_kkrr  (4),!4body pair.  terms (kap kap rho rho)
     8               e_4body_kkkk  (4),!4body pair.  terms (kap kap kap kap)
     8               e_4body       (4),!Total 4body
     9               e_norm        (4),e_pair        (4),e_sky      (4),
     8               e_tot
C
      common /nxyz / dx,dv
      common /pair / npair,neq,lln,lhf,lsenior,ldelta,lgauss
C
      logical     lln,lhf,lsenior,ldelta,lgauss
C
C=======================================================================
C
      CALL CPUTIM('ETGRAD',1)
C
C=======================================================================
C
      npair=0
      lln=.false.
      dv=1.0d0
C
      CALL edfcalc_f
C
c     print *,e_r_r_r
c     .................................................... 3-body normal energy
      ETGRAF=             e_r_r_r       (4) + e_t_r_r       (4)
     1                  + e_sj_sj_r     (4) + e_t_sj_sj     (4)
     2                  + e_Tj_sj_r     (4) + e_nir_nir_r   (4)
     3                  + e_nisj_nisj_r (4) + e_nir_nisj_sj (4)
     4                  + e_ji_ji_r     (4) + e_Jij_Jij_r   (4)
     5                  + e_ji_Jij_sj   (4) + e_nisa_Jib_sc (4)
c     ................................................... 3-body pairing energy
      ETGRAP=             e_rp_rp_r     (4) + e_t_rp_rp     (4)
     1                  + e_tp_rp_r     (4) + e_nirp_nirp_r (4)
     2                  + e_nirp_rp_nir (4) + e_Jpij_Jpij_r (4)
     3                  + e_Jpij_rp_Jij (4) + e_nirp_rp_ji  (4)
     4                  + e_nirp_Jpij_sj(4) + e_Jpij_rp_nisj(4)
     5                  + e_Jpia_Jpib_sc(4)
C
C=======================================================================
C
      CALL CPUTIM('ETGRAD',0)
C
C=======================================================================
C
      RETURN
      END
C
C=======================================================================
C
      SUBROUTINE TRADEN(NXHERM,NYHERM,NZHERM)
C=======================================================================
      USE HE_DEN
      USE PD_DEN
      USE HETDEN
      USE PDTDEN
C=======================================================================
      USE hfodd_sizes
C=======================================================================
      common /den  / frho(mv,2),fsx (mv,2),fsy (mv,2),fsz(mv,2)
      common /cur  / fjx (mv,2),fjy (mv,2),fjz (mv,2)
      common /taudj/ ftau(mv,2),fdJ (mv,2)
      common /wj2  / fJxx(mv,2),fJyx(mv,2),fJzx(mv,2)
     1              ,fJxy(mv,2),fJyy(mv,2),fJzy(mv,2)
     2              ,fJxz(mv,2),fJyz(mv,2),fJzz(mv,2)
      common /wtf  / fTx (mv,2),fTy (mv,2),fTz (mv,2)
     1              ,fFx (mv,2),fFy (mv,2),fFz (mv,2)
      common /locden/ flrho(mv,2),
     1                frosx(mv,2),frosy(mv,2),frosz(mv,2),
     2                flsx (mv,2),flsy (mv,2),flsz (mv,2),
     3                fns  (mv,2),
     4                fnrx (mv,2),fnry (mv,2),fnrz (mv,2),
     5                fnsxx(mv,2),fnsxy(mv,2),fnsxz(mv,2),
     6                fnsyx(mv,2),fnsyy(mv,2),fnsyz(mv,2),
     7                fnszx(mv,2),fnszy(mv,2),fnszz(mv,2),
     8                fnJx (mv,2),fnJy (mv,2),fnJz (mv,2),
     9                fnj  (mv,2),
     8                fnjxx(mv,2),fnjxy(mv,2),fnjxz(mv,2),
     7                fnjyx(mv,2),fnjyy(mv,2),fnjyz(mv,2),
     6                fnjzx(mv,2),fnjzy(mv,2),fnjzz(mv,2),
     5                fndsx(mv,2),fndsy(mv,2),fndsz(mv,2)
      common /denpr / frhotr (mv ,2),frhoti (mv ,2),
     1                ftautr (mv,2),ftauti (mv,2),
     2                flrhotr(mv,2),flrhoti(mv,2),
     3                fJtxxr (mv,2),fJtxyr (mv,2),fJtxzr (mv,2),
     4                fJtxxi (mv,2),fJtxyi (mv,2),fJtxzi (mv,2),
     5                fJtyxr (mv,2),fJtyyr (mv,2),fJtyzr (mv,2),
     6                fJtyxi (mv,2),fJtyyi (mv,2),fJtyzi (mv,2),
     7                fJtzxr (mv,2),fJtzyr (mv,2),fJtzzr (mv,2),
     8                fJtzxi (mv,2),fJtzyi (mv,2),fJtzzi (mv,2)
      common /denpr2/ fnrtxr(mv,2),fnrtyr(mv,2),fnrtzr(mv,2),
     1                fnrtxi(mv,2),fnrtyi(mv,2),fnrtzi(mv,2),
     2                fnJtxr(mv,2),fnJtyr(mv,2),fnJtzr(mv,2),
     3                fnJtxi(mv,2),fnJtyi(mv,2),fnJtzi(mv,2)
      COMMON
     *       /DENEXP/ EXPAUX(NDXHRM,NDYHRM,NDZHRM)
      COMMON
     *       /INTSTO/ FOURWG(1:NDGAUS,1:NDKART),
     *                FOURPT(1:NDGAUS,1:NDKART)
      COMMON
     *       /DENWEI/ U_HERM(mv)
      COMMON
     *       /NUHERM/ N_HERM
C
C=======================================================================
C
      CALL CPUTIM('TRADEN',1)
C
C=======================================================================
C        THIS SUBROUTINE TRANSFORMS THE HFODD DENSITIES INTO THE EV4
C        DENSITIES. NOTE THAT THIS REQUIRES  MULTIPLICATION  BY  THE
C        GAUSSIAN FACTOR. AT THE SAME TIME THE GAUSS-HERMITE WEIGHTS
C        ARE DIVIDED BY THE  GAUSSIAN  FACTOR  SQUARED,  BECAUSE  IN
C        HFODD, THE STANDARD INTEGRATION OF  DENSITIES  PERTAINS  TO
C        THE TWO-BODY TERMS.
C=======================================================================
C
      U_HERM=0.0D0
      N_HERM=0
C
      DO IX=1,NXHERM
         DO IY=1,NYHERM
            DO IZ=1,NZHERM
C
               N_HERM=N_HERM+1
C
               U_HERM(N_HERM)=FOURWG(IX,1)*FOURWG(IY,2)*FOURWG(IZ,3)/
     *                        EXPAUX(IX,IY,IZ)**2
C
               DO ICHARG=0,NDISOS
C
                  it=ICHARG+1
C
                  frho   (N_HERM,it)=DE_RHO(IX,IY,IZ,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  fsx    (N_HERM,it)=DE_SPI(IX,IY,IZ,1,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fsy    (N_HERM,it)=DE_SPI(IX,IY,IZ,2,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fsz    (N_HERM,it)=DE_SPI(IX,IY,IZ,3,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  fjx    (N_HERM,it)=DE_CUR(IX,IY,IZ,1,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fjy    (N_HERM,it)=DE_CUR(IX,IY,IZ,2,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fjz    (N_HERM,it)=DE_CUR(IX,IY,IZ,3,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  ftau   (N_HERM,it)=DE_TAU(IX,IY,IZ,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  fdJ    (N_HERM,it)=DE_DIV(IX,IY,IZ,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  fJxx   (N_HERM,it)=DE_SCU(IX,IY,IZ,1,1,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fJyx   (N_HERM,it)=DE_SCU(IX,IY,IZ,2,1,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fJzx   (N_HERM,it)=DE_SCU(IX,IY,IZ,3,1,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fJxy   (N_HERM,it)=DE_SCU(IX,IY,IZ,1,2,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fJyy   (N_HERM,it)=DE_SCU(IX,IY,IZ,2,2,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fJzy   (N_HERM,it)=DE_SCU(IX,IY,IZ,3,2,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fJxz   (N_HERM,it)=DE_SCU(IX,IY,IZ,1,3,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fJyz   (N_HERM,it)=DE_SCU(IX,IY,IZ,2,3,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fJzz   (N_HERM,it)=DE_SCU(IX,IY,IZ,3,3,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  fTx    (N_HERM,it)=DE_KIS(IX,IY,IZ,1,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fTy    (N_HERM,it)=DE_KIS(IX,IY,IZ,2,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fTz    (N_HERM,it)=DE_KIS(IX,IY,IZ,3,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  fFx    (N_HERM,it)=DE_KIF(IX,IY,IZ,1,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fFy    (N_HERM,it)=DE_KIF(IX,IY,IZ,2,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fFz    (N_HERM,it)=DE_KIF(IX,IY,IZ,3,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
C
                  flrho  (N_HERM,it)=DE_LPR(IX,IY,IZ,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  frosx  (N_HERM,it)=DE_ROS(IX,IY,IZ,1,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  frosy  (N_HERM,it)=DE_ROS(IX,IY,IZ,2,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  frosz  (N_HERM,it)=DE_ROS(IX,IY,IZ,3,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  flsx   (N_HERM,it)=DE_LPS(IX,IY,IZ,1,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  flsy   (N_HERM,it)=DE_LPS(IX,IY,IZ,2,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  flsz   (N_HERM,it)=DE_LPS(IX,IY,IZ,3,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  fns    (N_HERM,it)=DE_DES(IX,IY,IZ,1,1,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
     *                              +DE_DES(IX,IY,IZ,2,2,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
     *                              +DE_DES(IX,IY,IZ,3,3,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  fnrx   (N_HERM,it)=DE_GRR(IX,IY,IZ,1,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fnry   (N_HERM,it)=DE_GRR(IX,IY,IZ,2,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fnrz   (N_HERM,it)=DE_GRR(IX,IY,IZ,3,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  fnsxx  (N_HERM,it)=DE_DES(IX,IY,IZ,1,1,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fnsxy  (N_HERM,it)=DE_DES(IX,IY,IZ,1,2,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fnsxz  (N_HERM,it)=DE_DES(IX,IY,IZ,1,3,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  fnsyx  (N_HERM,it)=DE_DES(IX,IY,IZ,2,1,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fnsyy  (N_HERM,it)=DE_DES(IX,IY,IZ,2,2,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fnsyz  (N_HERM,it)=DE_DES(IX,IY,IZ,2,3,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  fnszx  (N_HERM,it)=DE_DES(IX,IY,IZ,3,1,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fnszy  (N_HERM,it)=DE_DES(IX,IY,IZ,3,2,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fnszz  (N_HERM,it)=DE_DES(IX,IY,IZ,3,3,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  fnJx   (N_HERM,it)=DE_DIS(IX,IY,IZ,1,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fnJy   (N_HERM,it)=DE_DIS(IX,IY,IZ,2,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)
                  fnJz   (N_HERM,it)=DE_DIS(IX,IY,IZ,3,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  fnj    (N_HERM,it)=DE_DIJ(IX,IY,IZ,ICHARG)*
     *                               EXPAUX(IX,IY,IZ)

                  fnjxx  (N_HERM,it)=0.
                  fnjxy  (N_HERM,it)=0.
                  fnjxz  (N_HERM,it)=0.

                  fnjyx  (N_HERM,it)=0.
                  fnjyy  (N_HERM,it)=0.
                  fnjyz  (N_HERM,it)=0.

                  fnjzx  (N_HERM,it)=0.
                  fnjzy  (N_HERM,it)=0.
                  fnjzz  (N_HERM,it)=0.

                  fndsx  (N_HERM,it)=0.
                  fndsy  (N_HERM,it)=0.
                  fndsz  (N_HERM,it)=0.
C
                  frhotr (N_HERM,it)= REAL(PD_RHO(IX,IY,IZ,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  frhoti (N_HERM,it)=AIMAG(PD_RHO(IX,IY,IZ,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)

                  ftautr (N_HERM,it)= REAL(PD_TAU(IX,IY,IZ,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  ftauti (N_HERM,it)=AIMAG(PD_TAU(IX,IY,IZ,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)

                  flrhotr(N_HERM,it)= REAL(PD_LPR(IX,IY,IZ,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  flrhoti(N_HERM,it)=AIMAG(PD_LPR(IX,IY,IZ,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)

                  fJtxxr (N_HERM,it)= REAL(PD_SCU(IX,IY,IZ,1,1,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fJtxyr (N_HERM,it)= REAL(PD_SCU(IX,IY,IZ,1,2,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fJtxzr (N_HERM,it)= REAL(PD_SCU(IX,IY,IZ,1,3,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)

                  fJtxxi (N_HERM,it)=AIMAG(PD_SCU(IX,IY,IZ,1,1,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fJtxyi (N_HERM,it)=AIMAG(PD_SCU(IX,IY,IZ,1,2,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fJtxzi (N_HERM,it)=AIMAG(PD_SCU(IX,IY,IZ,1,3,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)

                  fJtyxr (N_HERM,it)= REAL(PD_SCU(IX,IY,IZ,2,1,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fJtyyr (N_HERM,it)= REAL(PD_SCU(IX,IY,IZ,2,2,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fJtyzr (N_HERM,it)= REAL(PD_SCU(IX,IY,IZ,2,3,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)

                  fJtyxi (N_HERM,it)=AIMAG(PD_SCU(IX,IY,IZ,2,1,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fJtyyi (N_HERM,it)=AIMAG(PD_SCU(IX,IY,IZ,2,2,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fJtyzi (N_HERM,it)=AIMAG(PD_SCU(IX,IY,IZ,2,3,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)

                  fJtzxr (N_HERM,it)= REAL(PD_SCU(IX,IY,IZ,3,1,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fJtzyr (N_HERM,it)= REAL(PD_SCU(IX,IY,IZ,3,2,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fJtzzr (N_HERM,it)= REAL(PD_SCU(IX,IY,IZ,3,3,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)

                  fJtzxi (N_HERM,it)=AIMAG(PD_SCU(IX,IY,IZ,3,1,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fJtzyi (N_HERM,it)=AIMAG(PD_SCU(IX,IY,IZ,3,2,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fJtzzi (N_HERM,it)=AIMAG(PD_SCU(IX,IY,IZ,3,3,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)

                  fnrtxr (N_HERM,it)= REAL(PD_GRR(IX,IY,IZ,1,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fnrtyr (N_HERM,it)= REAL(PD_GRR(IX,IY,IZ,2,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fnrtzr (N_HERM,it)= REAL(PD_GRR(IX,IY,IZ,3,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)

                  fnrtxi (N_HERM,it)=AIMAG(PD_GRR(IX,IY,IZ,1,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fnrtyi (N_HERM,it)=AIMAG(PD_GRR(IX,IY,IZ,2,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fnrtzi (N_HERM,it)=AIMAG(PD_GRR(IX,IY,IZ,3,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)

                  fnJtxr (N_HERM,it)= REAL(PD_DIS(IX,IY,IZ,1,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fnJtyr (N_HERM,it)= REAL(PD_DIS(IX,IY,IZ,2,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fnJtzr (N_HERM,it)= REAL(PD_DIS(IX,IY,IZ,3,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)

                  fnJtxi (N_HERM,it)=AIMAG(PD_DIS(IX,IY,IZ,1,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fnJtyi (N_HERM,it)=AIMAG(PD_DIS(IX,IY,IZ,2,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
                  fnJtzi (N_HERM,it)=AIMAG(PD_DIS(IX,IY,IZ,3,ICHARG))*
     *                                     EXPAUX(IX,IY,IZ)
C
               END DO
C
            END DO
         END DO
      END DO
C
c     print *,'U_HERM 1',(U_HERM(iiiii),iiiii=1,18)
C=======================================================================
C
      CALL CPUTIM('TRADEN',0)
C
C=======================================================================
C
      RETURN
      END
C
C=======================================================================
C
      SUBROUTINE TRACPL
C=======================================================================
      USE hfodd_sizes
C=======================================================================
      common /force / t0_2b,x0_2b,t1_2b,x1_2b,t2_2b,x2_2b
     1               ,te_2b,to_2b,wso_2b
     2               ,u0_3b,u1_3b,y1_3b,u2_3b,y21_3b,y22_3b,v0_4b
     3               ,wsoq,t3a,x3a,yt3a,t3b,x3b,yt3b
     4               ,hbar,hbm(2),xm(3),afor
      COMMON
     *       /ATHRGR/ TGRA10,TGRA11,TGRA20,TGRA21,TGRA22,IGRAIN
      COMMON
     *       /ATHREE/ THREEB,THRINP,ITHRIN
C
      character*4 afor
C
C=======================================================================
C
      CALL CPUTIM('TRACPL',1)
C
C=======================================================================
C
      afor='xxxx'
C
C     u0_3b = THREEB
C
      u1_3b = TGRA10
      y1_3b = TGRA11
      u2_3b = TGRA20
      y21_3b= TGRA21
      y22_3b= TGRA22
C
      t0_2b =0.0D0
      x0_2b =0.0D0
      t1_2b =0.0D0
      x1_2b =0.0D0
      t2_2b =0.0D0
      x2_2b =0.0D0
      te_2b =0.0D0
      to_2b =0.0D0
      wso_2b=0.0D0
      u0_3b =0.0D0
      v0_4b =0.0D0
      wsoq  =0.0D0
      t3a   =0.0D0
      x3a   =0.0D0
      yt3a  =0.0D0
      t3b   =0.0D0
      x3b   =0.0D0
      yt3b  =0.0D0
C
      call cpling_f
C
C=======================================================================
C
      CALL CPUTIM('TRACPL',0)
C
C=======================================================================
C
      RETURN
      END
C
C=======================================================================
C
      SUBROUTINE TRAFLD(NXHERM,NYHERM,NZHERM)
C=======================================================================
      USE hfodd_sizes
C=======================================================================
      USE VE_FLD
      USE WD_FLD
C=======================================================================
C
      common /pot_f / potU   (mv,2),
     1                potB   (mv,2),
     2                potSx  (mv,2),potSy  (mv,2),potSz  (mv,2),
     3                potCx  (mv,2),potCy  (mv,2),potCz  (mv,2),
     4                potAx  (mv,2),potAy  (mv,2),potAz  (mv,2),
     5                potWxx (mv,2),potWxy (mv,2),potWxz (mv,2),
     6                potWyx (mv,2),potWyy (mv,2),potWyz (mv,2),
     7                potWzx (mv,2),potWzy (mv,2),potWzz (mv,2),
     8                potDx  (mv,2),potDy  (mv,2),potDz  (mv,2)
      common /ppot_f/ potUt  (mv,2,2),potBt  (mv,2,2),
     1                potWtxx(mv,2,2),potWtxy(mv,2,2),
     2                potWtxz(mv,2,2),
     3                potWtyx(mv,2,2),potWtyy(mv,2,2),
     4                potWtyz(mv,2,2),
     5                potWtzx(mv,2,2),potWtzy(mv,2,2),
     6                potWtzz(mv,2,2)
      common /fopt  / nfunc,ngal,njmunu,ncm2,nmass,ndd,nforce,ncoex
C
      COMMON
     *       /DENEXP/ EXPAUX(NDXHRM,NDYHRM,NDZHRM)
      COMMON
     *       /NUHERM/ N_HERM
      common /den  / frho(mv,2),fsx (mv,2),fsy (mv,2),fsz(mv,2)
C
C=======================================================================
C
      CALL CPUTIM('TRAFLD',1)
C
C=======================================================================
C        THIS SUBROUTINE TRANSFORMS THE EV4 FIELDS  INTO  THE  HFODD
C        FIELDS. NOTE THAT THIS REQUIRES DIVISION  BY  THE  GAUSSIAN
C        FACTOR, BECAUSE IN  HFODD, FIELDS RELATED TO TWO-BODY TERMS
C        CONTAIN ONLY THE POLYNOMIAL COMPONENTS.
C=======================================================================
C
      njmunu=2
      call vcal_f
      call compute_gaphf_f (1)
      call compute_gaphf_f (2)
C
      N_HERM=0
C
      DO IX=1,NXHERM
         DO IY=1,NYHERM
            DO IZ=1,NZHERM
C
               N_HERM=N_HERM+1
C
               DO ICHARG=0,NDISOS
C
                  it=ICHARG+1
C
c                 if (N_HERM.le.18) print *,N_HERM,it,
c    *            Real(VE_CEN(IX,IY,IZ,ICHARG)),
c    *            potU   (N_HERM,it)/EXPAUX(IX,IY,IZ),
c    *            Real(VE_CEN(IX,IY,IZ,ICHARG))/(
c    *            potu   (N_HERM,it)/EXPAUX(IX,IY,IZ)),
c    *            EXPAUX(IX,IY,IZ),
c    *            frho   (N_HERM,it)
c
                  VE_MAS(IX,IY,IZ,ICHARG)    =
     *            VE_MAS(IX,IY,IZ,ICHARG)    +potB   (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
                  VE_CEN(IX,IY,IZ,ICHARG)    =
     *            VE_CEN(IX,IY,IZ,ICHARG)    +potU   (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
                  VE_SPT(IX,IY,IZ,ICHARG)    =
     *            VE_SPT(IX,IY,IZ,ICHARG)    +0.0D0
C
                  VE_KIS(IX,IY,IZ,1,ICHARG)  =
     *            VE_KIS(IX,IY,IZ,1,ICHARG)  +potCx  (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
                  VE_KIS(IX,IY,IZ,2,ICHARG)  =
     *            VE_KIS(IX,IY,IZ,2,ICHARG)  +potCy  (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
                  VE_KIS(IX,IY,IZ,3,ICHARG)  =
     *            VE_KIS(IX,IY,IZ,3,ICHARG)  +potCz  (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
C
                  VE_SPI(IX,IY,IZ,1,ICHARG)  =
     *            VE_SPI(IX,IY,IZ,1,ICHARG)  +potSx  (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
                  VE_SPI(IX,IY,IZ,2,ICHARG)  =
     *            VE_SPI(IX,IY,IZ,2,ICHARG)  +potSy  (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
                  VE_SPI(IX,IY,IZ,3,ICHARG)  =
     *            VE_SPI(IX,IY,IZ,3,ICHARG)  +potSz  (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
C
                  VE_CUR(IX,IY,IZ,1,ICHARG)  =
     *            VE_CUR(IX,IY,IZ,1,ICHARG)  +potAx  (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
                  VE_CUR(IX,IY,IZ,2,ICHARG)  =
     *            VE_CUR(IX,IY,IZ,2,ICHARG)  +potAy  (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
                  VE_CUR(IX,IY,IZ,3,ICHARG)  =
     *            VE_CUR(IX,IY,IZ,3,ICHARG)  +potAz  (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
C
                  VE_KIT(IX,IY,IZ,1,ICHARG)  =
     *            VE_KIT(IX,IY,IZ,1,ICHARG)  +0.0D0
                  VE_KIT(IX,IY,IZ,2,ICHARG)  =
     *            VE_KIT(IX,IY,IZ,2,ICHARG)  +0.0D0
                  VE_KIT(IX,IY,IZ,3,ICHARG)  =
     *            VE_KIT(IX,IY,IZ,3,ICHARG)  +0.0D0
C
                  VE_SOR(IX,IY,IZ,1,1,ICHARG)=
     *            VE_SOR(IX,IY,IZ,1,1,ICHARG)+potWxx (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
                  VE_SOR(IX,IY,IZ,1,2,ICHARG)=
     *            VE_SOR(IX,IY,IZ,1,2,ICHARG)+potWxy (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
                  VE_SOR(IX,IY,IZ,1,3,ICHARG)=
     *            VE_SOR(IX,IY,IZ,1,3,ICHARG)+potWxz (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
C
                  VE_SOR(IX,IY,IZ,2,1,ICHARG)=
     *            VE_SOR(IX,IY,IZ,2,1,ICHARG)+potWyx (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
                  VE_SOR(IX,IY,IZ,2,2,ICHARG)=
     *            VE_SOR(IX,IY,IZ,2,2,ICHARG)+potWyy (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
                  VE_SOR(IX,IY,IZ,2,3,ICHARG)=
     *            VE_SOR(IX,IY,IZ,2,3,ICHARG)+potWyz (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
C
                  VE_SOR(IX,IY,IZ,3,1,ICHARG)=
     *            VE_SOR(IX,IY,IZ,3,1,ICHARG)+potWzx (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
                  VE_SOR(IX,IY,IZ,3,2,ICHARG)=
     *            VE_SOR(IX,IY,IZ,3,2,ICHARG)+potWzy (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
                  VE_SOR(IX,IY,IZ,3,3,ICHARG)=
     *            VE_SOR(IX,IY,IZ,3,3,ICHARG)+potWzz (N_HERM,it)/
     *            EXPAUX(IX,IY,IZ)
C
                  WD_TAU(IX,IY,IZ,ICHARG)    =
     *            WD_TAU(IX,IY,IZ,ICHARG)    +
     *                                 2*CMPLX(potBt  (N_HERM,1,it),
     *                                         potBt  (N_HERM,2,it))/
     *            EXPAUX(IX,IY,IZ)
C
                  WD_CEN(IX,IY,IZ,ICHARG)    =
     *            WD_CEN(IX,IY,IZ,ICHARG)    +
     *                                 2*CMPLX(potUt  (N_HERM,1,it),
     *                                         potUt  (N_HERM,2,it))/
     *            EXPAUX(IX,IY,IZ)
C
                  WD_SOR(IX,IY,IZ,1,1,ICHARG)=
     *            WD_SOR(IX,IY,IZ,1,1,ICHARG)+
     *                                 2*CMPLX(potWtxx(N_HERM,1,it),
     *                                         potWtxx(N_HERM,2,it))/
     *            EXPAUX(IX,IY,IZ)
C
                  WD_SOR(IX,IY,IZ,1,2,ICHARG)=
     *            WD_SOR(IX,IY,IZ,1,2,ICHARG)+
     *                                 2*CMPLX(potWtxy(N_HERM,1,it),
     *                                         potWtxy(N_HERM,2,it))/
     *            EXPAUX(IX,IY,IZ)
C
                  WD_SOR(IX,IY,IZ,1,3,ICHARG)=
     *            WD_SOR(IX,IY,IZ,1,3,ICHARG)+
     *                                 2*CMPLX(potWtxz(N_HERM,1,it),
     *                                         potWtxz(N_HERM,2,it))/
     *            EXPAUX(IX,IY,IZ)
C
                  WD_SOR(IX,IY,IZ,2,1,ICHARG)=
     *            WD_SOR(IX,IY,IZ,2,1,ICHARG)+
     *                                 2*CMPLX(potWtyx(N_HERM,1,it),
     *                                         potWtyx(N_HERM,2,it))/
     *            EXPAUX(IX,IY,IZ)
C
                  WD_SOR(IX,IY,IZ,2,2,ICHARG)=
     *            WD_SOR(IX,IY,IZ,2,2,ICHARG)+
     *                                 2*CMPLX(potWtyy(N_HERM,1,it),
     *                                         potWtyy(N_HERM,2,it))/
     *            EXPAUX(IX,IY,IZ)
C
                  WD_SOR(IX,IY,IZ,2,3,ICHARG)=
     *            WD_SOR(IX,IY,IZ,2,3,ICHARG)+
     *                                 2*CMPLX(potWtyz(N_HERM,1,it),
     *                                         potWtyz(N_HERM,2,it))/
     *            EXPAUX(IX,IY,IZ)
C
                  WD_SOR(IX,IY,IZ,3,1,ICHARG)=
     *            WD_SOR(IX,IY,IZ,3,1,ICHARG)+
     *                                 2*CMPLX(potWtzx(N_HERM,1,it),
     *                                         potWtzx(N_HERM,2,it))/
     *            EXPAUX(IX,IY,IZ)
C
                  WD_SOR(IX,IY,IZ,3,2,ICHARG)=
     *            WD_SOR(IX,IY,IZ,3,2,ICHARG)+
     *                                 2*CMPLX(potWtzy(N_HERM,1,it),
     *                                         potWtzy(N_HERM,2,it))/
     *            EXPAUX(IX,IY,IZ)
C
                  WD_SOR(IX,IY,IZ,3,3,ICHARG)=
     *            WD_SOR(IX,IY,IZ,3,3,ICHARG)+
     *                                 2*CMPLX(potWtzz(N_HERM,1,it),
     *                                         potWtzz(N_HERM,2,it))/
     *            EXPAUX(IX,IY,IZ)
C
c                 if (N_HERM.eq.2197)
c    *            write(*,'(6i4,4d14,6)') N_HERM,IX,IY,IZ,it,icharg,
c    *            WD_CEN(IX,IY,IZ,ICHARG),
c    *            potUt   (N_HERM,it,1)/EXPAUX(IX,IY,IZ),
c    *            potUt   (N_HERM,it,2)/EXPAUX(IX,IY,IZ)

               END DO
C
            END DO
         END DO
      END DO
C
C=======================================================================
C
      CALL CPUTIM('TRAFLD',0)
C
C=======================================================================
C
      RETURN
      END
C
C=======================================================================
C        DUMMY SUBROUTINES AND FUNCTIONS
C=======================================================================
C
      SUBROUTINE derx(a,b,i)
      END SUBROUTINE derx
      SUBROUTINE dery(a,b,i)
      END SUBROUTINE dery
      SUBROUTINE derz(a,b,i)
      END SUBROUTINE derz
      FUNCTION cutoff(a,b,c,i)
      cutoff=0
      END FUNCTION cutoff
C
C=======================================================================
C        HERE BEGIN ORIGNAL SUBROUTINES AND FUNCTIONS.
C        ATTENTION: FUNCTION   SSUM  HAS BEEN CHANGED INTO SSUM_MB
C                   FUNCTION   SDOT  HAS BEEN CHANGED INTO SDOT_MB
C                   SUBROUTINE SCOPY HAS BEEN CHANGED INTO SCOPY_MB
C=======================================================================
C
c______________________________________________________________________________
      subroutine edfcalc_f

c..............................................................................
c     calculate energies term-by-term in the energy functional                .
c..............................................................................
c     Final Skyrme energies stored as :
c       e_xxxx(1) : neutron-neutron
c       e_xxxx(2) : proton-proton
c       e_xxxx(3) : neutron-proton
c       e_xxxx(4) : total
c     Densities :    r  = rho  , nir  = nabla_i rho  , t  = tau  , ji   = j_i
c                    sj = s_j  , nisj = nabla_i s_j  , Tj = T_j  , Jij  = J_ij
c                    rp = rho- , nirp = nabla_i rho- , tp = tau- , Jpij = J-_ij
c                      or rho~       or nabla_i rho~     or tau~       or J~_ij
c     Particular case : When vector index are a,b,c, it means that there is a
c                       vectoriel product, for instance :
c                       nisa_Jib_sc = nabla_i s_a J_ib s_c * e_abc
c..............................................................................
      implicit real*8 (a-h,o-z)
      character*4 afor
c     include 'paramr8.h'

      common /coeff2/ b_r1r1, b_r1r2, b_sj1sj1, b_sj1sj2, b_t1r1,
     1                b_t1r2, b_Tj1sj1, b_Tj1sj2, b_nir1nir1,
     2                b_nir1nir2, b_nisj1nisj1, b_nisj1nisj2,
     3                b_ji1ji1, b_ji1ji2, b_Jij1Jij1, b_Jij1Jij2,
     4                b_r1naJbc1, b_r1naJbc2, b_ja1nbsc1, b_ja1nbsc2,
     5                b_Jii1Jjj1, b_Jii1Jjj2, b_Jij1Jji1, b_Jij1Jji2,
     6                b_nisi1njsj1, b_nisi1njsj2, b_Fj1sj1, b_Fj1sj2,
     7                b_rg1rd1, b_tg1rd1, b_td1rg1, b_nirg1nird1,
     8                b_Jgij1Jdij1, b_Jgii1Jdjj1, b_Jgij1Jdji1
      common /coeff3/ b_r1r1r2, b_sj1sj1r2, b_t1r1r1, b_t1r1r2,
     1                b_t1r2r2, b_Tj1sj1r2, b_Tj1sj2r1, b_t1sj1sj1,
     2                b_t1sj1sj2, b_t1sj2sj2, b_nir1nir1r1,
     3                b_nir1nir1r2, b_nir1nir2r1, b_nisj1nisj1r1,
     4                b_nisj1nisj1r2, b_nisj1nisj2r1, b_nir1nisj1sj1,
     5                b_nir1nisj1sj2, b_nir1nisj2sj1, b_nir1nisj2sj2,
     6                b_ji1ji1r1, b_ji1ji1r2, b_ji1ji2r1, b_Jij1Jij1r1,
     7                b_Jij1Jij1r2, b_Jij1Jij2r1, b_ji1Jij1sj1,
     8                b_ji1Jij1sj2, b_ji1Jij2sj1, b_ji1Jij2sj2,
     9                b_nisa1Jib1sc1, b_nisa1Jib1sc2, b_nisa1Jib2sc1,
     8                b_nisa1Jib2sc2, b_rg1rd1r2, b_t1rg1rd1,
     7                b_t2rg1rd1, b_tg1rd1r2, b_td1rg1r2,
     6                b_nirg1nird1r1, b_nirg1nird1r2, b_nirg1nir1rd1,
     5                b_nirg1nir2rd1, b_nird1nir1rg1, b_nird1nir2rg1,
     4                b_Jgij1Jdij1r1, b_Jgij1Jdij1r2, b_Jgij1Jij1rd1,
     3                b_Jgij1Jij2rd1, b_Jdij1Jij1rg1, b_Jdij1Jij2rg1,
     2                b_nirg1ji1rd1, b_nirg1ji2rd1, b_nird1ji1rg1,
     1                b_nird1ji2rg1, b_nirg1Jdij1sj1, b_nirg1Jdij1sj2,
     2                b_nird1Jgij1sj1, b_nird1Jgij1sj2, b_nisj1Jgij1rd1,
     3                b_nisj2Jgij1rd1, b_nisj1Jdij1rg1, b_nisj2Jdij1rg1,
     4                b_Jgia1Jdib1sc1, b_Jgia1Jdib1sc2
      common /coeff4/ b_r1r1r2r2, b_sj1sj1r2r2, b_si1si1sj2sj2,
     1                b_rg1rd1r2r2, b_rg1rd1sj2sj2, b_rg1rd1rg2rd2
      common /fopt  / nfunc,ngal,njmunu,ncm2,nmass,ndd,nforce,ncoex
      common /iwrit/ et0,ett,etd,et3a,et3b,esk,etrb,ecoul,eso(2),ek(3)
     1              ,ecoex,ejmunu(3),est(2),elaps(2),esf,edivs
     2              ,ecm(2,3),ecmp(3),etc,ete
      common /pairw/ ambda(2),gstr(2),xlamb(2),epair(3),eproj(3)
     1              ,disper(3)
      common /force / t0,x0,t1,x1,t2,x2,te,to,wso
     1               ,u0,u1,y1,u2,y21,y22,v0
     2               ,wsoq,t3a,x3a,yt3a,t3b,x3b,yt3b
     3               ,hbar,hbm(2),xm(3),afor
      common /den  / frho(mv,2),fsx (mv,2),fsy (mv,2),fsz(mv,2)
      common /cur  / fjx (mv,2),fjy (mv,2),fjz (mv,2)
      common /taudj/ ftau(mv,2),fdJ (mv,2)
      common /wj2  / fJxx(mv,2),fJyx(mv,2),fJzx(mv,2)
     1              ,fJxy(mv,2),fJyy(mv,2),fJzy(mv,2)
     2              ,fJxz(mv,2),fJyz(mv,2),fJzz(mv,2)
      common /wtf  / fTx (mv,2),fTy (mv,2),fTz (mv,2)
     1              ,fFx (mv,2),fFy (mv,2),fFz (mv,2)
      common /locden/ flrho(mv,2),
     1                frosx(mv,2),frosy(mv,2),frosz(mv,2),
     2                flsx (mv,2),flsy (mv,2),flsz (mv,2),
     3                fns  (mv,2),
     4                fnrx (mv,2),fnry (mv,2),fnrz (mv,2),
     5                fnsxx(mv,2),fnsxy(mv,2),fnsxz(mv,2),
     6                fnsyx(mv,2),fnsyy(mv,2),fnsyz(mv,2),
     7                fnszx(mv,2),fnszy(mv,2),fnszz(mv,2),
     8                fnJx (mv,2),fnJy (mv,2),fnJz (mv,2),
     9                fnj  (mv,2),
     8                fnjxx(mv,2),fnjxy(mv,2),fnjxz(mv,2),
     7                fnjyx(mv,2),fnjyy(mv,2),fnjyz(mv,2),
     6                fnjzx(mv,2),fnjzy(mv,2),fnjzz(mv,2),
     5                fndsx(mv,2),fndsy(mv,2),fndsz(mv,2)
      common /denpr / frhotr (mv ,2),frhoti (mv ,2),
     1                ftautr (mv,2),ftauti (mv,2),
     2                flrhotr(mv,2),flrhoti(mv,2),
     3                fJtxxr (mv,2),fJtxyr (mv,2),fJtxzr (mv,2),
     4                fJtxxi (mv,2),fJtxyi (mv,2),fJtxzi (mv,2),
     5                fJtyxr (mv,2),fJtyyr (mv,2),fJtyzr (mv,2),
     6                fJtyxi (mv,2),fJtyyi (mv,2),fJtyzi (mv,2),
     7                fJtzxr (mv,2),fJtzyr (mv,2),fJtzzr (mv,2),
     8                fJtzxi (mv,2),fJtzyi (mv,2),fJtzzi (mv,2)
      common /denpr2/ fnrtxr(mv,2),fnrtyr(mv,2),fnrtzr(mv,2),
     1                fnrtxi(mv,2),fnrtyi(mv,2),fnrtzi(mv,2),
     2                fnJtxr(mv,2),fnJtyr(mv,2),fnJtzr(mv,2),
     3                fnJtxi(mv,2),fnJtyi(mv,2),fnJtzi(mv,2)
      common /e_f  / e_kin(3),e_cm(2,3),e_ln(3),e_could,e_coulx,e_coulp,
     1               e_r_r         (4),e_t_r         (4),e_sj_sj    (4),
     2               e_Tj_sj       (4),e_nir_nir     (4),e_nisj_nisj(4),
     3               e_ji_ji       (4),e_Jij_Jij     (4),e_r_naJbc  (4),
     4               e_ja_nbsc     (4),e_nisi_njsj   (4),e_Jii_Jjj  (4),
     5               e_Jij_Jji     (4),e_Fj_sj       (4),
     6               e_rp_rp       (4),e_tp_rp       (4),
     7               e_nirp_nirp   (4),e_Jpij_Jpij   (4),
     8               e_Jpii_Jpjj   (4),e_Jpij_Jpji   (4),
     8               e_2body_rr    (4),!2body normal terms (rho rho)
     8               e_2body_kk    (4),!2body pair.  terms (kap kap)
     8               e_2body       (4),!Total 2body
     8               e_r_r_r       (4),e_t_r_r       (4),e_sj_sj_r  (4),
     7               e_t_sj_sj     (4),e_Tj_sj_r     (4),e_nir_nir_r(4),
     6               e_nisj_nisj_r (4),e_nir_nisj_sj (4),
     5               e_ji_ji_r     (4),e_Jij_Jij_r   (4),
     4               e_ji_Jij_sj   (4),e_nisa_Jib_sc (4),
     3               e_rp_rp_r     (4),e_t_rp_rp     (4),e_tp_rp_r  (4),
     2               e_nirp_nirp_r (4),e_nirp_rp_nir (4),
     1               e_Jpij_Jpij_r (4),e_Jpij_rp_Jij (4),
     2               e_nirp_rp_ji  (4),e_nirp_Jpij_sj(4),
     3               e_Jpij_rp_nisj(4),e_Jpia_Jpib_sc(4),
     8               e_3body_rrr   (4),!3body normal terms (rho rho rho)
     8               e_3body_kkr   (4),!3body pair.  terms (kap kap rho)
     8               e_3body       (4),!Total 3body
     5               e_r_r_r_r     (4),e_sj_sj_r_r   (4),
     6               e_si_si_sj_sj (4),e_rp_rp_r_r   (4),
     7               e_rp_rp_sj_sj (4),e_rp_rp_rp_rp (4),
     8               e_4body_rrrr  (4),!4body normal terms (rho rho rho rho)
     8               e_4body_kkrr  (4),!4body pair.  terms (kap kap rho rho)
     8               e_4body_kkkk  (4),!4body pair.  terms (kap kap kap kap)
     8               e_4body       (4),!Total 4body
     9               e_norm        (4),e_pair        (4),e_sky      (4),
     8               e_tot
      common /work / work1  (mv),work2  (mv),work3  (mv),work4  (mv)
     1              ,work_xr(mv),work_yr(mv),work_zr(mv)
     2              ,work_xi(mv),work_yi(mv),work_zi(mv)
     3              ,prho2  (mv,2),ps2  (mv,2)
     4              ,prhogd (mv,2),reste(12*mv)
      common /pot  / wcd(mv),wce(mv),wt3a(mv),wt3b(mv)

      common /drho / drhon(mv),drhop(mv)
      common /evohe/ dt,nitert,nxmu,ndiag,itert,nprint
      common /noyau/ nwaven,nwavep,nwave,npn,npp,npar(4,2),iit(2,2,2)
      common /nxyz / dx,dv
      common /stor / a(mq,mw),b(mq,mw)
      common /wave / w1(mv),w2(mv),w3(mv),w4(mv)
     1              ,p1(mv),p2(mv),p3(mv),p4(mv)
      common /spwfc/ kiso(mw),kparz(mw),keta(mw)
      common /spwf2/ v2(mw),espro(mw),xchf(mw),ichf(mw)


c     .......................................................... kinetic energy
c     ............................................................. c.m. energy
c     .......................................................... Coulomb energy
c     ............................................................... LN energy
      e_kin  (:) = 0.0d0    ! from summing int d^3r psi^+(r) Delta psi(r)
      e_cm (:,:) = 0.0d0    ! in the canonical single-particle basis
      iwa   = 0
      do iwa=1,nwave
        it  = kiso (iwa)
        zp  = kparz(iwa)
        oc  = v2   (iwa)
        call SCOPY_MB (mq,b(1,iwa),w1)
        call lapla (w1,p1, 1.0d0, 1.0d0, zp)
        call lapla (w2,p2,-1.0d0,-1.0d0, zp)
        call lapla (w3,p3,-1.0d0, 1.0d0,-zp)
        call lapla (w4,p4, 1.0d0,-1.0d0,-zp)
        e_kin (it) = e_kin (it) + oc * SDOT_MB(mq,w1,p1)
        e_cm(1,it) = e_cm(1,it) + oc * SDOT_MB(mq,w1,p1)
      enddo
      do it=1,2
        itb = 3 - it
        fac = - hbm(it) * 0.5d0 * dv
        e_kin (it) = fac * e_kin (it)
        fac =   hbm(it) * 0.5d0 * dv * (xm(it)/xm(3))  !(1-body c.m. correction)
        e_cm(1,it) = fac * e_cm(1,it)
        ! 2-body c.m. correction is computed in pipj routine.
        ! Looking at figaro, it seems to me that it should be (- ecm).
        if (ncm2.eq.1) e_cm(2,it) = - ecm(2,it)
        e_ln(it) = eproj(it)
      enddo
      e_could = 0.5d0  * dv * SDOT_MB(mv,frho(1,2),wcd(1))
      e_coulx = 0.0d0
      e_coulp = 0.0d0
      if (ncoex.eq.0) e_coulx =
     1                 0.75d0 * dv * SDOT_MB(mv,frho(1,2),wce(1))

c     ............................................... rho_q1 rho_q1        term
c     ............................................... rho_q1 rho_q2        term
c     ............................................... rho_q2 rho_q1 rho_q1 term
      e_r_r   (:) = 0.0d0
      e_r_r_r (:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) = frho(:,it) * frho(:,it)
        work2(:) = frho(:,it) * frho(:,itb)
        e_r_r   (it) = b_r1r1   * dv * SSUM_MB(mv,work1(1))
        e_r_r    (3) = e_r_r    (3)
     1               + b_r1r2   * dv * SSUM_MB(mv,work2(1))
        e_r_r_r  (3) = e_r_r_r  (3)
     1               + b_r1r1r2 * dv * SDOT_MB(mv,work1(1),frho(1,itb))
      enddo

c     ............................................... s_q1,j s_q1,j        term
c     ............................................... s_q1,j s_q2,j        term
c     ............................................... s_q1,j s_q1,j rho_q2 term
c     ............................................... tau_q1 s_q1,j s_q1,j term
c     ............................................... tau_q2 s_q1,j s_q1,j term
c    ................................................ tau_q1 s_q1,j s_q2,j term
      e_sj_sj   (:) = 0.0d0
      e_sj_sj_r (:) = 0.0d0
      e_t_sj_sj (:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fsx(:,it) * fsx(:,it)
     1             + fsy(:,it) * fsy(:,it)
     2             + fsz(:,it) * fsz(:,it)
        work2(:) =   fsx(:,it) * fsx(:,itb)
     1             + fsy(:,it) * fsy(:,itb)
     2             + fsz(:,it) * fsz(:,itb)
        e_sj_sj   (it) = b_sj1sj1   * dv * SSUM_MB(mv,work1(1))
        e_sj_sj    (3) = e_sj_sj   (3)
     1                 + b_sj1sj2   * dv * SSUM_MB(mv,work2(1))
        e_sj_sj_r  (3) = e_sj_sj_r (3)
     1                 + b_sj1sj1r2
     2                 * dv * SDOT_MB(mv,work1(1),frho(1,itb))
        e_t_sj_sj (it) = b_t1sj1sj1
     1                 * dv * SDOT_MB(mv,work1(1),ftau(1,it))
        e_t_sj_sj  (3) = e_t_sj_sj (3)
     1                 + b_t1sj2sj2
     2                 * dv * SDOT_MB(mv,work1(1),ftau(1,itb))
     3                 + b_t1sj1sj2
     4                 * dv * SDOT_MB(mv,work2(1),ftau(1,it))
      enddo

c     ............................................... tau_q1 rho_q1        term
c     ............................................... tau_q1 rho_q2        term
c     ............................................... tau_q1 rho_q1 rho_q1 term
c     ............................................... tau_q1 rho_q1 rho_q2 term
c     ............................................... tau_q2 rho_q1 rho_q1 term
      e_t_r   (:) = 0.0d0
      e_t_r_r (:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   ftau(:,it)  * frho(:,it)
        work2(:) =   ftau(:,itb) * frho(:,it)
        e_t_r   (it) = b_t1r1   * dv * SSUM_MB(mv,work1(1))
        e_t_r    (3) = e_t_r  (3)
     1               + b_t1r2   * dv * SSUM_MB(mv,work2(1))
        e_t_r_r (it) = b_t1r1r1 * dv * SDOT_MB(mv,work1(1),frho(1,it))
        e_t_r_r  (3) = e_t_r_r(3)
     1               + b_t1r1r2 * dv * SDOT_MB(mv,work1(1),frho(1,itb))
     2               + b_t1r2r2 * dv * SDOT_MB(mv,work2(1),frho(1,it))
      enddo

c     ............................................... T_q1,j s_q1,j        term
c     ............................................... T_q1,j s_q2,j        term
c     ............................................... T_q1,j s_q1,j rho_q2 term
c     ............................................... T_q1,j s_q2,j rho_q1 term
      e_Tj_sj  (:) = 0.0d0
      e_Tj_sj_r(:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fTx(:,it) * fsx(:,it)
     1             + fTy(:,it) * fsy(:,it)
     2             + fTz(:,it) * fsz(:,it)
        work2(:) =   fTx(:,it) * fsx(:,itb)
     1             + fTy(:,it) * fsy(:,itb)
     2             + fTz(:,it) * fsz(:,itb)
        e_Tj_sj  (it) = b_Tj1sj1   * dv * SSUM_MB(mv,work1(1))
        e_Tj_sj   (3) = e_Tj_sj  (3)
     1                + b_Tj1sj2   * dv * SSUM_MB(mv,work2(1))
        e_Tj_sj_r (3) = e_Tj_sj_r(3)
     1                + b_Tj1sj1r2
     2                * dv * SDOT_MB(mv,work1(1),frho(1,itb))
     3                + b_Tj1sj2r1
     4                * dv * SDOT_MB(mv,work2(1),frho(1,it))
      enddo

c     ........................... (nabla_i rho_q1) (nabla_i rho_q1)        term
c     ........................... (nabla_i rho_q1) (nabla_i rho_q2)        term
c     ........................... (nabla_i rho_q1) (nabla_i rho_q1) rho_q1 term
c     ........................... (nabla_i rho_q1) (nabla_i rho_q1) rho_q2 term
c     ........................... (nabla_i rho_q1) (nabla_i rho_q2) rho_q1 term
c     For the two body term (and only for the two-body) one can replace
c       (nabla_i rho) (nabla_i rho) = - (lap. rho) rho
      e_nir_nir (:)  = 0.0d0
      e_nir_nir_r(:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fnrx(:,it) * fnrx(:,it)
     1             + fnry(:,it) * fnry(:,it)
     2             + fnrz(:,it) * fnrz(:,it)
        work2(:) =   fnrx(:,it) * fnrx(:,itb)
     1             + fnry(:,it) * fnry(:,itb)
     2             + fnrz(:,it) * fnrz(:,itb)
        work3(:) = -flrho(:,it) * frho(:,it)
        work4(:) = -flrho(:,it) * frho(:,itb)
c        e_nir_nir   (it) = b_nir1nir1   * dv * SSUM_MB(mv,work1(1))
c        e_nir_nir    (3) = e_nir_nir (3)
c     1                   + b_nir1nir2   * dv * SSUM_MB(mv,work2(1))
        e_nir_nir   (it) = b_nir1nir1   * dv * SSUM_MB(mv,work3(1))
        e_nir_nir    (3) = e_nir_nir (3)
     1                   + b_nir1nir2   * dv * SSUM_MB(mv,work4(1))
        e_nir_nir_r (it) =
     1               + b_nir1nir1r1
     2               * dv * SDOT_MB(mv,work1(1),frho(1,it))
        e_nir_nir_r  (3) = e_nir_nir_r(3)
     1               + b_nir1nir1r2
     2               * dv * SDOT_MB(mv,work1(1),frho(1,itb))
     3               + b_nir1nir2r1
     4               * dv * SDOT_MB(mv,work2(1),frho(1,it))
      enddo

c     ........................... (nabla_i s_q1,j) (nabla_i s_q1,j)        term
c     ........................... (nabla_i s_q1,j) (nabla_i s_q2,j)        term
c     ........................... (nabla_i s_q1,j) (nabla_i s_q1,j) rho_q1 term
c     ........................... (nabla_i s_q1,j) (nabla_i s_q1,j) rho_q2 term
c     ........................... (nabla_i s_q1,j) (nabla_i s_q2,j) rho_q1 term
c     For the two body term (and only for the two-body) one can replace
c       (nabla_i s) (nabla_i s) = - (lap. s) s
      e_nisj_nisj  (:) = 0.0d0
      e_nisj_nisj_r(:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fnsxx(:,it) * fnsxx(:,it)
     1             + fnsxy(:,it) * fnsxy(:,it)
     2             + fnsxz(:,it) * fnsxz(:,it)
     3             + fnsyx(:,it) * fnsyx(:,it)
     4             + fnsyy(:,it) * fnsyy(:,it)
     5             + fnsyz(:,it) * fnsyz(:,it)
     6             + fnszx(:,it) * fnszx(:,it)
     7             + fnszy(:,it) * fnszy(:,it)
     8             + fnszz(:,it) * fnszz(:,it)
        work2(:) =   fnsxx(:,it) * fnsxx(:,itb)
     1             + fnsxy(:,it) * fnsxy(:,itb)
     2             + fnsxz(:,it) * fnsxz(:,itb)
     3             + fnsyx(:,it) * fnsyx(:,itb)
     4             + fnsyy(:,it) * fnsyy(:,itb)
     5             + fnsyz(:,it) * fnsyz(:,itb)
     6             + fnszx(:,it) * fnszx(:,itb)
     7             + fnszy(:,it) * fnszy(:,itb)
     8             + fnszz(:,it) * fnszz(:,itb)
        work3(:) = - flsx (:,it) * fsx  (:,it)
     1             - flsy (:,it) * fsy  (:,it)
     2             - flsz (:,it) * fsz  (:,it)
        work4(:) = - flsx (:,it) * fsx  (:,itb)
     1             - flsy (:,it) * fsy  (:,itb)
     2             - flsz (:,it) * fsz  (:,itb)
c        e_nisj_nisj  (it) = b_nisj1nisj1   * dv * SSUM_MB(mv,work1(1))
c        e_nisj_nisj  (3)  = e_nisj_nisj  (3)
c     1                    + b_nisj1nisj2   * dv * SSUM_MB(mv,work2(1))
        e_nisj_nisj  (it) = b_nisj1nisj1   * dv * SSUM_MB(mv,work3(1))
        e_nisj_nisj  (3)  = e_nisj_nisj  (3)
     1                    + b_nisj1nisj2   * dv * SSUM_MB(mv,work4(1))
        e_nisj_nisj_r(it) =
     1             + b_nisj1nisj1r1
     2             * dv * SDOT_MB(mv,work1(1),frho(1,it))
        e_nisj_nisj_r(3) = e_nisj_nisj_r(3)
     1             + b_nisj1nisj1r2
     2             * dv * SDOT_MB(mv,work1(1),frho(1,itb))
     3             + b_nisj1nisj2r1
     4             * dv * SDOT_MB(mv,work2(1),frho(1,it))
      enddo

c     .......................... (nabla_i rho_q1) (nabla_i s_q1,j) s_q1,j term
c     .......................... (nabla_i rho_q1) (nabla_i s_q1,j) s_q2,j term
c     .......................... (nabla_i rho_q1) (nabla_i s_q2,j) s_q1,j term
c     .......................... (nabla_i rho_q2) (nabla_i s_q1,j) s_q1,j term
      e_nir_nisj_sj(:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work_xr(:) =   fnrx(:,it) * fnsxx(:,it)
     1               + fnry(:,it) * fnsyx(:,it)
     2               + fnrz(:,it) * fnszx(:,it)
        work_yr(:) =   fnrx(:,it) * fnsxy(:,it)
     1               + fnry(:,it) * fnsyy(:,it)
     2               + fnrz(:,it) * fnszy(:,it)
        work_zr(:) =   fnrx(:,it) * fnsxz(:,it)
     1               + fnry(:,it) * fnsyz(:,it)
     2               + fnrz(:,it) * fnszz(:,it)
        work1(:)   =   work_xr(:) * fsx(:,it)
     1               + work_yr(:) * fsy(:,it)
     2               + work_zr(:) * fsz(:,it)
        work2(:)   =   work_xr(:) * fsx(:,itb)
     1               + work_yr(:) * fsy(:,itb)
     2               + work_zr(:) * fsz(:,itb)
        work_xr(:) =   fnrx(:,it) * fnsxx(:,itb)
     1               + fnry(:,it) * fnsyx(:,itb)
     2               + fnrz(:,it) * fnszx(:,itb)
        work_yr(:) =   fnrx(:,it) * fnsxy(:,itb)
     1               + fnry(:,it) * fnsyy(:,itb)
     2               + fnrz(:,it) * fnszy(:,itb)
        work_zr(:) =   fnrx(:,it) * fnsxz(:,itb)
     1               + fnry(:,it) * fnsyz(:,itb)
     2               + fnrz(:,it) * fnszz(:,itb)
        work3(:)   =   work_xr(:) * fsx(:,it)
     1               + work_yr(:) * fsy(:,it)
     2               + work_zr(:) * fsz(:,it)
        work4(:)   =   work_xr(:) * fsx(:,itb)
     1               + work_yr(:) * fsy(:,itb)
     2               + work_zr(:) * fsz(:,itb)
        e_nir_nisj_sj (it) = b_nir1nisj1sj1 * dv * SSUM_MB(mv,work1(1))
        e_nir_nisj_sj  (3) = e_nir_nisj_sj(3)
     1                     + b_nir1nisj1sj2 * dv * SSUM_MB(mv,work2(1))
     2                     + b_nir1nisj2sj1 * dv * SSUM_MB(mv,work3(1))
     3                     + b_nir1nisj2sj2 * dv * SSUM_MB(mv,work4(1))
      enddo

c     ............................................... j_q1,i j_q1,i        term
c     ............................................... j_q1,i j_q2,i        term
c     ............................................... j_q1,i j_q1,i rho_q1 term
c     ............................................... j_q1,i j_q1,i rho_q2 term
c     ............................................... j_q1,i j_q2,i rho_q1 term
      e_ji_ji  (:) = 0.0d0
      e_ji_ji_r(:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fjx(:,it) * fjx(:,it)
     1             + fjy(:,it) * fjy(:,it)
     2             + fjz(:,it) * fjz(:,it)
        work2(:) =   fjx(:,it) * fjx(:,itb)
     1             + fjy(:,it) * fjy(:,itb)
     2             + fjz(:,it) * fjz(:,itb)
        e_ji_ji   (it) = b_ji1ji1   * dv * SSUM_MB(mv,work1(1))
        e_ji_ji    (3) = e_ji_ji   (3)
     1                 + b_ji1ji2   * dv * SSUM_MB(mv,work2(1))
        e_ji_ji_r (it) = b_ji1ji1r1
     1                 * dv * SDOT_MB(mv,work1(1),frho(1,it))
        e_ji_ji_r  (3) = e_ji_ji_r (3)
     1                 + b_ji1ji1r2
     2                 * dv * SDOT_MB(mv,work1(1),frho(1,itb))
     3                 + b_ji1ji2r1
     4                 * dv * SDOT_MB(mv,work2(1),frho(1,it))
      enddo

c     ............................................. J_q1,ij J_q1,ij        term
c     ............................................. J_q1,ij J_q2,ij        term
c     ............................................. J_q1,ij J_q1,ij rho_q1 term
c     ............................................. J_q1,ij J_q1,ij rho_q2 term
c     ............................................. J_q1,ij J_q2,ij rho_q1 term
      e_Jij_Jij  (:) = 0.0d0
      e_Jij_Jij_r(:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fJxx(:,it) * fJxx(:,it)
     1             + fJxy(:,it) * fJxy(:,it)
     2             + fJxz(:,it) * fJxz(:,it)
     3             + fJyx(:,it) * fJyx(:,it)
     4             + fJyy(:,it) * fJyy(:,it)
     5             + fJyz(:,it) * fJyz(:,it)
     6             + fJzx(:,it) * fJzx(:,it)
     7             + fJzy(:,it) * fJzy(:,it)
     8             + fJzz(:,it) * fJzz(:,it)
        work2(:) =   fJxx(:,it) * fJxx(:,itb)
     1             + fJxy(:,it) * fJxy(:,itb)
     2             + fJxz(:,it) * fJxz(:,itb)
     3             + fJyx(:,it) * fJyx(:,itb)
     4             + fJyy(:,it) * fJyy(:,itb)
     5             + fJyz(:,it) * fJyz(:,itb)
     6             + fJzx(:,it) * fJzx(:,itb)
     7             + fJzy(:,it) * fJzy(:,itb)
     8             + fJzz(:,it) * fJzz(:,itb)
        e_Jij_Jij   (it) = b_Jij1Jij1   * dv * SSUM_MB(mv,work1(1))
        e_Jij_Jij    (3) = e_Jij_Jij   (3)
     1                   + b_Jij1Jij2   * dv * SSUM_MB(mv,work2(1))
        e_Jij_Jij_r (it) =
     1               + b_Jij1Jij1r1
     2               * dv * SDOT_MB(mv,work1(1),frho(1,it))
        e_Jij_Jij_r  (3) = e_Jij_Jij_r (3)
     1               + b_Jij1Jij1r2
     2               * dv * SDOT_MB(mv,work1(1),frho(1,itb))
     3               + b_Jij1Jij2r1
     4               * dv * SDOT_MB(mv,work2(1),frho(1,it))
      enddo

c     .............................................. j_q1,i J_q1,ij s_q1,j term
c     .............................................. j_q1,i J_q1,ij s_q2,j term
c     .............................................. j_q1,i J_q2,ij s_q1,j term
c     .............................................. j_q2,i J_q1,ij s_q1,j term
      e_ji_Jij_sj(:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work_xr(:) =   fjx(:,it) * fJxx(:,it)
     1               + fjy(:,it) * fJyx(:,it)
     2               + fjz(:,it) * fJzx(:,it)
        work_yr(:) =   fjx(:,it) * fJxy(:,it)
     1               + fjy(:,it) * fJyy(:,it)
     2               + fjz(:,it) * fJzy(:,it)
        work_zr(:) =   fjx(:,it) * fJxz(:,it)
     1               + fjy(:,it) * fJyz(:,it)
     2               + fjz(:,it) * fJzz(:,it)
        work1(:)   =   work_xr(:) * fsx(:,it)
     1               + work_yr(:) * fsy(:,it)
     2               + work_zr(:) * fsz(:,it)
        work2(:)   =   work_xr(:) * fsx(:,itb)
     1               + work_yr(:) * fsy(:,itb)
     2               + work_zr(:) * fsz(:,itb)
        work_xr(:) =   fjx(:,it) * fJxx(:,itb)
     1               + fjy(:,it) * fJyx(:,itb)
     2               + fjz(:,it) * fJzx(:,itb)
        work_yr(:) =   fjx(:,it) * fJxy(:,itb)
     1               + fjy(:,it) * fJyy(:,itb)
     2               + fjz(:,it) * fJzy(:,itb)
        work_zr(:) =   fjx(:,it) * fJxz(:,itb)
     1               + fjy(:,it) * fJyz(:,itb)
     2               + fjz(:,it) * fJzz(:,itb)
        work3(:)   =   work_xr(:) * fsx(:,it)
     1               + work_yr(:) * fsy(:,it)
     2               + work_zr(:) * fsz(:,it)
        work4(:)   =   work_xr(:) * fsx(:,itb)
     1               + work_yr(:) * fsy(:,itb)
     2               + work_zr(:) * fsz(:,itb)
        e_ji_Jij_sj (it) = b_ji1Jij1sj1 * dv * SSUM_MB(mv,work1(1))
        e_ji_Jij_sj  (3) = e_ji_Jij_sj (3)
     1                   + b_ji1Jij1sj2 * dv * SSUM_MB(mv,work2(1))
     2                   + b_ji1Jij2sj1 * dv * SSUM_MB(mv,work3(1))
     3                   + b_ji1Jij2sj2 * dv * SSUM_MB(mv,work4(1))
      enddo

c     ............................ (nabla_i s_q1,a) J_q1,ib s_q1,c * e_abc term
c     ............................ (nabla_i s_q1,a) J_q1,ib s_q2,c * e_abc term
c     ............................ (nabla_i s_q1,a) J_q2,ib s_q1,c * e_abc term
c     ............................ (nabla_i s_q2,a) J_q1,ib s_q1,c * e_abc term
      e_nisa_Jib_sc(:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work_xr(:) = + fnsxy(:,it) * fJxz(:,it)
     1               + fnsyy(:,it) * fJyz(:,it)
     2               + fnszy(:,it) * fJzz(:,it)
     3               - fnsxz(:,it) * fJxy(:,it)
     4               - fnsyz(:,it) * fJyy(:,it)
     5               - fnszz(:,it) * fJzy(:,it)
        work_yr(:) = - fnsxx(:,it) * fJxz(:,it)
     1               - fnsyx(:,it) * fJyz(:,it)
     2               - fnszx(:,it) * fJzz(:,it)
     3               + fnsxz(:,it) * fJxx(:,it)
     4               + fnsyz(:,it) * fJyx(:,it)
     5               + fnszz(:,it) * fJzx(:,it)
        work_zr(:) = + fnsxx(:,it) * fJxy(:,it)
     1               + fnsyx(:,it) * fJyy(:,it)
     2               + fnszx(:,it) * fJzy(:,it)
     3               - fnsxy(:,it) * fJxx(:,it)
     4               - fnsyy(:,it) * fJyx(:,it)
     5               - fnszy(:,it) * fJzx(:,it)
        work1(:)   =   work_xr(:) * fsx(:,it)
     1               + work_yr(:) * fsy(:,it)
     2               + work_zr(:) * fsz(:,it)
        work2(:)   =   work_xr(:) * fsx(:,itb)
     1               + work_yr(:) * fsy(:,itb)
     2               + work_zr(:) * fsz(:,itb)
        work_xr(:) = + fnsxy(:,it) * fJxz(:,itb)
     1               + fnsyy(:,it) * fJyz(:,itb)
     2               + fnszy(:,it) * fJzz(:,itb)
     3               - fnsxz(:,it) * fJxy(:,itb)
     4               - fnsyz(:,it) * fJyy(:,itb)
     5               - fnszz(:,it) * fJzy(:,itb)
        work_yr(:) = - fnsxx(:,it) * fJxz(:,itb)
     1               - fnsyx(:,it) * fJyz(:,itb)
     2               - fnszx(:,it) * fJzz(:,itb)
     3               + fnsxz(:,it) * fJxx(:,itb)
     4               + fnsyz(:,it) * fJyx(:,itb)
     5               + fnszz(:,it) * fJzx(:,itb)
        work_zr(:) = + fnsxx(:,it) * fJxy(:,itb)
     1               + fnsyx(:,it) * fJyy(:,itb)
     2               + fnszx(:,it) * fJzy(:,itb)
     3               - fnsxy(:,it) * fJxx(:,itb)
     4               - fnsyy(:,it) * fJyx(:,itb)
     5               - fnszy(:,it) * fJzx(:,itb)
        work3(:)   =   work_xr(:) * fsx(:,it)
     1               + work_yr(:) * fsy(:,it)
     2               + work_zr(:) * fsz(:,it)
        work4(:)   =   work_xr(:) * fsx(:,itb)
     1               + work_yr(:) * fsy(:,itb)
     2               + work_zr(:) * fsz(:,itb)
        e_nisa_Jib_sc (it) = b_nisa1Jib1sc1 * dv * SSUM_MB(mv,work1(1))
        e_nisa_Jib_sc  (3) = e_nisa_Jib_sc (3)
     1                     + b_nisa1Jib1sc2 * dv * SSUM_MB(mv,work2(1))
     2                     + b_nisa1Jib2sc1 * dv * SSUM_MB(mv,work3(1))
     3                     + b_nisa1Jib2sc2 * dv * SSUM_MB(mv,work4(1))
      enddo

c     ........................................... rho_q1 (nabla_a J_q1,bc) term
c     ........................................... rho_q1 (nabla_a J_q2,bc) term
      e_r_naJbc (:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   frho(:,it) * fdJ(:,it)
        work2(:) =   frho(:,it) * fdJ(:,itb)
        e_r_naJbc (it) = b_r1naJbc1 * dv * SSUM_MB(mv,work1(1))
        e_r_naJbc  (3) = e_r_naJbc (3)
     1                 + b_r1naJbc2 * dv * SSUM_MB(mv,work2(1))
      enddo

c     ............................................ j_q1,a (nabla_b s_q1,c) term
c     ............................................ j_q1,a (nabla_b s_q2,c) term
      e_ja_nbsc (:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:)   =   fjx(:,it) * frosx(:,it)
     1               + fjy(:,it) * frosy(:,it)
     2               + fjz(:,it) * frosz(:,it)
        work2(:)   =   fjx(:,it) * frosx(:,itb)
     1               + fjy(:,it) * frosy(:,itb)
     2               + fjz(:,it) * frosz(:,itb)
        e_ja_nbsc (it) = b_ja1nbsc1 * dv * SSUM_MB(mv,work1(1))
        e_ja_nbsc  (3) = e_ja_nbsc (3)
     1                 + b_ja1nbsc2 * dv * SSUM_MB(mv,work2(1))
      enddo

c     .................................. (nabla_i s_q1,i) (nabla_j s_q1,j) term
c     .................................. (nabla_i s_q1,i) (nabla_j s_q2,j) term
      e_nisi_njsj  (:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fns(:,it) * fns(:,it)
        work2(:) =   fns(:,it) * fns(:,itb)
        e_nisi_njsj (it) = b_nisi1njsj1 * dv * SSUM_MB(mv,work1(1))
        e_nisi_njsj  (3) = e_nisi_njsj  (3)
     1                   + b_nisi1njsj2 * dv * SSUM_MB(mv,work2(1))
      enddo

c     .................................................... J_q1,ii J_q1,jj term
c     .................................................... J_q1,ii J_q2,jj term
      e_Jii_Jjj  (:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fJxx(:,it) * fJxx(:,it)
     1             + fJxx(:,it) * fJyy(:,it)
     2             + fJxx(:,it) * fJzz(:,it)
     3             + fJyy(:,it) * fJxx(:,it)
     4             + fJyy(:,it) * fJyy(:,it)
     5             + fJyy(:,it) * fJzz(:,it)
     6             + fJzz(:,it) * fJxx(:,it)
     7             + fJzz(:,it) * fJyy(:,it)
     8             + fJzz(:,it) * fJzz(:,it)
        work2(:) =   fJxx(:,it) * fJxx(:,itb)
     1             + fJxx(:,it) * fJyy(:,itb)
     2             + fJxx(:,it) * fJzz(:,itb)
     3             + fJyy(:,it) * fJxx(:,itb)
     4             + fJyy(:,it) * fJyy(:,itb)
     5             + fJyy(:,it) * fJzz(:,itb)
     6             + fJzz(:,it) * fJxx(:,itb)
     7             + fJzz(:,it) * fJyy(:,itb)
     8             + fJzz(:,it) * fJzz(:,itb)
        e_Jii_Jjj (it) = b_Jii1Jjj1 * dv * SSUM_MB(mv,work1(1))
        e_Jii_Jjj  (3) = e_Jii_Jjj  (3)
     1                 + b_Jii1Jjj2 * dv * SSUM_MB(mv,work2(1))
      enddo

c     .................................................... J_q1,ij J_q1,ji term
c     .................................................... J_q1,ij J_q2,ji term
      e_Jij_Jji  (:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fJxx(:,it) * fJxx(:,it)
     1             + fJxy(:,it) * fJyx(:,it)
     2             + fJxz(:,it) * fJzx(:,it)
     3             + fJyx(:,it) * fJxy(:,it)
     4             + fJyy(:,it) * fJyy(:,it)
     5             + fJyz(:,it) * fJzy(:,it)
     6             + fJzx(:,it) * fJxz(:,it)
     7             + fJzy(:,it) * fJyz(:,it)
     8             + fJzz(:,it) * fJzz(:,it)
        work2(:) =   fJxx(:,it) * fJxx(:,itb)
     1             + fJxy(:,it) * fJyx(:,itb)
     2             + fJxz(:,it) * fJzx(:,itb)
     3             + fJyx(:,it) * fJxy(:,itb)
     4             + fJyy(:,it) * fJyy(:,itb)
     5             + fJyz(:,it) * fJzy(:,itb)
     6             + fJzx(:,it) * fJxz(:,itb)
     7             + fJzy(:,it) * fJyz(:,itb)
     8             + fJzz(:,it) * fJzz(:,itb)
        e_Jij_Jji (it) = b_Jij1Jji1 * dv * SSUM_MB(mv,work1(1))
        e_Jij_Jji  (3) = e_Jij_Jji  (3)
     1                 + b_Jij1Jji2 * dv * SSUM_MB(mv,work2(1))
      enddo

c     ...................................................... F_q1,j s_q1,j term
c     ...................................................... F_q1,j s_q2,j term
      e_Fj_sj  (:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fFx(:,it) * fsx(:,it)
     1             + fFy(:,it) * fsy(:,it)
     2             + fFz(:,it) * fsz(:,it)
        work2(:) =   fFx(:,it) * fsx(:,itb)
     1             + fFy(:,it) * fsy(:,itb)
     2             + fFz(:,it) * fsz(:,itb)
        e_Fj_sj (it) = b_Fj1sj1 * dv * SSUM_MB(mv,work1(1))
        e_Fj_sj  (3) = e_Fj_sj  (3)
     1               + b_Fj1sj2 * dv * SSUM_MB(mv,work2(1))
      enddo

c     .........................................................................
c     Here begins the calculation of the Ppairing part of the EDF             .
c     To use the same notation used in esperance and noname, some explanations.
c     We have to type dof term (using A, B, C, D as functional coefficients,  .
c                               and P1, P2, P3 as general notation for local  .
c                               densities)                                    .
c                                                                             .
c     1)    A * P1- P2~ P3  +  B * P1~ P2- P3                                 .
c     2)   iC * P1- P2~ P3  + iD * P1~ P2- P3                                 .
c                                                                             .
c     In esperance P1- and P1~ are distinct densities (left and right)        .
c     In cr8 P1- is the complex conjugate of P1~, i.e. P1- = P1~*             .
c     such that, defining P1R and P1I as the real and imaginary part of P1~   .
c                                                                             .
c     1) =   A * (P1R - i P1I) * (P2R + i P2I) * P3                           .
c           +B * (P1R + i P1I) * (P2R - i P2I) * P3                           .
c        =    (A+B) * (P1R P2R + P1I P2I) * P3                                .
c           +i(A-B) * (P1R P2I - P1I P2R) * P3                                .
c                                                                             .
c     2) =  iC * (P1R - i P1I) * (P2R + i P2I) * P3                           .
c          +iD * (P1R + i P1I) * (P2R - i P2I) * P3                           .
c        =   i(C+D) * (P1R P2R + P1I P2I) * P3                                .
c           + (C-D) * (P1I P2R - P1R P2I) * P3                                .
c                                                                             .
c     The functional is real, and thus respect the relation A=B and C=-D      .
c     However, as left and right pair pair densities are to be distinguished  .
c     in esperance, A, B, C and D have also been distinguished and are        .
c     labelled with either a letter "g" or "d" (for gauche=left and           .
c     droite=right in french). This notation is kept here and we will compute .
c     the two types of terms from                                             .
c                                                                             .
c     1)      (A+B) * (P1R P2R + P1I P2I) * P3                                .
c     2)      (C-D) * (P1I P2R - P1R P2I) * P3                                .
c                                                                             .
c     Knowing that the imaginary parts of the two types of terms              .
c                                                                             .
c     1)     i(A-B) * (P1R P2I - P1I P2R) * P3                                .
c     2)     i(C+D) * (P1R P2R + P1I P2I) * P3                                .
c                                                                             .
c     is zero a priori and will then not be compute.                          .
c     .........................................................................

c     ............................................ rho~*_q1 rho~_q1        term
c     ............................................ rho~*_q1 rho~_q1 rho_q2 term
c     ............................................ rho~*_q1 rho~_q1 tau_q1 term
c     ............................................ rho~*_q1 rho~_q1 tau_q2 term
      e_rp_rp   (:) = 0.0d0
      e_rp_rp_r (:) = 0.0d0
      e_t_rp_rp (:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   frhotr(:,it) * frhotr(:,it)
     1             + frhoti(:,it) * frhoti(:,it)
        e_rp_rp   (it) = b_rg1rd1   * dv * SSUM_MB(mv,work1(1))
        e_rp_rp_r  (3) = e_rp_rp_r (3)
     1                 + b_rg1rd1r2
     2                 * dv * SDOT_MB(mv,work1(1),frho(1,itb))
        e_t_rp_rp (it) = b_t1rg1rd1
     1                 * dv * SDOT_MB(mv,work1(1),ftau(1,it))
        e_t_rp_rp  (3) = e_t_rp_rp (3)
     1                 + b_t2rg1rd1
     2                 * dv * SDOT_MB(mv,work1(1),ftau(1,itb))
      enddo

c     ............................................ tau~*_q1 rho~_q1        term
c     ............................................ rho~*_q1 tau~_q1        term
c     ............................................ tau~*_q1 rho~_q1 rho_q2 term
c     ............................................ rho~*_q1 tau~_q1 rho_q2 term
      e_tp_rp  (:) = 0.0d0
      e_tp_rp_r(:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   ftautr(:,it) * frhotr(:,it)
     1             + ftauti(:,it) * frhoti(:,it)
        e_tp_rp  (it) = (b_tg1rd1   + b_td1rg1  )
     1                            * dv * SSUM_MB(mv,work1(1))
        e_tp_rp_r (3) = e_tp_rp_r(3)
     1                + (b_tg1rd1r2 + b_td1rg1r2)
     2                * dv * SDOT_MB(mv,work1(1),frho(1,itb))
      enddo

c     ........................ (nabla_i rho~*_q1) (nabla_i rho~_q1)        term
c     ........................ (nabla_i rho~*_q1) (nabla_i rho~_q1) rho_q1 term
c     ........................ (nabla_i rho~*_q1) (nabla_i rho~_q1) rho_q2 term
c     For the two body term (and only for the two-body) one can replace
c       (nabla_i rho~*) (nabla_i rho~) = - rho~* (lap. rho~)
      e_nirp_nirp  (:) = 0.0d0
      e_nirp_nirp_r(:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fnrtxr(:,it) * fnrtxr(:,it)
     1             + fnrtxi(:,it) * fnrtxi(:,it)
     2             + fnrtyr(:,it) * fnrtyr(:,it)
     3             + fnrtyi(:,it) * fnrtyi(:,it)
     4             + fnrtzr(:,it) * fnrtzr(:,it)
     5             + fnrtzi(:,it) * fnrtzi(:,it)
        work2(:) = - frhotr(:,it) * flrhotr(:,it)
     1             - frhoti(:,it) * flrhoti(:,it)
c        e_nirp_nirp   (it) = b_nirg1nird1   * dv * SSUM_MB(mv,work1(1))
        e_nirp_nirp   (it) = b_nirg1nird1   * dv * SSUM_MB(mv,work2(1))
        e_nirp_nirp_r (it) =
     1             + b_nirg1nird1r1
     2             * dv * SDOT_MB(mv,work1(1),frho(1,it))
        e_nirp_nirp_r  (3) = e_nirp_nirp_r (3)
     1             + b_nirg1nird1r2
     2             * dv * SDOT_MB(mv,work1(1),frho(1,itb))
      enddo

c     ........................ (nabla_i rho~*_q1) rho~_q1 (nabla_i rho_q1) term
c     ........................ (nabla_i rho~*_q1) rho~_q1 (nabla_i rho_q2) term
c     ........................ rho~*_q1 (nabla_i rho~_q1) (nabla_i rho_q1) term
c     ........................ rho~*_q1 (nabla_i rho~_q1) (nabla_i rho_q2) term
      e_nirp_rp_nir (:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work_xr(:) =   fnrtxr(:,it) * frhotr(:,it)
     1               + fnrtxi(:,it) * frhoti(:,it)
        work_yr(:) =   fnrtyr(:,it) * frhotr(:,it)
     1               + fnrtyi(:,it) * frhoti(:,it)
        work_zr(:) =   fnrtzr(:,it) * frhotr(:,it)
     1               + fnrtzi(:,it) * frhoti(:,it)
        work1(:) =   work_xr(:) * fnrx(:,it)
     1             + work_yr(:) * fnry(:,it)
     2             + work_zr(:) * fnrz(:,it)
        work2(:) =   work_xr(:) * fnrx(:,itb)
     1             + work_yr(:) * fnry(:,itb)
     2             + work_zr(:) * fnrz(:,itb)
        e_nirp_rp_nir (it) = (b_nirg1nir1rd1 + b_nird1nir1rg1)
     1                                       * dv * SSUM_MB(mv,work1(1))
        e_nirp_rp_nir  (3) = e_nirp_rp_nir (3)
     1                     + (b_nirg1nir2rd1 + b_nird1nir2rg1)
     2                                       * dv * SSUM_MB(mv,work2(1))
      enddo

c     .......................................... J~*_q1,ij J~_q1,ij        term
c     .......................................... J~*_q1,ij J~_q1,ij rho_q1 term
c     .......................................... J~*_q1,ij J~_q1,ij rho_q2 term
      e_Jpij_Jpij  (:) = 0.0d0
      e_Jpij_Jpij_r(:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fJtxxr(:,it) * fJtxxr(:,it)
     1             + fJtxxi(:,it) * fJtxxi(:,it)
     2             + fJtxyr(:,it) * fJtxyr(:,it)
     3             + fJtxyi(:,it) * fJtxyi(:,it)
     4             + fJtxzr(:,it) * fJtxzr(:,it)
     5             + fJtxzi(:,it) * fJtxzi(:,it)
     6             + fJtyxr(:,it) * fJtyxr(:,it)
     7             + fJtyxi(:,it) * fJtyxi(:,it)
     8             + fJtyyr(:,it) * fJtyyr(:,it)
     9             + fJtyyi(:,it) * fJtyyi(:,it)
     8             + fJtyzr(:,it) * fJtyzr(:,it)
     7             + fJtyzi(:,it) * fJtyzi(:,it)
     6             + fJtzxr(:,it) * fJtzxr(:,it)
     5             + fJtzxi(:,it) * fJtzxi(:,it)
     4             + fJtzyr(:,it) * fJtzyr(:,it)
     3             + fJtzyi(:,it) * fJtzyi(:,it)
     2             + fJtzzr(:,it) * fJtzzr(:,it)
     1             + fJtzzi(:,it) * fJtzzi(:,it)
        e_Jpij_Jpij   (it) = b_Jgij1Jdij1   * dv * SSUM_MB(mv,work1(1))
        e_Jpij_Jpij_r (it) =
     1             + b_Jgij1Jdij1r1
     2             * dv * SDOT_MB(mv,work1(1),frho(1,it))
        e_Jpij_Jpij_r  (3) = e_Jpij_Jpij_r (3)
     1             + b_Jgij1Jdij1r2
     2             * dv * SDOT_MB(mv,work1(1),frho(1,itb))
      enddo

c     .......................................... J~*_q1,ij rho~_q1 J_q1,ij term
c     .......................................... J~*_q1,ij rho~_q1 J_q2,ij term
c     .......................................... rho~*_q1 J~_q1,ij J_q1,ij term
c     .......................................... rho~*_q1 J~_q1,ij J_q2,ij term
      e_Jpij_rp_Jij(:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fJtxxr(:,it) * fJxx(:,it)
     1             + fJtxyr(:,it) * fJxy(:,it)
     2             + fJtxzr(:,it) * fJxz(:,it)
     3             + fJtyxr(:,it) * fJyx(:,it)
     4             + fJtyyr(:,it) * fJyy(:,it)
     5             + fJtyzr(:,it) * fJyz(:,it)
     6             + fJtzxr(:,it) * fJzx(:,it)
     7             + fJtzyr(:,it) * fJzy(:,it)
     8             + fJtzzr(:,it) * fJzz(:,it)
        work2(:) = - fJtxxi(:,it) * fJxx(:,it)
     1             - fJtxyi(:,it) * fJxy(:,it)
     2             - fJtxzi(:,it) * fJxz(:,it)
     3             - fJtyxi(:,it) * fJyx(:,it)
     4             - fJtyyi(:,it) * fJyy(:,it)
     5             - fJtyzi(:,it) * fJyz(:,it)
     6             - fJtzxi(:,it) * fJzx(:,it)
     7             - fJtzyi(:,it) * fJzy(:,it)
     8             - fJtzzi(:,it) * fJzz(:,it)
        work3(:) =   fJtxxr(:,it) * fJxx(:,itb)
     1             + fJtxyr(:,it) * fJxy(:,itb)
     2             + fJtxzr(:,it) * fJxz(:,itb)
     3             + fJtyxr(:,it) * fJyx(:,itb)
     4             + fJtyyr(:,it) * fJyy(:,itb)
     5             + fJtyzr(:,it) * fJyz(:,itb)
     6             + fJtzxr(:,it) * fJzx(:,itb)
     7             + fJtzyr(:,it) * fJzy(:,itb)
     8             + fJtzzr(:,it) * fJzz(:,itb)
        work4(:) = - fJtxxi(:,it) * fJxx(:,itb)
     1             - fJtxyi(:,it) * fJxy(:,itb)
     2             - fJtxzi(:,it) * fJxz(:,itb)
     3             - fJtyxi(:,it) * fJyx(:,itb)
     4             - fJtyyi(:,it) * fJyy(:,itb)
     5             - fJtyzi(:,it) * fJyz(:,itb)
     6             - fJtzxi(:,it) * fJzx(:,itb)
     7             - fJtzyi(:,it) * fJzy(:,itb)
     8             - fJtzzi(:,it) * fJzz(:,itb)
        e_Jpij_rp_Jij (it) = (b_Jgij1Jij1rd1 + b_Jdij1Jij1rg1)
     1                      * dv * (SDOT_MB(mv,work1(1),frhotr(1,it))
     2                             -SDOT_MB(mv,work2(1),frhoti(1,it)))
        e_Jpij_rp_Jij  (3) = e_Jpij_rp_Jij  (3)
     1                     + (b_Jgij1Jij2rd1 + b_Jdij1Jij2rg1)
     2                      * dv * (SDOT_MB(mv,work3(1),frhotr(1,it))
     3                             -SDOT_MB(mv,work4(1),frhoti(1,it)))
      enddo

c     ................................ i (nabla_i rho~*_q1) rho~_q1 j_q1,i term
c     ................................ i (nabla_i rho~*_q1) rho~_q1 j_q2,i term
c     ................................ i rho~*_q1 (nabla_i rho~_q1) j_q1,i term
c     ................................ i rho~*_q1 (nabla_i rho~_q1) j_q2,i term
      e_nirp_rp_ji(:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work_xi(:) =   fnrtxr(:,it) * frhoti(:,it)
     1               - fnrtxi(:,it) * frhotr(:,it)
        work_yi(:) =   fnrtyr(:,it) * frhoti(:,it)
     1               - fnrtyi(:,it) * frhotr(:,it)
        work_zi(:) =   fnrtzr(:,it) * frhoti(:,it)
     1               - fnrtzi(:,it) * frhotr(:,it)
        work1(:) =   work_xi(:) * fjx(:,it)
     1             + work_yi(:) * fjy(:,it)
     2             + work_zi(:) * fjz(:,it)
        work2(:) =   work_xi(:) * fjx(:,itb)
     1             + work_yi(:) * fjy(:,itb)
     2             + work_zi(:) * fjz(:,itb)
        e_nirp_rp_ji (it) = (- b_nirg1ji1rd1 + b_nird1ji1rg1)
     1                                  * dv * SSUM_MB(mv,work1(1))
        e_nirp_rp_ji  (3) = e_nirp_rp_ji (3)
     1                    + (- b_nirg1ji2rd1 + b_nird1ji2rg1)
     2                                  * dv * SSUM_MB(mv,work2(1))
      enddo

c     ............................... i (nabla_i rho~*_q1) J~_q1,ij s_q1,j term
c     ............................... i (nabla_i rho~*_q1) J~_q1,ij s_q2,j term
c     ............................... i J~*_q1,ij (nabla_i rho~_q1) s_q1,j term
c     ............................... i J~*_q1,ij (nabla_i rho~_q1) s_q2,j term
      e_nirp_Jpij_sj(:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work_xi(:) =   fnrtxr(:,it) * fJtxxi(:,it)
     1               - fnrtxi(:,it) * fJtxxr(:,it)
     2               + fnrtyr(:,it) * fJtyxi(:,it)
     3               - fnrtyi(:,it) * fJtyxr(:,it)
     4               + fnrtzr(:,it) * fJtzxi(:,it)
     5               - fnrtzi(:,it) * fJtzxr(:,it)
        work_yi(:) =   fnrtxr(:,it) * fJtxyi(:,it)
     1               - fnrtxi(:,it) * fJtxyr(:,it)
     2               + fnrtyr(:,it) * fJtyyi(:,it)
     3               - fnrtyi(:,it) * fJtyyr(:,it)
     4               + fnrtzr(:,it) * fJtzyi(:,it)
     5               - fnrtzi(:,it) * fJtzyr(:,it)
        work_zi(:) =   fnrtxr(:,it) * fJtxzi(:,it)
     1               - fnrtxi(:,it) * fJtxzr(:,it)
     2               + fnrtyr(:,it) * fJtyzi(:,it)
     3               - fnrtyi(:,it) * fJtyzr(:,it)
     4               + fnrtzr(:,it) * fJtzzi(:,it)
     5               - fnrtzi(:,it) * fJtzzr(:,it)
        work1(:)   =   work_xi(:) * fsx(:,it)
     1               + work_yi(:) * fsy(:,it)
     2               + work_zi(:) * fsz(:,it)
        work2(:)   =   work_xi(:) * fsx(:,itb)
     1               + work_yi(:) * fsy(:,itb)
     2               + work_zi(:) * fsz(:,itb)
        e_nirp_Jpij_sj (it) = (- b_nirg1Jdij1sj1 + b_nird1Jgij1sj1)
     1                                      * dv * SSUM_MB(mv,work1(1))
        e_nirp_Jpij_sj  (3) = e_nirp_Jpij_sj (3)
     1                      + (- b_nirg1Jdij1sj2 + b_nird1Jgij1sj2)
     2                                      * dv * SSUM_MB(mv,work2(1))
      enddo

c     ............................... i J~*_q1,ij rho~_q1 (nabla_i s_q1,j) term
c     ............................... i J~*_q1,ij rho~_q1 (nabla_i s_q2,j) term
c     ............................... i rho~*_q1 J~_q1,ij (nabla_i s_q1,j) term
c     ............................... i rho~*_q1 J~_q1,ij (nabla_i s_q2,j) term
      e_Jpij_rp_nisj (:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fJtxxr(:,it) * fnsxx(:,it)
     1             + fJtxyr(:,it) * fnsxy(:,it)
     2             + fJtxzr(:,it) * fnsxz(:,it)
     3             + fJtyxr(:,it) * fnsyx(:,it)
     4             + fJtyyr(:,it) * fnsyy(:,it)
     5             + fJtyzr(:,it) * fnsyz(:,it)
     6             + fJtzxr(:,it) * fnszx(:,it)
     7             + fJtzyr(:,it) * fnszy(:,it)
     8             + fJtzzr(:,it) * fnszz(:,it)
        work2(:) = - fJtxxi(:,it) * fnsxx(:,it)
     1             - fJtxyi(:,it) * fnsxy(:,it)
     2             - fJtxzi(:,it) * fnsxz(:,it)
     3             - fJtyxi(:,it) * fnsyx(:,it)
     4             - fJtyyi(:,it) * fnsyy(:,it)
     5             - fJtyzi(:,it) * fnsyz(:,it)
     6             - fJtzxi(:,it) * fnszx(:,it)
     7             - fJtzyi(:,it) * fnszy(:,it)
     8             - fJtzzi(:,it) * fnszz(:,it)
        work3(:) =   fJtxxr(:,it) * fnsxx(:,itb)
     1             + fJtxyr(:,it) * fnsxy(:,itb)
     2             + fJtxzr(:,it) * fnsxz(:,itb)
     3             + fJtyxr(:,it) * fnsyx(:,itb)
     4             + fJtyyr(:,it) * fnsyy(:,itb)
     5             + fJtyzr(:,it) * fnsyz(:,itb)
     6             + fJtzxr(:,it) * fnszx(:,itb)
     7             + fJtzyr(:,it) * fnszy(:,itb)
     8             + fJtzzr(:,it) * fnszz(:,itb)
        work4(:) = - fJtxxi(:,it) * fnsxx(:,itb)
     1             - fJtxyi(:,it) * fnsxy(:,itb)
     2             - fJtxzi(:,it) * fnsxz(:,itb)
     3             - fJtyxi(:,it) * fnsyx(:,itb)
     4             - fJtyyi(:,it) * fnsyy(:,itb)
     5             - fJtyzi(:,it) * fnsyz(:,itb)
     6             - fJtzxi(:,it) * fnszx(:,itb)
     7             - fJtzyi(:,it) * fnszy(:,itb)
     8             - fJtzzi(:,it) * fnszz(:,itb)
        e_Jpij_rp_nisj (it) = (- b_nisj1Jgij1rd1 + b_nisj1Jdij1rg1)
     1                       * dv * (SDOT_MB(mv,work1(1),frhoti(1,it))
     2                              +SDOT_MB(mv,work2(1),frhotr(1,it)))
        e_Jpij_rp_nisj  (3) = e_Jpij_rp_nisj (3)
     1                      + (- b_nisj2Jgij1rd1 + b_nisj2Jdij1rg1)
     2                       * dv * (SDOT_MB(mv,work3(1),frhoti(1,it))
     3                              +SDOT_MB(mv,work4(1),frhotr(1,it)))
      enddo

c     ................................ i J~*_q1,ia J~_q1,ib s_q1,c * e_abc term
c     ................................ i J~*_q1,ia J~_q1,ib s_q2,c * e_abc term
      e_Jpia_Jpib_sc(:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work_xi(:) = + fJtxyr(:,it) * fJtxzi(:,it)
     1               - fJtxyi(:,it) * fJtxzr(:,it)
     2               + fJtyyr(:,it) * fJtyzi(:,it)
     3               - fJtyyi(:,it) * fJtyzr(:,it)
     4               + fJtzyr(:,it) * fJtzzi(:,it)
     5               - fJtzyi(:,it) * fJtzzr(:,it)
     6               - fJtxzr(:,it) * fJtxyi(:,it)
     7               + fJtxzi(:,it) * fJtxyr(:,it)
     8               - fJtyzr(:,it) * fJtyyi(:,it)
     9               + fJtyzi(:,it) * fJtyyr(:,it)
     8               - fJtzzr(:,it) * fJtzyi(:,it)
     7               + fJtzzi(:,it) * fJtzyr(:,it)
        work_yi(:) = - fJtxxr(:,it) * fJtxzi(:,it)
     1               + fJtxxi(:,it) * fJtxzr(:,it)
     2               - fJtyxr(:,it) * fJtyzi(:,it)
     3               + fJtyxi(:,it) * fJtyzr(:,it)
     4               - fJtzxr(:,it) * fJtzzi(:,it)
     5               + fJtzxi(:,it) * fJtzzr(:,it)
     6               + fJtxzr(:,it) * fJtxxi(:,it)
     7               - fJtxzi(:,it) * fJtxxr(:,it)
     8               + fJtyzr(:,it) * fJtyxi(:,it)
     9               - fJtyzi(:,it) * fJtyxr(:,it)
     8               + fJtzzr(:,it) * fJtzxi(:,it)
     7               - fJtzzi(:,it) * fJtzxr(:,it)
        work_zi(:) = + fJtxxr(:,it) * fJtxyi(:,it)
     1               - fJtxxi(:,it) * fJtxyr(:,it)
     2               + fJtyxr(:,it) * fJtyyi(:,it)
     3               - fJtyxi(:,it) * fJtyyr(:,it)
     4               + fJtzxr(:,it) * fJtzyi(:,it)
     5               - fJtzxi(:,it) * fJtzyr(:,it)
     6               - fJtxyr(:,it) * fJtxxi(:,it)
     7               + fJtxyi(:,it) * fJtxxr(:,it)
     8               - fJtyyr(:,it) * fJtyxi(:,it)
     9               + fJtyyi(:,it) * fJtyxr(:,it)
     8               - fJtzyr(:,it) * fJtzxi(:,it)
     7               + fJtzyi(:,it) * fJtzxr(:,it)
        work1(:)   =   work_xi(:) * fsx(:,it)
     1               + work_yi(:) * fsy(:,it)
     2               + work_zi(:) * fsz(:,it)
        work2(:)   =   work_xi(:) * fsx(:,itb)
     1               + work_yi(:) * fsy(:,itb)
     2               + work_zi(:) * fsz(:,itb)
        e_Jpia_Jpib_sc (it) = - b_Jgia1Jdib1sc1
     1                      * dv * SSUM_MB(mv,work1(1))
        e_Jpia_Jpib_sc  (3) = e_Jpia_Jpib_sc (3)
     1                        - b_Jgia1Jdib1sc2
     2                      * dv * SSUM_MB(mv,work2(1))
      enddo

c     ................................................. J~*_q1,ii J~_q1,jj term
      e_Jpii_Jpjj  (:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fJtxxr(:,it) * fJtxxr(:,it)
     1             + fJtxxi(:,it) * fJtxxi(:,it)
     2             + fJtxxr(:,it) * fJtyyr(:,it)
     3             + fJtxxi(:,it) * fJtyyi(:,it)
     4             + fJtxxr(:,it) * fJtzzr(:,it)
     5             + fJtxxi(:,it) * fJtzzi(:,it)
     6             + fJtyyr(:,it) * fJtxxr(:,it)
     7             + fJtyyi(:,it) * fJtxxi(:,it)
     8             + fJtyyr(:,it) * fJtyyr(:,it)
     9             + fJtyyi(:,it) * fJtyyi(:,it)
     8             + fJtyyr(:,it) * fJtzzr(:,it)
     7             + fJtyyi(:,it) * fJtzzi(:,it)
     6             + fJtzzr(:,it) * fJtxxr(:,it)
     5             + fJtzzi(:,it) * fJtxxi(:,it)
     4             + fJtzzr(:,it) * fJtyyr(:,it)
     3             + fJtzzi(:,it) * fJtyyi(:,it)
     2             + fJtzzr(:,it) * fJtzzr(:,it)
     1             + fJtzzi(:,it) * fJtzzi(:,it)
        e_Jpii_Jpjj (it) = b_Jgii1Jdjj1 * dv * SSUM_MB(mv,work1(1))
      enddo

c     ................................................. J~*_q1,ij J~_q1,ji term
      e_Jpij_Jpji  (:) = 0.0d0
      do it=1,2
        itb = 3 - it
        work1(:) =   fJtxxr(:,it) * fJtxxr(:,it)
     1             + fJtxxi(:,it) * fJtxxi(:,it)
     2             + fJtxyr(:,it) * fJtyxr(:,it)
     3             + fJtxyi(:,it) * fJtyxi(:,it)
     4             + fJtxzr(:,it) * fJtzxr(:,it)
     5             + fJtxzi(:,it) * fJtzxi(:,it)
     6             + fJtyxr(:,it) * fJtxyr(:,it)
     7             + fJtyxi(:,it) * fJtxyi(:,it)
     8             + fJtyyr(:,it) * fJtyyr(:,it)
     9             + fJtyyi(:,it) * fJtyyi(:,it)
     8             + fJtyzr(:,it) * fJtzyr(:,it)
     7             + fJtyzi(:,it) * fJtzyi(:,it)
     6             + fJtzxr(:,it) * fJtxzr(:,it)
     5             + fJtzxi(:,it) * fJtxzi(:,it)
     4             + fJtzyr(:,it) * fJtyzr(:,it)
     3             + fJtzyi(:,it) * fJtyzi(:,it)
     2             + fJtzzr(:,it) * fJtzzr(:,it)
     1             + fJtzzi(:,it) * fJtzzi(:,it)
        e_Jpij_Jpji (it) = b_Jgij1Jdji1 * dv * SSUM_MB(mv,work1(1))
      enddo

c     .................................. rho_q1 rho_q1 rho_q2 rho_q2       term
c     .................................. s_q1,j s_q1,j rho_q2 rho_q2       term
c     .................................. s_q1,i s_q1,i s_q2,j s_q2,j       term
c     .................................. rho~*_q1 rho~_q1 rho_q2 rho_q2    term
c     .................................. rho~*_q1 rho~_q1 s_q2,j s_q2,j    term
c     .................................. rho~*_q1 rho~_q1 rho~*_q2 rho~_q2 term
      e_r_r_r_r     (:) = 0.0d0
      e_sj_sj_r_r   (:) = 0.0d0
      e_si_si_sj_sj (:) = 0.0d0
      e_rp_rp_r_r   (:) = 0.0d0
      e_rp_rp_sj_sj (:) = 0.0d0
      e_rp_rp_rp_rp (:) = 0.0d0
      prho2       (:,:) = 0.0d0
      ps2         (:,:) = 0.0d0
      prhogd      (:,:) = 0.0d0
      do it=1,2
        itb = 3 - it
        prho2 (:,it) = prho2 (:,it) + frho  (:,it) * frho  (:,it)
        ps2   (:,it) = ps2   (:,it) + fsx   (:,it) * fsx   (:,it)
     1                              + fsy   (:,it) * fsy   (:,it)
     2                              + fsz   (:,it) * fsz   (:,it)
        prhogd(:,it) = prhogd(:,it) + frhotr(:,it) * frhotr(:,it)
     1                              + frhoti(:,it) * frhoti(:,it)
      enddo
      e_r_r_r_r    (3) = b_r1r1r2r2     * dv * 2.0d0 *
     1                            SDOT_MB(mv, prho2 (1,1), prho2 (1,2))
      e_sj_sj_r_r  (3) = b_sj1sj1r2r2   * dv *
     1                           (SDOT_MB(mv, ps2   (1,1), prho2 (1,2))
     2                           +SDOT_MB(mv, ps2   (1,2), prho2 (1,1)))
      e_si_si_sj_sj(3) = b_si1si1sj2sj2 * dv * 2.0d0 *
     1                            SDOT_MB(mv, ps2   (1,1), ps2   (1,2))

      e_rp_rp_r_r  (3) = b_rg1rd1r2r2   * dv *
     1                           (SDOT_MB(mv, prhogd(1,1), prho2 (1,2))
     2                           +SDOT_MB(mv, prhogd(1,2), prho2 (1,1)))
      e_rp_rp_sj_sj(3) = b_rg1rd1sj2sj2 * dv *
     1                           (SDOT_MB(mv, prhogd(1,1), ps2   (1,2))
     2                           +SDOT_MB(mv, prhogd(1,2), ps2   (1,1)))
      e_rp_rp_rp_rp(3) = b_rg1rd1rg2rd2 * dv * 2.0d0 *
     1                            SDOT_MB(mv, prhogd(1,1), prhogd(1,2))


c     .........................................................................
c     .                            SUMS ENERGIES                              .
c     .........................................................................

      e_kin         (3) = e_kin         (1) + e_kin         (2)
      e_cm        (1,3) = e_cm        (1,1) + e_cm        (1,2)
      e_cm        (2,3) = e_cm        (2,1) + e_cm        (2,2)
      e_ln          (3) = e_ln          (1) + e_ln          (2)
      e_r_r         (4) = e_r_r         (1) + e_r_r         (2)
     1                                      + e_r_r         (3)
      e_t_r         (4) = e_t_r         (1) + e_t_r         (2)
     1                                      + e_t_r         (3)
      e_sj_sj       (4) = e_sj_sj       (1) + e_sj_sj       (2)
     1                                      + e_sj_sj       (3)
      e_Tj_sj       (4) = e_Tj_sj       (1) + e_Tj_sj       (2)
     1                                      + e_Tj_sj       (3)
      e_nir_nir     (4) = e_nir_nir     (1) + e_nir_nir     (2)
     1                                      + e_nir_nir     (3)
      e_nisj_nisj   (4) = e_nisj_nisj   (1) + e_nisj_nisj   (2)
     1                                      + e_nisj_nisj   (3)
      e_ji_ji       (4) = e_ji_ji       (1) + e_ji_ji       (2)
     1                                      + e_ji_ji       (3)
      e_Jij_Jij     (4) = e_Jij_Jij     (1) + e_Jij_Jij     (2)
     1                                      + e_Jij_Jij     (3)
      e_r_naJbc     (4) = e_r_naJbc     (1) + e_r_naJbc     (2)
     1                                      + e_r_naJbc     (3)
      e_ja_nbsc     (4) = e_ja_nbsc     (1) + e_ja_nbsc     (2)
     1                                      + e_ja_nbsc     (3)
      e_nisi_njsj   (4) = e_nisi_njsj   (1) + e_nisi_njsj   (2)
     1                                      + e_nisi_njsj   (3)
      e_Jii_Jjj     (4) = e_Jii_Jjj     (1) + e_Jii_Jjj     (2)
     1                                      + e_Jii_Jjj     (3)
      e_Jij_Jji     (4) = e_Jij_Jji     (1) + e_Jij_Jji     (2)
     1                                      + e_Jij_Jji     (3)
      e_Fj_sj       (4) = e_Fj_sj       (1) + e_Fj_sj       (2)
     1                                      + e_Fj_sj       (3)
      e_rp_rp       (4) = e_rp_rp       (1) + e_rp_rp       (2)
     1                                      + e_rp_rp       (3)
      e_tp_rp       (4) = e_tp_rp       (1) + e_tp_rp       (2)
     1                                      + e_tp_rp       (3)
      e_nirp_nirp   (4) = e_nirp_nirp   (1) + e_nirp_nirp   (2)
     1                                      + e_nirp_nirp   (3)
      e_Jpij_Jpij   (4) = e_Jpij_Jpij   (1) + e_Jpij_Jpij   (2)
     1                                      + e_Jpij_Jpij   (3)
      e_Jpii_Jpjj   (4) = e_Jpii_Jpjj   (1) + e_Jpii_Jpjj   (2)
     1                                      + e_Jpii_Jpjj   (3)
      e_Jpij_Jpji   (4) = e_Jpij_Jpji   (1) + e_Jpij_Jpji   (2)
     1                                      + e_Jpij_Jpji   (3)
      e_r_r_r       (4) = e_r_r_r       (1) + e_r_r_r       (2)
     1                                      + e_r_r_r       (3)
      e_t_r_r       (4) = e_t_r_r       (1) + e_t_r_r       (2)
     1                                      + e_t_r_r       (3)
      e_sj_sj_r     (4) = e_sj_sj_r     (1) + e_sj_sj_r     (2)
     1                                      + e_sj_sj_r     (3)
      e_t_sj_sj     (4) = e_t_sj_sj     (1) + e_t_sj_sj     (2)
     1                                      + e_t_sj_sj     (3)
      e_Tj_sj_r     (4) = e_Tj_sj_r     (1) + e_Tj_sj_r     (2)
     1                                      + e_Tj_sj_r     (3)
      e_nir_nir_r   (4) = e_nir_nir_r   (1) + e_nir_nir_r   (2)
     1                                      + e_nir_nir_r   (3)
      e_nisj_nisj_r (4) = e_nisj_nisj_r (1) + e_nisj_nisj_r (2)
     1                                      + e_nisj_nisj_r (3)
      e_nir_nisj_sj (4) = e_nir_nisj_sj (1) + e_nir_nisj_sj (2)
     1                                      + e_nir_nisj_sj (3)
      e_ji_ji_r     (4) = e_ji_ji_r     (1) + e_ji_ji_r     (2)
     1                                      + e_ji_ji_r     (3)
      e_Jij_Jij_r   (4) = e_Jij_Jij_r   (1) + e_Jij_Jij_r   (2)
     1                                      + e_Jij_Jij_r   (3)
      e_ji_Jij_sj   (4) = e_ji_Jij_sj   (1) + e_ji_Jij_sj   (2)
     1                                      + e_ji_Jij_sj   (3)
      e_nisa_Jib_sc (4) = e_nisa_Jib_sc (1) + e_nisa_Jib_sc (2)
     1                                      + e_nisa_Jib_sc (3)
      e_rp_rp_r     (4) = e_rp_rp_r     (1) + e_rp_rp_r     (2)
     1                                      + e_rp_rp_r     (3)
      e_t_rp_rp     (4) = e_t_rp_rp     (1) + e_t_rp_rp     (2)
     1                                      + e_t_rp_rp     (3)
      e_tp_rp_r     (4) = e_tp_rp_r     (1) + e_tp_rp_r     (2)
     1                                      + e_tp_rp_r     (3)
      e_nirp_nirp_r (4) = e_nirp_nirp_r (1) + e_nirp_nirp_r (2)
     1                                      + e_nirp_nirp_r (3)
      e_nirp_rp_nir (4) = e_nirp_rp_nir (1) + e_nirp_rp_nir (2)
     1                                      + e_nirp_rp_nir (3)
      e_Jpij_Jpij_r (4) = e_Jpij_Jpij_r (1) + e_Jpij_Jpij_r (2)
     1                                      + e_Jpij_Jpij_r (3)
      e_Jpij_rp_Jij (4) = e_Jpij_rp_Jij (1) + e_Jpij_rp_Jij (2)
     1                                      + e_Jpij_rp_Jij (3)
      e_nirp_rp_ji  (4) = e_nirp_rp_ji  (1) + e_nirp_rp_ji  (2)
     1                                      + e_nirp_rp_ji  (3)
      e_nirp_Jpij_sj(4) = e_nirp_Jpij_sj(1) + e_nirp_Jpij_sj(2)
     1                                      + e_nirp_Jpij_sj(3)
      e_Jpij_rp_nisj(4) = e_Jpij_rp_nisj(1) + e_Jpij_rp_nisj(2)
     1                                      + e_Jpij_rp_nisj(3)
      e_Jpia_Jpib_sc(4) = e_Jpia_Jpib_sc(1) + e_Jpia_Jpib_sc(2)
     1                                      + e_Jpia_Jpib_sc(3)
      e_r_r_r_r     (4) = e_r_r_r_r     (1) + e_r_r_r_r     (2)
     1                                      + e_r_r_r_r     (3)
      e_sj_sj_r_r   (4) = e_sj_sj_r_r   (1) + e_sj_sj_r_r   (2)
     1                                      + e_sj_sj_r_r   (3)
      e_si_si_sj_sj (4) = e_si_si_sj_sj (1) + e_si_si_sj_sj (2)
     1                                      + e_si_si_sj_sj (3)
      e_rp_rp_r_r   (4) = e_rp_rp_r_r   (1) + e_rp_rp_r_r   (2)
     1                                      + e_rp_rp_r_r   (3)
      e_rp_rp_sj_sj (4) = e_rp_rp_sj_sj (1) + e_rp_rp_sj_sj (2)
     1                                      + e_rp_rp_sj_sj (3)
      e_rp_rp_rp_rp (4) = e_rp_rp_rp_rp (1) + e_rp_rp_rp_rp (2)
     1                                      + e_rp_rp_rp_rp (3)




c     .........................................................................
c     .                            TOTAL ENERGIES                             .
c     .........................................................................

c     .........................................................................
c     .                            2-body energy                              .
c     .................................................... 2-body normal energy
      e_2body_rr  (:) =   e_r_r         (:) + e_t_r         (:)
     1                  + e_sj_sj       (:) + e_Tj_sj       (:)
     2                  + e_nir_nir     (:) + e_nisj_nisj   (:)
     3                  + e_ji_ji       (:) + e_Jij_Jij     (:)
     4                  + e_r_naJbc     (:) + e_ja_nbsc     (:)
     5                  + e_nisi_njsj   (:) + e_Jii_Jjj     (:)
     6                  + e_Jij_Jji     (:) + e_Fj_sj       (:)
c     ................................................... 2-body pairing energy
      e_2body_kk  (:) =   e_rp_rp       (:) + e_tp_rp       (:)
     1                  + e_nirp_nirp   (:) + e_Jpij_Jpij   (:)
     2                  + e_Jpii_Jpjj   (:) + e_Jpij_Jpji   (:)
c     ..................................................... 2-body total energy
      e_2body     (:) =   e_2body_rr    (:) + e_2body_kk    (:)


c     .........................................................................
c     .                            3-body energy                              .
c     .................................................... 3-body normal energy
      e_3body_rrr (:) =   e_r_r_r       (:) + e_t_r_r       (:)
     1                  + e_sj_sj_r     (:) + e_t_sj_sj     (:)
     2                  + e_Tj_sj_r     (:) + e_nir_nir_r   (:)
     3                  + e_nisj_nisj_r (:) + e_nir_nisj_sj (:)
     4                  + e_ji_ji_r     (:) + e_Jij_Jij_r   (:)
     5                  + e_ji_Jij_sj   (:) + e_nisa_Jib_sc (:)
c     ................................................... 3-body pairing energy
      e_3body_kkr (:) =   e_rp_rp_r     (:) + e_t_rp_rp     (:)
     1                  + e_tp_rp_r     (:) + e_nirp_nirp_r (:)
     2                  + e_nirp_rp_nir (:) + e_Jpij_Jpij_r (:)
     3                  + e_Jpij_rp_Jij (:) + e_nirp_rp_ji  (:)
     4                  + e_nirp_Jpij_sj(:) + e_Jpij_rp_nisj(:)
     5                  + e_Jpia_Jpib_sc(:)
c     ..................................................... 3-body total energy
      e_3body     (:) =   e_3body_rrr   (:) + e_3body_kkr   (:)


c     .........................................................................
c     .                            4-body energy                              .
c     .................................................... 4-body normal energy
      e_4body_rrrr(:) =   e_r_r_r_r     (:) + e_sj_sj_r_r   (:)
     1                  + e_si_si_sj_sj (:)
c     ................................................... 4-body pairing energy
      e_4body_kkrr(:) =   e_rp_rp_r_r   (:) + e_rp_rp_sj_sj (:)
      e_4body_kkkk(:) =   e_rp_rp_rp_rp (:)
c     ..................................................... 4-body total energy
      e_4body     (:) =   e_4body_rrrr  (:) + e_4body_kkrr  (:)
     1                                      + e_4body_kkkk  (:)


c     .........................................................................
c     .                            Skyrme energy                              .
c     ........................................................... Normal energy
      e_norm      (:) =   e_2body_rr    (:) + e_3body_rrr   (:)
     1                  + e_4body_rrrr  (:)
c     .......................................................... Pairing energy
      e_pair      (:) =   e_2body_kk    (:) + e_3body_kkr   (:)
     1                  + e_4body_kkrr  (:) + e_4body_kkkk  (:)
c     .......................................................... Skyrme energy
      e_sky       (:) =   e_norm        (:) + e_pair        (:)

c     ............................................................ total energy
      e_tot =  e_kin (3)
     1       + e_cm  (1,3)
     2       + e_cm  (2,3)
     2       + e_ln    (3)
     3       + e_could     + e_coulx     + e_coulp
     4       + e_sky (4)
      etot  =  e_tot

      end subroutine edfcalc_f
c______________________________________________________________________________
      subroutine vcal_f

c..............................................................................
c     calculate mean fields                                                   .
c..............................................................................
c     unlike the mean-field codes, there is no attempt made to save storage   .
c     for "simple" potentials that are just proportional to one density.      .
c     Everything is stored in its own array to allow for diagnostic printing  .
c     of cuts through the potentials in the future                            .
c..............................................................................
c     Note that some of the potentials are not defined as in the BHF paper    .
c     The definitions here are strictly field = dE/ddensity for the 7 local   .
c     densities contained in the Skyrme functional                            .
c..............................................................................
      implicit real*8 (a-h,o-z)
C     include 'paramr8.h'
      character*4 afor

      common /coeff2/ b_r1r1, b_r1r2, b_sj1sj1, b_sj1sj2, b_t1r1,
     1                b_t1r2, b_Tj1sj1, b_Tj1sj2, b_nir1nir1,
     2                b_nir1nir2, b_nisj1nisj1, b_nisj1nisj2,
     3                b_ji1ji1, b_ji1ji2, b_Jij1Jij1, b_Jij1Jij2,
     4                b_r1naJbc1, b_r1naJbc2, b_ja1nbsc1, b_ja1nbsc2,
     5                b_Jii1Jjj1, b_Jii1Jjj2, b_Jij1Jji1, b_Jij1Jji2,
     6                b_nisi1njsj1, b_nisi1njsj2, b_Fj1sj1, b_Fj1sj2,
     7                b_rg1rd1, b_tg1rd1, b_td1rg1, b_nirg1nird1,
     8                b_Jgij1Jdij1, b_Jgii1Jdjj1, b_Jgij1Jdji1
      common /coeff3/ b_r1r1r2, b_sj1sj1r2, b_t1r1r1, b_t1r1r2,
     1                b_t1r2r2, b_Tj1sj1r2, b_Tj1sj2r1, b_t1sj1sj1,
     2                b_t1sj1sj2, b_t1sj2sj2, b_nir1nir1r1,
     3                b_nir1nir1r2, b_nir1nir2r1, b_nisj1nisj1r1,
     4                b_nisj1nisj1r2, b_nisj1nisj2r1, b_nir1nisj1sj1,
     5                b_nir1nisj1sj2, b_nir1nisj2sj1, b_nir1nisj2sj2,
     6                b_ji1ji1r1, b_ji1ji1r2, b_ji1ji2r1, b_Jij1Jij1r1,
     7                b_Jij1Jij1r2, b_Jij1Jij2r1, b_ji1Jij1sj1,
     8                b_ji1Jij1sj2, b_ji1Jij2sj1, b_ji1Jij2sj2,
     9                b_nisa1Jib1sc1, b_nisa1Jib1sc2, b_nisa1Jib2sc1,
     8                b_nisa1Jib2sc2, b_rg1rd1r2, b_t1rg1rd1,
     7                b_t2rg1rd1, b_tg1rd1r2, b_td1rg1r2,
     6                b_nirg1nird1r1, b_nirg1nird1r2, b_nirg1nir1rd1,
     5                b_nirg1nir2rd1, b_nird1nir1rg1, b_nird1nir2rg1,
     4                b_Jgij1Jdij1r1, b_Jgij1Jdij1r2, b_Jgij1Jij1rd1,
     3                b_Jgij1Jij2rd1, b_Jdij1Jij1rg1, b_Jdij1Jij2rg1,
     2                b_nirg1ji1rd1, b_nirg1ji2rd1, b_nird1ji1rg1,
     1                b_nird1ji2rg1, b_nirg1Jdij1sj1, b_nirg1Jdij1sj2,
     2                b_nird1Jgij1sj1, b_nird1Jgij1sj2, b_nisj1Jgij1rd1,
     3                b_nisj2Jgij1rd1, b_nisj1Jdij1rg1, b_nisj2Jdij1rg1,
     4                b_Jgia1Jdib1sc1, b_Jgia1Jdib1sc2
      common /coeff4/ b_r1r1r2r2, b_sj1sj1r2r2, b_si1si1sj2sj2,
     1                b_rg1rd1r2r2, b_rg1rd1sj2sj2, b_rg1rd1rg2rd2
      common /fopt  / nfunc,ngal,njmunu,ncm2,nmass,ndd,nforce,ncoex
      common /force / t0,x0,t1,x1,t2,x2,te,to,wso
     1               ,u0,u1,y1,u2,y21,y22,v0
     2               ,wsoq,t3a,x3a,yt3a,t3b,x3b,yt3b
     3               ,hbar,hbm(2),xm(3),afor
      common /pot  / wcd(mv),wce(mv),wt3a(mv),wt3b(mv)
      common /den  / frho(mv,2),fsx (mv,2),fsy (mv,2),fsz(mv,2)
      common /cur  / fjx (mv,2),fjy (mv,2),fjz (mv,2)
      common /taudj/ ftau(mv,2),fdJ (mv,2)
      common /wj2  / fJxx(mv,2),fJyx(mv,2),fJzx(mv,2)
     1              ,fJxy(mv,2),fJyy(mv,2),fJzy(mv,2)
     2              ,fJxz(mv,2),fJyz(mv,2),fJzz(mv,2)
      common /wtf  / fTx (mv,2),fTy (mv,2),fTz (mv,2)
     1              ,fFx (mv,2),fFy (mv,2),fFz (mv,2)
      common /locden/ flrho(mv,2),
     1                frosx(mv,2),frosy(mv,2),frosz(mv,2),
     2                flsx (mv,2),flsy (mv,2),flsz (mv,2),
     3                fns  (mv,2),
     4                fnrx (mv,2),fnry (mv,2),fnrz (mv,2),
     5                fnsxx(mv,2),fnsxy(mv,2),fnsxz(mv,2),
     6                fnsyx(mv,2),fnsyy(mv,2),fnsyz(mv,2),
     7                fnszx(mv,2),fnszy(mv,2),fnszz(mv,2),
     8                fnJx (mv,2),fnJy (mv,2),fnJz (mv,2),
     9                fnj  (mv,2),
     8                fnjxx(mv,2),fnjxy(mv,2),fnjxz(mv,2),
     7                fnjyx(mv,2),fnjyy(mv,2),fnjyz(mv,2),
     6                fnjzx(mv,2),fnjzy(mv,2),fnjzz(mv,2),
     5                fndsx(mv,2),fndsy(mv,2),fndsz(mv,2)
      common /denpr / frhotr (mv ,2),frhoti (mv ,2),
     1                ftautr (mv,2),ftauti (mv,2),
     2                flrhotr(mv,2),flrhoti(mv,2),
     3                fJtxxr (mv,2),fJtxyr (mv,2),fJtxzr (mv,2),
     4                fJtxxi (mv,2),fJtxyi (mv,2),fJtxzi (mv,2),
     5                fJtyxr (mv,2),fJtyyr (mv,2),fJtyzr (mv,2),
     6                fJtyxi (mv,2),fJtyyi (mv,2),fJtyzi (mv,2),
     7                fJtzxr (mv,2),fJtzyr (mv,2),fJtzzr (mv,2),
     8                fJtzxi (mv,2),fJtzyi (mv,2),fJtzzi (mv,2)
      common /denpr2/ fnrtxr(mv,2),fnrtyr(mv,2),fnrtzr(mv,2),
     1                fnrtxi(mv,2),fnrtyi(mv,2),fnrtzi(mv,2),
     2                fnJtxr(mv,2),fnJtyr(mv,2),fnJtzr(mv,2),
     3                fnJtxi(mv,2),fnJtyi(mv,2),fnJtzi(mv,2)
      common /pair  / npair,neq,lln,lhf,lsenior,ldelta,lgauss
      common /pot_f / potU   (mv,2),
     1                potB   (mv,2),
     2                potSx  (mv,2),potSy  (mv,2),potSz  (mv,2),
     3                potCx  (mv,2),potCy  (mv,2),potCz  (mv,2),
     4                potAx  (mv,2),potAy  (mv,2),potAz  (mv,2),
     5                potWxx (mv,2),potWxy (mv,2),potWxz (mv,2),
     6                potWyx (mv,2),potWyy (mv,2),potWyz (mv,2),
     7                potWzx (mv,2),potWzy (mv,2),potWzz (mv,2),
     8                potDx  (mv,2),potDy  (mv,2),potDz  (mv,2)
      common /ppot_f/ potUt  (mv,2,2),potBt  (mv,2,2),
     1                potWtxx(mv,2,2),potWtxy(mv,2,2),
     2                potWtxz(mv,2,2),
     3                potWtyx(mv,2,2),potWtyy(mv,2,2),
     4                potWtyz(mv,2,2),
     5                potWtzx(mv,2,2),potWtzy(mv,2,2),
     6                potWtzz(mv,2,2)
c..............................................................................
c     MB: there are a few combinations of densities that appear repeatedly and
c         that might be worth calculating once into temporary arrays
c     1) two-body
c         fJxx(:,it) + fJyy(:,it) + fJzz(:,it)        (is this not zero ???)
c
c     2) three-body
c          frho(:,it) * frho(:,it')
c
c          fnrx (:,it) * fnrx(:,it')
c        + fnry (:,it) * fnry(:,it')
c        + fnrz (:,it) * fnrz(:,it')
c
c..............................................................................
c      if (ndd.lt.0)    call stp (' capot : ndd < 0 !')
c      if (ndd.gt.1)    call stp (' capot : ndd > 1 !')
      if (njmunu.lt.0) call stp (' capot : njmunu < 0 !')
      if (njmunu.gt.2) call stp (' capot : njmunu > 2 !')

      potU   (:,:)   = 0.0d0
      potB   (:,:)   = 0.0d0
      potSx  (:,:)   = 0.0d0
      potSy  (:,:)   = 0.0d0
      potSz  (:,:)   = 0.0d0
      potCx  (:,:)   = 0.0d0
      potCy  (:,:)   = 0.0d0
      potCz  (:,:)   = 0.0d0
      potAx  (:,:)   = 0.0d0
      potAy  (:,:)   = 0.0d0
      potAz  (:,:)   = 0.0d0
      potWxx (:,:)   = 0.0d0
      potWxy (:,:)   = 0.0d0
      potWxz (:,:)   = 0.0d0
      potWyx (:,:)   = 0.0d0
      potWyy (:,:)   = 0.0d0
      potWyz (:,:)   = 0.0d0
      potWzx (:,:)   = 0.0d0
      potWzy (:,:)   = 0.0d0
      potWzz (:,:)   = 0.0d0
      potDx  (:,:)   = 0.0d0
      potDy  (:,:)   = 0.0d0
      potDz  (:,:)   = 0.0d0
      potUt  (:,:,:) = 0.0d0
      potBt  (:,:,:) = 0.0d0
      potWtxx(:,:,:) = 0.0d0
      potWtxy(:,:,:) = 0.0d0
      potWtxz(:,:,:) = 0.0d0
      potWtyx(:,:,:) = 0.0d0
      potWtyy(:,:,:) = 0.0d0
      potWtyz(:,:,:) = 0.0d0
      potWtzx(:,:,:) = 0.0d0
      potWtzy(:,:,:) = 0.0d0
      potWtzz(:,:,:) = 0.0d0

c     .........................................................................
c     ................................. 2 body ................................
c     .........................................................................

c     ......................................... Coulomb contribution to U field
      potU(:,2) = potU(:,2) + wcd(:) + wce(:)

c     .......................................... 2-body contribution to U field
      do it=1,2
        itb = 3-it
        potU(:,it) = potU(:,it)
     1                 + 2.0d0 * b_r1r1     * frho (:,it)
     2                 + 2.0d0 * b_r1r2     * frho (:,itb)
        potU(:,it) = potU(:,it)
     1                 +         b_t1r1     * ftau (:,it)
     2                 +         b_t1r2     * ftau (:,itb)
        potU(:,it) = potU(:,it)
     1                 - 2.0d0 * b_nir1nir1 * flrho(:,it)
     2                 - 2.0d0 * b_nir1nir2 * flrho(:,itb)

c       ................. for spin-orbit term one have rho (nabla_a J_bc) e_abc
c                            the contribution to U is thus (nabla_a J_bc) e_abc
        potU(:,it) = potU(:,it)
     1                 +         b_r1naJbc1 * fdJ  (:,it)
     2                 +         b_r1naJbc2 * fdJ  (:,itb)
      enddo

c     .......................................... 2-body contribution to S field
      do it=1,2
        itb = 3-it
        potSx(:,it) = potSx(:,it)
     1                  + 2.0d0 * b_sj1sj1     * fsx (:,it)
     2                  + 2.0d0 * b_sj1sj2     * fsx (:,itb)
        potSy(:,it) = potSy(:,it)
     1                  + 2.0d0 * b_sj1sj1     * fsy (:,it)
     2                  + 2.0d0 * b_sj1sj2     * fsy (:,itb)
        potSz(:,it) = potSz(:,it)
     1                  + 2.0d0 * b_sj1sj1     * fsz (:,it)
     2                  + 2.0d0 * b_sj1sj2     * fsz (:,itb)
        potSx(:,it) = potSx(:,it)
     1                  +         b_Tj1sj1     * fTx (:,it)
     2                  +         b_Tj1sj2     * fTx (:,itb)
        potSy(:,it) = potSy(:,it)
     1                  +         b_Tj1sj1     * fTy (:,it)
     2                  +         b_Tj1sj2     * fTy (:,itb)
        potSz(:,it) = potSz(:,it)
     1                  +         b_Tj1sj1     * fTz (:,it)
     2                  +         b_Tj1sj2     * fTz (:,itb)
        potSx(:,it) = potSx(:,it)
     1                  - 2.0d0 * b_nisj1nisj1 * flsx(:,it)
     2                  - 2.0d0 * b_nisj1nisj2 * flsx(:,itb)
        potSy(:,it) = potSy(:,it)
     1                  - 2.0d0 * b_nisj1nisj1 * flsy(:,it)
     2                  - 2.0d0 * b_nisj1nisj2 * flsy(:,itb)
        potSz(:,it) = potSz(:,it)
     1                  - 2.0d0 * b_nisj1nisj1 * flsz(:,it)
     2                  - 2.0d0 * b_nisj1nisj2 * flsz(:,itb)

c       ................. for spin-orbit term one has - (nabla_b j_a) s_c e_abc
c                         The contribution to S_i is thus - (nabla_b j_a) e_abi
        potSx(:,it) = potSx(:,it)
     1                  +         b_ja1nbsc1 * fnjyz(:,it)
     2                  -         b_ja1nbsc1 * fnjzy(:,it)
     3                  +         b_ja1nbsc2 * fnjyz(:,itb)
     4                  -         b_ja1nbsc2 * fnjzy(:,itb)
        potSy(:,it) = potSy(:,it)
     1                  -         b_ja1nbsc1 * fnjxz(:,it)
     2                  +         b_ja1nbsc1 * fnjzx(:,it)
     3                  -         b_ja1nbsc2 * fnjxz(:,itb)
     4                  +         b_ja1nbsc2 * fnjzx(:,itb)
        potSz(:,it) = potSz(:,it)
     1                  +         b_ja1nbsc1 * fnjxy(:,it)
     2                  -         b_ja1nbsc1 * fnjyx(:,it)
     3                  +         b_ja1nbsc2 * fnjxy(:,itb)
     4                  -         b_ja1nbsc2 * fnjyx(:,itb)

c       ................... for tensor term one has (nabla_i s_i) (nabla_j s_j)
c                     The contribution to S_i is thus - 2 (nabla_i nabla_j s_j)
c
        potSx(:,it) = potSx(:,it)
     1                  - 2.0d0 * b_nisi1njsj1 * fndsx(:,it)
     3                  - 2.0d0 * b_nisi1njsj2 * fndsx(:,itb)
        potSy(:,it) = potSy(:,it)
     1                  - 2.0d0 * b_nisi1njsj1 * fndsy(:,it)
     3                  - 2.0d0 * b_nisi1njsj2 * fndsy(:,itb)
        potSz(:,it) = potSz(:,it)
     1                  - 2.0d0 * b_nisi1njsj1 * fndsz(:,it)
     3                  - 2.0d0 * b_nisi1njsj2 * fndsz(:,itb)

c       ....................................... for tensor term one has s_j F_j
c                                           the contribution to S_i is thus F_i
        potSx(:,it) = potSx(:,it)
     1                  +         b_Fj1sj1 * fFx(:,it)
     3                  +         b_Fj1sj2 * fFx(:,itb)
        potSy(:,it) = potSy(:,it)
     1                  +         b_Fj1sj1 * fFy(:,it)
     3                  +         b_Fj1sj2 * fFy(:,itb)
        potSz(:,it) = potSz(:,it)
     1                  +         b_Fj1sj1 * fFz(:,it)
     3                  +         b_Fj1sj2 * fFz(:,itb)

      enddo

c     .......................................... 2-body contribution to B field
      do it=1,2
        itb = 3-it
        potB(:,it) = potB(:,it)
     1                 +         b_t1r1 * frho(:,it)
     2                 +         b_t1r2 * frho(:,itb)
       enddo

c     .......................................... 2-body contribution to C field
      do it=1,2
        itb = 3-it
        potCx(:,it) = potCx(:,it)
     1                  +         b_Tj1sj1 * fsx(:,it)
     2                  +         b_Tj1sj2 * fsx(:,itb)
        potCy(:,it) = potCy(:,it)
     1                  +         b_Tj1sj1 * fsy(:,it)
     2                  +         b_Tj1sj2 * fsy(:,itb)
        potCz(:,it) = potCz(:,it)
     1                  +         b_Tj1sj1 * fsz(:,it)
     2                  +         b_Tj1sj2 * fsz(:,itb)
      enddo

c     .......................................... 2-body contribution to A field
      do it=1,2
        itb = 3-it
        potAx(:,it) = potAx(:,it)
     1                  + 2.0d0 * b_ji1ji1 * fjx(:,it)
     2                  + 2.0d0 * b_ji1ji2 * fjx(:,itb)
        potAy(:,it) = potAy(:,it)
     1                  + 2.0d0 * b_ji1ji1 * fjy(:,it)
     2                  + 2.0d0 * b_ji1ji2 * fjy(:,itb)
        potAz(:,it) = potAz(:,it)
     1                  + 2.0d0 * b_ji1ji1 * fjz(:,it)
     2                  + 2.0d0 * b_ji1ji2 * fjz(:,itb)

c       .................. for spin-orbit term one have j_a (nabla_b s_c) e_abc
c                           the contribution to A_i is thus (nabla_b s_c) e_ibc
        potAx(:,it) = potAx(:,it)
     1                  +         b_ja1nbsc1 * fnsyz(:,it)
     2                  -         b_ja1nbsc1 * fnszy(:,it)
     3                  +         b_ja1nbsc2 * fnsyz(:,itb)
     4                  -         b_ja1nbsc2 * fnszy(:,itb)
        potAy(:,it) = potAy(:,it)
     1                  -         b_ja1nbsc1 * fnsxz(:,it)
     2                  +         b_ja1nbsc1 * fnszx(:,it)
     3                  -         b_ja1nbsc2 * fnsxz(:,itb)
     4                  +         b_ja1nbsc2 * fnszx(:,itb)
        potAz(:,it) = potAz(:,it)
     1                  +         b_ja1nbsc1 * fnsxy(:,it)
     2                  -         b_ja1nbsc1 * fnsyx(:,it)
     3                  +         b_ja1nbsc2 * fnsxy(:,itb)
     4                  -         b_ja1nbsc2 * fnsyx(:,itb)
      enddo

c     .......................................... 2-body contribution to W field
      do it=1,2
        itb = 3-it
        potWxx(:,it) = potWxx(:,it)
     1                   + 2.0d0 * b_Jij1Jij1 * fJxx(:,it)
     2                   + 2.0d0 * b_Jij1Jij2 * fJxx(:,itb)
        potWxy(:,it) = potWxy(:,it)
     1                   + 2.0d0 * b_Jij1Jij1 * fJxy(:,it)
     2                   + 2.0d0 * b_Jij1Jij2 * fJxy(:,itb)
        potWxz(:,it) = potWxz(:,it)
     1                   + 2.0d0 * b_Jij1Jij1 * fJxz(:,it)
     2                   + 2.0d0 * b_Jij1Jij2 * fJxz(:,itb)
        potWyx(:,it) = potWyx(:,it)
     1                   + 2.0d0 * b_Jij1Jij1 * fJyx(:,it)
     2                   + 2.0d0 * b_Jij1Jij2 * fJyx(:,itb)
        potWyy(:,it) = potWyy(:,it)
     1                   + 2.0d0 * b_Jij1Jij1 * fJyy(:,it)
     2                   + 2.0d0 * b_Jij1Jij2 * fJyy(:,itb)
        potWyz(:,it) = potWyz(:,it)
     1                   + 2.0d0 * b_Jij1Jij1 * fJyz(:,it)
     2                   + 2.0d0 * b_Jij1Jij2 * fJyz(:,itb)
        potWzx(:,it) = potWzx(:,it)
     1                   + 2.0d0 * b_Jij1Jij1 * fJzx(:,it)
     2                   + 2.0d0 * b_Jij1Jij2 * fJzx(:,itb)
        potWzy(:,it) = potWzy(:,it)
     1                   + 2.0d0 * b_Jij1Jij1 * fJzy(:,it)
     2                   + 2.0d0 * b_Jij1Jij2 * fJzy(:,itb)
        potWzz(:,it) = potWzz(:,it)
     1                   + 2.0d0 * b_Jij1Jij1 * fJzz(:,it)
     2                   + 2.0d0 * b_Jij1Jij2 * fJzz(:,itb)

      enddo

c     .................. for spin orbit term one has - (nabla_a rho) J_bc e_abc
c                        The contribution to W_ij is thus - (nabla_a rho) e_aij
      do it=1,2
        itb = 3-it
        potWxy(:,it) = potWxy(:,it)
     1                   -         b_r1naJbc1 * fnrz(:,it)
     2                   -         b_r1naJbc2 * fnrz(:,itb)
        potWxz(:,it) = potWxz(:,it)
     1                   +         b_r1naJbc1 * fnry(:,it)
     2                   +         b_r1naJbc2 * fnry(:,itb)
        potWyx(:,it) = potWyx(:,it)
     1                   +         b_r1naJbc1 * fnrz(:,it)
     2                   +         b_r1naJbc2 * fnrz(:,itb)
        potWyz(:,it) = potWyz(:,it)
     1                   -         b_r1naJbc1 * fnrx(:,it)
     2                   -         b_r1naJbc2 * fnrx(:,itb)
        potWzx(:,it) = potWzx(:,it)
     1                   -         b_r1naJbc1 * fnry(:,it)
     2                   -         b_r1naJbc2 * fnry(:,itb)
        potWzy(:,it) = potWzy(:,it)
     1                   +         b_r1naJbc1 * fnrx(:,it)
     2                   +         b_r1naJbc2 * fnrx(:,itb)
      enddo

      do it=1,2
        itb = 3-it
c       ..................................... for tensor term one has J_ii J_jj
c                                       The contribution to W_ii is thus 2 J_jj
        potWxx(:,it) = potWxx(:,it)
     1                   + 2.0d0 * b_Jii1Jjj1 * fJxx(:,it)
     2                   + 2.0d0 * b_Jii1Jjj1 * fJyy(:,it)
     3                   + 2.0d0 * b_Jii1Jjj1 * fJzz(:,it)
     4                   + 2.0d0 * b_Jii1Jjj2 * fJxx(:,itb)
     5                   + 2.0d0 * b_Jii1Jjj2 * fJyy(:,itb)
     6                   + 2.0d0 * b_Jii1Jjj2 * fJzz(:,itb)
        potWyy(:,it) = potWyy(:,it)
     1                   + 2.0d0 * b_Jii1Jjj1 * fJxx(:,it)
     2                   + 2.0d0 * b_Jii1Jjj1 * fJyy(:,it)
     3                   + 2.0d0 * b_Jii1Jjj1 * fJzz(:,it)
     4                   + 2.0d0 * b_Jii1Jjj2 * fJxx(:,itb)
     5                   + 2.0d0 * b_Jii1Jjj2 * fJyy(:,itb)
     6                   + 2.0d0 * b_Jii1Jjj2 * fJzz(:,itb)
        potWzz(:,it) = potWzz(:,it)
     1                   + 2.0d0 * b_Jii1Jjj1 * fJxx(:,it)
     2                   + 2.0d0 * b_Jii1Jjj1 * fJyy(:,it)
     3                   + 2.0d0 * b_Jii1Jjj1 * fJzz(:,it)
     4                   + 2.0d0 * b_Jii1Jjj2 * fJxx(:,itb)
     5                   + 2.0d0 * b_Jii1Jjj2 * fJyy(:,itb)
     6                   + 2.0d0 * b_Jii1Jjj2 * fJzz(:,itb)

c       For tensor term one have J_ij J_ji
c       The contribution to W_ij is thus 2 J_ji
        potWxx(:,it) = potWxx(:,it)
     1                   + 2.0d0 * b_Jij1Jji1 * fJxx(:,it)
     2                   + 2.0d0 * b_Jij1Jji2 * fJxx(:,itb)
        potWxy(:,it) = potWxy(:,it)
     1                   + 2.0d0 * b_Jij1Jji1 * fJyx(:,it)
     2                   + 2.0d0 * b_Jij1Jji2 * fJyx(:,itb)
        potWxz(:,it) = potWxz(:,it)
     1                   + 2.0d0 * b_Jij1Jji1 * fJzx(:,it)
     2                   + 2.0d0 * b_Jij1Jji2 * fJzx(:,itb)
        potWyx(:,it) = potWyx(:,it)
     1                   + 2.0d0 * b_Jij1Jji1 * fJxy(:,it)
     2                   + 2.0d0 * b_Jij1Jji2 * fJxy(:,itb)
        potWyy(:,it) = potWyy(:,it)
     1                   + 2.0d0 * b_Jij1Jji1 * fJyy(:,it)
     2                   + 2.0d0 * b_Jij1Jji2 * fJyy(:,itb)
        potWyz(:,it) = potWyz(:,it)
     1                   + 2.0d0 * b_Jij1Jji1 * fJzy(:,it)
     2                   + 2.0d0 * b_Jij1Jji2 * fJzy(:,itb)
        potWzx(:,it) = potWzx(:,it)
     1                   + 2.0d0 * b_Jij1Jji1 * fJxz(:,it)
     2                   + 2.0d0 * b_Jij1Jji2 * fJxz(:,itb)
        potWzy(:,it) = potWzy(:,it)
     1                   + 2.0d0 * b_Jij1Jji1 * fJyz(:,it)
     2                   + 2.0d0 * b_Jij1Jji2 * fJyz(:,itb)
        potWzz(:,it) = potWzz(:,it)
     1                   + 2.0d0 * b_Jij1Jji1 * fJzz(:,it)
     2                   + 2.0d0 * b_Jij1Jji2 * fJzz(:,itb)
      enddo

c     ........................................... 2body contribution to D field
      if (njmunu.ge.2) then
        do it=1,2
          itb = 3-it
          potDx(:,it) = potDx(:,it)
     1                    +         b_Fj1sj1 * fsx(:,it)
     2                    +         b_Fj1sj2 * fsx(:,itb)
          potDy(:,it) = potDy(:,it)
     1                    +         b_Fj1sj1 * fsy(:,it)
     2                    +         b_Fj1sj2 * fsy(:,itb)
          potDz(:,it) = potDz(:,it)
     1                    +         b_Fj1sj1 * fsz(:,it)
     2                    +         b_Fj1sj2 * fsz(:,itb)
        enddo
      endif

c     .........................................................................
c     ................................. 3 body ................................
c     .........................................................................

c     .................... 3-body contribution to U field with normal densities
      do it=1,2
        itb = 3-it
        potU(:,it) = potU(:,it)
     1              +         b_r1r1r2 * frho(:,itb) * frho(:,itb)
     2              + 2.0d0 * b_r1r1r2 * frho(:,it)  * frho(:,itb)
        potU(:,it) = potU(:,it)
     1              +         b_sj1sj1r2 * fsx(:,itb) * fsx(:,itb)
     2              +         b_sj1sj1r2 * fsy(:,itb) * fsy(:,itb)
     3              +         b_sj1sj1r2 * fsz(:,itb) * fsz(:,itb)
        potU(:,it) = potU(:,it)
     1              + 2.0d0 * b_t1r1r1 * ftau(:,it)  * frho(:,it)
     2              +         b_t1r1r2 * ftau(:,itb) * frho(:,itb)
     3              +         b_t1r1r2 * ftau(:,it)  * frho(:,itb)
     4              + 2.0d0 * b_t1r2r2 * ftau(:,itb) * frho(:,it)
        potU(:,it) = potU(:,it)
     1              +         b_Tj1sj1r2 * fTx(:,itb) * fsx(:,itb)
     2              +         b_Tj1sj1r2 * fTy(:,itb) * fsy(:,itb)
     3              +         b_Tj1sj1r2 * fTz(:,itb) * fsz(:,itb)
     4              +         b_Tj1sj2r1 * fTx(:,it)  * fsx(:,itb)
     5              +         b_Tj1sj2r1 * fTy(:,it)  * fsy(:,itb)
     6              +         b_Tj1sj2r1 * fTz(:,it)  * fsz(:,itb)
        potU(:,it) = potU(:,it)
     1         - 2.0d0 * b_nir1nir1r1 * fnrx (:,it)  * fnrx(:,it)
     2         - 2.0d0 * b_nir1nir1r1 * fnry (:,it)  * fnry(:,it)
     3         - 2.0d0 * b_nir1nir1r1 * fnrz (:,it)  * fnrz(:,it)
     4         +         b_nir1nir1r1 * fnrx (:,it)  * fnrx(:,it)
     5         +         b_nir1nir1r1 * fnry (:,it)  * fnry(:,it)
     6         +         b_nir1nir1r1 * fnrz (:,it)  * fnrz(:,it)
     7         - 2.0d0 * b_nir1nir1r1 * flrho(:,it)  * frho(:,it)
     8         +         b_nir1nir1r2 * fnrx (:,itb) * fnrx(:,itb)
     9         +         b_nir1nir1r2 * fnry (:,itb) * fnry(:,itb)
     8         +         b_nir1nir1r2 * fnrz (:,itb) * fnrz(:,itb)
     7         - 2.0d0 * b_nir1nir1r2 * fnrx (:,it)  * fnrx(:,itb)
     6         - 2.0d0 * b_nir1nir1r2 * fnry (:,it)  * fnry(:,itb)
     5         - 2.0d0 * b_nir1nir1r2 * fnrz (:,it)  * fnrz(:,itb)
     4         - 2.0d0 * b_nir1nir1r2 * flrho(:,it)  * frho(:,itb)
     3         -         b_nir1nir2r1 * fnrx (:,itb) * fnrx(:,itb)
     2         -         b_nir1nir2r1 * fnry (:,itb) * fnry(:,itb)
     1         -         b_nir1nir2r1 * fnrz (:,itb) * fnrz(:,itb)
     2         -         b_nir1nir2r1 * fnrx (:,itb) * fnrx(:,it)
     3         -         b_nir1nir2r1 * fnry (:,itb) * fnry(:,it)
     4         -         b_nir1nir2r1 * fnrz (:,itb) * fnrz(:,it)
     5         +         b_nir1nir2r1 * fnrx (:,it)  * fnrx(:,itb)
     6         +         b_nir1nir2r1 * fnry (:,it)  * fnry(:,itb)
     7         +         b_nir1nir2r1 * fnrz (:,it)  * fnrz(:,itb)
     8         -         b_nir1nir2r1 * flrho(:,itb) * frho(:,itb)
     9         -         b_nir1nir2r1 * flrho(:,itb) * frho(:,it)
        potU(:,it) = potU(:,it)
     1      +         b_nisj1nisj1r1 * fnsxx(:,it)  * fnsxx(:,it)
     2      +         b_nisj1nisj1r1 * fnsxy(:,it)  * fnsxy(:,it)
     3      +         b_nisj1nisj1r1 * fnsxz(:,it)  * fnsxz(:,it)
     4      +         b_nisj1nisj1r1 * fnsyx(:,it)  * fnsyx(:,it)
     5      +         b_nisj1nisj1r1 * fnsyy(:,it)  * fnsyy(:,it)
     6      +         b_nisj1nisj1r1 * fnsyz(:,it)  * fnsyz(:,it)
     7      +         b_nisj1nisj1r1 * fnszx(:,it)  * fnszx(:,it)
     8      +         b_nisj1nisj1r1 * fnszy(:,it)  * fnszy(:,it)
     9      +         b_nisj1nisj1r1 * fnszz(:,it)  * fnszz(:,it)
     1      +         b_nisj1nisj1r2 * fnsxx(:,itb) * fnsxx(:,itb)
     2      +         b_nisj1nisj1r2 * fnsxy(:,itb) * fnsxy(:,itb)
     3      +         b_nisj1nisj1r2 * fnsxz(:,itb) * fnsxz(:,itb)
     4      +         b_nisj1nisj1r2 * fnsyx(:,itb) * fnsyx(:,itb)
     5      +         b_nisj1nisj1r2 * fnsyy(:,itb) * fnsyy(:,itb)
     6      +         b_nisj1nisj1r2 * fnsyz(:,itb) * fnsyz(:,itb)
     7      +         b_nisj1nisj1r2 * fnszx(:,itb) * fnszx(:,itb)
     8      +         b_nisj1nisj1r2 * fnszy(:,itb) * fnszy(:,itb)
     9      +         b_nisj1nisj1r2 * fnszz(:,itb) * fnszz(:,itb)
     1      +         b_nisj1nisj2r1 * fnsxx(:,it)  * fnsxx(:,itb)
     2      +         b_nisj1nisj2r1 * fnsxy(:,it)  * fnsxy(:,itb)
     3      +         b_nisj1nisj2r1 * fnsxz(:,it)  * fnsxz(:,itb)
     4      +         b_nisj1nisj2r1 * fnsyx(:,it)  * fnsyx(:,itb)
     5      +         b_nisj1nisj2r1 * fnsyy(:,it)  * fnsyy(:,itb)
     6      +         b_nisj1nisj2r1 * fnsyz(:,it)  * fnsyz(:,itb)
     7      +         b_nisj1nisj2r1 * fnszx(:,it)  * fnszx(:,itb)
     8      +         b_nisj1nisj2r1 * fnszy(:,it)  * fnszy(:,itb)
     9      +         b_nisj1nisj2r1 * fnszz(:,it)  * fnszz(:,itb)
        potU(:,it) = potU(:,it)
     1      -         b_nir1nisj1sj1 * fnsxx(:,it)  * fnsxx(:,it)
     2      -         b_nir1nisj1sj1 * fnsxy(:,it)  * fnsxy(:,it)
     3      -         b_nir1nisj1sj1 * fnsxz(:,it)  * fnsxz(:,it)
     4      -         b_nir1nisj1sj1 * fnsyx(:,it)  * fnsyx(:,it)
     5      -         b_nir1nisj1sj1 * fnsyy(:,it)  * fnsyy(:,it)
     6      -         b_nir1nisj1sj1 * fnsyz(:,it)  * fnsyz(:,it)
     7      -         b_nir1nisj1sj1 * fnszx(:,it)  * fnszx(:,it)
     8      -         b_nir1nisj1sj1 * fnszy(:,it)  * fnszy(:,it)
     9      -         b_nir1nisj1sj1 * fnszz(:,it)  * fnszz(:,it)
     1      -         b_nir1nisj1sj1 * flsx (:,it)  * fsx  (:,it)
     2      -         b_nir1nisj1sj1 * flsy (:,it)  * fsy  (:,it)
     3      -         b_nir1nisj1sj1 * flsz (:,it)  * fsz  (:,it)
     1      -         b_nir1nisj1sj2 * fnsxx(:,it)  * fnsxx(:,itb)
     2      -         b_nir1nisj1sj2 * fnsxy(:,it)  * fnsxy(:,itb)
     3      -         b_nir1nisj1sj2 * fnsxz(:,it)  * fnsxz(:,itb)
     4      -         b_nir1nisj1sj2 * fnsyx(:,it)  * fnsyx(:,itb)
     5      -         b_nir1nisj1sj2 * fnsyy(:,it)  * fnsyy(:,itb)
     6      -         b_nir1nisj1sj2 * fnsyz(:,it)  * fnsyz(:,itb)
     7      -         b_nir1nisj1sj2 * fnszx(:,it)  * fnszx(:,itb)
     8      -         b_nir1nisj1sj2 * fnszy(:,it)  * fnszy(:,itb)
     9      -         b_nir1nisj1sj2 * fnszz(:,it)  * fnszz(:,itb)
     1      -         b_nir1nisj1sj2 * flsx (:,it)  * fsx  (:,itb)
     2      -         b_nir1nisj1sj2 * flsy (:,it)  * fsy  (:,itb)
     3      -         b_nir1nisj1sj2 * flsz (:,it)  * fsz  (:,itb)
     1      -         b_nir1nisj2sj1 * fnsxx(:,itb) * fnsxx(:,it)
     2      -         b_nir1nisj2sj1 * fnsxy(:,itb) * fnsxy(:,it)
     3      -         b_nir1nisj2sj1 * fnsxz(:,itb) * fnsxz(:,it)
     4      -         b_nir1nisj2sj1 * fnsyx(:,itb) * fnsyx(:,it)
     5      -         b_nir1nisj2sj1 * fnsyy(:,itb) * fnsyy(:,it)
     6      -         b_nir1nisj2sj1 * fnsyz(:,itb) * fnsyz(:,it)
     7      -         b_nir1nisj2sj1 * fnszx(:,itb) * fnszx(:,it)
     8      -         b_nir1nisj2sj1 * fnszy(:,itb) * fnszy(:,it)
     9      -         b_nir1nisj2sj1 * fnszz(:,itb) * fnszz(:,it)
     1      -         b_nir1nisj2sj1 * flsx (:,itb) * fsx  (:,it)
     2      -         b_nir1nisj2sj1 * flsy (:,itb) * fsy  (:,it)
     3      -         b_nir1nisj2sj1 * flsz (:,itb) * fsz  (:,it)
     1      -         b_nir1nisj2sj2 * fnsxx(:,itb) * fnsxx(:,itb)
     2      -         b_nir1nisj2sj2 * fnsxy(:,itb) * fnsxy(:,itb)
     3      -         b_nir1nisj2sj2 * fnsxz(:,itb) * fnsxz(:,itb)
     4      -         b_nir1nisj2sj2 * fnsyx(:,itb) * fnsyx(:,itb)
     5      -         b_nir1nisj2sj2 * fnsyy(:,itb) * fnsyy(:,itb)
     6      -         b_nir1nisj2sj2 * fnsyz(:,itb) * fnsyz(:,itb)
     7      -         b_nir1nisj2sj2 * fnszx(:,itb) * fnszx(:,itb)
     8      -         b_nir1nisj2sj2 * fnszy(:,itb) * fnszy(:,itb)
     9      -         b_nir1nisj2sj2 * fnszz(:,itb) * fnszz(:,itb)
     1      -         b_nir1nisj2sj2 * flsx (:,itb) * fsx  (:,itb)
     2      -         b_nir1nisj2sj2 * flsy (:,itb) * fsy  (:,itb)
     3      -         b_nir1nisj2sj2 * flsz (:,itb) * fsz  (:,itb)
        potU(:,it) = potU(:,it)
     1              +         b_ji1ji1r1 * fjx(:,it)  * fjx(:,it)
     2              +         b_ji1ji1r1 * fjy(:,it)  * fjy(:,it)
     3              +         b_ji1ji1r1 * fjz(:,it)  * fjz(:,it)
     4              +         b_ji1ji1r2 * fjx(:,itb) * fjx(:,itb)
     5              +         b_ji1ji1r2 * fjy(:,itb) * fjy(:,itb)
     6              +         b_ji1ji1r2 * fjz(:,itb) * fjz(:,itb)
     7              +         b_ji1ji2r1 * fjx(:,it)  * fjx(:,itb)
     8              +         b_ji1ji2r1 * fjy(:,it)  * fjy(:,itb)
     9              +         b_ji1ji2r1 * fjz(:,it)  * fjz(:,itb)
        potU(:,it) = potU(:,it)
     1          +         b_Jij1Jij1r1 * fJxx(:,it)  * fJxx(:,it)
     2          +         b_Jij1Jij1r1 * fJxy(:,it)  * fJxy(:,it)
     3          +         b_Jij1Jij1r1 * fJxz(:,it)  * fJxz(:,it)
     4          +         b_Jij1Jij1r1 * fJyx(:,it)  * fJyx(:,it)
     5          +         b_Jij1Jij1r1 * fJyy(:,it)  * fJyy(:,it)
     6          +         b_Jij1Jij1r1 * fJyz(:,it)  * fJyz(:,it)
     7          +         b_Jij1Jij1r1 * fJzx(:,it)  * fJzx(:,it)
     8          +         b_Jij1Jij1r1 * fJzy(:,it)  * fJzy(:,it)
     9          +         b_Jij1Jij1r1 * fJzz(:,it)  * fJzz(:,it)
     1          +         b_Jij1Jij1r2 * fJxx(:,itb) * fJxx(:,itb)
     2          +         b_Jij1Jij1r2 * fJxy(:,itb) * fJxy(:,itb)
     3          +         b_Jij1Jij1r2 * fJxz(:,itb) * fJxz(:,itb)
     4          +         b_Jij1Jij1r2 * fJyx(:,itb) * fJyx(:,itb)
     5          +         b_Jij1Jij1r2 * fJyy(:,itb) * fJyy(:,itb)
     6          +         b_Jij1Jij1r2 * fJyz(:,itb) * fJyz(:,itb)
     7          +         b_Jij1Jij1r2 * fJzx(:,itb) * fJzx(:,itb)
     8          +         b_Jij1Jij1r2 * fJzy(:,itb) * fJzy(:,itb)
     9          +         b_Jij1Jij1r2 * fJzz(:,itb) * fJzz(:,itb)
     1          +         b_Jij1Jij2r1 * fJxx(:,it)  * fJxx(:,itb)
     2          +         b_Jij1Jij2r1 * fJxy(:,it)  * fJxy(:,itb)
     3          +         b_Jij1Jij2r1 * fJxz(:,it)  * fJxz(:,itb)
     4          +         b_Jij1Jij2r1 * fJyx(:,it)  * fJyx(:,itb)
     5          +         b_Jij1Jij2r1 * fJyy(:,it)  * fJyy(:,itb)
     6          +         b_Jij1Jij2r1 * fJyz(:,it)  * fJyz(:,itb)
     7          +         b_Jij1Jij2r1 * fJzx(:,it)  * fJzx(:,itb)
     8          +         b_Jij1Jij2r1 * fJzy(:,it)  * fJzy(:,itb)
     9          +         b_Jij1Jij2r1 * fJzz(:,it)  * fJzz(:,itb)

c       ................................ 3-body pairing contribution to U field
        if (npair.ne.1) then
          potU(:,it) = potU(:,it)
     1          +         b_rg1rd1r2 * frhotr(:,itb) * frhotr(:,itb)
     2          +         b_rg1rd1r2 * frhoti(:,itb) * frhoti(:,itb)
          potU(:,it) = potU(:,it)
     1          +         b_tg1rd1r2 * ftautr(:,itb) * frhotr(:,itb)
     2          +         b_td1rg1r2 * ftautr(:,itb) * frhotr(:,itb)
     3          +         b_tg1rd1r2 * ftauti(:,itb) * frhoti(:,itb)
     4          +         b_td1rg1r2 * ftauti(:,itb) * frhoti(:,itb)
          potU(:,it) = potU(:,it)
     1      +         b_nirg1nird1r1 * fnrtxr(:,it)  * fnrtxr(:,it)
     2      +         b_nirg1nird1r1 * fnrtyr(:,it)  * fnrtyr(:,it)
     3      +         b_nirg1nird1r1 * fnrtzr(:,it)  * fnrtzr(:,it)
     1      +         b_nirg1nird1r2 * fnrtxr(:,itb) * fnrtxr(:,itb)
     2      +         b_nirg1nird1r2 * fnrtyr(:,itb) * fnrtyr(:,itb)
     3      +         b_nirg1nird1r2 * fnrtzr(:,itb) * fnrtzr(:,itb)
     1      +         b_nirg1nird1r1 * fnrtxi(:,it)  * fnrtxi(:,it)
     2      +         b_nirg1nird1r1 * fnrtyi(:,it)  * fnrtyi(:,it)
     3      +         b_nirg1nird1r1 * fnrtzi(:,it)  * fnrtzi(:,it)
     1      +         b_nirg1nird1r2 * fnrtxi(:,itb) * fnrtxi(:,itb)
     2      +         b_nirg1nird1r2 * fnrtyi(:,itb) * fnrtyi(:,itb)
     3      +         b_nirg1nird1r2 * fnrtzi(:,itb) * fnrtzi(:,itb)
          potU(:,it) = potU(:,it)
     1     -         b_nirg1nir1rd1 * fnrtxr (:,it)  * fnrtxr(:,it)
     2     -         b_nirg1nir1rd1 * fnrtyr (:,it)  * fnrtyr(:,it)
     3     -         b_nirg1nir1rd1 * fnrtzr (:,it)  * fnrtzr(:,it)
     4     -         b_nirg1nir1rd1 * flrhotr(:,it)  * frhotr(:,it)
     1     -         b_nirg1nir2rd1 * fnrtxr (:,itb) * fnrtxr(:,itb)
     2     -         b_nirg1nir2rd1 * fnrtyr (:,itb) * fnrtyr(:,itb)
     3     -         b_nirg1nir2rd1 * fnrtzr (:,itb) * fnrtzr(:,itb)
     4     -         b_nirg1nir2rd1 * flrhotr(:,itb) * frhotr(:,itb)
     1     -         b_nird1nir1rg1 * fnrtxr (:,it)  * fnrtxr(:,it)
     2     -         b_nird1nir1rg1 * fnrtyr (:,it)  * fnrtyr(:,it)
     3     -         b_nird1nir1rg1 * fnrtzr (:,it)  * fnrtzr(:,it)
     4     -         b_nird1nir1rg1 * flrhotr(:,it)  * frhotr(:,it)
     1     -         b_nird1nir2rg1 * fnrtxr (:,itb) * fnrtxr(:,itb)
     2     -         b_nird1nir2rg1 * fnrtyr (:,itb) * fnrtyr(:,itb)
     3     -         b_nird1nir2rg1 * fnrtzr (:,itb) * fnrtzr(:,itb)
     4     -         b_nird1nir2rg1 * flrhotr(:,itb) * frhotr(:,itb)
     1     -         b_nirg1nir1rd1 * fnrtxi (:,it)  * fnrtxi(:,it)
     2     -         b_nirg1nir1rd1 * fnrtyi (:,it)  * fnrtyi(:,it)
     3     -         b_nirg1nir1rd1 * fnrtzi (:,it)  * fnrtzi(:,it)
     4     -         b_nirg1nir1rd1 * flrhoti(:,it)  * frhoti(:,it)
     1     -         b_nirg1nir2rd1 * fnrtxi (:,itb) * fnrtxi(:,itb)
     2     -         b_nirg1nir2rd1 * fnrtyi (:,itb) * fnrtyi(:,itb)
     3     -         b_nirg1nir2rd1 * fnrtzi (:,itb) * fnrtzi(:,itb)
     4     -         b_nirg1nir2rd1 * flrhoti(:,itb) * frhoti(:,itb)
     1     -         b_nird1nir1rg1 * fnrtxi (:,it)  * fnrtxi(:,it)
     2     -         b_nird1nir1rg1 * fnrtyi (:,it)  * fnrtyi(:,it)
     3     -         b_nird1nir1rg1 * fnrtzi (:,it)  * fnrtzi(:,it)
     4     -         b_nird1nir1rg1 * flrhoti(:,it)  * frhoti(:,it)
     1     -         b_nird1nir2rg1 * fnrtxi (:,itb) * fnrtxi(:,itb)
     2     -         b_nird1nir2rg1 * fnrtyi (:,itb) * fnrtyi(:,itb)
     3     -         b_nird1nir2rg1 * fnrtzi (:,itb) * fnrtzi(:,itb)
     4     -         b_nird1nir2rg1 * flrhoti(:,itb) * frhoti(:,itb)
          potU(:,it) = potU(:,it)
     1      +         b_Jgij1Jdij1r1 * fJtxxr(:,it)  * fJtxxr(:,it)
     2      +         b_Jgij1Jdij1r1 * fJtxyr(:,it)  * fJtxyr(:,it)
     3      +         b_Jgij1Jdij1r1 * fJtxzr(:,it)  * fJtxzr(:,it)
     4      +         b_Jgij1Jdij1r1 * fJtyxr(:,it)  * fJtyxr(:,it)
     5      +         b_Jgij1Jdij1r1 * fJtyyr(:,it)  * fJtyyr(:,it)
     6      +         b_Jgij1Jdij1r1 * fJtyzr(:,it)  * fJtyzr(:,it)
     7      +         b_Jgij1Jdij1r1 * fJtzxr(:,it)  * fJtzxr(:,it)
     8      +         b_Jgij1Jdij1r1 * fJtzyr(:,it)  * fJtzyr(:,it)
     9      +         b_Jgij1Jdij1r1 * fJtzzr(:,it)  * fJtzzr(:,it)
     1      +         b_Jgij1Jdij1r2 * fJtxxr(:,itb) * fJtxxr(:,itb)
     2      +         b_Jgij1Jdij1r2 * fJtxyr(:,itb) * fJtxyr(:,itb)
     3      +         b_Jgij1Jdij1r2 * fJtxzr(:,itb) * fJtxzr(:,itb)
     4      +         b_Jgij1Jdij1r2 * fJtyxr(:,itb) * fJtyxr(:,itb)
     5      +         b_Jgij1Jdij1r2 * fJtyyr(:,itb) * fJtyyr(:,itb)
     6      +         b_Jgij1Jdij1r2 * fJtyzr(:,itb) * fJtyzr(:,itb)
     7      +         b_Jgij1Jdij1r2 * fJtzxr(:,itb) * fJtzxr(:,itb)
     8      +         b_Jgij1Jdij1r2 * fJtzyr(:,itb) * fJtzyr(:,itb)
     9      +         b_Jgij1Jdij1r2 * fJtzzr(:,itb) * fJtzzr(:,itb)
     1      +         b_Jgij1Jdij1r1 * fJtxxi(:,it)  * fJtxxi(:,it)
     2      +         b_Jgij1Jdij1r1 * fJtxyi(:,it)  * fJtxyi(:,it)
     3      +         b_Jgij1Jdij1r1 * fJtxzi(:,it)  * fJtxzi(:,it)
     4      +         b_Jgij1Jdij1r1 * fJtyxi(:,it)  * fJtyxi(:,it)
     5      +         b_Jgij1Jdij1r1 * fJtyyi(:,it)  * fJtyyi(:,it)
     6      +         b_Jgij1Jdij1r1 * fJtyzi(:,it)  * fJtyzi(:,it)
     7      +         b_Jgij1Jdij1r1 * fJtzxi(:,it)  * fJtzxi(:,it)
     8      +         b_Jgij1Jdij1r1 * fJtzyi(:,it)  * fJtzyi(:,it)
     9      +         b_Jgij1Jdij1r1 * fJtzzi(:,it)  * fJtzzi(:,it)
     1      +         b_Jgij1Jdij1r2 * fJtxxi(:,itb) * fJtxxi(:,itb)
     2      +         b_Jgij1Jdij1r2 * fJtxyi(:,itb) * fJtxyi(:,itb)
     3      +         b_Jgij1Jdij1r2 * fJtxzi(:,itb) * fJtxzi(:,itb)
     4      +         b_Jgij1Jdij1r2 * fJtyxi(:,itb) * fJtyxi(:,itb)
     5      +         b_Jgij1Jdij1r2 * fJtyyi(:,itb) * fJtyyi(:,itb)
     6      +         b_Jgij1Jdij1r2 * fJtyzi(:,itb) * fJtyzi(:,itb)
     7      +         b_Jgij1Jdij1r2 * fJtzxi(:,itb) * fJtzxi(:,itb)
     8      +         b_Jgij1Jdij1r2 * fJtzyi(:,itb) * fJtzyi(:,itb)
     9      +         b_Jgij1Jdij1r2 * fJtzzi(:,itb) * fJtzzi(:,itb)
        endif
      enddo

c     ........................................... 3body contribution to S field
      do it=1,2
        itb = 3-it
        potSx(:,it) = potSx(:,it)
     1              + 2.0d0 * b_sj1sj1r2 * fsx(:,it) * frho(:,itb)
        potSy(:,it) = potSy(:,it)
     1              + 2.0d0 * b_sj1sj1r2 * fsy(:,it) * frho(:,itb)
        potSz(:,it) = potSz(:,it)
     1              + 2.0d0 * b_sj1sj1r2 * fsz(:,it) * frho(:,itb)

        potSx(:,it) = potSx(:,it)
     1             +         b_Tj1sj1r2 * fTx(:,it)  * frho(:,itb)
     2             +         b_Tj1sj2r1 * fTx(:,itb) * frho(:,itb)
        potSy(:,it) = potSy(:,it)
     1             +         b_Tj1sj1r2 * fTy(:,it)  * frho(:,itb)
     2             +         b_Tj1sj2r1 * fTy(:,itb) * frho(:,itb)
        potSz(:,it) = potSz(:,it)
     1             +         b_Tj1sj1r2 * fTz(:,it)  * frho(:,itb)
     2             +         b_Tj1sj2r1 * fTz(:,itb) * frho(:,itb)


        potSx(:,it) = potSx(:,it)
     1             + 2.0d0 * b_t1sj1sj1 * ftau(:,it)  * fsx(:,it)
     2             +         b_t1sj1sj2 * ftau(:,itb) * fsx(:,itb)
     3             +         b_t1sj1sj2 * ftau(:,it)  * fsx(:,itb)
     4             + 2.0d0 * b_t1sj2sj2 * ftau(:,itb) * fsx(:,it)
        potSy(:,it) = potSy(:,it)
     1             + 2.0d0 * b_t1sj1sj1 * ftau(:,it)  * fsy(:,it)
     2             +         b_t1sj1sj2 * ftau(:,itb) * fsy(:,itb)
     3             +         b_t1sj1sj2 * ftau(:,it)  * fsy(:,itb)
     4             + 2.0d0 * b_t1sj2sj2 * ftau(:,itb) * fsy(:,it)
        potSz(:,it) = potSz(:,it)
     1             + 2.0d0 * b_t1sj1sj1 * ftau(:,it)  * fsz(:,it)
     2             +         b_t1sj1sj2 * ftau(:,itb) * fsz(:,itb)
     3             +         b_t1sj1sj2 * ftau(:,it)  * fsz(:,itb)
     4             + 2.0d0 * b_t1sj2sj2 * ftau(:,itb) * fsz(:,it)


        potSx(:,it) = potSx(:,it)
     1       - 2.0d0 * b_nisj1nisj1r1 * fnsxx(:,it)  * fnrx(:,it)
     2       - 2.0d0 * b_nisj1nisj1r1 * fnsyx(:,it)  * fnry(:,it)
     3       - 2.0d0 * b_nisj1nisj1r1 * fnszx(:,it)  * fnrz(:,it)
     4       - 2.0d0 * b_nisj1nisj1r1 * flsx (:,it)  * frho(:,it)
     5       - 2.0d0 * b_nisj1nisj1r2 * fnsxx(:,it)  * fnrx(:,itb)
     6       - 2.0d0 * b_nisj1nisj1r2 * fnsyx(:,it)  * fnry(:,itb)
     7       - 2.0d0 * b_nisj1nisj1r2 * fnszx(:,it)  * fnrz(:,itb)
     8       - 2.0d0 * b_nisj1nisj1r2 * flsx (:,it)  * frho(:,itb)
     9       -         b_nisj1nisj2r1 * fnsxx(:,itb) * fnrx(:,itb)
     8       -         b_nisj1nisj2r1 * fnsyx(:,itb) * fnry(:,itb)
     7       -         b_nisj1nisj2r1 * fnszx(:,itb) * fnrz(:,itb)
     6       -         b_nisj1nisj2r1 * fnsxx(:,itb) * fnrx(:,it)
     5       -         b_nisj1nisj2r1 * fnsyx(:,itb) * fnry(:,it)
     4       -         b_nisj1nisj2r1 * fnszx(:,itb) * fnrz(:,it)
     3       -         b_nisj1nisj2r1 * flsx (:,itb) * frho(:,itb)
     2       -         b_nisj1nisj2r1 * flsx (:,itb) * frho(:,it)
        potSy(:,it) = potSy(:,it)
     1       - 2.0d0 * b_nisj1nisj1r1 * fnsxy(:,it)  * fnrx(:,it)
     2       - 2.0d0 * b_nisj1nisj1r1 * fnsyy(:,it)  * fnry(:,it)
     3       - 2.0d0 * b_nisj1nisj1r1 * fnszy(:,it)  * fnrz(:,it)
     4       - 2.0d0 * b_nisj1nisj1r1 * flsy (:,it)  * frho(:,it)
     5       - 2.0d0 * b_nisj1nisj1r2 * fnsxy(:,it)  * fnrx(:,itb)
     6       - 2.0d0 * b_nisj1nisj1r2 * fnsyy(:,it)  * fnry(:,itb)
     7       - 2.0d0 * b_nisj1nisj1r2 * fnszy(:,it)  * fnrz(:,itb)
     8       - 2.0d0 * b_nisj1nisj1r2 * flsy (:,it)  * frho(:,itb)
     9       -         b_nisj1nisj2r1 * fnsxy(:,itb) * fnrx(:,itb)
     8       -         b_nisj1nisj2r1 * fnsyy(:,itb) * fnry(:,itb)
     7       -         b_nisj1nisj2r1 * fnszy(:,itb) * fnrz(:,itb)
     6       -         b_nisj1nisj2r1 * fnsxy(:,itb) * fnrx(:,it)
     5       -         b_nisj1nisj2r1 * fnsyy(:,itb) * fnry(:,it)
     4       -         b_nisj1nisj2r1 * fnszy(:,itb) * fnrz(:,it)
     3       -         b_nisj1nisj2r1 * flsy (:,itb) * frho(:,itb)
     2       -         b_nisj1nisj2r1 * flsy (:,itb) * frho(:,it)
        potSz(:,it) = potSz(:,it)
     1       - 2.0d0 * b_nisj1nisj1r1 * fnsxz(:,it)  * fnrx(:,it)
     2       - 2.0d0 * b_nisj1nisj1r1 * fnsyz(:,it)  * fnry(:,it)
     3       - 2.0d0 * b_nisj1nisj1r1 * fnszz(:,it)  * fnrz(:,it)
     4       - 2.0d0 * b_nisj1nisj1r1 * flsz (:,it)  * frho(:,it)
     5       - 2.0d0 * b_nisj1nisj1r2 * fnsxz(:,it)  * fnrx(:,itb)
     6       - 2.0d0 * b_nisj1nisj1r2 * fnsyz(:,it)  * fnry(:,itb)
     7       - 2.0d0 * b_nisj1nisj1r2 * fnszz(:,it)  * fnrz(:,itb)
     8       - 2.0d0 * b_nisj1nisj1r2 * flsz (:,it)  * frho(:,itb)
     9       -         b_nisj1nisj2r1 * fnsxz(:,itb) * fnrx(:,itb)
     8       -         b_nisj1nisj2r1 * fnsyz(:,itb) * fnry(:,itb)
     7       -         b_nisj1nisj2r1 * fnszz(:,itb) * fnrz(:,itb)
     6       -         b_nisj1nisj2r1 * fnsxz(:,itb) * fnrx(:,it)
     5       -         b_nisj1nisj2r1 * fnsyz(:,itb) * fnry(:,it)
     4       -         b_nisj1nisj2r1 * fnszz(:,itb) * fnrz(:,it)
     3       -         b_nisj1nisj2r1 * flsz (:,itb) * frho(:,itb)
     2       -         b_nisj1nisj2r1 * flsz (:,itb) * frho(:,it)

        potSx(:,it) = potSx(:,it)
     1      -         b_nir1nisj1sj1 * fnrx (:,it)  * fnsxx(:,it)
     2      -         b_nir1nisj1sj1 * fnry (:,it)  * fnsyx(:,it)
     3      -         b_nir1nisj1sj1 * fnrz (:,it)  * fnszx(:,it)
     4      +         b_nir1nisj1sj1 * fnrx (:,it)  * fnsxx(:,it)
     5      +         b_nir1nisj1sj1 * fnry (:,it)  * fnsyx(:,it)
     6      +         b_nir1nisj1sj1 * fnrz (:,it)  * fnszx(:,it)
     7      -         b_nir1nisj1sj1 * flrho(:,it)  * fsx  (:,it)
     8      +         b_nir1nisj1sj2 * fnrx (:,itb) * fnsxx(:,itb)
     9      +         b_nir1nisj1sj2 * fnry (:,itb) * fnsyx(:,itb)
     8      +         b_nir1nisj1sj2 * fnrz (:,itb) * fnszx(:,itb)
     7      -         b_nir1nisj1sj2 * fnrx (:,it)  * fnsxx(:,itb)
     6      -         b_nir1nisj1sj2 * fnry (:,it)  * fnsyx(:,itb)
     5      -         b_nir1nisj1sj2 * fnrz (:,it)  * fnszx(:,itb)
     4      -         b_nir1nisj1sj2 * flrho(:,it)  * fsx  (:,itb)
     3      -         b_nir1nisj2sj1 * fnrx (:,itb) * fnsxx(:,itb)
     2      -         b_nir1nisj2sj1 * fnry (:,itb) * fnsyx(:,itb)
     1      -         b_nir1nisj2sj1 * fnrz (:,itb) * fnszx(:,itb)
     2      +         b_nir1nisj2sj1 * fnrx (:,it)  * fnsxx(:,itb)
     3      +         b_nir1nisj2sj1 * fnry (:,it)  * fnsyx(:,itb)
     4      +         b_nir1nisj2sj1 * fnrz (:,it)  * fnszx(:,itb)
     5      -         b_nir1nisj2sj1 * flrho(:,itb) * fsx  (:,itb)
     6      -         b_nir1nisj2sj2 * fnrx (:,itb) * fnsxx(:,it)
     7      -         b_nir1nisj2sj2 * fnry (:,itb) * fnsyx(:,it)
     8      -         b_nir1nisj2sj2 * fnrz (:,itb) * fnszx(:,it)
     9      +         b_nir1nisj2sj2 * fnrx (:,itb) * fnsxx(:,it)
     8      +         b_nir1nisj2sj2 * fnry (:,itb) * fnsyx(:,it)
     7      +         b_nir1nisj2sj2 * fnrz (:,itb) * fnszx(:,it)
     6      -         b_nir1nisj2sj2 * flrho(:,itb) * fsx  (:,it)
        potSy(:,it) = potSy(:,it)
     1      -         b_nir1nisj1sj1 * fnrx (:,it)  * fnsxy(:,it)
     2      -         b_nir1nisj1sj1 * fnry (:,it)  * fnsyy(:,it)
     3      -         b_nir1nisj1sj1 * fnrz (:,it)  * fnszy(:,it)
     4      +         b_nir1nisj1sj1 * fnrx (:,it)  * fnsxy(:,it)
     5      +         b_nir1nisj1sj1 * fnry (:,it)  * fnsyy(:,it)
     6      +         b_nir1nisj1sj1 * fnrz (:,it)  * fnszy(:,it)
     7      -         b_nir1nisj1sj1 * flrho(:,it)  * fsy  (:,it)
     8      +         b_nir1nisj1sj2 * fnrx (:,itb) * fnsxy(:,itb)
     9      +         b_nir1nisj1sj2 * fnry (:,itb) * fnsyy(:,itb)
     8      +         b_nir1nisj1sj2 * fnrz (:,itb) * fnszy(:,itb)
     7      -         b_nir1nisj1sj2 * fnrx (:,it)  * fnsxy(:,itb)
     6      -         b_nir1nisj1sj2 * fnry (:,it)  * fnsyy(:,itb)
     5      -         b_nir1nisj1sj2 * fnrz (:,it)  * fnszy(:,itb)
     4      -         b_nir1nisj1sj2 * flrho(:,it)  * fsy  (:,itb)
     3      -         b_nir1nisj2sj1 * fnrx (:,itb) * fnsxy(:,itb)
     2      -         b_nir1nisj2sj1 * fnry (:,itb) * fnsyy(:,itb)
     1      -         b_nir1nisj2sj1 * fnrz (:,itb) * fnszy(:,itb)
     2      +         b_nir1nisj2sj1 * fnrx (:,it)  * fnsxy(:,itb)
     3      +         b_nir1nisj2sj1 * fnry (:,it)  * fnsyy(:,itb)
     4      +         b_nir1nisj2sj1 * fnrz (:,it)  * fnszy(:,itb)
     5      -         b_nir1nisj2sj1 * flrho(:,itb) * fsy  (:,itb)
     6      -         b_nir1nisj2sj2 * fnrx (:,itb) * fnsxy(:,it)
     7      -         b_nir1nisj2sj2 * fnry (:,itb) * fnsyy(:,it)
     8      -         b_nir1nisj2sj2 * fnrz (:,itb) * fnszy(:,it)
     9      +         b_nir1nisj2sj2 * fnrx (:,itb) * fnsxy(:,it)
     8      +         b_nir1nisj2sj2 * fnry (:,itb) * fnsyy(:,it)
     7      +         b_nir1nisj2sj2 * fnrz (:,itb) * fnszy(:,it)
     6      -         b_nir1nisj2sj2 * flrho(:,itb) * fsy  (:,it)
        potSz(:,it) = potSz(:,it)
     1      -         b_nir1nisj1sj1 * fnrx (:,it)  * fnsxz(:,it)
     2      -         b_nir1nisj1sj1 * fnry (:,it)  * fnsyz(:,it)
     3      -         b_nir1nisj1sj1 * fnrz (:,it)  * fnszz(:,it)
     4      +         b_nir1nisj1sj1 * fnrx (:,it)  * fnsxz(:,it)
     5      +         b_nir1nisj1sj1 * fnry (:,it)  * fnsyz(:,it)
     6      +         b_nir1nisj1sj1 * fnrz (:,it)  * fnszz(:,it)
     7      -         b_nir1nisj1sj1 * flrho(:,it)  * fsz  (:,it)
     8      +         b_nir1nisj1sj2 * fnrx (:,itb) * fnsxz(:,itb)
     9      +         b_nir1nisj1sj2 * fnry (:,itb) * fnsyz(:,itb)
     8      +         b_nir1nisj1sj2 * fnrz (:,itb) * fnszz(:,itb)
     7      -         b_nir1nisj1sj2 * fnrx (:,it)  * fnsxz(:,itb)
     6      -         b_nir1nisj1sj2 * fnry (:,it)  * fnsyz(:,itb)
     5      -         b_nir1nisj1sj2 * fnrz (:,it)  * fnszz(:,itb)
     4      -         b_nir1nisj1sj2 * flrho(:,it)  * fsz  (:,itb)
     3      -         b_nir1nisj2sj1 * fnrx (:,itb) * fnsxz(:,itb)
     2      -         b_nir1nisj2sj1 * fnry (:,itb) * fnsyz(:,itb)
     1      -         b_nir1nisj2sj1 * fnrz (:,itb) * fnszz(:,itb)
     2      +         b_nir1nisj2sj1 * fnrx (:,it)  * fnsxz(:,itb)
     3      +         b_nir1nisj2sj1 * fnry (:,it)  * fnsyz(:,itb)
     4      +         b_nir1nisj2sj1 * fnrz (:,it)  * fnszz(:,itb)
     5      -         b_nir1nisj2sj1 * flrho(:,itb) * fsz  (:,itb)
     6      -         b_nir1nisj2sj2 * fnrx (:,itb) * fnsxz(:,it)
     7      -         b_nir1nisj2sj2 * fnry (:,itb) * fnsyz(:,it)
     8      -         b_nir1nisj2sj2 * fnrz (:,itb) * fnszz(:,it)
     9      +         b_nir1nisj2sj2 * fnrx (:,itb) * fnsxz(:,it)
     8      +         b_nir1nisj2sj2 * fnry (:,itb) * fnsyz(:,it)
     7      +         b_nir1nisj2sj2 * fnrz (:,itb) * fnszz(:,it)
     6      -         b_nir1nisj2sj2 * flrho(:,itb) * fsz  (:,it)

        potSx(:,it) = potSx(:,it)
     1           +         b_ji1Jij1sj1 * fjx(:,it)  * fJxx(:,it)
     2           +         b_ji1Jij1sj1 * fjy(:,it)  * fJyx(:,it)
     3           +         b_ji1Jij1sj1 * fjz(:,it)  * fJzx(:,it)
     4           +         b_ji1Jij1sj2 * fjx(:,itb) * fJxx(:,itb)
     5           +         b_ji1Jij1sj2 * fjy(:,itb) * fJyx(:,itb)
     6           +         b_ji1Jij1sj2 * fjz(:,itb) * fJzx(:,itb)
     7           +         b_ji1Jij2sj1 * fjx(:,it)  * fJxx(:,itb)
     8           +         b_ji1Jij2sj1 * fjy(:,it)  * fJyx(:,itb)
     9           +         b_ji1Jij2sj1 * fjz(:,it)  * fJzx(:,itb)
     8           +         b_ji1Jij2sj2 * fjx(:,itb) * fJxx(:,it)
     7           +         b_ji1Jij2sj2 * fjy(:,itb) * fJyx(:,it)
     6           +         b_ji1Jij2sj2 * fjz(:,itb) * fJzx(:,it)
        potSy(:,it) = potSy(:,it)
     1           +         b_ji1Jij1sj1 * fjx(:,it)  * fJxy(:,it)
     2           +         b_ji1Jij1sj1 * fjy(:,it)  * fJyy(:,it)
     3           +         b_ji1Jij1sj1 * fjz(:,it)  * fJzy(:,it)
     4           +         b_ji1Jij1sj2 * fjx(:,itb) * fJxy(:,itb)
     5           +         b_ji1Jij1sj2 * fjy(:,itb) * fJyy(:,itb)
     6           +         b_ji1Jij1sj2 * fjz(:,itb) * fJzy(:,itb)
     7           +         b_ji1Jij2sj1 * fjx(:,it)  * fJxy(:,itb)
     8           +         b_ji1Jij2sj1 * fjy(:,it)  * fJyy(:,itb)
     9           +         b_ji1Jij2sj1 * fjz(:,it)  * fJzy(:,itb)
     8           +         b_ji1Jij2sj2 * fjx(:,itb) * fJxy(:,it)
     7           +         b_ji1Jij2sj2 * fjy(:,itb) * fJyy(:,it)
     6           +         b_ji1Jij2sj2 * fjz(:,itb) * fJzy(:,it)
        potSz(:,it) = potSz(:,it)
     1           +         b_ji1Jij1sj1 * fjx(:,it)  * fJxz(:,it)
     2           +         b_ji1Jij1sj1 * fjy(:,it)  * fJyz(:,it)
     3           +         b_ji1Jij1sj1 * fjz(:,it)  * fJzz(:,it)
     4           +         b_ji1Jij1sj2 * fjx(:,itb) * fJxz(:,itb)
     5           +         b_ji1Jij1sj2 * fjy(:,itb) * fJyz(:,itb)
     6           +         b_ji1Jij1sj2 * fjz(:,itb) * fJzz(:,itb)
     7           +         b_ji1Jij2sj1 * fjx(:,it)  * fJxz(:,itb)
     8           +         b_ji1Jij2sj1 * fjy(:,it)  * fJyz(:,itb)
     9           +         b_ji1Jij2sj1 * fjz(:,it)  * fJzz(:,itb)
     8           +         b_ji1Jij2sj2 * fjx(:,itb) * fJxz(:,it)
     7           +         b_ji1Jij2sj2 * fjy(:,itb) * fJyz(:,it)
     6           +         b_ji1Jij2sj2 * fjz(:,itb) * fJzz(:,it)


        potSx(:,it) = potSx(:,it)                     ! Warning: vector product
     1      -         b_nisa1Jib1sc1 * fJxy (:,it)  * fnsxz(:,it)
     2      -         b_nisa1Jib1sc1 * fJyy (:,it)  * fnsyz(:,it)
     3      -         b_nisa1Jib1sc1 * fJzy (:,it)  * fnszz(:,it)
     4      -         b_nisa1Jib1sc1 * fnJy (:,it)  * fsz  (:,it)
     5      +         b_nisa1Jib1sc1 * fnsxy(:,it)  * fJxz (:,it)
     6      +         b_nisa1Jib1sc1 * fnsyy(:,it)  * fJyz (:,it)
     7      +         b_nisa1Jib1sc1 * fnszy(:,it)  * fJzz (:,it)
     8      -         b_nisa1Jib1sc2 * fJxy (:,it)  * fnsxz(:,itb)
     9      -         b_nisa1Jib1sc2 * fJyy (:,it)  * fnsyz(:,itb)
     8      -         b_nisa1Jib1sc2 * fJzy (:,it)  * fnszz(:,itb)
     7      -         b_nisa1Jib1sc2 * fnJy (:,it)  * fsz  (:,itb)
     6      +         b_nisa1Jib1sc2 * fnsxy(:,itb) * fJxz (:,itb)
     5      +         b_nisa1Jib1sc2 * fnsyy(:,itb) * fJyz (:,itb)
     4      +         b_nisa1Jib1sc2 * fnszy(:,itb) * fJzz (:,itb)
     3      -         b_nisa1Jib2sc1 * fJxy (:,itb) * fnsxz(:,it)
     2      -         b_nisa1Jib2sc1 * fJyy (:,itb) * fnsyz(:,it)
     1      -         b_nisa1Jib2sc1 * fJzy (:,itb) * fnszz(:,it)
     2      -         b_nisa1Jib2sc1 * fnJy (:,itb) * fsz  (:,it)
     3      +         b_nisa1Jib2sc1 * fnsxy(:,it)  * fJxz (:,itb)
     4      +         b_nisa1Jib2sc1 * fnsyy(:,it)  * fJyz (:,itb)
     5      +         b_nisa1Jib2sc1 * fnszy(:,it)  * fJzz (:,itb)
     6      -         b_nisa1Jib2sc2 * fJxy (:,itb) * fnsxz(:,itb)
     7      -         b_nisa1Jib2sc2 * fJyy (:,itb) * fnsyz(:,itb)
     8      -         b_nisa1Jib2sc2 * fJzy (:,itb) * fnszz(:,itb)
     9      -         b_nisa1Jib2sc2 * fnJy (:,itb) * fsz  (:,itb)
     8      +         b_nisa1Jib2sc2 * fnsxy(:,itb) * fJxz (:,it)
     7      +         b_nisa1Jib2sc2 * fnsyy(:,itb) * fJyz (:,it)
     6      +         b_nisa1Jib2sc2 * fnszy(:,itb) * fJzz (:,it)
     1      +         b_nisa1Jib1sc1 * fJxz (:,it)  * fnsxy(:,it)
     2      +         b_nisa1Jib1sc1 * fJyz (:,it)  * fnsyy(:,it)
     3      +         b_nisa1Jib1sc1 * fJzz (:,it)  * fnszy(:,it)
     4      +         b_nisa1Jib1sc1 * fnJz (:,it)  * fsy  (:,it)
     5      -         b_nisa1Jib1sc1 * fnsxz(:,it)  * fJxy (:,it)
     6      -         b_nisa1Jib1sc1 * fnsyz(:,it)  * fJyy (:,it)
     7      -         b_nisa1Jib1sc1 * fnszz(:,it)  * fJzy (:,it)
     8      +         b_nisa1Jib1sc2 * fJxz (:,it)  * fnsxy(:,itb)
     9      +         b_nisa1Jib1sc2 * fJyz (:,it)  * fnsyy(:,itb)
     8      +         b_nisa1Jib1sc2 * fJzz (:,it)  * fnszy(:,itb)
     7      +         b_nisa1Jib1sc2 * fnJz (:,it)  * fsy  (:,itb)
     6      -         b_nisa1Jib1sc2 * fnsxz(:,itb) * fJxy (:,itb)
     5      -         b_nisa1Jib1sc2 * fnsyz(:,itb) * fJyy (:,itb)
     4      -         b_nisa1Jib1sc2 * fnszz(:,itb) * fJzy (:,itb)
     3      +         b_nisa1Jib2sc1 * fJxz (:,itb) * fnsxy(:,it)
     2      +         b_nisa1Jib2sc1 * fJyz (:,itb) * fnsyy(:,it)
     1      +         b_nisa1Jib2sc1 * fJzz (:,itb) * fnszy(:,it)
     2      +         b_nisa1Jib2sc1 * fnJz (:,itb) * fsy  (:,it)
     3      -         b_nisa1Jib2sc1 * fnsxz(:,it)  * fJxy (:,itb)
     4      -         b_nisa1Jib2sc1 * fnsyz(:,it)  * fJyy (:,itb)
     5      -         b_nisa1Jib2sc1 * fnszz(:,it)  * fJzy (:,itb)
     6      +         b_nisa1Jib2sc2 * fJxz (:,itb) * fnsxy(:,itb)
     7      +         b_nisa1Jib2sc2 * fJyz (:,itb) * fnsyy(:,itb)
     8      +         b_nisa1Jib2sc2 * fJzz (:,itb) * fnszy(:,itb)
     9      +         b_nisa1Jib2sc2 * fnJz (:,itb) * fsy  (:,itb)
     8      -         b_nisa1Jib2sc2 * fnsxz(:,itb) * fJxy (:,it)
     7      -         b_nisa1Jib2sc2 * fnsyz(:,itb) * fJyy (:,it)
     6      -         b_nisa1Jib2sc2 * fnszz(:,itb) * fJzy (:,it)
        potSy(:,it) = potSy(:,it)  ! Warning vectoriel product
     1      +         b_nisa1Jib1sc1 * fJxx (:,it)  * fnsxz(:,it)
     2      +         b_nisa1Jib1sc1 * fJyx (:,it)  * fnsyz(:,it)
     3      +         b_nisa1Jib1sc1 * fJzx (:,it)  * fnszz(:,it)
     4      +         b_nisa1Jib1sc1 * fnJx (:,it)  * fsz  (:,it)
     5      -         b_nisa1Jib1sc1 * fnsxx(:,it)  * fJxz (:,it)
     6      -         b_nisa1Jib1sc1 * fnsyx(:,it)  * fJyz (:,it)
     7      -         b_nisa1Jib1sc1 * fnszx(:,it)  * fJzz (:,it)
     8      +         b_nisa1Jib1sc2 * fJxx (:,it)  * fnsxz(:,itb)
     9      +         b_nisa1Jib1sc2 * fJyx (:,it)  * fnsyz(:,itb)
     8      +         b_nisa1Jib1sc2 * fJzx (:,it)  * fnszz(:,itb)
     7      +         b_nisa1Jib1sc2 * fnJx (:,it)  * fsz  (:,itb)
     6      -         b_nisa1Jib1sc2 * fnsxx(:,itb) * fJxz (:,itb)
     5      -         b_nisa1Jib1sc2 * fnsyx(:,itb) * fJyz (:,itb)
     4      -         b_nisa1Jib1sc2 * fnszx(:,itb) * fJzz (:,itb)
     3      +         b_nisa1Jib2sc1 * fJxx (:,itb) * fnsxz(:,it)
     2      +         b_nisa1Jib2sc1 * fJyx (:,itb) * fnsyz(:,it)
     1      +         b_nisa1Jib2sc1 * fJzx (:,itb) * fnszz(:,it)
     2      +         b_nisa1Jib2sc1 * fnJx (:,itb) * fsz  (:,it)
     3      -         b_nisa1Jib2sc1 * fnsxx(:,it)  * fJxz (:,itb)
     4      -         b_nisa1Jib2sc1 * fnsyx(:,it)  * fJyz (:,itb)
     5      -         b_nisa1Jib2sc1 * fnszx(:,it)  * fJzz (:,itb)
     6      +         b_nisa1Jib2sc2 * fJxx (:,itb) * fnsxz(:,itb)
     7      +         b_nisa1Jib2sc2 * fJyx (:,itb) * fnsyz(:,itb)
     8      +         b_nisa1Jib2sc2 * fJzx (:,itb) * fnszz(:,itb)
     9      +         b_nisa1Jib2sc2 * fnJx (:,itb) * fsz  (:,itb)
     8      -         b_nisa1Jib2sc2 * fnsxx(:,itb) * fJxz (:,it)
     7      -         b_nisa1Jib2sc2 * fnsyx(:,itb) * fJyz (:,it)
     6      -         b_nisa1Jib2sc2 * fnszx(:,itb) * fJzz (:,it)
     1      -         b_nisa1Jib1sc1 * fJxz (:,it)  * fnsxx(:,it)
     2      -         b_nisa1Jib1sc1 * fJyz (:,it)  * fnsyx(:,it)
     3      -         b_nisa1Jib1sc1 * fJzz (:,it)  * fnszx(:,it)
     4      -         b_nisa1Jib1sc1 * fnJz (:,it)  * fsx  (:,it)
     5      +         b_nisa1Jib1sc1 * fnsxz(:,it)  * fJxx (:,it)
     6      +         b_nisa1Jib1sc1 * fnsyz(:,it)  * fJyx (:,it)
     7      +         b_nisa1Jib1sc1 * fnszz(:,it)  * fJzx (:,it)
     8      -         b_nisa1Jib1sc2 * fJxz (:,it)  * fnsxx(:,itb)
     9      -         b_nisa1Jib1sc2 * fJyz (:,it)  * fnsyx(:,itb)
     8      -         b_nisa1Jib1sc2 * fJzz (:,it)  * fnszx(:,itb)
     7      -         b_nisa1Jib1sc2 * fnJz (:,it)  * fsx  (:,itb)
     6      +         b_nisa1Jib1sc2 * fnsxz(:,itb) * fJxx (:,itb)
     5      +         b_nisa1Jib1sc2 * fnsyz(:,itb) * fJyx (:,itb)
     4      +         b_nisa1Jib1sc2 * fnszz(:,itb) * fJzx (:,itb)
     3      -         b_nisa1Jib2sc1 * fJxz (:,itb) * fnsxx(:,it)
     2      -         b_nisa1Jib2sc1 * fJyz (:,itb) * fnsyx(:,it)
     1      -         b_nisa1Jib2sc1 * fJzz (:,itb) * fnszx(:,it)
     2      -         b_nisa1Jib2sc1 * fnJz (:,itb) * fsx  (:,it)
     3      +         b_nisa1Jib2sc1 * fnsxz(:,it)  * fJxx (:,itb)
     4      +         b_nisa1Jib2sc1 * fnsyz(:,it)  * fJyx (:,itb)
     5      +         b_nisa1Jib2sc1 * fnszz(:,it)  * fJzx (:,itb)
     6      -         b_nisa1Jib2sc2 * fJxz (:,itb) * fnsxx(:,itb)
     7      -         b_nisa1Jib2sc2 * fJyz (:,itb) * fnsyx(:,itb)
     8      -         b_nisa1Jib2sc2 * fJzz (:,itb) * fnszx(:,itb)
     9      -         b_nisa1Jib2sc2 * fnJz (:,itb) * fsx  (:,itb)
     8      +         b_nisa1Jib2sc2 * fnsxz(:,itb) * fJxx (:,it)
     7      +         b_nisa1Jib2sc2 * fnsyz(:,itb) * fJyx (:,it)
     6      +         b_nisa1Jib2sc2 * fnszz(:,itb) * fJzx (:,it)
        potSz(:,it) = potSz(:,it)  ! Warning vectoriel product
     1      -         b_nisa1Jib1sc1 * fJxx (:,it)  * fnsxy(:,it)
     2      -         b_nisa1Jib1sc1 * fJyx (:,it)  * fnsyy(:,it)
     3      -         b_nisa1Jib1sc1 * fJzx (:,it)  * fnszy(:,it)
     4      -         b_nisa1Jib1sc1 * fnJx (:,it)  * fsy  (:,it)
     5      +         b_nisa1Jib1sc1 * fnsxx(:,it)  * fJxy (:,it)
     6      +         b_nisa1Jib1sc1 * fnsyx(:,it)  * fJyy (:,it)
     7      +         b_nisa1Jib1sc1 * fnszx(:,it)  * fJzy (:,it)
     8      -         b_nisa1Jib1sc2 * fJxx (:,it)  * fnsxy(:,itb)
     9      -         b_nisa1Jib1sc2 * fJyx (:,it)  * fnsyy(:,itb)
     8      -         b_nisa1Jib1sc2 * fJzx (:,it)  * fnszy(:,itb)
     7      -         b_nisa1Jib1sc2 * fnJx (:,it)  * fsy  (:,itb)
     6      +         b_nisa1Jib1sc2 * fnsxx(:,itb) * fJxy (:,itb)
     5      +         b_nisa1Jib1sc2 * fnsyx(:,itb) * fJyy (:,itb)
     4      +         b_nisa1Jib1sc2 * fnszx(:,itb) * fJzy (:,itb)
     3      -         b_nisa1Jib2sc1 * fJxx (:,itb) * fnsxy(:,it)
     2      -         b_nisa1Jib2sc1 * fJyx (:,itb) * fnsyy(:,it)
     1      -         b_nisa1Jib2sc1 * fJzx (:,itb) * fnszy(:,it)
     2      -         b_nisa1Jib2sc1 * fnJx (:,itb) * fsy  (:,it)
     3      +         b_nisa1Jib2sc1 * fnsxx(:,it)  * fJxy (:,itb)
     4      +         b_nisa1Jib2sc1 * fnsyx(:,it)  * fJyy (:,itb)
     5      +         b_nisa1Jib2sc1 * fnszx(:,it)  * fJzy (:,itb)
     6      -         b_nisa1Jib2sc2 * fJxx (:,itb) * fnsxy(:,itb)
     7      -         b_nisa1Jib2sc2 * fJyx (:,itb) * fnsyy(:,itb)
     8      -         b_nisa1Jib2sc2 * fJzx (:,itb) * fnszy(:,itb)
     9      -         b_nisa1Jib2sc2 * fnJx (:,itb) * fsy  (:,itb)
     8      +         b_nisa1Jib2sc2 * fnsxx(:,itb) * fJxy (:,it)
     7      +         b_nisa1Jib2sc2 * fnsyx(:,itb) * fJyy (:,it)
     6      +         b_nisa1Jib2sc2 * fnszx(:,itb) * fJzy (:,it)
     1      +         b_nisa1Jib1sc1 * fJxy (:,it)  * fnsxx(:,it)
     2      +         b_nisa1Jib1sc1 * fJyy (:,it)  * fnsyx(:,it)
     3      +         b_nisa1Jib1sc1 * fJzy (:,it)  * fnszx(:,it)
     4      +         b_nisa1Jib1sc1 * fnJy (:,it)  * fsx  (:,it)
     5      -         b_nisa1Jib1sc1 * fnsxy(:,it)  * fJxx (:,it)
     6      -         b_nisa1Jib1sc1 * fnsyy(:,it)  * fJyx (:,it)
     7      -         b_nisa1Jib1sc1 * fnszy(:,it)  * fJzx (:,it)
     8      +         b_nisa1Jib1sc2 * fJxy (:,it)  * fnsxx(:,itb)
     9      +         b_nisa1Jib1sc2 * fJyy (:,it)  * fnsyx(:,itb)
     8      +         b_nisa1Jib1sc2 * fJzy (:,it)  * fnszx(:,itb)
     7      +         b_nisa1Jib1sc2 * fnJy (:,it)  * fsx  (:,itb)
     6      -         b_nisa1Jib1sc2 * fnsxy(:,itb) * fJxx (:,itb)
     5      -         b_nisa1Jib1sc2 * fnsyy(:,itb) * fJyx (:,itb)
     4      -         b_nisa1Jib1sc2 * fnszy(:,itb) * fJzx (:,itb)
     3      +         b_nisa1Jib2sc1 * fJxy (:,itb) * fnsxx(:,it)
     2      +         b_nisa1Jib2sc1 * fJyy (:,itb) * fnsyx(:,it)
     1      +         b_nisa1Jib2sc1 * fJzy (:,itb) * fnszx(:,it)
     2      +         b_nisa1Jib2sc1 * fnJy (:,itb) * fsx  (:,it)
     3      -         b_nisa1Jib2sc1 * fnsxy(:,it)  * fJxx (:,itb)
     4      -         b_nisa1Jib2sc1 * fnsyy(:,it)  * fJyx (:,itb)
     5      -         b_nisa1Jib2sc1 * fnszy(:,it)  * fJzx (:,itb)
     6      +         b_nisa1Jib2sc2 * fJxy (:,itb) * fnsxx(:,itb)
     7      +         b_nisa1Jib2sc2 * fJyy (:,itb) * fnsyx(:,itb)
     8      +         b_nisa1Jib2sc2 * fJzy (:,itb) * fnszx(:,itb)
     9      +         b_nisa1Jib2sc2 * fnJy (:,itb) * fsx  (:,itb)
     8      -         b_nisa1Jib2sc2 * fnsxy(:,itb) * fJxx (:,it)
     7      -         b_nisa1Jib2sc2 * fnsyy(:,itb) * fJyx (:,it)
     6      -         b_nisa1Jib2sc2 * fnszy(:,itb) * fJzx (:,it)

        potSx(:,it) = potSx(:,it)
     1   -         b_nirg1Jdij1sj1 * fnrtxr(:,it)  * fJtxxi(:,it)
     2   -         b_nirg1Jdij1sj1 * fnrtyr(:,it)  * fJtyxi(:,it)
     3   -         b_nirg1Jdij1sj1 * fnrtzr(:,it)  * fJtzxi(:,it)
     4   -         b_nirg1Jdij1sj2 * fnrtxr(:,itb) * fJtxxi(:,itb)
     5   -         b_nirg1Jdij1sj2 * fnrtyr(:,itb) * fJtyxi(:,itb)
     6   -         b_nirg1Jdij1sj2 * fnrtzr(:,itb) * fJtzxi(:,itb)
     7   +         b_nird1Jgij1sj1 * fnrtxr(:,it)  * fJtxxi(:,it)
     8   +         b_nird1Jgij1sj1 * fnrtyr(:,it)  * fJtyxi(:,it)
     9   +         b_nird1Jgij1sj1 * fnrtzr(:,it)  * fJtzxi(:,it)
     8   +         b_nird1Jgij1sj2 * fnrtxr(:,itb) * fJtxxi(:,itb)
     7   +         b_nird1Jgij1sj2 * fnrtyr(:,itb) * fJtyxi(:,itb)
     6   +         b_nird1Jgij1sj2 * fnrtzr(:,itb) * fJtzxi(:,itb)
     1   +         b_nirg1Jdij1sj1 * fnrtxi(:,it)  * fJtxxr(:,it)
     2   +         b_nirg1Jdij1sj1 * fnrtyi(:,it)  * fJtyxr(:,it)
     3   +         b_nirg1Jdij1sj1 * fnrtzi(:,it)  * fJtzxr(:,it)
     4   +         b_nirg1Jdij1sj2 * fnrtxi(:,itb) * fJtxxr(:,itb)
     5   +         b_nirg1Jdij1sj2 * fnrtyi(:,itb) * fJtyxr(:,itb)
     6   +         b_nirg1Jdij1sj2 * fnrtzi(:,itb) * fJtzxr(:,itb)
     7   -         b_nird1Jgij1sj1 * fnrtxi(:,it)  * fJtxxr(:,it)
     8   -         b_nird1Jgij1sj1 * fnrtyi(:,it)  * fJtyxr(:,it)
     9   -         b_nird1Jgij1sj1 * fnrtzi(:,it)  * fJtzxr(:,it)
     8   -         b_nird1Jgij1sj2 * fnrtxi(:,itb) * fJtxxr(:,itb)
     7   -         b_nird1Jgij1sj2 * fnrtyi(:,itb) * fJtyxr(:,itb)
     6   -         b_nird1Jgij1sj2 * fnrtzi(:,itb) * fJtzxr(:,itb)
        potSy(:,it) = potSy(:,it)
     1   -         b_nirg1Jdij1sj1 * fnrtxr(:,it)  * fJtxyi(:,it)
     2   -         b_nirg1Jdij1sj1 * fnrtyr(:,it)  * fJtyyi(:,it)
     3   -         b_nirg1Jdij1sj1 * fnrtzr(:,it)  * fJtzyi(:,it)
     4   -         b_nirg1Jdij1sj2 * fnrtxr(:,itb) * fJtxyi(:,itb)
     5   -         b_nirg1Jdij1sj2 * fnrtyr(:,itb) * fJtyyi(:,itb)
     6   -         b_nirg1Jdij1sj2 * fnrtzr(:,itb) * fJtzyi(:,itb)
     7   +         b_nird1Jgij1sj1 * fnrtxr(:,it)  * fJtxyi(:,it)
     8   +         b_nird1Jgij1sj1 * fnrtyr(:,it)  * fJtyyi(:,it)
     9   +         b_nird1Jgij1sj1 * fnrtzr(:,it)  * fJtzyi(:,it)
     8   +         b_nird1Jgij1sj2 * fnrtxr(:,itb) * fJtxyi(:,itb)
     7   +         b_nird1Jgij1sj2 * fnrtyr(:,itb) * fJtyyi(:,itb)
     6   +         b_nird1Jgij1sj2 * fnrtzr(:,itb) * fJtzyi(:,itb)
     1   +         b_nirg1Jdij1sj1 * fnrtxi(:,it)  * fJtxyr(:,it)
     2   +         b_nirg1Jdij1sj1 * fnrtyi(:,it)  * fJtyyr(:,it)
     3   +         b_nirg1Jdij1sj1 * fnrtzi(:,it)  * fJtzyr(:,it)
     4   +         b_nirg1Jdij1sj2 * fnrtxi(:,itb) * fJtxyr(:,itb)
     5   +         b_nirg1Jdij1sj2 * fnrtyi(:,itb) * fJtyyr(:,itb)
     6   +         b_nirg1Jdij1sj2 * fnrtzi(:,itb) * fJtzyr(:,itb)
     7   -         b_nird1Jgij1sj1 * fnrtxi(:,it)  * fJtxyr(:,it)
     8   -         b_nird1Jgij1sj1 * fnrtyi(:,it)  * fJtyyr(:,it)
     9   -         b_nird1Jgij1sj1 * fnrtzi(:,it)  * fJtzyr(:,it)
     8   -         b_nird1Jgij1sj2 * fnrtxi(:,itb) * fJtxyr(:,itb)
     7   -         b_nird1Jgij1sj2 * fnrtyi(:,itb) * fJtyyr(:,itb)
     6   -         b_nird1Jgij1sj2 * fnrtzi(:,itb) * fJtzyr(:,itb)
        potSz(:,it) = potSz(:,it)
     1   -         b_nirg1Jdij1sj1 * fnrtxr(:,it)  * fJtxzi(:,it)
     2   -         b_nirg1Jdij1sj1 * fnrtyr(:,it)  * fJtyzi(:,it)
     3   -         b_nirg1Jdij1sj1 * fnrtzr(:,it)  * fJtzzi(:,it)
     4   -         b_nirg1Jdij1sj2 * fnrtxr(:,itb) * fJtxzi(:,itb)
     5   -         b_nirg1Jdij1sj2 * fnrtyr(:,itb) * fJtyzi(:,itb)
     6   -         b_nirg1Jdij1sj2 * fnrtzr(:,itb) * fJtzzi(:,itb)
     7   +         b_nird1Jgij1sj1 * fnrtxr(:,it)  * fJtxzi(:,it)
     8   +         b_nird1Jgij1sj1 * fnrtyr(:,it)  * fJtyzi(:,it)
     9   +         b_nird1Jgij1sj1 * fnrtzr(:,it)  * fJtzzi(:,it)
     8   +         b_nird1Jgij1sj2 * fnrtxr(:,itb) * fJtxzi(:,itb)
     7   +         b_nird1Jgij1sj2 * fnrtyr(:,itb) * fJtyzi(:,itb)
     6   +         b_nird1Jgij1sj2 * fnrtzr(:,itb) * fJtzzi(:,itb)
     1   +         b_nirg1Jdij1sj1 * fnrtxi(:,it)  * fJtxzr(:,it)
     2   +         b_nirg1Jdij1sj1 * fnrtyi(:,it)  * fJtyzr(:,it)
     3   +         b_nirg1Jdij1sj1 * fnrtzi(:,it)  * fJtzzr(:,it)
     4   +         b_nirg1Jdij1sj2 * fnrtxi(:,itb) * fJtxzr(:,itb)
     5   +         b_nirg1Jdij1sj2 * fnrtyi(:,itb) * fJtyzr(:,itb)
     6   +         b_nirg1Jdij1sj2 * fnrtzi(:,itb) * fJtzzr(:,itb)
     7   -         b_nird1Jgij1sj1 * fnrtxi(:,it)  * fJtxzr(:,it)
     8   -         b_nird1Jgij1sj1 * fnrtyi(:,it)  * fJtyzr(:,it)
     9   -         b_nird1Jgij1sj1 * fnrtzi(:,it)  * fJtzzr(:,it)
     8   -         b_nird1Jgij1sj2 * fnrtxi(:,itb) * fJtxzr(:,itb)
     7   -         b_nird1Jgij1sj2 * fnrtyi(:,itb) * fJtyzr(:,itb)
     6   -         b_nird1Jgij1sj2 * fnrtzi(:,itb) * fJtzzr(:,itb)

        potSx(:,it) = potSx(:,it)
     1   +         b_nisj1Jgij1rd1 * fJtxxr(:,it)  * fnrtxi(:,it)
     2   +         b_nisj1Jgij1rd1 * fJtyxr(:,it)  * fnrtyi(:,it)
     3   +         b_nisj1Jgij1rd1 * fJtzxr(:,it)  * fnrtzi(:,it)
     4   +         b_nisj1Jgij1rd1 * fnJtxr(:,it)  * frhoti(:,it)
     5   -         b_nisj1Jdij1rg1 * fJtxxr(:,it)  * fnrtxi(:,it)
     6   -         b_nisj1Jdij1rg1 * fJtyxr(:,it)  * fnrtyi(:,it)
     7   -         b_nisj1Jdij1rg1 * fJtzxr(:,it)  * fnrtzi(:,it)
     8   -         b_nisj1Jdij1rg1 * fnJtxr(:,it)  * frhoti(:,it)
     1   +         b_nisj2Jgij1rd1 * fJtxxr(:,itb) * fnrtxi(:,itb)
     2   +         b_nisj2Jgij1rd1 * fJtyxr(:,itb) * fnrtyi(:,itb)
     3   +         b_nisj2Jgij1rd1 * fJtzxr(:,itb) * fnrtzi(:,itb)
     4   +         b_nisj2Jgij1rd1 * fnJtxr(:,itb) * frhoti(:,itb)
     5   -         b_nisj2Jdij1rg1 * fJtxxr(:,itb) * fnrtxi(:,itb)
     6   -         b_nisj2Jdij1rg1 * fJtyxr(:,itb) * fnrtyi(:,itb)
     7   -         b_nisj2Jdij1rg1 * fJtzxr(:,itb) * fnrtzi(:,itb)
     8   -         b_nisj2Jdij1rg1 * fnJtxr(:,itb) * frhoti(:,itb)
     1   -         b_nisj1Jgij1rd1 * fJtxxi(:,it)  * fnrtxr(:,it)
     2   -         b_nisj1Jgij1rd1 * fJtyxi(:,it)  * fnrtyr(:,it)
     3   -         b_nisj1Jgij1rd1 * fJtzxi(:,it)  * fnrtzr(:,it)
     4   -         b_nisj1Jgij1rd1 * fnJtxi(:,it)  * frhotr(:,it)
     5   +         b_nisj1Jdij1rg1 * fJtxxi(:,it)  * fnrtxr(:,it)
     6   +         b_nisj1Jdij1rg1 * fJtyxi(:,it)  * fnrtyr(:,it)
     7   +         b_nisj1Jdij1rg1 * fJtzxi(:,it)  * fnrtzr(:,it)
     8   +         b_nisj1Jdij1rg1 * fnJtxi(:,it)  * frhotr(:,it)
     1   -         b_nisj2Jgij1rd1 * fJtxxi(:,itb) * fnrtxr(:,itb)
     2   -         b_nisj2Jgij1rd1 * fJtyxi(:,itb) * fnrtyr(:,itb)
     3   -         b_nisj2Jgij1rd1 * fJtzxi(:,itb) * fnrtzr(:,itb)
     4   -         b_nisj2Jgij1rd1 * fnJtxi(:,itb) * frhotr(:,itb)
     5   +         b_nisj2Jdij1rg1 * fJtxxi(:,itb) * fnrtxr(:,itb)
     6   +         b_nisj2Jdij1rg1 * fJtyxi(:,itb) * fnrtyr(:,itb)
     7   +         b_nisj2Jdij1rg1 * fJtzxi(:,itb) * fnrtzr(:,itb)
     8   +         b_nisj2Jdij1rg1 * fnJtxi(:,itb) * frhotr(:,itb)
        potSy(:,it) = potSy(:,it)
     1   +         b_nisj1Jgij1rd1 * fJtxyr(:,it)  * fnrtxi(:,it)
     2   +         b_nisj1Jgij1rd1 * fJtyyr(:,it)  * fnrtyi(:,it)
     3   +         b_nisj1Jgij1rd1 * fJtzyr(:,it)  * fnrtzi(:,it)
     4   +         b_nisj1Jgij1rd1 * fnJtyr(:,it)  * frhoti(:,it)
     5   -         b_nisj1Jdij1rg1 * fJtxyr(:,it)  * fnrtxi(:,it)
     6   -         b_nisj1Jdij1rg1 * fJtyyr(:,it)  * fnrtyi(:,it)
     7   -         b_nisj1Jdij1rg1 * fJtzyr(:,it)  * fnrtzi(:,it)
     8   -         b_nisj1Jdij1rg1 * fnJtyr(:,it)  * frhoti(:,it)
     1   +         b_nisj2Jgij1rd1 * fJtxyr(:,itb) * fnrtxi(:,itb)
     2   +         b_nisj2Jgij1rd1 * fJtyyr(:,itb) * fnrtyi(:,itb)
     3   +         b_nisj2Jgij1rd1 * fJtzyr(:,itb) * fnrtzi(:,itb)
     4   +         b_nisj2Jgij1rd1 * fnJtyr(:,itb) * frhoti(:,itb)
     5   -         b_nisj2Jdij1rg1 * fJtxyr(:,itb) * fnrtxi(:,itb)
     6   -         b_nisj2Jdij1rg1 * fJtyyr(:,itb) * fnrtyi(:,itb)
     7   -         b_nisj2Jdij1rg1 * fJtzyr(:,itb) * fnrtzi(:,itb)
     8   -         b_nisj2Jdij1rg1 * fnJtyr(:,itb) * frhoti(:,itb)
     1   -         b_nisj1Jgij1rd1 * fJtxyi(:,it)  * fnrtxr(:,it)
     2   -         b_nisj1Jgij1rd1 * fJtyyi(:,it)  * fnrtyr(:,it)
     3   -         b_nisj1Jgij1rd1 * fJtzyi(:,it)  * fnrtzr(:,it)
     4   -         b_nisj1Jgij1rd1 * fnJtyi(:,it)  * frhotr(:,it)
     5   +         b_nisj1Jdij1rg1 * fJtxyi(:,it)  * fnrtxr(:,it)
     6   +         b_nisj1Jdij1rg1 * fJtyyi(:,it)  * fnrtyr(:,it)
     7   +         b_nisj1Jdij1rg1 * fJtzyi(:,it)  * fnrtzr(:,it)
     8   +         b_nisj1Jdij1rg1 * fnJtyi(:,it)  * frhotr(:,it)
     1   -         b_nisj2Jgij1rd1 * fJtxyi(:,itb) * fnrtxr(:,itb)
     2   -         b_nisj2Jgij1rd1 * fJtyyi(:,itb) * fnrtyr(:,itb)
     3   -         b_nisj2Jgij1rd1 * fJtzyi(:,itb) * fnrtzr(:,itb)
     4   -         b_nisj2Jgij1rd1 * fnJtyi(:,itb) * frhotr(:,itb)
     5   +         b_nisj2Jdij1rg1 * fJtxyi(:,itb) * fnrtxr(:,itb)
     6   +         b_nisj2Jdij1rg1 * fJtyyi(:,itb) * fnrtyr(:,itb)
     7   +         b_nisj2Jdij1rg1 * fJtzyi(:,itb) * fnrtzr(:,itb)
     8   +         b_nisj2Jdij1rg1 * fnJtyi(:,itb) * frhotr(:,itb)
        potSz(:,it) = potSz(:,it)
     1   +         b_nisj1Jgij1rd1 * fJtxzr(:,it)  * fnrtxi(:,it)
     2   +         b_nisj1Jgij1rd1 * fJtyzr(:,it)  * fnrtyi(:,it)
     3   +         b_nisj1Jgij1rd1 * fJtzzr(:,it)  * fnrtzi(:,it)
     4   +         b_nisj1Jgij1rd1 * fnJtzr(:,it)  * frhoti(:,it)
     5   -         b_nisj1Jdij1rg1 * fJtxzr(:,it)  * fnrtxi(:,it)
     6   -         b_nisj1Jdij1rg1 * fJtyzr(:,it)  * fnrtyi(:,it)
     7   -         b_nisj1Jdij1rg1 * fJtzzr(:,it)  * fnrtzi(:,it)
     8   -         b_nisj1Jdij1rg1 * fnJtzr(:,it)  * frhoti(:,it)
     1   +         b_nisj2Jgij1rd1 * fJtxzr(:,itb) * fnrtxi(:,itb)
     2   +         b_nisj2Jgij1rd1 * fJtyzr(:,itb) * fnrtyi(:,itb)
     3   +         b_nisj2Jgij1rd1 * fJtzzr(:,itb) * fnrtzi(:,itb)
     4   +         b_nisj2Jgij1rd1 * fnJtzr(:,itb) * frhoti(:,itb)
     5   -         b_nisj2Jdij1rg1 * fJtxzr(:,itb) * fnrtxi(:,itb)
     6   -         b_nisj2Jdij1rg1 * fJtyzr(:,itb) * fnrtyi(:,itb)
     7   -         b_nisj2Jdij1rg1 * fJtzzr(:,itb) * fnrtzi(:,itb)
     8   -         b_nisj2Jdij1rg1 * fnJtzr(:,itb) * frhoti(:,itb)
     1   -         b_nisj1Jgij1rd1 * fJtxzi(:,it)  * fnrtxr(:,it)
     2   -         b_nisj1Jgij1rd1 * fJtyzi(:,it)  * fnrtyr(:,it)
     3   -         b_nisj1Jgij1rd1 * fJtzzi(:,it)  * fnrtzr(:,it)
     4   -         b_nisj1Jgij1rd1 * fnJtzi(:,it)  * frhotr(:,it)
     5   +         b_nisj1Jdij1rg1 * fJtxzi(:,it)  * fnrtxr(:,it)
     6   +         b_nisj1Jdij1rg1 * fJtyzi(:,it)  * fnrtyr(:,it)
     7   +         b_nisj1Jdij1rg1 * fJtzzi(:,it)  * fnrtzr(:,it)
     8   +         b_nisj1Jdij1rg1 * fnJtzi(:,it)  * frhotr(:,it)
     1   -         b_nisj2Jgij1rd1 * fJtxzi(:,itb) * fnrtxr(:,itb)
     2   -         b_nisj2Jgij1rd1 * fJtyzi(:,itb) * fnrtyr(:,itb)
     3   -         b_nisj2Jgij1rd1 * fJtzzi(:,itb) * fnrtzr(:,itb)
     4   -         b_nisj2Jgij1rd1 * fnJtzi(:,itb) * frhotr(:,itb)
     5   +         b_nisj2Jdij1rg1 * fJtxzi(:,itb) * fnrtxr(:,itb)
     6   +         b_nisj2Jdij1rg1 * fJtyzi(:,itb) * fnrtyr(:,itb)
     7   +         b_nisj2Jdij1rg1 * fJtzzi(:,itb) * fnrtzr(:,itb)
     8   +         b_nisj2Jdij1rg1 * fnJtzi(:,itb) * frhotr(:,itb)

        potSx(:,it) = potSx(:,it)  ! Warning vectoriel product
     1   -         b_Jgia1Jdib1sc1 * fJtxyr(:,it)  * fJtxzi(:,it)
     2   -         b_Jgia1Jdib1sc1 * fJtyyr(:,it)  * fJtyzi(:,it)
     3   -         b_Jgia1Jdib1sc1 * fJtzyr(:,it)  * fJtzzi(:,it)
     4   -         b_Jgia1Jdib1sc2 * fJtxyr(:,itb) * fJtxzi(:,itb)
     5   -         b_Jgia1Jdib1sc2 * fJtyyr(:,itb) * fJtyzi(:,itb)
     6   -         b_Jgia1Jdib1sc2 * fJtzyr(:,itb) * fJtzzi(:,itb)
     7   +         b_Jgia1Jdib1sc1 * fJtxyi(:,it)  * fJtxzr(:,it)
     8   +         b_Jgia1Jdib1sc1 * fJtyyi(:,it)  * fJtyzr(:,it)
     9   +         b_Jgia1Jdib1sc1 * fJtzyi(:,it)  * fJtzzr(:,it)
     8   +         b_Jgia1Jdib1sc2 * fJtxyi(:,itb) * fJtxzr(:,itb)
     7   +         b_Jgia1Jdib1sc2 * fJtyyi(:,itb) * fJtyzr(:,itb)
     6   +         b_Jgia1Jdib1sc2 * fJtzyi(:,itb) * fJtzzr(:,itb)
     1   +         b_Jgia1Jdib1sc1 * fJtxzr(:,it)  * fJtxyi(:,it)
     2   +         b_Jgia1Jdib1sc1 * fJtyzr(:,it)  * fJtyyi(:,it)
     3   +         b_Jgia1Jdib1sc1 * fJtzzr(:,it)  * fJtzyi(:,it)
     4   +         b_Jgia1Jdib1sc2 * fJtxzr(:,itb) * fJtxyi(:,itb)
     5   +         b_Jgia1Jdib1sc2 * fJtyzr(:,itb) * fJtyyi(:,itb)
     6   +         b_Jgia1Jdib1sc2 * fJtzzr(:,itb) * fJtzyi(:,itb)
     7   -         b_Jgia1Jdib1sc1 * fJtxzi(:,it)  * fJtxyr(:,it)
     8   -         b_Jgia1Jdib1sc1 * fJtyzi(:,it)  * fJtyyr(:,it)
     9   -         b_Jgia1Jdib1sc1 * fJtzzi(:,it)  * fJtzyr(:,it)
     8   -         b_Jgia1Jdib1sc2 * fJtxzi(:,itb) * fJtxyr(:,itb)
     7   -         b_Jgia1Jdib1sc2 * fJtyzi(:,itb) * fJtyyr(:,itb)
     6   -         b_Jgia1Jdib1sc2 * fJtzzi(:,itb) * fJtzyr(:,itb)
        potSy(:,it) = potSy(:,it)  ! Warning vectoriel product
     1   +         b_Jgia1Jdib1sc1 * fJtxxr(:,it)  * fJtxzi(:,it)
     2   +         b_Jgia1Jdib1sc1 * fJtyxr(:,it)  * fJtyzi(:,it)
     3   +         b_Jgia1Jdib1sc1 * fJtzxr(:,it)  * fJtzzi(:,it)
     4   +         b_Jgia1Jdib1sc2 * fJtxxr(:,itb) * fJtxzi(:,itb)
     5   +         b_Jgia1Jdib1sc2 * fJtyxr(:,itb) * fJtyzi(:,itb)
     6   +         b_Jgia1Jdib1sc2 * fJtzxr(:,itb) * fJtzzi(:,itb)
     7   -         b_Jgia1Jdib1sc1 * fJtxxi(:,it)  * fJtxzr(:,it)
     8   -         b_Jgia1Jdib1sc1 * fJtyxi(:,it)  * fJtyzr(:,it)
     9   -         b_Jgia1Jdib1sc1 * fJtzxi(:,it)  * fJtzzr(:,it)
     8   -         b_Jgia1Jdib1sc2 * fJtxxi(:,itb) * fJtxzr(:,itb)
     7   -         b_Jgia1Jdib1sc2 * fJtyxi(:,itb) * fJtyzr(:,itb)
     6   -         b_Jgia1Jdib1sc2 * fJtzxi(:,itb) * fJtzzr(:,itb)
     1   -         b_Jgia1Jdib1sc1 * fJtxzr(:,it)  * fJtxxi(:,it)
     2   -         b_Jgia1Jdib1sc1 * fJtyzr(:,it)  * fJtyxi(:,it)
     3   -         b_Jgia1Jdib1sc1 * fJtzzr(:,it)  * fJtzxi(:,it)
     4   -         b_Jgia1Jdib1sc2 * fJtxzr(:,itb) * fJtxxi(:,itb)
     5   -         b_Jgia1Jdib1sc2 * fJtyzr(:,itb) * fJtyxi(:,itb)
     6   -         b_Jgia1Jdib1sc2 * fJtzzr(:,itb) * fJtzxi(:,itb)
     7   +         b_Jgia1Jdib1sc1 * fJtxzi(:,it)  * fJtxxr(:,it)
     8   +         b_Jgia1Jdib1sc1 * fJtyzi(:,it)  * fJtyxr(:,it)
     9   +         b_Jgia1Jdib1sc1 * fJtzzi(:,it)  * fJtzxr(:,it)
     8   +         b_Jgia1Jdib1sc2 * fJtxzi(:,itb) * fJtxxr(:,itb)
     7   +         b_Jgia1Jdib1sc2 * fJtyzi(:,itb) * fJtyxr(:,itb)
     6   +         b_Jgia1Jdib1sc2 * fJtzzi(:,itb) * fJtzxr(:,itb)
        potSz(:,it) = potSz(:,it)  ! Warning vectoriel product
     1   -         b_Jgia1Jdib1sc1 * fJtxxr(:,it)  * fJtxyi(:,it)
     2   -         b_Jgia1Jdib1sc1 * fJtyxr(:,it)  * fJtyyi(:,it)
     3   -         b_Jgia1Jdib1sc1 * fJtzxr(:,it)  * fJtzyi(:,it)
     4   -         b_Jgia1Jdib1sc2 * fJtxxr(:,itb) * fJtxyi(:,itb)
     5   -         b_Jgia1Jdib1sc2 * fJtyxr(:,itb) * fJtyyi(:,itb)
     6   -         b_Jgia1Jdib1sc2 * fJtzxr(:,itb) * fJtzyi(:,itb)
     7   +         b_Jgia1Jdib1sc1 * fJtxxi(:,it)  * fJtxyr(:,it)
     8   +         b_Jgia1Jdib1sc1 * fJtyxi(:,it)  * fJtyyr(:,it)
     9   +         b_Jgia1Jdib1sc1 * fJtzxi(:,it)  * fJtzyr(:,it)
     8   +         b_Jgia1Jdib1sc2 * fJtxxi(:,itb) * fJtxyr(:,itb)
     7   +         b_Jgia1Jdib1sc2 * fJtyxi(:,itb) * fJtyyr(:,itb)
     6   +         b_Jgia1Jdib1sc2 * fJtzxi(:,itb) * fJtzyr(:,itb)
     1   +         b_Jgia1Jdib1sc1 * fJtxyr(:,it)  * fJtxxi(:,it)
     2   +         b_Jgia1Jdib1sc1 * fJtyyr(:,it)  * fJtyxi(:,it)
     3   +         b_Jgia1Jdib1sc1 * fJtzyr(:,it)  * fJtzxi(:,it)
     4   +         b_Jgia1Jdib1sc2 * fJtxyr(:,itb) * fJtxxi(:,itb)
     5   +         b_Jgia1Jdib1sc2 * fJtyyr(:,itb) * fJtyxi(:,itb)
     6   +         b_Jgia1Jdib1sc2 * fJtzyr(:,itb) * fJtzxi(:,itb)
     7   -         b_Jgia1Jdib1sc1 * fJtxyi(:,it)  * fJtxxr(:,it)
     8   -         b_Jgia1Jdib1sc1 * fJtyyi(:,it)  * fJtyxr(:,it)
     9   -         b_Jgia1Jdib1sc1 * fJtzyi(:,it)  * fJtzxr(:,it)
     8   -         b_Jgia1Jdib1sc2 * fJtxyi(:,itb) * fJtxxr(:,itb)
     7   -         b_Jgia1Jdib1sc2 * fJtyyi(:,itb) * fJtyxr(:,itb)
     6   -         b_Jgia1Jdib1sc2 * fJtzyi(:,itb) * fJtzxr(:,itb)
       enddo

c     .................... 3-body contribution to B field with normal densities
      do it=1,2
        itb = 3-it

        potB(:,it) = potB(:,it)
     1              +         b_t1r1r1 * frho(:,it)  * frho(:,it)
     2              +         b_t1r1r2 * frho(:,it)  * frho(:,itb)
     3              +         b_t1r2r2 * frho(:,itb) * frho(:,itb)
        potB(:,it) = potB(:,it)
     1              +         b_t1sj1sj1 * fsx(:,it)  * fsx(:,it)
     2              +         b_t1sj1sj1 * fsy(:,it)  * fsy(:,it)
     3              +         b_t1sj1sj1 * fsz(:,it)  * fsz(:,it)
     4              +         b_t1sj1sj2 * fsx(:,it)  * fsx(:,itb)
     5              +         b_t1sj1sj2 * fsy(:,it)  * fsy(:,itb)
     6              +         b_t1sj1sj2 * fsz(:,it)  * fsz(:,itb)
     7              +         b_t1sj2sj2 * fsx(:,itb) * fsx(:,itb)
     8              +         b_t1sj2sj2 * fsy(:,itb) * fsy(:,itb)
     9              +         b_t1sj2sj2 * fsz(:,itb) * fsz(:,itb)

c       .......................................... 3-body pairing contributions
        if (npair.ne.1) then
          potB(:,it) = potB(:,it)
     1              +         b_t1rg1rd1 * frhotr(:,it)  * frhotr(:,it)
     2              +         b_t2rg1rd1 * frhotr(:,itb) * frhotr(:,itb)
        endif
       enddo

c     ........................................... 3body contribution to C field
      do it=1,2
        itb = 3-it

        potCx(:,it) = potCx(:,it)
     1             +         b_Tj1sj1r2 * fsx(:,it)  * frho(:,itb)
     2             +         b_Tj1sj2r1 * fsx(:,itb) * frho(:,it)

        potCy(:,it) = potCy(:,it)
     1             +         b_Tj1sj1r2 * fsy(:,it)  * frho(:,itb)
     2             +         b_Tj1sj2r1 * fsy(:,itb) * frho(:,it)

        potCz(:,it) = potCz(:,it)
     1             +         b_Tj1sj1r2 * fsz(:,it)  * frho(:,itb)
     2             +         b_Tj1sj2r1 * fsz(:,itb) * frho(:,it)

       enddo

c     ........................................... 3body contribution to A field
      do it=1,2
        itb = 3-it

        potAx(:,it) = potAx(:,it)
     1             + 2.0d0 * b_ji1ji1r1 * fjx(:,it)  * frho(:,it)
     2             + 2.0d0 * b_ji1ji1r2 * fjx(:,it)  * frho(:,itb)
     3             +         b_ji1ji2r1 * fjx(:,itb) * frho(:,itb)
     4             +         b_ji1ji2r1 * fjx(:,itb) * frho(:,it)
        potAy(:,it) = potAy(:,it)
     1             + 2.0d0 * b_ji1ji1r1 * fjy(:,it)  * frho(:,it)
     2             + 2.0d0 * b_ji1ji1r2 * fjy(:,it)  * frho(:,itb)
     3             +         b_ji1ji2r1 * fjy(:,itb) * frho(:,itb)
     4             +         b_ji1ji2r1 * fjy(:,itb) * frho(:,it)
        potAz(:,it) = potAz(:,it)
     1             + 2.0d0 * b_ji1ji1r1 * fjz(:,it)  * frho(:,it)
     2             + 2.0d0 * b_ji1ji1r2 * fjz(:,it)  * frho(:,itb)
     3             +         b_ji1ji2r1 * fjz(:,itb) * frho(:,itb)
     4             +         b_ji1ji2r1 * fjz(:,itb) * frho(:,it)

        potAx(:,it) = potAx(:,it)
     1           +         b_ji1Jij1sj1 * fJxx(:,it)  * fsx(:,it)
     2           +         b_ji1Jij1sj1 * fJxy(:,it)  * fsy(:,it)
     3           +         b_ji1Jij1sj1 * fJxz(:,it)  * fsz(:,it)
     4           +         b_ji1Jij1sj2 * fJxx(:,it)  * fsx(:,itb)
     5           +         b_ji1Jij1sj2 * fJxy(:,it)  * fsy(:,itb)
     6           +         b_ji1Jij1sj2 * fJxz(:,it)  * fsz(:,itb)
     7           +         b_ji1Jij2sj1 * fJxx(:,itb) * fsx(:,it)
     8           +         b_ji1Jij2sj1 * fJxy(:,itb) * fsy(:,it)
     9           +         b_ji1Jij2sj1 * fJxz(:,itb) * fsz(:,it)
     8           +         b_ji1Jij2sj2 * fJxx(:,itb) * fsx(:,itb)
     7           +         b_ji1Jij2sj2 * fJxy(:,itb) * fsy(:,itb)
     6           +         b_ji1Jij2sj2 * fJxz(:,itb) * fsz(:,itb)
        potAy(:,it) = potAy(:,it)
     1           +         b_ji1Jij1sj1 * fJyx(:,it)  * fsx(:,it)
     2           +         b_ji1Jij1sj1 * fJyy(:,it)  * fsy(:,it)
     3           +         b_ji1Jij1sj1 * fJyz(:,it)  * fsz(:,it)
     4           +         b_ji1Jij1sj2 * fJyx(:,it)  * fsx(:,itb)
     5           +         b_ji1Jij1sj2 * fJyy(:,it)  * fsy(:,itb)
     6           +         b_ji1Jij1sj2 * fJyz(:,it)  * fsz(:,itb)
     7           +         b_ji1Jij2sj1 * fJyx(:,itb) * fsx(:,it)
     8           +         b_ji1Jij2sj1 * fJyy(:,itb) * fsy(:,it)
     9           +         b_ji1Jij2sj1 * fJyz(:,itb) * fsz(:,it)
     8           +         b_ji1Jij2sj2 * fJyx(:,itb) * fsx(:,itb)
     7           +         b_ji1Jij2sj2 * fJyy(:,itb) * fsy(:,itb)
     6           +         b_ji1Jij2sj2 * fJyz(:,itb) * fsz(:,itb)
        potAz(:,it) = potAz(:,it)
     1           +         b_ji1Jij1sj1 * fJzx(:,it)  * fsx(:,it)
     2           +         b_ji1Jij1sj1 * fJzy(:,it)  * fsy(:,it)
     3           +         b_ji1Jij1sj1 * fJzz(:,it)  * fsz(:,it)
     4           +         b_ji1Jij1sj2 * fJzx(:,it)  * fsx(:,itb)
     5           +         b_ji1Jij1sj2 * fJzy(:,it)  * fsy(:,itb)
     6           +         b_ji1Jij1sj2 * fJzz(:,it)  * fsz(:,itb)
     7           +         b_ji1Jij2sj1 * fJzx(:,itb) * fsx(:,it)
     8           +         b_ji1Jij2sj1 * fJzy(:,itb) * fsy(:,it)
     9           +         b_ji1Jij2sj1 * fJzz(:,itb) * fsz(:,it)
     8           +         b_ji1Jij2sj2 * fJzx(:,itb) * fsx(:,itb)
     7           +         b_ji1Jij2sj2 * fJzy(:,itb) * fsy(:,itb)
     6           +         b_ji1Jij2sj2 * fJzz(:,itb) * fsz(:,itb)

        potAx(:,it) = potAx(:,it)
     1     -         b_nirg1ji1rd1 * fnrtxr(:,it)  * frhoti(:,it)
     2     -         b_nirg1ji2rd1 * fnrtxr(:,itb) * frhoti(:,itb)
     3     +         b_nird1ji1rg1 * fnrtxr(:,it)  * frhoti(:,it)
     4     +         b_nird1ji2rg1 * fnrtxr(:,itb) * frhoti(:,itb)
     1     +         b_nirg1ji1rd1 * fnrtxi(:,it)  * frhotr(:,it)
     2     +         b_nirg1ji2rd1 * fnrtxi(:,itb) * frhotr(:,itb)
     3     -         b_nird1ji1rg1 * fnrtxi(:,it)  * frhotr(:,it)
     4     -         b_nird1ji2rg1 * fnrtxi(:,itb) * frhotr(:,itb)
        potAy(:,it) = potAy(:,it)
     1     -         b_nirg1ji1rd1 * fnrtyr(:,it)  * frhoti(:,it)
     2     -         b_nirg1ji2rd1 * fnrtyr(:,itb) * frhoti(:,itb)
     3     +         b_nird1ji1rg1 * fnrtyr(:,it)  * frhoti(:,it)
     4     +         b_nird1ji2rg1 * fnrtyr(:,itb) * frhoti(:,itb)
     1     +         b_nirg1ji1rd1 * fnrtyi(:,it)  * frhotr(:,it)
     2     +         b_nirg1ji2rd1 * fnrtyi(:,itb) * frhotr(:,itb)
     3     -         b_nird1ji1rg1 * fnrtyi(:,it)  * frhotr(:,it)
     4     -         b_nird1ji2rg1 * fnrtyi(:,itb) * frhotr(:,itb)
        potAz(:,it) = potAz(:,it)
     1     -         b_nirg1ji1rd1 * fnrtzr(:,it)  * frhoti(:,it)
     2     -         b_nirg1ji2rd1 * fnrtzr(:,itb) * frhoti(:,itb)
     3     +         b_nird1ji1rg1 * fnrtzr(:,it)  * frhoti(:,it)
     4     +         b_nird1ji2rg1 * fnrtzr(:,itb) * frhoti(:,itb)
     1     +         b_nirg1ji1rd1 * fnrtzi(:,it)  * frhotr(:,it)
     2     +         b_nirg1ji2rd1 * fnrtzi(:,itb) * frhotr(:,itb)
     3     -         b_nird1ji1rg1 * fnrtzi(:,it)  * frhotr(:,it)
     4     -         b_nird1ji2rg1 * fnrtzi(:,itb) * frhotr(:,itb)

      enddo

c     ........................................... 3body contribution to W field
      do it=1,2
        itb = 3-it

        potWxx(:,it) = potWxx(:,it)
     1          + 2.0d0 * b_Jij1Jij1r1 * fJxx(:,it)  * frho(:,it)
     2          + 2.0d0 * b_Jij1Jij1r2 * fJxx(:,it)  * frho(:,itb)
     3          +         b_Jij1Jij2r1 * fJxx(:,itb) * frho(:,itb)
     4          +         b_Jij1Jij2r1 * fJxx(:,itb) * frho(:,it)
        potWxy(:,it) = potWxy(:,it)
     1          + 2.0d0 * b_Jij1Jij1r1 * fJxy(:,it)  * frho(:,it)
     2          + 2.0d0 * b_Jij1Jij1r2 * fJxy(:,it)  * frho(:,itb)
     3          +         b_Jij1Jij2r1 * fJxy(:,itb) * frho(:,itb)
     4          +         b_Jij1Jij2r1 * fJxy(:,itb) * frho(:,it)
        potWxz(:,it) = potWxz(:,it)
     1          + 2.0d0 * b_Jij1Jij1r1 * fJxz(:,it)  * frho(:,it)
     2          + 2.0d0 * b_Jij1Jij1r2 * fJxz(:,it)  * frho(:,itb)
     3          +         b_Jij1Jij2r1 * fJxz(:,itb) * frho(:,itb)
     4          +         b_Jij1Jij2r1 * fJxz(:,itb) * frho(:,it)
        potWyx(:,it) = potWyx(:,it)
     1          + 2.0d0 * b_Jij1Jij1r1 * fJyx(:,it)  * frho(:,it)
     2          + 2.0d0 * b_Jij1Jij1r2 * fJyx(:,it)  * frho(:,itb)
     3          +         b_Jij1Jij2r1 * fJyx(:,itb) * frho(:,itb)
     4          +         b_Jij1Jij2r1 * fJyx(:,itb) * frho(:,it)
        potWyy(:,it) = potWyy(:,it)
     1          + 2.0d0 * b_Jij1Jij1r1 * fJyy(:,it)  * frho(:,it)
     2          + 2.0d0 * b_Jij1Jij1r2 * fJyy(:,it)  * frho(:,itb)
     3          +         b_Jij1Jij2r1 * fJyy(:,itb) * frho(:,itb)
     4          +         b_Jij1Jij2r1 * fJyy(:,itb) * frho(:,it)
        potWyz(:,it) = potWyz(:,it)
     1          + 2.0d0 * b_Jij1Jij1r1 * fJyz(:,it)  * frho(:,it)
     2          + 2.0d0 * b_Jij1Jij1r2 * fJyz(:,it)  * frho(:,itb)
     3          +         b_Jij1Jij2r1 * fJyz(:,itb) * frho(:,itb)
     4          +         b_Jij1Jij2r1 * fJyz(:,itb) * frho(:,it)
        potWzx(:,it) = potWzx(:,it)
     1          + 2.0d0 * b_Jij1Jij1r1 * fJzx(:,it)  * frho(:,it)
     2          + 2.0d0 * b_Jij1Jij1r2 * fJzx(:,it)  * frho(:,itb)
     3          +         b_Jij1Jij2r1 * fJzx(:,itb) * frho(:,itb)
     4          +         b_Jij1Jij2r1 * fJzx(:,itb) * frho(:,it)
        potWzy(:,it) = potWzy(:,it)
     1          + 2.0d0 * b_Jij1Jij1r1 * fJzy(:,it)  * frho(:,it)
     2          + 2.0d0 * b_Jij1Jij1r2 * fJzy(:,it)  * frho(:,itb)
     3          +         b_Jij1Jij2r1 * fJzy(:,itb) * frho(:,itb)
     4          +         b_Jij1Jij2r1 * fJzy(:,itb) * frho(:,it)
        potWzz(:,it) = potWzz(:,it)
     1          + 2.0d0 * b_Jij1Jij1r1 * fJzz(:,it)  * frho(:,it)
     2          + 2.0d0 * b_Jij1Jij1r2 * fJzz(:,it)  * frho(:,itb)
     3          +         b_Jij1Jij2r1 * fJzz(:,itb) * frho(:,itb)
     4          +         b_Jij1Jij2r1 * fJzz(:,itb) * frho(:,it)

        potWxx(:,it) = potWxx(:,it)
     1            +         b_ji1Jij1sj1 * fjx(:,it)  * fsx(:,it)
     2            +         b_ji1Jij1sj2 * fjx(:,it)  * fsx(:,itb)
     3            +         b_ji1Jij2sj1 * fjx(:,itb) * fsx(:,itb)
     4            +         b_ji1Jij2sj2 * fjx(:,itb) * fsx(:,it)
        potWxy(:,it) = potWxy(:,it)
     1            +         b_ji1Jij1sj1 * fjx(:,it)  * fsy(:,it)
     2            +         b_ji1Jij1sj2 * fjx(:,it)  * fsy(:,itb)
     3            +         b_ji1Jij2sj1 * fjx(:,itb) * fsy(:,itb)
     4            +         b_ji1Jij2sj2 * fjx(:,itb) * fsy(:,it)
        potWxz(:,it) = potWxz(:,it)
     1            +         b_ji1Jij1sj1 * fjx(:,it)  * fsz(:,it)
     2            +         b_ji1Jij1sj2 * fjx(:,it)  * fsz(:,itb)
     3            +         b_ji1Jij2sj1 * fjx(:,itb) * fsz(:,itb)
     4            +         b_ji1Jij2sj2 * fjx(:,itb) * fsz(:,it)
        potWyx(:,it) = potWyx(:,it)
     1            +         b_ji1Jij1sj1 * fjy(:,it)  * fsx(:,it)
     2            +         b_ji1Jij1sj2 * fjy(:,it)  * fsx(:,itb)
     3            +         b_ji1Jij2sj1 * fjy(:,itb) * fsx(:,itb)
     4            +         b_ji1Jij2sj2 * fjy(:,itb) * fsx(:,it)
        potWyy(:,it) = potWyy(:,it)
     1            +         b_ji1Jij1sj1 * fjy(:,it)  * fsy(:,it)
     2            +         b_ji1Jij1sj2 * fjy(:,it)  * fsy(:,itb)
     3            +         b_ji1Jij2sj1 * fjy(:,itb) * fsy(:,itb)
     4            +         b_ji1Jij2sj2 * fjy(:,itb) * fsy(:,it)
        potWyz(:,it) = potWyz(:,it)
     1            +         b_ji1Jij1sj1 * fjy(:,it)  * fsz(:,it)
     2            +         b_ji1Jij1sj2 * fjy(:,it)  * fsz(:,itb)
     3            +         b_ji1Jij2sj1 * fjy(:,itb) * fsz(:,itb)
     4            +         b_ji1Jij2sj2 * fjy(:,itb) * fsz(:,it)
        potWzx(:,it) = potWzx(:,it)
     1            +         b_ji1Jij1sj1 * fjz(:,it)  * fsx(:,it)
     2            +         b_ji1Jij1sj2 * fjz(:,it)  * fsx(:,itb)
     3            +         b_ji1Jij2sj1 * fjz(:,itb) * fsx(:,itb)
     4            +         b_ji1Jij2sj2 * fjz(:,itb) * fsx(:,it)
        potWzy(:,it) = potWzy(:,it)
     1            +         b_ji1Jij1sj1 * fjz(:,it)  * fsy(:,it)
     2            +         b_ji1Jij1sj2 * fjz(:,it)  * fsy(:,itb)
     3            +         b_ji1Jij2sj1 * fjz(:,itb) * fsy(:,itb)
     4            +         b_ji1Jij2sj2 * fjz(:,itb) * fsy(:,it)
        potWzz(:,it) = potWzz(:,it)
     1            +         b_ji1Jij1sj1 * fjz(:,it)  * fsz(:,it)
     2            +         b_ji1Jij1sj2 * fjz(:,it)  * fsz(:,itb)
     3            +         b_ji1Jij2sj1 * fjz(:,itb) * fsz(:,itb)
     4            +         b_ji1Jij2sj2 * fjz(:,itb) * fsz(:,it)

        potWxx(:,it) = potWxx(:,it)  ! Warning vectoriel product
     1        -         b_nisa1Jib1sc1 * fnsxy(:,it)  * fsz(:,it)
     2        -         b_nisa1Jib1sc2 * fnsxy(:,it)  * fsz(:,itb)
     3        -         b_nisa1Jib2sc1 * fnsxy(:,itb) * fsz(:,itb)
     4        -         b_nisa1Jib2sc2 * fnsxy(:,itb) * fsz(:,it)
     1        +         b_nisa1Jib1sc1 * fnsxz(:,it)  * fsy(:,it)
     2        +         b_nisa1Jib1sc2 * fnsxz(:,it)  * fsy(:,itb)
     3        +         b_nisa1Jib2sc1 * fnsxz(:,itb) * fsy(:,itb)
     4        +         b_nisa1Jib2sc2 * fnsxz(:,itb) * fsy(:,it)
        potWxy(:,it) = potWxy(:,it)  ! Warning vectoriel product
     1        +         b_nisa1Jib1sc1 * fnsxx(:,it)  * fsz(:,it)
     2        +         b_nisa1Jib1sc2 * fnsxx(:,it)  * fsz(:,itb)
     3        +         b_nisa1Jib2sc1 * fnsxx(:,itb) * fsz(:,itb)
     4        +         b_nisa1Jib2sc2 * fnsxx(:,itb) * fsz(:,it)
     1        -         b_nisa1Jib1sc1 * fnsxz(:,it)  * fsx(:,it)
     2        -         b_nisa1Jib1sc2 * fnsxz(:,it)  * fsx(:,itb)
     3        -         b_nisa1Jib2sc1 * fnsxz(:,itb) * fsx(:,itb)
     4        -         b_nisa1Jib2sc2 * fnsxz(:,itb) * fsx(:,it)
        potWxz(:,it) = potWxz(:,it)  ! Warning vectoriel product
     1        -         b_nisa1Jib1sc1 * fnsxx(:,it)  * fsy(:,it)
     2        -         b_nisa1Jib1sc2 * fnsxx(:,it)  * fsy(:,itb)
     3        -         b_nisa1Jib2sc1 * fnsxx(:,itb) * fsy(:,itb)
     4        -         b_nisa1Jib2sc2 * fnsxx(:,itb) * fsy(:,it)
     1        +         b_nisa1Jib1sc1 * fnsxy(:,it)  * fsx(:,it)
     2        +         b_nisa1Jib1sc2 * fnsxy(:,it)  * fsx(:,itb)
     3        +         b_nisa1Jib2sc1 * fnsxy(:,itb) * fsx(:,itb)
     4        +         b_nisa1Jib2sc2 * fnsxy(:,itb) * fsx(:,it)
        potWyx(:,it) = potWyx(:,it)  ! Warning vectoriel product
     1        -         b_nisa1Jib1sc1 * fnsyy(:,it)  * fsz(:,it)
     2        -         b_nisa1Jib1sc2 * fnsyy(:,it)  * fsz(:,itb)
     3        -         b_nisa1Jib2sc1 * fnsyy(:,itb) * fsz(:,itb)
     4        -         b_nisa1Jib2sc2 * fnsyy(:,itb) * fsz(:,it)
     1        +         b_nisa1Jib1sc1 * fnsyz(:,it)  * fsy(:,it)
     2        +         b_nisa1Jib1sc2 * fnsyz(:,it)  * fsy(:,itb)
     3        +         b_nisa1Jib2sc1 * fnsyz(:,itb) * fsy(:,itb)
     4        +         b_nisa1Jib2sc2 * fnsyz(:,itb) * fsy(:,it)
        potWyy(:,it) = potWyy(:,it)  ! Warning vectoriel product
     1        +         b_nisa1Jib1sc1 * fnsyx(:,it)  * fsz(:,it)
     2        +         b_nisa1Jib1sc2 * fnsyx(:,it)  * fsz(:,itb)
     3        +         b_nisa1Jib2sc1 * fnsyx(:,itb) * fsz(:,itb)
     4        +         b_nisa1Jib2sc2 * fnsyx(:,itb) * fsz(:,it)
     1        -         b_nisa1Jib1sc1 * fnsyz(:,it)  * fsx(:,it)
     2        -         b_nisa1Jib1sc2 * fnsyz(:,it)  * fsx(:,itb)
     3        -         b_nisa1Jib2sc1 * fnsyz(:,itb) * fsx(:,itb)
     4        -         b_nisa1Jib2sc2 * fnsyz(:,itb) * fsx(:,it)
        potWyz(:,it) = potWyz(:,it)  ! Warning vectoriel product
     1        -         b_nisa1Jib1sc1 * fnsyx(:,it)  * fsy(:,it)
     2        -         b_nisa1Jib1sc2 * fnsyx(:,it)  * fsy(:,itb)
     3        -         b_nisa1Jib2sc1 * fnsyx(:,itb) * fsy(:,itb)
     4        -         b_nisa1Jib2sc2 * fnsyx(:,itb) * fsy(:,it)
     1        +         b_nisa1Jib1sc1 * fnsyy(:,it)  * fsx(:,it)
     2        +         b_nisa1Jib1sc2 * fnsyy(:,it)  * fsx(:,itb)
     3        +         b_nisa1Jib2sc1 * fnsyy(:,itb) * fsx(:,itb)
     4        +         b_nisa1Jib2sc2 * fnsyy(:,itb) * fsx(:,it)
        potWzx(:,it) = potWzx(:,it)  ! Warning vectoriel product
     1        -         b_nisa1Jib1sc1 * fnszy(:,it)  * fsz(:,it)
     2        -         b_nisa1Jib1sc2 * fnszy(:,it)  * fsz(:,itb)
     3        -         b_nisa1Jib2sc1 * fnszy(:,itb) * fsz(:,itb)
     4        -         b_nisa1Jib2sc2 * fnszy(:,itb) * fsz(:,it)
     1        +         b_nisa1Jib1sc1 * fnszz(:,it)  * fsy(:,it)
     2        +         b_nisa1Jib1sc2 * fnszz(:,it)  * fsy(:,itb)
     3        +         b_nisa1Jib2sc1 * fnszz(:,itb) * fsy(:,itb)
     4        +         b_nisa1Jib2sc2 * fnszz(:,itb) * fsy(:,it)
        potWzy(:,it) = potWzy(:,it)  ! Warning vectoriel product
     1        +         b_nisa1Jib1sc1 * fnszx(:,it)  * fsz(:,it)
     2        +         b_nisa1Jib1sc2 * fnszx(:,it)  * fsz(:,itb)
     3        +         b_nisa1Jib2sc1 * fnszx(:,itb) * fsz(:,itb)
     4        +         b_nisa1Jib2sc2 * fnszx(:,itb) * fsz(:,it)
     1        -         b_nisa1Jib1sc1 * fnszz(:,it)  * fsx(:,it)
     2        -         b_nisa1Jib1sc2 * fnszz(:,it)  * fsx(:,itb)
     3        -         b_nisa1Jib2sc1 * fnszz(:,itb) * fsx(:,itb)
     4        -         b_nisa1Jib2sc2 * fnszz(:,itb) * fsx(:,it)
        potWzz(:,it) = potWzz(:,it)  ! Warning vectoriel product
     1        -         b_nisa1Jib1sc1 * fnszx(:,it)  * fsy(:,it)
     2        -         b_nisa1Jib1sc2 * fnszx(:,it)  * fsy(:,itb)
     3        -         b_nisa1Jib2sc1 * fnszx(:,itb) * fsy(:,itb)
     4        -         b_nisa1Jib2sc2 * fnszx(:,itb) * fsy(:,it)
     1        +         b_nisa1Jib1sc1 * fnszy(:,it)  * fsx(:,it)
     2        +         b_nisa1Jib1sc2 * fnszy(:,it)  * fsx(:,itb)
     3        +         b_nisa1Jib2sc1 * fnszy(:,itb) * fsx(:,itb)
     4        +         b_nisa1Jib2sc2 * fnszy(:,itb) * fsx(:,it)

        potWxx(:,it) = potWxx(:,it)
     1    +         b_Jgij1Jij1rd1 * fJtxxr(:,it)  * frhotr(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtxxr(:,itb) * frhotr(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtxxr(:,it)  * frhotr(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtxxr(:,itb) * frhotr(:,itb)
     1    +         b_Jgij1Jij1rd1 * fJtxxi(:,it)  * frhoti(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtxxi(:,itb) * frhoti(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtxxi(:,it)  * frhoti(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtxxi(:,itb) * frhoti(:,itb)
        potWxy(:,it) = potWxy(:,it)
     1    +         b_Jgij1Jij1rd1 * fJtxyr(:,it)  * frhotr(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtxyr(:,itb) * frhotr(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtxyr(:,it)  * frhotr(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtxyr(:,itb) * frhotr(:,itb)
     1    +         b_Jgij1Jij1rd1 * fJtxyi(:,it)  * frhoti(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtxyi(:,itb) * frhoti(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtxyi(:,it)  * frhoti(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtxyi(:,itb) * frhoti(:,itb)
        potWxz(:,it) = potWxz(:,it)
     1    +         b_Jgij1Jij1rd1 * fJtxzr(:,it)  * frhotr(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtxzr(:,itb) * frhotr(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtxzr(:,it)  * frhotr(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtxzr(:,itb) * frhotr(:,itb)
     1    +         b_Jgij1Jij1rd1 * fJtxzi(:,it)  * frhoti(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtxzi(:,itb) * frhoti(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtxzi(:,it)  * frhoti(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtxzi(:,itb) * frhoti(:,itb)
        potWyx(:,it) = potWyx(:,it)
     1    +         b_Jgij1Jij1rd1 * fJtyxr(:,it)  * frhotr(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtyxr(:,itb) * frhotr(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtyxr(:,it)  * frhotr(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtyxr(:,itb) * frhotr(:,itb)
     1    +         b_Jgij1Jij1rd1 * fJtyxi(:,it)  * frhoti(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtyxi(:,itb) * frhoti(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtyxi(:,it)  * frhoti(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtyxi(:,itb) * frhoti(:,itb)
        potWyy(:,it) = potWyy(:,it)
     1    +         b_Jgij1Jij1rd1 * fJtyyr(:,it)  * frhotr(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtyyr(:,itb) * frhotr(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtyyr(:,it)  * frhotr(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtyyr(:,itb) * frhotr(:,itb)
     1    +         b_Jgij1Jij1rd1 * fJtyyi(:,it)  * frhoti(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtyyi(:,itb) * frhoti(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtyyi(:,it)  * frhoti(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtyyi(:,itb) * frhoti(:,itb)
        potWyz(:,it) = potWyz(:,it)
     1    +         b_Jgij1Jij1rd1 * fJtyzr(:,it)  * frhotr(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtyzr(:,itb) * frhotr(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtyzr(:,it)  * frhotr(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtyzr(:,itb) * frhotr(:,itb)
     1    +         b_Jgij1Jij1rd1 * fJtyzi(:,it)  * frhoti(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtyzi(:,itb) * frhoti(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtyzi(:,it)  * frhoti(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtyzi(:,itb) * frhoti(:,itb)
        potWzx(:,it) = potWzx(:,it)
     1    +         b_Jgij1Jij1rd1 * fJtzxr(:,it)  * frhotr(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtzxr(:,itb) * frhotr(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtzxr(:,it)  * frhotr(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtzxr(:,itb) * frhotr(:,itb)
     1    +         b_Jgij1Jij1rd1 * fJtzxi(:,it)  * frhoti(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtzxi(:,itb) * frhoti(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtzxi(:,it)  * frhoti(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtzxi(:,itb) * frhoti(:,itb)
        potWzy(:,it) = potWzy(:,it)
     1    +         b_Jgij1Jij1rd1 * fJtzyr(:,it)  * frhotr(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtzyr(:,itb) * frhotr(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtzyr(:,it)  * frhotr(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtzyr(:,itb) * frhotr(:,itb)
     1    +         b_Jgij1Jij1rd1 * fJtzyi(:,it)  * frhoti(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtzyi(:,itb) * frhoti(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtzyi(:,it)  * frhoti(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtzyi(:,itb) * frhoti(:,itb)
        potWzz(:,it) = potWzz(:,it)
     1    +         b_Jgij1Jij1rd1 * fJtzzr(:,it)  * frhotr(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtzzr(:,itb) * frhotr(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtzzr(:,it)  * frhotr(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtzzr(:,itb) * frhotr(:,itb)
     1    +         b_Jgij1Jij1rd1 * fJtzzi(:,it)  * frhoti(:,it)
     2    +         b_Jgij1Jij2rd1 * fJtzzi(:,itb) * frhoti(:,itb)
     3    +         b_Jdij1Jij1rg1 * fJtzzi(:,it)  * frhoti(:,it)
     4    +         b_Jdij1Jij2rg1 * fJtzzi(:,itb) * frhoti(:,itb)
       enddo

c     .........................................................................
c     ................................. 4 body ................................
c     .........................................................................


c     ........................................... 4body contribution to U field
      do it=1,2
        itb = 3-it
        potU(:,it) = potU(:,it)
     1                 + 4.0d0 * b_r1r1r2r2
     2                 * frho(:,it) * frho(:,itb) * frho(:,itb)

        potU(:,it) = potU(:,it)
     1                 + 2.0d0 * b_sj1sj1r2r2
     2                 * frho(:,it) * fsx(:,itb) * fsx(:,itb)
     3                 + 2.0d0 * b_sj1sj1r2r2
     4                 * frho(:,it) * fsy(:,itb) * fsy(:,itb)
     5                 + 2.0d0 * b_sj1sj1r2r2
     6                 * frho(:,it) * fsz(:,itb) * fsz(:,itb)

        potU(:,it) = potU(:,it)
     1             + 2.0d0 * b_rg1rd1r2r2
     2             * frho(:,it) * frhotr(:,itb) * frhotr(:,itb)
     3             + 2.0d0 * b_rg1rd1r2r2
     4             * frho(:,it) * frhoti(:,itb) * frhoti(:,itb)

      enddo

c     ........................................... 4body contribution to S field
      do it=1,2
        itb = 3-it
        potSx(:,it) = potSx(:,it)
     1                 + 2.0d0 * b_sj1sj1r2r2
     2                 * fsx(:,it) * frho(:,itb) * frho(:,itb)
        potSy(:,it) = potSy(:,it)
     1                 + 2.0d0 * b_sj1sj1r2r2
     2                 * fsy(:,it) * frho(:,itb) * frho(:,itb)
        potSz(:,it) = potSz(:,it)
     1                 + 2.0d0 * b_sj1sj1r2r2
     2                 * fsz(:,it) * frho(:,itb) * frho(:,itb)

        potSx(:,it) = potSx(:,it)
     1                  + 4.0d0 * b_si1si1sj2sj2
     2                  * fsx(:,it) * fsx(:,itb) * fsx(:,itb)
     3                  + 4.0d0 * b_si1si1sj2sj2
     4                  * fsx(:,it) * fsy(:,itb) * fsy(:,itb)
     5                  + 4.0d0 * b_si1si1sj2sj2
     6                  * fsx(:,it) * fsz(:,itb) * fsz(:,itb)
        potSy(:,it) = potSy(:,it)
     1                  + 4.0d0 * b_si1si1sj2sj2
     2                  * fsy(:,it) * fsx(:,itb) * fsx(:,itb)
     3                  + 4.0d0 * b_si1si1sj2sj2
     4                  * fsy(:,it) * fsy(:,itb) * fsy(:,itb)
     5                  + 4.0d0 * b_si1si1sj2sj2
     6                  * fsy(:,it) * fsz(:,itb) * fsz(:,itb)
        potSz(:,it) = potSz(:,it)
     1                  + 4.0d0 * b_si1si1sj2sj2
     2                  * fsz(:,it) * fsx(:,itb) * fsx(:,itb)
     3                  + 4.0d0 * b_si1si1sj2sj2
     4                  * fsz(:,it) * fsy(:,itb) * fsy(:,itb)
     5                  + 4.0d0 * b_si1si1sj2sj2
     6                  * fsz(:,it) * fsz(:,itb) * fsz(:,itb)

        potSx(:,it) = potSx(:,it)
     1              + 2.0d0 * b_rg1rd1sj2sj2
     2              * fsx(:,it) * frhotr(:,itb) * frhotr(:,itb)
     1              + 2.0d0 * b_rg1rd1sj2sj2
     2              * fsx(:,it) * frhoti(:,itb) * frhoti(:,itb)
        potSy(:,it) = potSy(:,it)
     1              + 2.0d0 * b_rg1rd1sj2sj2
     2              * fsy(:,it) * frhotr(:,itb) * frhotr(:,itb)
     1              + 2.0d0 * b_rg1rd1sj2sj2
     2              * fsy(:,it) * frhoti(:,itb) * frhoti(:,itb)
        potSz(:,it) = potSz(:,it)
     1              + 2.0d0 * b_rg1rd1sj2sj2
     2              * fsz(:,it) * frhotr(:,itb) * frhotr(:,itb)
     1              + 2.0d0 * b_rg1rd1sj2sj2
     2              * fsz(:,it) * frhoti(:,itb) * frhoti(:,itb)

      enddo

      return
      end subroutine vcal_f
c______________________________________________________________________________
      subroutine compute_gaphf_f (it)

c..............................................................................
c     computes pairing matrix elements for isospin it in the HF basis         .
c..............................................................................
c     gamka is (1-2*rho)*kappa, calculated for +- z-sig couplings
c..............................................................................
      implicit real*8 (a-h,o-z)
C     include 'paramr8.h'
      logical     lforce,lfd,lf3
      logical     lln,lhf,lsenior,ldelta,lgauss
      character*4 afor

      common /bogo / rrn(mnp,mnp,2,2),rrt(mnp,mnp,2,2),xkap(mnp,mnp,2,2)
     1              ,d(mnp,mnp,2,2),dln(mnp,mnp,2,2),delta(mnp,mnp,2,2)
      common /bogor/ dr(mv,2),di(mv,2),dlnr(mv,2),dlni(mv,2),
     1               drhor(mv,2),drhoi(mv,2),
     2               dtaur(mv,2),dtaui(mv,2),
     3               dJxxr(mv,2),dJxyr(mv,2),dJxzr(mv,2),
     4               dJxxi(mv,2),dJxyi(mv,2),dJxzi(mv,2),
     5               dJyxr(mv,2),dJyyr(mv,2),dJyzr(mv,2),
     6               dJyxi(mv,2),dJyyi(mv,2),dJyzi(mv,2),
     7               dJzxr(mv,2),dJzyr(mv,2),dJzzr(mv,2),
     8               dJzxi(mv,2),dJzyi(mv,2),dJzzi(mv,2)
      common /coeff2/ b_r1r1, b_r1r2, b_sj1sj1, b_sj1sj2, b_t1r1,
     1                b_t1r2, b_Tj1sj1, b_Tj1sj2, b_nir1nir1,
     2                b_nir1nir2, b_nisj1nisj1, b_nisj1nisj2,
     3                b_ji1ji1, b_ji1ji2, b_Jij1Jij1, b_Jij1Jij2,
     4                b_r1naJbc1, b_r1naJbc2, b_ja1nbsc1, b_ja1nbsc2,
     5                b_Jii1Jjj1, b_Jii1Jjj2, b_Jij1Jji1, b_Jij1Jji2,
     6                b_nisi1njsj1, b_nisi1njsj2, b_Fj1sj1, b_Fj1sj2,
     7                b_rg1rd1, b_tg1rd1, b_td1rg1, b_nirg1nird1,
     8                b_Jgij1Jdij1, b_Jgii1Jdjj1, b_Jgij1Jdji1
      common /coeff3/ b_r1r1r2, b_sj1sj1r2, b_t1r1r1, b_t1r1r2,
     1                b_t1r2r2, b_Tj1sj1r2, b_Tj1sj2r1, b_t1sj1sj1,
     2                b_t1sj1sj2, b_t1sj2sj2, b_nir1nir1r1,
     3                b_nir1nir1r2, b_nir1nir2r1, b_nisj1nisj1r1,
     4                b_nisj1nisj1r2, b_nisj1nisj2r1, b_nir1nisj1sj1,
     5                b_nir1nisj1sj2, b_nir1nisj2sj1, b_nir1nisj2sj2,
     6                b_ji1ji1r1, b_ji1ji1r2, b_ji1ji2r1, b_Jij1Jij1r1,
     7                b_Jij1Jij1r2, b_Jij1Jij2r1, b_ji1Jij1sj1,
     8                b_ji1Jij1sj2, b_ji1Jij2sj1, b_ji1Jij2sj2,
     9                b_nisa1Jib1sc1, b_nisa1Jib1sc2, b_nisa1Jib2sc1,
     8                b_nisa1Jib2sc2, b_rg1rd1r2, b_t1rg1rd1,
     7                b_t2rg1rd1, b_tg1rd1r2, b_td1rg1r2,
     6                b_nirg1nird1r1, b_nirg1nird1r2, b_nirg1nir1rd1,
     5                b_nirg1nir2rd1, b_nird1nir1rg1, b_nird1nir2rg1,
     4                b_Jgij1Jdij1r1, b_Jgij1Jdij1r2, b_Jgij1Jij1rd1,
     3                b_Jgij1Jij2rd1, b_Jdij1Jij1rg1, b_Jdij1Jij2rg1,
     2                b_nirg1ji1rd1, b_nirg1ji2rd1, b_nird1ji1rg1,
     1                b_nird1ji2rg1, b_nirg1Jdij1sj1, b_nirg1Jdij1sj2,
     2                b_nird1Jgij1sj1, b_nird1Jgij1sj2, b_nisj1Jgij1rd1,
     3                b_nisj2Jgij1rd1, b_nisj1Jdij1rg1, b_nisj2Jdij1rg1,
     4                b_Jgia1Jdib1sc1, b_Jgia1Jdib1sc2
      common /coeff4/ b_r1r1r2r2, b_sj1sj1r2r2, b_si1si1sj2sj2,
     1                b_rg1rd1r2r2, b_rg1rd1sj2sj2, b_rg1rd1rg2rd2
      common /denpr / frhotr (mv ,2),frhoti (mv ,2),
     1                ftautr (mv,2),ftauti (mv,2),
     2                flrhotr(mv,2),flrhoti(mv,2),
     3                fJtxxr (mv,2),fJtxyr (mv,2),fJtxzr (mv,2),
     4                fJtxxi (mv,2),fJtxyi (mv,2),fJtxzi (mv,2),
     5                fJtyxr (mv,2),fJtyyr (mv,2),fJtyzr (mv,2),
     6                fJtyxi (mv,2),fJtyyi (mv,2),fJtyzi (mv,2),
     7                fJtzxr (mv,2),fJtzyr (mv,2),fJtzzr (mv,2),
     8                fJtzxi (mv,2),fJtzyi (mv,2),fJtzzi (mv,2)
      common /denpr2/ fnrtxr(mv,2),fnrtyr(mv,2),fnrtzr(mv,2),
     1                fnrtxi(mv,2),fnrtyi(mv,2),fnrtzi(mv,2),
     2                fnJtxr(mv,2),fnJtyr(mv,2),fnJtzr(mv,2),
     3                fnJtxi(mv,2),fnJtyi(mv,2),fnJtzi(mv,2)
      common /fopt  / nfunc,ngal,njmunu,ncm2,nmass,ndd,nforce,ncoex
      common /force / t0,x0,t1,x1,t2,x2,te,to,wso
     1               ,u0,u1,y1,u2,y21,y22,v0
     2               ,wsoq,t3a,x3a,yt3a,t3b,x3b,yt3b
     3               ,hbar,hbm(2),xm(3),afor
      common /pairconstraint / c_rg1rd1(2)
      common /den  / frho(mv,2),fsx (mv,2),fsy (mv,2),fsz(mv,2)
      common /cur  / fjx (mv,2),fjy (mv,2),fjz (mv,2)
      common /taudj/ ftau(mv,2),fdJ (mv,2)
      common /wj2  / fJxx(mv,2),fJyx(mv,2),fJzx(mv,2)
     1              ,fJxy(mv,2),fJyy(mv,2),fJzy(mv,2)
     2              ,fJxz(mv,2),fJyz(mv,2),fJzz(mv,2)
      common /wtf  / fTx (mv,2),fTy (mv,2),fTz (mv,2)
     1              ,fFx (mv,2),fFy (mv,2),fFz (mv,2)
      common /locden/ flrho(mv,2),
     1                frosx(mv,2),frosy(mv,2),frosz(mv,2),
     2                flsx (mv,2),flsy (mv,2),flsz (mv,2),
     3                fns  (mv,2),
     4                fnrx (mv,2),fnry (mv,2),fnrz (mv,2),
     5                fnsxx(mv,2),fnsxy(mv,2),fnsxz(mv,2),
     6                fnsyx(mv,2),fnsyy(mv,2),fnsyz(mv,2),
     7                fnszx(mv,2),fnszy(mv,2),fnszz(mv,2),
     8                fnJx (mv,2),fnJy (mv,2),fnJz (mv,2),
     9                fnj  (mv,2),
     8                fnjxx(mv,2),fnjxy(mv,2),fnjxz(mv,2),
     7                fnjyx(mv,2),fnjyy(mv,2),fnjyz(mv,2),
     6                fnjzx(mv,2),fnjzy(mv,2),fnjzz(mv,2),
     5                fndsx(mv,2),fndsy(mv,2),fndsz(mv,2)
      common /noyau/ nwaven,nwavep,nwave,npn,npp,npar(4,2),iit(2,2,2)
      common /pair / npair,neq,lln,lhf,lsenior,ldelta,lgauss
      common /paird/ gn,gp,dcut,encut,epcut,alpha,alphap,icut,ibasis,iln
      common /pairw/ ambda(2),gstr(2),xlamb(2),epair(3),eproj(3)
     1              ,disper(3)
      common /pot_f / potU   (mv,2),
     1                potB   (mv,2),
     2                potSx  (mv,2),potSy  (mv,2),potSz  (mv,2),
     3                potCx  (mv,2),potCy  (mv,2),potCz  (mv,2),
     4                potAx  (mv,2),potAy  (mv,2),potAz  (mv,2),
     5                potWxx (mv,2),potWxy (mv,2),potWxz (mv,2),
     6                potWyx (mv,2),potWyy (mv,2),potWyz (mv,2),
     7                potWzx (mv,2),potWzy (mv,2),potWzz (mv,2),
     8                potDx  (mv,2),potDy  (mv,2),potDz  (mv,2)
      common /ppot_f/ potUt  (mv,2,2),potBt  (mv,2,2),
     1                potWtxx(mv,2,2),potWtxy(mv,2,2),
     2                potWtxz(mv,2,2),
     3                potWtyx(mv,2,2),potWtyy(mv,2,2),
     4                potWtyz(mv,2,2),
     5                potWtzx(mv,2,2),potWtzy(mv,2,2),
     6                potWtzz(mv,2,2)
      common /spwfc/ kiso(mw),kparz(mw),keta(mw)
      common /spwf1/ esp1(mw),esp2(mw),esp3(mw),roii(mw)
      common /stor / a(mv,4,mw),b(mv,4,mw)
      common /stord/ drva(3*mq,mw),drvb(3*mq,mw)
      common /waved/ wx1(mv),wx2(mv),wx3(mv),wx4(mv)
     1              ,wy1(mv),wy2(mv),wy3(mv),wy4(mv)
     2              ,wz1(mv),wz2(mv),wz3(mv),wz4(mv)
      common /wavep/ px1(mv),px2(mv),px3(mv),px4(mv)
     1              ,py1(mv),py2(mv),py3(mv),py4(mv)
     2              ,pz1(mv),pz2(mv),pz3(mv),pz4(mv)
      common /wtmp / ar(mv),ai(mv),fj(2*mv)

      dimension gamka(mnp,mnp)
      dimension br(mv), bi(mv)
      dimension pl1(mv),pl2(mv),pl3(mv),pl4(mv)
      dimension wl1(mv),wl2(mv),wl3(mv),wl4(mv)
      dimension tmp1r(mv),tmp1i(mv),tmp2r(mv),tmp2i(mv)
      dimension c1 (mv),c2 (mv),c3 (mv),c4 (mv),c5 (mv),c6 (mv),
     1          c7 (mv),c8 (mv),c9 (mv),c10(mv),c11(mv),c12(mv),
     2          c13(mv),c14(mv),c15(mv),c16(mv),c17(mv),c18(mv),
     3          c19(mv),c20(mv),c21(mv),c22(mv),c23(mv),c24(mv)
c
      go to 2674  ! JD 31/10/20 ignore everything apart from the calculation of 3B potentials
c
c.................................... prepare energy cut-off and its diffusness
      gnp   = -1.d0
      ecut = encut*(2-it) + epcut*(it-1)

c     ................................................. flush of pairing fields
c                                                                 and densities
c                                d[r,i]: real (imag) part of the pairing fields
c                              dln[r,i]: Modified pairing fields for LN lambda2
      do i=1,mv
        dr  (i,it) = 0.d0
        di  (i,it) = 0.d0
        dlnr(i,it) = 0.d0
        dlni(i,it) = 0.d0
      enddo
      do i=1,mv
        drhor(i,it) = 0.d0
        drhoi(i,it) = 0.d0
        dtaur(i,it) = 0.d0
        dtaui(i,it) = 0.d0
        dJxxr(i,it) = 0.d0
        dJxxi(i,it) = 0.d0
        dJxyr(i,it) = 0.d0
        dJxyi(i,it) = 0.d0
        dJxzr(i,it) = 0.d0
        dJxzi(i,it) = 0.d0
        dJyxr(i,it) = 0.d0
        dJyxi(i,it) = 0.d0
        dJyyr(i,it) = 0.d0
        dJyyi(i,it) = 0.d0
        dJyzr(i,it) = 0.d0
        dJyzi(i,it) = 0.d0
        dJzxr(i,it) = 0.d0
        dJzxi(i,it) = 0.d0
        dJzyr(i,it) = 0.d0
        dJzyi(i,it) = 0.d0
        dJzzr(i,it) = 0.d0
        dJzzi(i,it) = 0.d0
      enddo
      do i=1,mv
        potUt  (i,:,it) = 0.0d0
        potBt  (i,:,it) = 0.0d0
        potWtxx(i,:,it) = 0.0d0
        potWtxy(i,:,it) = 0.0d0
        potWtxz(i,:,it) = 0.0d0
        potWtyx(i,:,it) = 0.0d0
        potWtyy(i,:,it) = 0.0d0
        potWtyz(i,:,it) = 0.0d0
        potWtzx(i,:,it) = 0.0d0
        potWtzy(i,:,it) = 0.0d0
        potWtzz(i,:,it) = 0.0d0
      enddo
      do i=1,mv
        frhotr (i,it) = 0.d0
        frhoti (i,it) = 0.d0
        flrhotr(i,it) = 0.d0
        flrhoti(i,it) = 0.d0
        ftautr (i,it) = 0.d0
        ftauti (i,it) = 0.d0
        fJtxxr (i,it) = 0.d0
        fJtxxi (i,it) = 0.d0
        fJtxyr (i,it) = 0.d0
        fJtxyi (i,it) = 0.d0
        fJtxzr (i,it) = 0.d0
        fJtxzi (i,it) = 0.d0
        fJtyxr (i,it) = 0.d0
        fJtyxi (i,it) = 0.d0
        fJtyyr (i,it) = 0.d0
        fJtyyi (i,it) = 0.d0
        fJtyzr (i,it) = 0.d0
        fJtyzi (i,it) = 0.d0
        fJtzxr (i,it) = 0.d0
        fJtzxi (i,it) = 0.d0
        fJtzyr (i,it) = 0.d0
        fJtzyi (i,it) = 0.d0
        fJtzzr (i,it) = 0.d0
        fJtzzi (i,it) = 0.d0
      enddo
      do i=1,mv
        fnrtxr (i,it) = 0.d0
        fnrtyr (i,it) = 0.d0
        fnrtzr (i,it) = 0.d0
        fnrtxi (i,it) = 0.d0
        fnrtyi (i,it) = 0.d0
        fnrtzi (i,it) = 0.d0
        fnJtxr (i,it) = 0.d0
        fnJtyr (i,it) = 0.d0
        fnJtzr (i,it) = 0.d0
        fnJtxi (i,it) = 0.d0
        fnJtyi (i,it) = 0.d0
        fnJtzi (i,it) = 0.d0
      enddo

c     ...... calculation of the pairing field sum_{s}(2s*<r,s;r,-s|V|ij>*fi*fj)

c     .........................................................................
c     MB, 15/06/09 What is the use of this? This is for ULB pairing !?
c     .........................................................................
      do ipa=1,2
        if ( lln ) then
          do i=1,npar(ipa,it)
            do j=1,npar(ipa+2,it)
              gamka(i,j) = xkap(i,j,ipa,it)
              do k=1,npar(ipa,it)
                gamka(i,j) = gamka(i,j) -
     1                       2.d0*rrn(i,k,ipa,it)*xkap(k,j,ipa,it)
              enddo
            enddo
          enddo
        endif
        do j=1,npar(ipa+2,it)
          jw    = j + iit(ipa,2,it)
          fj(j) = cutoff(esp1(jw)-ambda(it),ecut,dcut,icut)
        enddo
        do i=1,npar(ipa,it)
          iw  = i + iit(ipa,1,it)
          fi  = cutoff(esp1(iw)-ambda(it),ecut,dcut,icut)
          if ( dabs(fi).lt.1.0d-14 ) cycle
          do j=1,npar(ipa+2,it)
            if ( dabs(fj(j)).lt.1.0d-14 ) cycle
            jw = j + iit(ipa,2,it)
            call SCOPY_MB(3*mq,drva(1,iw),wx1)
            call SCOPY_MB(3*mq,drva(1,jw),px1)

c           ............................. compute spatial contributions of rho~
c           At this point, w(iw) is a state with signature +1, and p(jw) a
c           state with signature -1; hence,
c
c                        ( psi_3 + i psi_4)
c                Psi_j = ( psi_1 + i psi_2)
c
c           With this, the expression below corresponds to
c
c               psi_i1 psi_j3 - psi_i2 psi_j4 - psi_i3 psi_j1 - psi_i4 psi_j2
c           +i[ psi_i1 psi_j4 + psi_i2 psi_j3 - psi_i3 psi_j2 - psi_i4 psi_j1 ]
c           ...................................................................

c           ............................. compute spatial contributions of rho~
            do k=1,mv
c             ar(k) = a(k,1,jw)*a(k,1,iw) - a(k,2,jw)*a(k,2,iw)   ! MB 15/06/12
c    1               -a(k,3,jw)*a(k,3,iw) + a(k,4,jw)*a(k,4,iw)
c             ai(k) = a(k,1,jw)*a(k,2,iw) + a(k,2,jw)*a(k,1,iw)
c    1               -a(k,3,jw)*a(k,4,iw) - a(k,4,jw)*a(k,3,iw)

              ar(k) = a(k,1,iw)*a(k,1,jw) - a(k,2,iw)*a(k,2,jw)
     1               -a(k,3,iw)*a(k,3,jw) + a(k,4,iw)*a(k,4,jw)
              ai(k) = a(k,1,iw)*a(k,2,jw) + a(k,2,iw)*a(k,1,jw)
     1               -a(k,3,iw)*a(k,4,jw) - a(k,4,iw)*a(k,3,jw)
            enddo

c           .............................................................. tau~
            call SCOPY_MB(3*mq,drva(1,jw),px1)
            do k=1,mv
c             br(k)= px1(k)*wx1(k) - px2(k)*wx2(k)                ! MB 15/06/12
c    1              -px3(k)*wx3(k) + px4(k)*wx4(k)
c    2              +py1(k)*wy1(k) - py2(k)*wy2(k)
c    3              -py3(k)*wy3(k) + py4(k)*wy4(k)
c    4              +pz1(k)*wz1(k) - pz2(k)*wz2(k)
c    5              -pz3(k)*wz3(k) + pz4(k)*wz4(k)
c             bi(k)= px1(k)*wx2(k) + px2(k)*wx1(k)
c    1              -px3(k)*wx4(k) - px4(k)*wx3(k)
c    2              +py1(k)*wy2(k) + py2(k)*wy1(k)
c    3              -py3(k)*wy4(k) - py4(k)*wy3(k)
c    4              +pz1(k)*wz2(k) + pz2(k)*wz1(k)
c    5              -pz3(k)*wz4(k) - pz4(k)*wz3(k)

              br(k)= wx1(k)*px1(k) - wx2(k)*px2(k)
     1              -wx3(k)*px3(k) + wx4(k)*px4(k)
     2              +wy1(k)*py1(k) - wy2(k)*py2(k)
     3              -wy3(k)*py3(k) + wy4(k)*py4(k)
     4              +wz1(k)*pz1(k) - wz2(k)*pz2(k)
     5              -wz3(k)*pz3(k) + wz4(k)*pz4(k)
              bi(k)= wx1(k)*px2(k) + wx2(k)*px1(k)
     1              -wx3(k)*px4(k) - wx4(k)*px3(k)
     2              +wy1(k)*py2(k) + wy2(k)*py1(k)
     3              -wy3(k)*py4(k) - wy4(k)*py3(k)
     4              +wz1(k)*pz2(k) + wz2(k)*pz1(k)
     5              -wz3(k)*pz4(k) - wz4(k)*pz3(k)
            enddo

c           .............................................................. Jmn~
            do k=1,mv
c             e1 =   a(k,3,jw)*wx1(k) - px3(k)*a(k,1,iw)        ! MB 15/06/12
c    1             - a(k,4,jw)*wx2(k) + px4(k)*a(k,2,iw)
c             e2 =   a(k,1,jw)*wx3(k) - px1(k)*a(k,3,iw)
c    1             - a(k,2,jw)*wx4(k) + px2(k)*a(k,4,iw)
c             e3 =   a(k,3,jw)*wx2(k) - px3(k)*a(k,2,iw)
c    1             + a(k,4,jw)*wx1(k) - px4(k)*a(k,1,iw)
c             e4 =   a(k,1,jw)*wx4(k) - px1(k)*a(k,4,iw)
c    1             + a(k,2,jw)*wx3(k) - px2(k)*a(k,3,iw)
c             e5 =   a(k,3,jw)*wx3(k) - px3(k)*a(k,3,iw)
c    1             - a(k,4,jw)*wx4(k) + px4(k)*a(k,4,iw)
c             e6 =   a(k,1,jw)*wx1(k) - px1(k)*a(k,1,iw)
c    1             - a(k,2,jw)*wx2(k) + px2(k)*a(k,2,iw)
c             e7 =   a(k,3,jw)*wx4(k) - px3(k)*a(k,4,iw)
c    1             + a(k,4,jw)*wx3(k) - px4(k)*a(k,3,iw)
c             e8 =   a(k,2,jw)*wx1(k) - px2(k)*a(k,1,iw)
c    1             + a(k,1,jw)*wx2(k) - px1(k)*a(k,2,iw)

              e1 =   a(k,1,iw)*px3(k) - wx1(k)*a(k,3,jw)
     1             - a(k,2,iw)*px4(k) + wx2(k)*a(k,4,jw)
              e2 =   a(k,3,iw)*px1(k) - wx3(k)*a(k,1,jw)
     1             - a(k,4,iw)*px2(k) + wx4(k)*a(k,2,jw)
              e3 =   a(k,2,iw)*px3(k) - wx2(k)*a(k,3,jw)
     1             + a(k,1,iw)*px4(k) - wx1(k)*a(k,4,jw)
              e4 =   a(k,4,iw)*px1(k) - wx4(k)*a(k,1,jw)
     1             + a(k,3,iw)*px2(k) - wx3(k)*a(k,2,jw)
              e5 =   a(k,1,iw)*px1(k) - wx1(k)*a(k,1,jw)
     1             - a(k,2,iw)*px2(k) + wx2(k)*a(k,2,jw)
              e6 =   a(k,3,iw)*px3(k) - wx3(k)*a(k,3,jw)
     1             - a(k,4,iw)*px4(k) + wx4(k)*a(k,4,jw)
              e7 =   a(k,1,iw)*px2(k) - wx1(k)*a(k,2,jw)
     1             + a(k,2,iw)*px1(k) - wx2(k)*a(k,1,jw)
              e8 =   a(k,4,iw)*px3(k) - wx4(k)*a(k,3,jw)
     1             + a(k,3,iw)*px4(k) - wx3(k)*a(k,4,jw)
              c1(k) =  (-e4 + e3)*0.5d0  ! Re(Jxx)
              c2(k) = -( e1 - e2)*0.5d0  ! Im(Jxx)
              c3(k) =  ( e1 + e2)*0.5d0  ! Re(Jxy)
              c4(k) = -(-e4 - e3)*0.5d0  ! Im(Jxy)
              c5(k) =  (-e7 - e8)*0.5d0  ! Re(Jxz)
              c6(k) = -(-e5 - e6)*0.5d0  ! Im(Jxz)
            enddo
            do k=1,mv
c             e1 =   a(k,3,jw)*wy1(k) - py3(k)*a(k,1,iw)        ! MB 15/06/12
c    1             - a(k,4,jw)*wy2(k) + py4(k)*a(k,2,iw)
c             e2 =   a(k,1,jw)*wy3(k) - py1(k)*a(k,3,iw)
c    1             - a(k,2,jw)*wy4(k) + py2(k)*a(k,4,iw)
c             e3 =   a(k,3,jw)*wy2(k) - py3(k)*a(k,2,iw)
c    1             + a(k,4,jw)*wy1(k) - py4(k)*a(k,1,iw)
c             e4 =   a(k,1,jw)*wy4(k) - py1(k)*a(k,4,iw)
c    1             + a(k,2,jw)*wy3(k) - py2(k)*a(k,3,iw)
c             e5 =   a(k,3,jw)*wy3(k) - py3(k)*a(k,3,iw)
c    1             - a(k,4,jw)*wy4(k) + py4(k)*a(k,4,iw)
c             e6 =   a(k,1,jw)*wy1(k) - py1(k)*a(k,1,iw)
c    1             - a(k,2,jw)*wy2(k) + py2(k)*a(k,2,iw)
c             e7 =   a(k,3,jw)*wy4(k) - py3(k)*a(k,4,iw)
c    1             + a(k,4,jw)*wy3(k) - py4(k)*a(k,3,iw)
c             e8 =   a(k,2,jw)*wy1(k) - py2(k)*a(k,1,iw)
c    1             + a(k,1,jw)*wy2(k) - py1(k)*a(k,2,iw)

              e1 =   a(k,1,iw)*py3(k) - wy1(k)*a(k,3,jw)
     1             - a(k,2,iw)*py4(k) + wy2(k)*a(k,4,jw)
              e2 =   a(k,3,iw)*py1(k) - wy3(k)*a(k,1,jw)
     1             - a(k,4,iw)*py2(k) + wy4(k)*a(k,2,jw)
              e3 =   a(k,2,iw)*py3(k) - wy2(k)*a(k,3,jw)
     1             + a(k,1,iw)*py4(k) - wy1(k)*a(k,4,jw)
              e4 =   a(k,4,iw)*py1(k) - wy4(k)*a(k,1,jw)
     1             + a(k,3,iw)*py2(k) - wy3(k)*a(k,2,jw)
              e5 =   a(k,1,iw)*py1(k) - wy1(k)*a(k,1,jw)
     1             - a(k,2,iw)*py2(k) + wy2(k)*a(k,2,jw)
              e6 =   a(k,3,iw)*py3(k) - wy3(k)*a(k,3,jw)
     1             - a(k,4,iw)*py4(k) + wy4(k)*a(k,4,jw)
              e7 =   a(k,1,iw)*py2(k) - wy1(k)*a(k,2,jw)
     1             + a(k,2,iw)*py1(k) - wy2(k)*a(k,1,jw)
              e8 =   a(k,4,iw)*py3(k) - wy4(k)*a(k,3,jw)
     1             + a(k,3,iw)*py4(k) - wy3(k)*a(k,4,jw)
              c7(k) =  (-e4 + e3)*0.5d0  ! Re(Jyx)
              c8(k) = -( e1 - e2)*0.5d0  ! Im(Jyx)
              c9(k) =  ( e1 + e2)*0.5d0  ! Re(Jyy)
              c10(k)= -(-e4 - e3)*0.5d0  ! Im(Jyy)
              c11(k)=  (-e7 - e8)*0.5d0  ! Re(Jyz)
              c12(k)= -(-e5 - e6)*0.5d0  ! Im(Jyz)
            enddo
            do k=1,mv
c             e1 =   a(k,3,jw)*wz1(k) - pz3(k)*a(k,1,iw)        ! MB 15/06/12
c    1             - a(k,4,jw)*wz2(k) + pz4(k)*a(k,2,iw)
c             e2 =   a(k,1,jw)*wz3(k) - pz1(k)*a(k,3,iw)
c    1             - a(k,2,jw)*wz4(k) + pz2(k)*a(k,4,iw)
c             e3 =   a(k,3,jw)*wz2(k) - pz3(k)*a(k,2,iw)
c    1             + a(k,4,jw)*wz1(k) - pz4(k)*a(k,1,iw)
c             e4 =   a(k,1,jw)*wz4(k) - pz1(k)*a(k,4,iw)
c    1             + a(k,2,jw)*wz3(k) - pz2(k)*a(k,3,iw)
c             e5 =   a(k,3,jw)*wz3(k) - pz3(k)*a(k,3,iw)
c    1             - a(k,4,jw)*wz4(k) + pz4(k)*a(k,4,iw)
c             e6 =   a(k,1,jw)*wz1(k) - pz1(k)*a(k,1,iw)
c    1             - a(k,2,jw)*wz2(k) + pz2(k)*a(k,2,iw)
c             e7 =   a(k,3,jw)*wz4(k) - pz3(k)*a(k,4,iw)
c    1             + a(k,4,jw)*wz3(k) - pz4(k)*a(k,3,iw)
c             e8 =   a(k,2,jw)*wz1(k) - pz2(k)*a(k,1,iw)
c    1             + a(k,1,jw)*wz2(k) - pz1(k)*a(k,2,iw)

              e1 =   a(k,1,iw)*pz3(k) - wz1(k)*a(k,3,jw)
     1             - a(k,2,iw)*pz4(k) + wz2(k)*a(k,4,jw)
              e2 =   a(k,3,iw)*pz1(k) - wz3(k)*a(k,1,jw)
     1             - a(k,4,iw)*pz2(k) + wz4(k)*a(k,2,jw)
              e3 =   a(k,2,iw)*pz3(k) - wz2(k)*a(k,3,jw)
     1             + a(k,1,iw)*pz4(k) - wz1(k)*a(k,4,jw)
              e4 =   a(k,4,iw)*pz1(k) - wz4(k)*a(k,1,jw)
     1             + a(k,3,iw)*pz2(k) - wz3(k)*a(k,2,jw)
              e5 =   a(k,1,iw)*pz1(k) - wz1(k)*a(k,1,jw)
     1             - a(k,2,iw)*pz2(k) + wz2(k)*a(k,2,jw)
              e6 =   a(k,3,iw)*pz3(k) - wz3(k)*a(k,3,jw)
     1             - a(k,4,iw)*pz4(k) + wz4(k)*a(k,4,jw)
              e7 =   a(k,1,iw)*pz2(k) - wz1(k)*a(k,2,jw)
     1             + a(k,2,iw)*pz1(k) - wz2(k)*a(k,1,jw)
              e8 =   a(k,4,iw)*pz3(k) - wz4(k)*a(k,3,jw)
     1             + a(k,3,iw)*pz4(k) - wz3(k)*a(k,4,jw)
              c13(k)=  (-e4 + e3)*0.5d0  ! Re(Jzx)
              c14(k)= -( e1 - e2)*0.5d0  ! Im(Jzx)
              c15(k)=  ( e1 + e2)*0.5d0  ! Re(Jzy)
              c16(k)= -(-e4 - e3)*0.5d0  ! Im(Jzy)
              c17(k)=  (-e7 - e8)*0.5d0  ! Re(Jzz)
              c18(k)= -(-e5 - e6)*0.5d0  ! Im(Jzz)
            enddo

c           .................................................... (nabla_n Jnm~)
            zp_w = kparz(iw)
            call lapla (a(1,1,iw),wl1(1), 1.0d0, 1.0d0, zp_w)
            call lapla (a(1,2,iw),wl2(1),-1.0d0,-1.0d0, zp_w)
            call lapla (a(1,3,iw),wl3(1),-1.0d0, 1.0d0,-zp_w)
            call lapla (a(1,4,iw),wl4(1), 1.0d0,-1.0d0,-zp_w)
            zp_p = kparz(jw)
            call lapla (a(1,1,jw),pl1(1), 1.0d0, 1.0d0, zp_p)
            call lapla (a(1,2,jw),pl2(1),-1.0d0,-1.0d0, zp_p)
            call lapla (a(1,3,jw),pl3(1),-1.0d0, 1.0d0,-zp_p)
            call lapla (a(1,4,jw),pl4(1), 1.0d0,-1.0d0,-zp_p)

            do k=1,mv
c             e1 =   a(k,3,jw)*wl1(k) - pl3(k)*a(k,1,iw)
c    1             - a(k,4,jw)*wl2(k) + pl4(k)*a(k,2,iw)
c             e2 =   a(k,1,jw)*wl3(k) - pl1(k)*a(k,3,iw)
c    1             - a(k,2,jw)*wl4(k) + pl2(k)*a(k,4,iw)
c             e3 =   a(k,3,jw)*wl2(k) - pl3(k)*a(k,2,iw)
c    1             + a(k,4,jw)*wl1(k) - pl4(k)*a(k,1,iw)
c             e4 =   a(k,1,jw)*wl4(k) - pl1(k)*a(k,4,iw)
c    1             + a(k,2,jw)*wl3(k) - pl2(k)*a(k,3,iw)
c             e5 =   a(k,3,jw)*wl3(k) - pl3(k)*a(k,3,iw)
c    1             - a(k,4,jw)*wl4(k) + pl4(k)*a(k,4,iw)
c             e6 =   a(k,1,jw)*wl1(k) - pl1(k)*a(k,1,iw)
c    1             - a(k,2,jw)*wl2(k) + pl2(k)*a(k,2,iw)
c             e7 =   a(k,3,jw)*wl4(k) - pl3(k)*a(k,4,iw)
c    1             + a(k,4,jw)*wl3(k) - pl4(k)*a(k,3,iw)
c             e8 =   a(k,2,jw)*wl1(k) - pl2(k)*a(k,1,iw)
c    1             + a(k,1,jw)*wl2(k) - pl1(k)*a(k,2,iw)

              e1 =   wl1(k)*a(k,3,jw) - a(k,1,iw)*pl3(k)
     1             - wl2(k)*a(k,4,jw) + a(k,2,iw)*pl4(k)
              e2 =   wl3(k)*a(k,1,jw) - a(k,3,iw)*pl1(k)
     1             - wl4(k)*a(k,2,jw) + a(k,4,iw)*pl2(k)
              e3 =   wl2(k)*a(k,3,jw) - a(k,2,iw)*pl3(k)
     1             + wl1(k)*a(k,4,jw) - a(k,1,iw)*pl4(k)
              e4 =   wl4(k)*a(k,1,jw) - a(k,4,iw)*pl1(k)
     1             + wl3(k)*a(k,2,jw) - a(k,3,iw)*pl2(k)
              e5 =   wl3(k)*a(k,3,jw) - a(k,3,iw)*pl3(k)
     1             - wl4(k)*a(k,4,jw) + a(k,4,iw)*pl4(k)
              e6 =   wl1(k)*a(k,1,jw) - a(k,1,iw)*pl1(k)
     1             - wl2(k)*a(k,2,jw) + a(k,2,iw)*pl2(k)
              e7 =   wl4(k)*a(k,3,jw) - a(k,4,iw)*pl3(k)
     1             + wl3(k)*a(k,4,jw) - a(k,3,iw)*pl4(k)
              e8 =   wl1(k)*a(k,2,jw) - a(k,1,iw)*pl2(k)
     1             + wl2(k)*a(k,1,jw) - a(k,2,iw)*pl1(k)
              c19(k) =  (-e4 + e3)*0.5d0  ! Re(nabla_u Jux)
              c20(k) = -( e1 - e2)*0.5d0  ! Im(nabla_u Jux)
              c21(k) =  ( e1 + e2)*0.5d0  ! Re(nabla_u Juy)
              c22(k) = -(-e4 - e3)*0.5d0  ! Im(nabla_u Juy)
              c23(k) =  (-e7 - e8)*0.5d0  ! Re(nabla_u Juz)
              c24(k) = -(-e5 - e6)*0.5d0  ! Im(nabla_u Juz)
            enddo

c           ............................. sum up the densities rho~, tau~, Jmn~
c           note: profiting from the skew-symmetry of the pair tensor and the
c           spatial contribution to the pair densities, the pair densities can
c           be calculated as 2 times the contribution w(sig +1) * w(sig -1).
c           Hence the loop over half the space only and the additional factor
c           2 in "facd".
c           ...................................................................
c           note also that the pair densities are
c           rho~(r) = sum_{ij} kappa_{ji} operator w_i p_j
c           ...................................................................
c           facd = 2.d0 * fi * fj(j) * xkap(i,j,ipa,it)           ! MB 15/06/12
c           facd = 2.d0 * fi * fj(j) * xkap(j,i,ipa,it)  ! JD 16/09/20 saxpy not conform with blas
c           call saxpy (mv,facd,ar (1),frhotr(1,it))
c           call saxpy (mv,facd,ai (1),frhoti(1,it))
c           call saxpy (mv,facd,br (1),ftautr(1,it))
c           call saxpy (mv,facd,bi (1),ftauti(1,it))
c           call saxpy (mv,facd,c1 (1),fJtxxr(1,it))
c           call saxpy (mv,facd,c2 (1),fJtxxi(1,it))
c           call saxpy (mv,facd,c3 (1),fJtxyr(1,it))
c           call saxpy (mv,facd,c4 (1),fJtxyi(1,it))
c           call saxpy (mv,facd,c5 (1),fJtxzr(1,it))
c           call saxpy (mv,facd,c6 (1),fJtxzi(1,it))
c           call saxpy (mv,facd,c7 (1),fJtyxr(1,it))
c           call saxpy (mv,facd,c8 (1),fJtyxi(1,it))
c           call saxpy (mv,facd,c9 (1),fJtyyr(1,it))
c           call saxpy (mv,facd,c10(1),fJtyyi(1,it))
c           call saxpy (mv,facd,c11(1),fJtyzr(1,it))
c           call saxpy (mv,facd,c12(1),fJtyzi(1,it))
c           call saxpy (mv,facd,c13(1),fJtzxr(1,it))
c           call saxpy (mv,facd,c14(1),fJtzxi(1,it))
c           call saxpy (mv,facd,c15(1),fJtzyr(1,it))
c           call saxpy (mv,facd,c16(1),fJtzyi(1,it))
c           call saxpy (mv,facd,c17(1),fJtzzr(1,it))
c           call saxpy (mv,facd,c18(1),fJtzzi(1,it))
c
c           call saxpy (mv,facd,c19(1),fnJtxr(1,it))
c           call saxpy (mv,facd,c20(1),fnJtxi(1,it))
c           call saxpy (mv,facd,c21(1),fnJtyr(1,it))
c           call saxpy (mv,facd,c22(1),fnJtyi(1,it))
c           call saxpy (mv,facd,c23(1),fnJtzr(1,it))
c           call saxpy (mv,facd,c24(1),fnJtzi(1,it))
          enddo
        enddo
      enddo

c     ..................................... calculate the density : lapla(rho~)
      tmp1r(:) = frhotr(:,it)
      tmp1i(:) = frhoti(:,it)
      call lapla (tmp1r(1),tmp2r(1),1.d0,1.d0,1.d0)
      call lapla (tmp1i(1),tmp2i(1),1.d0,1.d0,1.d0)
      flrhotr(:,it) = tmp2r(:)
      flrhoti(:,it) = tmp2i(:)

c     ..................................... calculate the density : nabla(rho~)
      call derx(frhotr(1,it),fnrtxr(1,it), 1)
      call dery(frhotr(1,it),fnrtyr(1,it), 1)
      call derz(frhotr(1,it),fnrtzr(1,it), 1)
      call derx(frhoti(1,it),fnrtxi(1,it),-1)
      call dery(frhoti(1,it),fnrtyi(1,it),-1)
      call derz(frhoti(1,it),fnrtzi(1,it), 1)

c     -------------------------------------------------------------------------
c     --------------------------------- fields --------------------------------
c     -------------------------------------------------------------------------


c     .........................................................................
c     note: this subroutine is called for given it. As a sonsequence, the
c     contribution from the four-body term rho~*_n rho~_n rho~*_p rho~_p cannot
c     yet be calculated here, as the pairing densities of protons have not
c     been calculated yet when calling this subroutine for neutrons. This term
c     will be calculated lateron in a separate subroutine "add_4body2gap".
c     .........................................................................
c     JS : A future version should have a loop over it.
c     .........................................................................


c     .........................................................................
c     ................................. 2 body ................................
c     .........................................................................

c     .................................... 2body contribution to tilde(U) field

c      do it=1,2
        itb = 3-it

c       .............................. EXPERIMENTAL: add "external" field to U~
        potUt(:,1,it) = potUt(:,1,it) + c_rg1rd1(it) * frhotr (:,it)
        potUt(:,2,it) = potUt(:,2,it) + c_rg1rd1(it) * frhoti (:,it)

        potUt(:,1,it) = potUt(:,1,it) + b_rg1rd1     * frhotr (:,it)
        potUt(:,2,it) = potUt(:,2,it) + b_rg1rd1     * frhoti (:,it)
        potUt(:,1,it) = potUt(:,1,it) + b_td1rg1     * ftautr (:,it)
        potUt(:,2,it) = potUt(:,2,it) + b_td1rg1     * ftauti (:,it)
        potUt(:,1,it) = potUt(:,1,it) - b_nirg1nird1 * flrhotr(:,it)
        potUt(:,2,it) = potUt(:,2,it) - b_nirg1nird1 * flrhoti(:,it)
c      enddo

c     .................................... 2body contribution to tilde(B) field
c      do it=1,2
        itb = 3-it
        potBt(:,1,it) = potBt(:,1,it) + b_tg1rd1 * frhotr(:,it)
        potBt(:,2,it) = potBt(:,2,it) + b_tg1rd1 * frhoti(:,it)
c       enddo

c     .................................... 2body contribution to tilde(W) field
c      do it=1,2
        itb = 3-it
        potWtxx(:,1,it) = potWtxx(:,1,it) + b_Jgij1Jdij1 * fJtxxr(:,it)
        potWtxy(:,1,it) = potWtxy(:,1,it) + b_Jgij1Jdij1 * fJtxyr(:,it)
        potWtxz(:,1,it) = potWtxz(:,1,it) + b_Jgij1Jdij1 * fJtxzr(:,it)
        potWtyx(:,1,it) = potWtyx(:,1,it) + b_Jgij1Jdij1 * fJtyxr(:,it)
        potWtyy(:,1,it) = potWtyy(:,1,it) + b_Jgij1Jdij1 * fJtyyr(:,it)
        potWtyz(:,1,it) = potWtyz(:,1,it) + b_Jgij1Jdij1 * fJtyzr(:,it)
        potWtzx(:,1,it) = potWtzx(:,1,it) + b_Jgij1Jdij1 * fJtzxr(:,it)
        potWtzy(:,1,it) = potWtzy(:,1,it) + b_Jgij1Jdij1 * fJtzyr(:,it)
        potWtzz(:,1,it) = potWtzz(:,1,it) + b_Jgij1Jdij1 * fJtzzr(:,it)
        potWtxx(:,2,it) = potWtxx(:,2,it) + b_Jgij1Jdij1 * fJtxxi(:,it)
        potWtxy(:,2,it) = potWtxy(:,2,it) + b_Jgij1Jdij1 * fJtxyi(:,it)
        potWtxz(:,2,it) = potWtxz(:,2,it) + b_Jgij1Jdij1 * fJtxzi(:,it)
        potWtyx(:,2,it) = potWtyx(:,2,it) + b_Jgij1Jdij1 * fJtyxi(:,it)
        potWtyy(:,2,it) = potWtyy(:,2,it) + b_Jgij1Jdij1 * fJtyyi(:,it)
        potWtyz(:,2,it) = potWtyz(:,2,it) + b_Jgij1Jdij1 * fJtyzi(:,it)
        potWtzx(:,2,it) = potWtzx(:,2,it) + b_Jgij1Jdij1 * fJtzxi(:,it)
        potWtzy(:,2,it) = potWtzy(:,2,it) + b_Jgij1Jdij1 * fJtzyi(:,it)
        potWtzz(:,2,it) = potWtzz(:,2,it) + b_Jgij1Jdij1 * fJtzzi(:,it)

c       For tensor term one have Jg_ii Jd_jj
c       The contribution to Wt_ii is thus Jd_jj
        potWtxx(:,1,it) = potWtxx(:,1,it) + b_Jgii1Jdjj1 * fJtxxr(:,it)
     2                                    + b_Jgii1Jdjj1 * fJtyyr(:,it)
     3                                    + b_Jgii1Jdjj1 * fJtzzr(:,it)
        potWtyy(:,1,it) = potWtyy(:,1,it) + b_Jgii1Jdjj1 * fJtxxr(:,it)
     2                                    + b_Jgii1Jdjj1 * fJtyyr(:,it)
     3                                    + b_Jgii1Jdjj1 * fJtzzr(:,it)
        potWtzz(:,1,it) = potWtzz(:,1,it) + b_Jgii1Jdjj1 * fJtxxr(:,it)
     2                                    + b_Jgii1Jdjj1 * fJtyyr(:,it)
     3                                    + b_Jgii1Jdjj1 * fJtzzr(:,it)
        potWtxx(:,2,it) = potWtxx(:,2,it) + b_Jgii1Jdjj1 * fJtxxi(:,it)
     2                                    + b_Jgii1Jdjj1 * fJtyyi(:,it)
     3                                    + b_Jgii1Jdjj1 * fJtzzi(:,it)
        potWtyy(:,2,it) = potWtyy(:,2,it) + b_Jgii1Jdjj1 * fJtxxi(:,it)
     2                                    + b_Jgii1Jdjj1 * fJtyyi(:,it)
     3                                    + b_Jgii1Jdjj1 * fJtzzi(:,it)
        potWtzz(:,2,it) = potWtzz(:,2,it) + b_Jgii1Jdjj1 * fJtxxi(:,it)
     2                                    + b_Jgii1Jdjj1 * fJtyyi(:,it)
     3                                    + b_Jgii1Jdjj1 * fJtzzi(:,it)

c       For tensor term one has Jg_ij Jd_ji
c       The contribution to Wt_ij is thus Jd_ji
        potWtxx(:,1,it) = potWtxx(:,1,it) + b_Jgij1Jdji1 * fJtxxr(:,it)
        potWtxy(:,1,it) = potWtxy(:,1,it) + b_Jgij1Jdji1 * fJtyxr(:,it)
        potWtxz(:,1,it) = potWtxz(:,1,it) + b_Jgij1Jdji1 * fJtzxr(:,it)
        potWtyx(:,1,it) = potWtyx(:,1,it) + b_Jgij1Jdji1 * fJtxyr(:,it)
        potWtyy(:,1,it) = potWtyy(:,1,it) + b_Jgij1Jdji1 * fJtyyr(:,it)
        potWtyz(:,1,it) = potWtyz(:,1,it) + b_Jgij1Jdji1 * fJtzyr(:,it)
        potWtzx(:,1,it) = potWtzx(:,1,it) + b_Jgij1Jdji1 * fJtxzr(:,it)
        potWtzy(:,1,it) = potWtzy(:,1,it) + b_Jgij1Jdji1 * fJtyzr(:,it)
        potWtzz(:,1,it) = potWtzz(:,1,it) + b_Jgij1Jdji1 * fJtzzr(:,it)
        potWtxx(:,2,it) = potWtxx(:,2,it) + b_Jgij1Jdji1 * fJtxxi(:,it)
        potWtxy(:,2,it) = potWtxy(:,2,it) + b_Jgij1Jdji1 * fJtyxi(:,it)
        potWtxz(:,2,it) = potWtxz(:,2,it) + b_Jgij1Jdji1 * fJtzxi(:,it)
        potWtyx(:,2,it) = potWtyx(:,2,it) + b_Jgij1Jdji1 * fJtxyi(:,it)
        potWtyy(:,2,it) = potWtyy(:,2,it) + b_Jgij1Jdji1 * fJtyyi(:,it)
        potWtyz(:,2,it) = potWtyz(:,2,it) + b_Jgij1Jdji1 * fJtzyi(:,it)
        potWtzx(:,2,it) = potWtzx(:,2,it) + b_Jgij1Jdji1 * fJtxzi(:,it)
        potWtzy(:,2,it) = potWtzy(:,2,it) + b_Jgij1Jdji1 * fJtyzi(:,it)
        potWtzz(:,2,it) = potWtzz(:,2,it) + b_Jgij1Jdji1 * fJtzzi(:,it)
c      enddo

c     .........................................................................
c     ................................. 3 body ................................
c     .........................................................................

 2674 continue ! JD 31/10/20

c     .................................... 3body contribution to tilde(U) field
c      do it=1,2
        itb = 3-it
        potUt(:,1,it) = potUt(:,1,it)
     1           + b_rg1rd1r2 * frhotr(:,it) * frho(:,itb)
        potUt(:,2,it) = potUt(:,2,it)
     2           + b_rg1rd1r2 * frhoti(:,it) * frho(:,itb)

        potUt(:,1,it) = potUt(:,1,it)
     1           + b_td1rg1r2 * ftautr(:,it) * frho(:,itb)
        potUt(:,2,it) = potUt(:,2,it)
     2           + b_td1rg1r2 * ftauti(:,it) * frho(:,itb)

        potUt(:,1,it) = potUt(:,1,it)
     1           + b_t1rg1rd1 * ftau(:,it)  * frhotr(:,it)
     2           + b_t2rg1rd1 * ftau(:,itb) * frhotr(:,it)
        potUt(:,2,it) = potUt(:,2,it)
     1           + b_t1rg1rd1 * ftau(:,it)  * frhoti(:,it)
     2           + b_t2rg1rd1 * ftau(:,itb) * frhoti(:,it)

        potUt(:,1,it) = potUt(:,1,it)
     1      - b_nirg1nird1r1 * fnrtxr (:,it) * fnrx(:,it)
     2      - b_nirg1nird1r1 * fnrtyr (:,it) * fnry(:,it)
     3      - b_nirg1nird1r1 * fnrtzr (:,it) * fnrz(:,it)
     4      - b_nirg1nird1r1 * flrhotr(:,it) * frho(:,it)
     5      - b_nirg1nird1r2 * fnrtxr (:,it) * fnrx(:,itb)
     6      - b_nirg1nird1r2 * fnrtyr (:,it) * fnry(:,itb)
     7      - b_nirg1nird1r2 * fnrtzr (:,it) * fnrz(:,itb)
     8      - b_nirg1nird1r2 * flrhotr(:,it) * frho(:,itb)
        potUt(:,2,it) = potUt(:,2,it)
     1      - b_nirg1nird1r1 * fnrtxi (:,it) * fnrx(:,it)
     2      - b_nirg1nird1r1 * fnrtyi (:,it) * fnry(:,it)
     3      - b_nirg1nird1r1 * fnrtzi (:,it) * fnrz(:,it)
     4      - b_nirg1nird1r1 * flrhoti(:,it) * frho(:,it)
     5      - b_nirg1nird1r2 * fnrtxi (:,it) * fnrx(:,itb)
     6      - b_nirg1nird1r2 * fnrtyi (:,it) * fnry(:,itb)
     7      - b_nirg1nird1r2 * fnrtzi (:,it) * fnrz(:,itb)
     8      - b_nirg1nird1r2 * flrhoti(:,it) * frho(:,itb)

        potUt(:,1,it) = potUt(:,1,it)
     1    - b_nirg1nir1rd1 * fnrx  (:,it)  * fnrtxr(:,it)
     2    - b_nirg1nir1rd1 * fnry  (:,it)  * fnrtyr(:,it)
     3    - b_nirg1nir1rd1 * fnrz  (:,it)  * fnrtzr(:,it)
     4    - b_nirg1nir1rd1 * flrho (:,it)  * frhotr(:,it)
     5    - b_nirg1nir2rd1 * fnrx  (:,itb) * fnrtxr(:,it)
     6    - b_nirg1nir2rd1 * fnry  (:,itb) * fnrtyr(:,it)
     7    - b_nirg1nir2rd1 * fnrz  (:,itb) * fnrtzr(:,it)
     8    - b_nirg1nir2rd1 * flrho (:,itb) * frhotr(:,it)
     9    + b_nird1nir1rg1 * fnrtxr(:,it)  * fnrx  (:,it)
     8    + b_nird1nir1rg1 * fnrtyr(:,it)  * fnry  (:,it)
     7    + b_nird1nir1rg1 * fnrtzr(:,it)  * fnrz  (:,it)
     6    + b_nird1nir2rg1 * fnrtxr(:,it)  * fnrx  (:,itb)
     5    + b_nird1nir2rg1 * fnrtyr(:,it)  * fnry  (:,itb)
     4    + b_nird1nir2rg1 * fnrtzr(:,it)  * fnrz  (:,itb)
        potUt(:,2,it) = potUt(:,2,it)
     1    - b_nirg1nir1rd1 * fnrx  (:,it)  * fnrtxi(:,it)
     2    - b_nirg1nir1rd1 * fnry  (:,it)  * fnrtyi(:,it)
     3    - b_nirg1nir1rd1 * fnrz  (:,it)  * fnrtzi(:,it)
     4    - b_nirg1nir1rd1 * flrho (:,it)  * frhoti(:,it)
     5    - b_nirg1nir2rd1 * fnrx  (:,itb) * fnrtxi(:,it)
     6    - b_nirg1nir2rd1 * fnry  (:,itb) * fnrtyi(:,it)
     7    - b_nirg1nir2rd1 * fnrz  (:,itb) * fnrtzi(:,it)
     8    - b_nirg1nir2rd1 * flrho (:,itb) * frhoti(:,it)
     9    + b_nird1nir1rg1 * fnrtxi(:,it)  * fnrx  (:,it)
     8    + b_nird1nir1rg1 * fnrtyi(:,it)  * fnry  (:,it)
     7    + b_nird1nir1rg1 * fnrtzi(:,it)  * fnrz  (:,it)
     6    + b_nird1nir2rg1 * fnrtxi(:,it)  * fnrx  (:,itb)
     5    + b_nird1nir2rg1 * fnrtyi(:,it)  * fnry  (:,itb)
     4    + b_nird1nir2rg1 * fnrtzi(:,it)  * fnrz  (:,itb)

        potUt(:,1,it) = potUt(:,1,it)
     1       + b_Jdij1Jij1rg1 * fJtxxr(:,it) * fJxx(:,it)
     2       + b_Jdij1Jij1rg1 * fJtxyr(:,it) * fJxy(:,it)
     3       + b_Jdij1Jij1rg1 * fJtxzr(:,it) * fJxz(:,it)
     4       + b_Jdij1Jij1rg1 * fJtyxr(:,it) * fJyx(:,it)
     5       + b_Jdij1Jij1rg1 * fJtyyr(:,it) * fJyy(:,it)
     6       + b_Jdij1Jij1rg1 * fJtyzr(:,it) * fJyz(:,it)
     7       + b_Jdij1Jij1rg1 * fJtzxr(:,it) * fJzx(:,it)
     8       + b_Jdij1Jij1rg1 * fJtzyr(:,it) * fJzy(:,it)
     9       + b_Jdij1Jij1rg1 * fJtzzr(:,it) * fJzz(:,it)
     8       + b_Jdij1Jij2rg1 * fJtxxr(:,it) * fJxx(:,itb)
     7       + b_Jdij1Jij2rg1 * fJtxyr(:,it) * fJxy(:,itb)
     6       + b_Jdij1Jij2rg1 * fJtxzr(:,it) * fJxz(:,itb)
     5       + b_Jdij1Jij2rg1 * fJtyxr(:,it) * fJyx(:,itb)
     4       + b_Jdij1Jij2rg1 * fJtyyr(:,it) * fJyy(:,itb)
     3       + b_Jdij1Jij2rg1 * fJtyzr(:,it) * fJyz(:,itb)
     2       + b_Jdij1Jij2rg1 * fJtzxr(:,it) * fJzx(:,itb)
     1       + b_Jdij1Jij2rg1 * fJtzyr(:,it) * fJzy(:,itb)
     2       + b_Jdij1Jij2rg1 * fJtzzr(:,it) * fJzz(:,itb)
        potUt(:,2,it) = potUt(:,2,it)
     1       + b_Jdij1Jij1rg1 * fJtxxi(:,it) * fJxx(:,it)
     2       + b_Jdij1Jij1rg1 * fJtxyi(:,it) * fJxy(:,it)
     3       + b_Jdij1Jij1rg1 * fJtxzi(:,it) * fJxz(:,it)
     4       + b_Jdij1Jij1rg1 * fJtyxi(:,it) * fJyx(:,it)
     5       + b_Jdij1Jij1rg1 * fJtyyi(:,it) * fJyy(:,it)
     6       + b_Jdij1Jij1rg1 * fJtyzi(:,it) * fJyz(:,it)
     7       + b_Jdij1Jij1rg1 * fJtzxi(:,it) * fJzx(:,it)
     8       + b_Jdij1Jij1rg1 * fJtzyi(:,it) * fJzy(:,it)
     9       + b_Jdij1Jij1rg1 * fJtzzi(:,it) * fJzz(:,it)
     8       + b_Jdij1Jij2rg1 * fJtxxi(:,it) * fJxx(:,itb)
     7       + b_Jdij1Jij2rg1 * fJtxyi(:,it) * fJxy(:,itb)
     6       + b_Jdij1Jij2rg1 * fJtxzi(:,it) * fJxz(:,itb)
     5       + b_Jdij1Jij2rg1 * fJtyxi(:,it) * fJyx(:,itb)
     4       + b_Jdij1Jij2rg1 * fJtyyi(:,it) * fJyy(:,itb)
     3       + b_Jdij1Jij2rg1 * fJtyzi(:,it) * fJyz(:,itb)
     2       + b_Jdij1Jij2rg1 * fJtzxi(:,it) * fJzx(:,itb)
     1       + b_Jdij1Jij2rg1 * fJtzyi(:,it) * fJzy(:,itb)
     2       + b_Jdij1Jij2rg1 * fJtzzi(:,it) * fJzz(:,itb)

        potUt(:,1,it) = potUt(:,1,it)
     1     + b_nirg1Jdij1sj1 * fJtxxi(:,it) * fnsxx(:,it)
     2     + b_nirg1Jdij1sj1 * fJtxyi(:,it) * fnsxy(:,it)
     3     + b_nirg1Jdij1sj1 * fJtxzi(:,it) * fnsxz(:,it)
     4     + b_nirg1Jdij1sj1 * fJtyxi(:,it) * fnsyx(:,it)
     5     + b_nirg1Jdij1sj1 * fJtyyi(:,it) * fnsyy(:,it)
     6     + b_nirg1Jdij1sj1 * fJtyzi(:,it) * fnsyz(:,it)
     7     + b_nirg1Jdij1sj1 * fJtzxi(:,it) * fnszx(:,it)
     8     + b_nirg1Jdij1sj1 * fJtzyi(:,it) * fnszy(:,it)
     9     + b_nirg1Jdij1sj1 * fJtzzi(:,it) * fnszz(:,it)
     8     + b_nirg1Jdij1sj1 * fnJtxi(:,it) * fsx  (:,it)
     7     + b_nirg1Jdij1sj1 * fnJtyi(:,it) * fsy  (:,it)
     6     + b_nirg1Jdij1sj1 * fnJtzi(:,it) * fsz  (:,it)
     5     + b_nirg1Jdij1sj2 * fJtxxi(:,it) * fnsxx(:,itb)
     4     + b_nirg1Jdij1sj2 * fJtxyi(:,it) * fnsxy(:,itb)
     3     + b_nirg1Jdij1sj2 * fJtxzi(:,it) * fnsxz(:,itb)
     2     + b_nirg1Jdij1sj2 * fJtyxi(:,it) * fnsyx(:,itb)
     1     + b_nirg1Jdij1sj2 * fJtyyi(:,it) * fnsyy(:,itb)
     2     + b_nirg1Jdij1sj2 * fJtyzi(:,it) * fnsyz(:,itb)
     3     + b_nirg1Jdij1sj2 * fJtzxi(:,it) * fnszx(:,itb)
     4     + b_nirg1Jdij1sj2 * fJtzyi(:,it) * fnszy(:,itb)
     5     + b_nirg1Jdij1sj2 * fJtzzi(:,it) * fnszz(:,itb)
     6     + b_nirg1Jdij1sj2 * fnJtxi(:,it) * fsx  (:,itb)
     7     + b_nirg1Jdij1sj2 * fnJtyi(:,it) * fsy  (:,itb)
     8     + b_nirg1Jdij1sj2 * fnJtzi(:,it) * fsz  (:,itb)
        potUt(:,2,it) = potUt(:,2,it)
     1     - b_nirg1Jdij1sj1 * fJtxxr(:,it) * fnsxx(:,it)
     2     - b_nirg1Jdij1sj1 * fJtxyr(:,it) * fnsxy(:,it)
     3     - b_nirg1Jdij1sj1 * fJtxzr(:,it) * fnsxz(:,it)
     4     - b_nirg1Jdij1sj1 * fJtyxr(:,it) * fnsyx(:,it)
     5     - b_nirg1Jdij1sj1 * fJtyyr(:,it) * fnsyy(:,it)
     6     - b_nirg1Jdij1sj1 * fJtyzr(:,it) * fnsyz(:,it)
     7     - b_nirg1Jdij1sj1 * fJtzxr(:,it) * fnszx(:,it)
     8     - b_nirg1Jdij1sj1 * fJtzyr(:,it) * fnszy(:,it)
     9     - b_nirg1Jdij1sj1 * fJtzzr(:,it) * fnszz(:,it)
     8     - b_nirg1Jdij1sj1 * fnJtxr(:,it) * fsx  (:,it)
     7     - b_nirg1Jdij1sj1 * fnJtyr(:,it) * fsy  (:,it)
     6     - b_nirg1Jdij1sj1 * fnJtzr(:,it) * fsz  (:,it)
     5     - b_nirg1Jdij1sj2 * fJtxxr(:,it) * fnsxx(:,itb)
     4     - b_nirg1Jdij1sj2 * fJtxyr(:,it) * fnsxy(:,itb)
     3     - b_nirg1Jdij1sj2 * fJtxzr(:,it) * fnsxz(:,itb)
     2     - b_nirg1Jdij1sj2 * fJtyxr(:,it) * fnsyx(:,itb)
     1     - b_nirg1Jdij1sj2 * fJtyyr(:,it) * fnsyy(:,itb)
     2     - b_nirg1Jdij1sj2 * fJtyzr(:,it) * fnsyz(:,itb)
     3     - b_nirg1Jdij1sj2 * fJtzxr(:,it) * fnszx(:,itb)
     4     - b_nirg1Jdij1sj2 * fJtzyr(:,it) * fnszy(:,itb)
     5     - b_nirg1Jdij1sj2 * fJtzzr(:,it) * fnszz(:,itb)
     6     - b_nirg1Jdij1sj2 * fnJtxr(:,it) * fsx  (:,itb)
     7     - b_nirg1Jdij1sj2 * fnJtyr(:,it) * fsy  (:,itb)
     8     - b_nirg1Jdij1sj2 * fnJtzr(:,it) * fsz  (:,itb)

        potUt(:,1,it) = potUt(:,1,it)
     1     + b_nirg1ji1rd1 * fjx   (:,it)  * fnrtxi(:,it)
     2     + b_nirg1ji1rd1 * fjy   (:,it)  * fnrtyi(:,it)
     3     + b_nirg1ji1rd1 * fjz   (:,it)  * fnrtzi(:,it)
     4     + b_nirg1ji1rd1 * fnj   (:,it)  * frhoti(:,it)
     5     + b_nirg1ji2rd1 * fjx   (:,itb) * fnrtxi(:,it)
     6     + b_nirg1ji2rd1 * fjy   (:,itb) * fnrtyi(:,it)
     7     + b_nirg1ji2rd1 * fjz   (:,itb) * fnrtzi(:,it)
     8     + b_nirg1ji2rd1 * fnj   (:,itb) * frhoti(:,it)
     9     - b_nird1ji1rg1 * fnrtxi(:,it)  * fjx   (:,it)
     8     - b_nird1ji1rg1 * fnrtyi(:,it)  * fjy   (:,it)
     7     - b_nird1ji1rg1 * fnrtzi(:,it)  * fjz   (:,it)
     6     - b_nird1ji2rg1 * fnrtxi(:,it)  * fjx   (:,itb)
     5     - b_nird1ji2rg1 * fnrtyi(:,it)  * fjy   (:,itb)
     4     - b_nird1ji2rg1 * fnrtzi(:,it)  * fjz   (:,itb)
        potUt(:,2,it) = potUt(:,2,it)
     1     - b_nirg1ji1rd1 * fjx   (:,it)  * fnrtxr(:,it)
     2     - b_nirg1ji1rd1 * fjy   (:,it)  * fnrtyr(:,it)
     3     - b_nirg1ji1rd1 * fjz   (:,it)  * fnrtzr(:,it)
     4     - b_nirg1ji1rd1 * fnj   (:,it)  * frhotr(:,it)
     5     - b_nirg1ji2rd1 * fjx   (:,itb) * fnrtxr(:,it)
     6     - b_nirg1ji2rd1 * fjy   (:,itb) * fnrtyr(:,it)
     7     - b_nirg1ji2rd1 * fjz   (:,itb) * fnrtzr(:,it)
     8     - b_nirg1ji2rd1 * fnj   (:,itb) * frhotr(:,it)
     9     + b_nird1ji1rg1 * fnrtxr(:,it)  * fjx   (:,it)
     8     + b_nird1ji1rg1 * fnrtyr(:,it)  * fjy   (:,it)
     7     + b_nird1ji1rg1 * fnrtzr(:,it)  * fjz   (:,it)
     6     + b_nird1ji2rg1 * fnrtxr(:,it)  * fjx   (:,itb)
     5     + b_nird1ji2rg1 * fnrtyr(:,it)  * fjy   (:,itb)
     4     + b_nird1ji2rg1 * fnrtzr(:,it)  * fjz   (:,itb)

        potUt(:,1,it) = potUt(:,1,it)
     1     - b_nisj1Jdij1rg1 * fnsxx(:,it)  * fJtxxi(:,it)
     2     - b_nisj1Jdij1rg1 * fnsxy(:,it)  * fJtxyi(:,it)
     3     - b_nisj1Jdij1rg1 * fnsxz(:,it)  * fJtxzi(:,it)
     4     - b_nisj1Jdij1rg1 * fnsyx(:,it)  * fJtyxi(:,it)
     5     - b_nisj1Jdij1rg1 * fnsyy(:,it)  * fJtyyi(:,it)
     6     - b_nisj1Jdij1rg1 * fnsyz(:,it)  * fJtyzi(:,it)
     7     - b_nisj1Jdij1rg1 * fnszx(:,it)  * fJtzxi(:,it)
     8     - b_nisj1Jdij1rg1 * fnszy(:,it)  * fJtzyi(:,it)
     9     - b_nisj1Jdij1rg1 * fnszz(:,it)  * fJtzzi(:,it)
     1     - b_nisj2Jdij1rg1 * fnsxx(:,itb) * fJtxxi(:,it)
     2     - b_nisj2Jdij1rg1 * fnsxy(:,itb) * fJtxyi(:,it)
     3     - b_nisj2Jdij1rg1 * fnsxz(:,itb) * fJtxzi(:,it)
     4     - b_nisj2Jdij1rg1 * fnsyx(:,itb) * fJtyxi(:,it)
     5     - b_nisj2Jdij1rg1 * fnsyy(:,itb) * fJtyyi(:,it)
     6     - b_nisj2Jdij1rg1 * fnsyz(:,itb) * fJtyzi(:,it)
     7     - b_nisj2Jdij1rg1 * fnszx(:,itb) * fJtzxi(:,it)
     8     - b_nisj2Jdij1rg1 * fnszy(:,itb) * fJtzyi(:,it)
     9     - b_nisj2Jdij1rg1 * fnszz(:,itb) * fJtzzi(:,it)
        potUt(:,2,it) = potUt(:,2,it)
     1     + b_nisj1Jdij1rg1 * fnsxx(:,it)  * fJtxxr(:,it)
     2     + b_nisj1Jdij1rg1 * fnsxy(:,it)  * fJtxyr(:,it)
     3     + b_nisj1Jdij1rg1 * fnsxz(:,it)  * fJtxzr(:,it)
     4     + b_nisj1Jdij1rg1 * fnsyx(:,it)  * fJtyxr(:,it)
     5     + b_nisj1Jdij1rg1 * fnsyy(:,it)  * fJtyyr(:,it)
     6     + b_nisj1Jdij1rg1 * fnsyz(:,it)  * fJtyzr(:,it)
     7     + b_nisj1Jdij1rg1 * fnszx(:,it)  * fJtzxr(:,it)
     8     + b_nisj1Jdij1rg1 * fnszy(:,it)  * fJtzyr(:,it)
     9     + b_nisj1Jdij1rg1 * fnszz(:,it)  * fJtzzr(:,it)
     1     + b_nisj2Jdij1rg1 * fnsxx(:,itb) * fJtxxr(:,it)
     2     + b_nisj2Jdij1rg1 * fnsxy(:,itb) * fJtxyr(:,it)
     3     + b_nisj2Jdij1rg1 * fnsxz(:,itb) * fJtxzr(:,it)
     4     + b_nisj2Jdij1rg1 * fnsyx(:,itb) * fJtyxr(:,it)
     5     + b_nisj2Jdij1rg1 * fnsyy(:,itb) * fJtyyr(:,it)
     6     + b_nisj2Jdij1rg1 * fnsyz(:,itb) * fJtyzr(:,it)
     7     + b_nisj2Jdij1rg1 * fnszx(:,itb) * fJtzxr(:,it)
     8     + b_nisj2Jdij1rg1 * fnszy(:,itb) * fJtzyr(:,it)
     9     + b_nisj2Jdij1rg1 * fnszz(:,itb) * fJtzzr(:,it)
c      enddo

c     .................................... 3body contribution to tilde(B) field
c      do it=1,2
        itb = 3-it
        potBt(:,1,it) = potBt(:,1,it)
     1           + b_tg1rd1r2 * frhotr(:,it) * frho(:,itb)
        potBt(:,2,it) = potBt(:,2,it)
     2           + b_tg1rd1r2 * frhoti(:,it) * frho(:,itb)
c      enddo

c     .................................... 3body contribution to tilde(W) field
c      do it=1,2
        itb = 3-it

        potWtxx(:,1,it) = potWtxx(:,1,it)
     1       + b_Jgij1Jdij1r1 * fJtxxr(:,it) * frho(:,it)
     2       + b_Jgij1Jdij1r2 * fJtxxr(:,it) * frho(:,itb)
        potWtxy(:,1,it) = potWtxy(:,1,it)
     1       + b_Jgij1Jdij1r1 * fJtxyr(:,it) * frho(:,it)
     2       + b_Jgij1Jdij1r2 * fJtxyr(:,it) * frho(:,itb)
        potWtxz(:,1,it) = potWtxz(:,1,it)
     1       + b_Jgij1Jdij1r1 * fJtxzr(:,it) * frho(:,it)
     2       + b_Jgij1Jdij1r2 * fJtxzr(:,it) * frho(:,itb)
        potWtyx(:,1,it) = potWtyx(:,1,it)
     1       + b_Jgij1Jdij1r1 * fJtyxr(:,it) * frho(:,it)
     2       + b_Jgij1Jdij1r2 * fJtyxr(:,it) * frho(:,itb)
        potWtyy(:,1,it) = potWtyy(:,1,it)
     1       + b_Jgij1Jdij1r1 * fJtyyr(:,it) * frho(:,it)
     2       + b_Jgij1Jdij1r2 * fJtyyr(:,it) * frho(:,itb)
        potWtyz(:,1,it) = potWtyz(:,1,it)
     1       + b_Jgij1Jdij1r1 * fJtyzr(:,it) * frho(:,it)
     2       + b_Jgij1Jdij1r2 * fJtyzr(:,it) * frho(:,itb)
        potWtzx(:,1,it) = potWtzx(:,1,it)
     1       + b_Jgij1Jdij1r1 * fJtzxr(:,it) * frho(:,it)
     2       + b_Jgij1Jdij1r2 * fJtzxr(:,it) * frho(:,itb)
        potWtzy(:,1,it) = potWtzy(:,1,it)
     1       + b_Jgij1Jdij1r1 * fJtzyr(:,it) * frho(:,it)
     2       + b_Jgij1Jdij1r2 * fJtzyr(:,it) * frho(:,itb)
        potWtzz(:,1,it) = potWtzz(:,1,it)
     1       + b_Jgij1Jdij1r1 * fJtzzr(:,it) * frho(:,it)
     2       + b_Jgij1Jdij1r2 * fJtzzr(:,it) * frho(:,itb)
        potWtxx(:,2,it) = potWtxx(:,2,it)
     3       + b_Jgij1Jdij1r1 * fJtxxi(:,it) * frho(:,it)
     4       + b_Jgij1Jdij1r2 * fJtxxi(:,it) * frho(:,itb)
        potWtxy(:,2,it) = potWtxy(:,2,it)
     3       + b_Jgij1Jdij1r1 * fJtxyi(:,it) * frho(:,it)
     4       + b_Jgij1Jdij1r2 * fJtxyi(:,it) * frho(:,itb)
        potWtxz(:,2,it) = potWtxz(:,2,it)
     3       + b_Jgij1Jdij1r1 * fJtxzi(:,it) * frho(:,it)
     4       + b_Jgij1Jdij1r2 * fJtxzi(:,it) * frho(:,itb)
        potWtyx(:,2,it) = potWtyx(:,2,it)
     3       + b_Jgij1Jdij1r1 * fJtyxi(:,it) * frho(:,it)
     4       + b_Jgij1Jdij1r2 * fJtyxi(:,it) * frho(:,itb)
        potWtyy(:,2,it) = potWtyy(:,2,it)
     3       + b_Jgij1Jdij1r1 * fJtyyi(:,it) * frho(:,it)
     4       + b_Jgij1Jdij1r2 * fJtyyi(:,it) * frho(:,itb)
        potWtyz(:,2,it) = potWtyz(:,2,it)
     3       + b_Jgij1Jdij1r1 * fJtyzi(:,it) * frho(:,it)
     4       + b_Jgij1Jdij1r2 * fJtyzi(:,it) * frho(:,itb)
        potWtzx(:,2,it) = potWtzx(:,2,it)
     3       + b_Jgij1Jdij1r1 * fJtzxi(:,it) * frho(:,it)
     4       + b_Jgij1Jdij1r2 * fJtzxi(:,it) * frho(:,itb)
        potWtzy(:,2,it) = potWtzy(:,2,it)
     3       + b_Jgij1Jdij1r1 * fJtzyi(:,it) * frho(:,it)
     4       + b_Jgij1Jdij1r2 * fJtzyi(:,it) * frho(:,itb)
        potWtzz(:,2,it) = potWtzz(:,2,it)
     3       + b_Jgij1Jdij1r1 * fJtzzi(:,it) * frho(:,it)
     4       + b_Jgij1Jdij1r2 * fJtzzi(:,it) * frho(:,itb)

        potWtxx(:,1,it) = potWtxx(:,1,it)  ! Warning vectoriel product
     3       - b_Jgia1Jdib1sc1 * fJtxyi(:,it) * fsz(:,it)
     4       - b_Jgia1Jdib1sc2 * fJtxyi(:,it) * fsz(:,itb)
     3       + b_Jgia1Jdib1sc1 * fJtxzi(:,it) * fsy(:,it)
     4       + b_Jgia1Jdib1sc2 * fJtxzi(:,it) * fsy(:,itb)
        potWtxy(:,1,it) = potWtxy(:,1,it)  ! Warning vectoriel product
     3       + b_Jgia1Jdib1sc1 * fJtxxi(:,it) * fsz(:,it)
     4       + b_Jgia1Jdib1sc2 * fJtxxi(:,it) * fsz(:,itb)
     3       - b_Jgia1Jdib1sc1 * fJtxzi(:,it) * fsx(:,it)
     4       - b_Jgia1Jdib1sc2 * fJtxzi(:,it) * fsx(:,itb)
        potWtxz(:,1,it) = potWtxz(:,1,it)  ! Warning vectoriel product
     3       - b_Jgia1Jdib1sc1 * fJtxxi(:,it) * fsy(:,it)
     4       - b_Jgia1Jdib1sc2 * fJtxxi(:,it) * fsy(:,itb)
     3       + b_Jgia1Jdib1sc1 * fJtxyi(:,it) * fsx(:,it)
     4       + b_Jgia1Jdib1sc2 * fJtxyi(:,it) * fsx(:,itb)
        potWtyx(:,1,it) = potWtyx(:,1,it)  ! Warning vectoriel product
     3       - b_Jgia1Jdib1sc1 * fJtyyi(:,it) * fsz(:,it)
     4       - b_Jgia1Jdib1sc2 * fJtyyi(:,it) * fsz(:,itb)
     3       + b_Jgia1Jdib1sc1 * fJtyzi(:,it) * fsy(:,it)
     4       + b_Jgia1Jdib1sc2 * fJtyzi(:,it) * fsy(:,itb)
        potWtyy(:,1,it) = potWtyy(:,1,it)  ! Warning vectoriel product
     3       + b_Jgia1Jdib1sc1 * fJtyxi(:,it) * fsz(:,it)
     4       + b_Jgia1Jdib1sc2 * fJtyxi(:,it) * fsz(:,itb)
     3       - b_Jgia1Jdib1sc1 * fJtyzi(:,it) * fsx(:,it)
     4       - b_Jgia1Jdib1sc2 * fJtyzi(:,it) * fsx(:,itb)
        potWtyz(:,1,it) = potWtyz(:,1,it)  ! Warning vectoriel product
     3       - b_Jgia1Jdib1sc1 * fJtyxi(:,it) * fsy(:,it)
     4       - b_Jgia1Jdib1sc2 * fJtyxi(:,it) * fsy(:,itb)
     3       + b_Jgia1Jdib1sc1 * fJtyyi(:,it) * fsx(:,it)
     4       + b_Jgia1Jdib1sc2 * fJtyyi(:,it) * fsx(:,itb)
        potWtzx(:,1,it) = potWtzx(:,1,it)  ! Warning vectoriel product
     3       - b_Jgia1Jdib1sc1 * fJtzyi(:,it) * fsz(:,it)
     4       - b_Jgia1Jdib1sc2 * fJtzyi(:,it) * fsz(:,itb)
     3       + b_Jgia1Jdib1sc1 * fJtzzi(:,it) * fsy(:,it)
     4       + b_Jgia1Jdib1sc2 * fJtzzi(:,it) * fsy(:,itb)
        potWtzy(:,1,it) = potWtzy(:,1,it)  ! Warning vectoriel product
     3       + b_Jgia1Jdib1sc1 * fJtzxi(:,it) * fsz(:,it)
     4       + b_Jgia1Jdib1sc2 * fJtzxi(:,it) * fsz(:,itb)
     3       - b_Jgia1Jdib1sc1 * fJtzzi(:,it) * fsx(:,it)
     4       - b_Jgia1Jdib1sc2 * fJtzzi(:,it) * fsx(:,itb)
        potWtzz(:,1,it) = potWtzz(:,1,it)  ! Warning vectoriel product
     3       - b_Jgia1Jdib1sc1 * fJtzxi(:,it) * fsy(:,it)
     4       - b_Jgia1Jdib1sc2 * fJtzxi(:,it) * fsy(:,itb)
     3       + b_Jgia1Jdib1sc1 * fJtzyi(:,it) * fsx(:,it)
     4       + b_Jgia1Jdib1sc2 * fJtzyi(:,it) * fsx(:,itb)
        potWtxx(:,2,it) = potWtxx(:,2,it)  ! Warning vectoriel product
     1       + b_Jgia1Jdib1sc1 * fJtxyr(:,it) * fsz(:,it)
     2       + b_Jgia1Jdib1sc2 * fJtxyr(:,it) * fsz(:,itb)
     1       - b_Jgia1Jdib1sc1 * fJtxzr(:,it) * fsy(:,it)
     2       - b_Jgia1Jdib1sc2 * fJtxzr(:,it) * fsy(:,itb)
        potWtxy(:,2,it) = potWtxy(:,2,it)  ! Warning vectoriel product
     1       - b_Jgia1Jdib1sc1 * fJtxxr(:,it) * fsz(:,it)
     2       - b_Jgia1Jdib1sc2 * fJtxxr(:,it) * fsz(:,itb)
     1       + b_Jgia1Jdib1sc1 * fJtxzr(:,it) * fsx(:,it)
     2       + b_Jgia1Jdib1sc2 * fJtxzr(:,it) * fsx(:,itb)
        potWtxz(:,2,it) = potWtxz(:,2,it)  ! Warning vectoriel product
     1       + b_Jgia1Jdib1sc1 * fJtxxr(:,it) * fsy(:,it)
     2       + b_Jgia1Jdib1sc2 * fJtxxr(:,it) * fsy(:,itb)
     1       - b_Jgia1Jdib1sc1 * fJtxyr(:,it) * fsx(:,it)
     2       - b_Jgia1Jdib1sc2 * fJtxyr(:,it) * fsx(:,itb)
        potWtyx(:,2,it) = potWtyx(:,2,it)  ! Warning vectoriel product
     1       + b_Jgia1Jdib1sc1 * fJtyyr(:,it) * fsz(:,it)
     2       + b_Jgia1Jdib1sc2 * fJtyyr(:,it) * fsz(:,itb)
     1       - b_Jgia1Jdib1sc1 * fJtyzr(:,it) * fsy(:,it)
     2       - b_Jgia1Jdib1sc2 * fJtyzr(:,it) * fsy(:,itb)
        potWtyy(:,2,it) = potWtyy(:,2,it)  ! Warning vectoriel product
     1       - b_Jgia1Jdib1sc1 * fJtyxr(:,it) * fsz(:,it)
     2       - b_Jgia1Jdib1sc2 * fJtyxr(:,it) * fsz(:,itb)
     1       + b_Jgia1Jdib1sc1 * fJtyzr(:,it) * fsx(:,it)
     2       + b_Jgia1Jdib1sc2 * fJtyzr(:,it) * fsx(:,itb)
        potWtyz(:,2,it) = potWtyz(:,2,it)  ! Warning vectoriel product
     1       + b_Jgia1Jdib1sc1 * fJtyxr(:,it) * fsy(:,it)
     2       + b_Jgia1Jdib1sc2 * fJtyxr(:,it) * fsy(:,itb)
     1       - b_Jgia1Jdib1sc1 * fJtyyr(:,it) * fsx(:,it)
     2       - b_Jgia1Jdib1sc2 * fJtyyr(:,it) * fsx(:,itb)
        potWtzx(:,2,it) = potWtzx(:,2,it)  ! Warning vectoriel product
     1       + b_Jgia1Jdib1sc1 * fJtzyr(:,it) * fsz(:,it)
     2       + b_Jgia1Jdib1sc2 * fJtzyr(:,it) * fsz(:,itb)
     1       - b_Jgia1Jdib1sc1 * fJtzzr(:,it) * fsy(:,it)
     2       - b_Jgia1Jdib1sc2 * fJtzzr(:,it) * fsy(:,itb)
        potWtzy(:,2,it) = potWtzy(:,2,it)  ! Warning vectoriel product
     1       - b_Jgia1Jdib1sc1 * fJtzxr(:,it) * fsz(:,it)
     2       - b_Jgia1Jdib1sc2 * fJtzxr(:,it) * fsz(:,itb)
     1       + b_Jgia1Jdib1sc1 * fJtzzr(:,it) * fsx(:,it)
     2       + b_Jgia1Jdib1sc2 * fJtzzr(:,it) * fsx(:,itb)
        potWtzz(:,2,it) = potWtzz(:,2,it)  ! Warning vectoriel product
     1       + b_Jgia1Jdib1sc1 * fJtzxr(:,it) * fsy(:,it)
     2       + b_Jgia1Jdib1sc2 * fJtzxr(:,it) * fsy(:,itb)
     1       - b_Jgia1Jdib1sc1 * fJtzyr(:,it) * fsx(:,it)
     2       - b_Jgia1Jdib1sc2 * fJtzyr(:,it) * fsx(:,itb)

        potWtxx(:,1,it) = potWtxx(:,1,it)
     1       + b_Jgij1Jij1rd1 * fJxx(:,it)  * frhotr(:,it)
     2       + b_Jgij1Jij2rd1 * fJxx(:,itb) * frhotr(:,it)
        potWtxy(:,1,it) = potWtxy(:,1,it)
     1       + b_Jgij1Jij1rd1 * fJxy(:,it)  * frhotr(:,it)
     2       + b_Jgij1Jij2rd1 * fJxy(:,itb) * frhotr(:,it)
        potWtxz(:,1,it) = potWtxz(:,1,it)
     1       + b_Jgij1Jij1rd1 * fJxz(:,it)  * frhotr(:,it)
     2       + b_Jgij1Jij2rd1 * fJxz(:,itb) * frhotr(:,it)
        potWtyx(:,1,it) = potWtyx(:,1,it)
     1       + b_Jgij1Jij1rd1 * fJyx(:,it)  * frhotr(:,it)
     2       + b_Jgij1Jij2rd1 * fJyx(:,itb) * frhotr(:,it)
        potWtyy(:,1,it) = potWtyy(:,1,it)
     1       + b_Jgij1Jij1rd1 * fJyy(:,it)  * frhotr(:,it)
     2       + b_Jgij1Jij2rd1 * fJyy(:,itb) * frhotr(:,it)
        potWtyz(:,1,it) = potWtyz(:,1,it)
     1       + b_Jgij1Jij1rd1 * fJyz(:,it)  * frhotr(:,it)
     2       + b_Jgij1Jij2rd1 * fJyz(:,itb) * frhotr(:,it)
        potWtzx(:,1,it) = potWtzx(:,1,it)
     1       + b_Jgij1Jij1rd1 * fJzx(:,it)  * frhotr(:,it)
     2       + b_Jgij1Jij2rd1 * fJzx(:,itb) * frhotr(:,it)
        potWtzy(:,1,it) = potWtzy(:,1,it)
     1       + b_Jgij1Jij1rd1 * fJzy(:,it)  * frhotr(:,it)
     2       + b_Jgij1Jij2rd1 * fJzy(:,itb) * frhotr(:,it)
        potWtzz(:,1,it) = potWtzz(:,1,it)
     1       + b_Jgij1Jij1rd1 * fJzz(:,it)  * frhotr(:,it)
     2       + b_Jgij1Jij2rd1 * fJzz(:,itb) * frhotr(:,it)
        potWtxx(:,2,it) = potWtxx(:,2,it)
     1       + b_Jgij1Jij1rd1 * fJxx(:,it)  * frhoti(:,it)
     2       + b_Jgij1Jij2rd1 * fJxx(:,itb) * frhoti(:,it)
        potWtxy(:,2,it) = potWtxy(:,2,it)
     1       + b_Jgij1Jij1rd1 * fJxy(:,it)  * frhoti(:,it)
     2       + b_Jgij1Jij2rd1 * fJxy(:,itb) * frhoti(:,it)
        potWtxz(:,2,it) = potWtxz(:,2,it)
     1       + b_Jgij1Jij1rd1 * fJxz(:,it)  * frhoti(:,it)
     2       + b_Jgij1Jij2rd1 * fJxz(:,itb) * frhoti(:,it)
        potWtyx(:,2,it) = potWtyx(:,2,it)
     1       + b_Jgij1Jij1rd1 * fJyx(:,it)  * frhoti(:,it)
     2       + b_Jgij1Jij2rd1 * fJyx(:,itb) * frhoti(:,it)
        potWtyy(:,2,it) = potWtyy(:,2,it)
     1       + b_Jgij1Jij1rd1 * fJyy(:,it)  * frhoti(:,it)
     2       + b_Jgij1Jij2rd1 * fJyy(:,itb) * frhoti(:,it)
        potWtyz(:,2,it) = potWtyz(:,2,it)
     1       + b_Jgij1Jij1rd1 * fJyz(:,it)  * frhoti(:,it)
     2       + b_Jgij1Jij2rd1 * fJyz(:,itb) * frhoti(:,it)
        potWtzx(:,2,it) = potWtzx(:,2,it)
     1       + b_Jgij1Jij1rd1 * fJzx(:,it)  * frhoti(:,it)
     2       + b_Jgij1Jij2rd1 * fJzx(:,itb) * frhoti(:,it)
        potWtzy(:,2,it) = potWtzy(:,2,it)
     1       + b_Jgij1Jij1rd1 * fJzy(:,it)  * frhoti(:,it)
     2       + b_Jgij1Jij2rd1 * fJzy(:,itb) * frhoti(:,it)
        potWtzz(:,2,it) = potWtzz(:,2,it)
     1       + b_Jgij1Jij1rd1 * fJzz(:,it)  * frhoti(:,it)
     2       + b_Jgij1Jij2rd1 * fJzz(:,itb) * frhoti(:,it)

        potWtxx(:,1,it) = potWtxx(:,1,it)
     3       - b_nird1Jgij1sj1 * fnrtxi(:,it) * fsx(:,it)
     4       - b_nird1Jgij1sj2 * fnrtxi(:,it) * fsx(:,itb)
        potWtxy(:,1,it) = potWtxy(:,1,it)
     3       - b_nird1Jgij1sj1 * fnrtxi(:,it) * fsy(:,it)
     4       - b_nird1Jgij1sj2 * fnrtxi(:,it) * fsy(:,itb)
        potWtxz(:,1,it) = potWtxz(:,1,it)
     3       - b_nird1Jgij1sj1 * fnrtxi(:,it) * fsz(:,it)
     4       - b_nird1Jgij1sj2 * fnrtxi(:,it) * fsz(:,itb)
        potWtyx(:,1,it) = potWtyx(:,1,it)
     3       - b_nird1Jgij1sj1 * fnrtyi(:,it) * fsx(:,it)
     4       - b_nird1Jgij1sj2 * fnrtyi(:,it) * fsx(:,itb)
        potWtyy(:,1,it) = potWtyy(:,1,it)
     3       - b_nird1Jgij1sj1 * fnrtyi(:,it) * fsy(:,it)
     4       - b_nird1Jgij1sj2 * fnrtyi(:,it) * fsy(:,itb)
        potWtyz(:,1,it) = potWtyz(:,1,it)
     3       - b_nird1Jgij1sj1 * fnrtyi(:,it) * fsz(:,it)
     4       - b_nird1Jgij1sj2 * fnrtyi(:,it) * fsz(:,itb)
        potWtzx(:,1,it) = potWtzx(:,1,it)
     3       - b_nird1Jgij1sj1 * fnrtzi(:,it) * fsx(:,it)
     4       - b_nird1Jgij1sj2 * fnrtzi(:,it) * fsx(:,itb)
        potWtzy(:,1,it) = potWtzy(:,1,it)
     3       - b_nird1Jgij1sj1 * fnrtzi(:,it) * fsy(:,it)
     4       - b_nird1Jgij1sj2 * fnrtzi(:,it) * fsy(:,itb)
        potWtzz(:,1,it) = potWtzz(:,1,it)
     3       - b_nird1Jgij1sj1 * fnrtzi(:,it) * fsz(:,it)
     4       - b_nird1Jgij1sj2 * fnrtzi(:,it) * fsz(:,itb)
        potWtxx(:,2,it) = potWtxx(:,2,it)
     1       + b_nird1Jgij1sj1 * fnrtxr(:,it) * fsx(:,it)
     2       + b_nird1Jgij1sj2 * fnrtxr(:,it) * fsx(:,itb)
        potWtxy(:,2,it) = potWtxy(:,2,it)
     1       + b_nird1Jgij1sj1 * fnrtxr(:,it) * fsy(:,it)
     2       + b_nird1Jgij1sj2 * fnrtxr(:,it) * fsy(:,itb)
        potWtxz(:,2,it) = potWtxz(:,2,it)
     1       + b_nird1Jgij1sj1 * fnrtxr(:,it) * fsz(:,it)
     2       + b_nird1Jgij1sj2 * fnrtxr(:,it) * fsz(:,itb)
        potWtyx(:,2,it) = potWtyx(:,2,it)
     1       + b_nird1Jgij1sj1 * fnrtyr(:,it) * fsx(:,it)
     2       + b_nird1Jgij1sj2 * fnrtyr(:,it) * fsx(:,itb)
        potWtyy(:,2,it) = potWtyy(:,2,it)
     1       + b_nird1Jgij1sj1 * fnrtyr(:,it) * fsy(:,it)
     2       + b_nird1Jgij1sj2 * fnrtyr(:,it) * fsy(:,itb)
        potWtyz(:,2,it) = potWtyz(:,2,it)
     1       + b_nird1Jgij1sj1 * fnrtyr(:,it) * fsz(:,it)
     2       + b_nird1Jgij1sj2 * fnrtyr(:,it) * fsz(:,itb)
        potWtzx(:,2,it) = potWtzx(:,2,it)
     1       + b_nird1Jgij1sj1 * fnrtzr(:,it) * fsx(:,it)
     2       + b_nird1Jgij1sj2 * fnrtzr(:,it) * fsx(:,itb)
        potWtzy(:,2,it) = potWtzy(:,2,it)
     1       + b_nird1Jgij1sj1 * fnrtzr(:,it) * fsy(:,it)
     2       + b_nird1Jgij1sj2 * fnrtzr(:,it) * fsy(:,itb)
        potWtzz(:,2,it) = potWtzz(:,2,it)
     1       + b_nird1Jgij1sj1 * fnrtzr(:,it) * fsz(:,it)
     2       + b_nird1Jgij1sj2 * fnrtzr(:,it) * fsz(:,itb)

        potWtxx(:,1,it) = potWtxx(:,1,it)
     1     - b_nisj1Jgij1rd1 * fnsxx(:,it)  * frhoti(:,it)
     2     - b_nisj2Jgij1rd1 * fnsxx(:,itb) * frhoti(:,it)
        potWtxy(:,1,it) = potWtxy(:,1,it)
     1     - b_nisj1Jgij1rd1 * fnsxy(:,it)  * frhoti(:,it)
     2     - b_nisj2Jgij1rd1 * fnsxy(:,itb) * frhoti(:,it)
        potWtxz(:,1,it) = potWtxz(:,1,it)
     1     - b_nisj1Jgij1rd1 * fnsxz(:,it)  * frhoti(:,it)
     2     - b_nisj2Jgij1rd1 * fnsxz(:,itb) * frhoti(:,it)
        potWtyx(:,1,it) = potWtyx(:,1,it)
     1     - b_nisj1Jgij1rd1 * fnsyx(:,it)  * frhoti(:,it)
     2     - b_nisj2Jgij1rd1 * fnsyx(:,itb) * frhoti(:,it)
        potWtyy(:,1,it) = potWtyy(:,1,it)
     1     - b_nisj1Jgij1rd1 * fnsyy(:,it)  * frhoti(:,it)
     2     - b_nisj2Jgij1rd1 * fnsyy(:,itb) * frhoti(:,it)
        potWtyz(:,1,it) = potWtyz(:,1,it)
     1     - b_nisj1Jgij1rd1 * fnsyz(:,it)  * frhoti(:,it)
     2     - b_nisj2Jgij1rd1 * fnsyz(:,itb) * frhoti(:,it)
        potWtzx(:,1,it) = potWtzx(:,1,it)
     1     - b_nisj1Jgij1rd1 * fnszx(:,it)  * frhoti(:,it)
     2     - b_nisj2Jgij1rd1 * fnszx(:,itb) * frhoti(:,it)
        potWtzy(:,1,it) = potWtzy(:,1,it)
     1     - b_nisj1Jgij1rd1 * fnszy(:,it)  * frhoti(:,it)
     2     - b_nisj2Jgij1rd1 * fnszy(:,itb) * frhoti(:,it)
        potWtzz(:,1,it) = potWtzz(:,1,it)
     1     - b_nisj1Jgij1rd1 * fnszz(:,it)  * frhoti(:,it)
     2     - b_nisj2Jgij1rd1 * fnszz(:,itb) * frhoti(:,it)
        potWtxx(:,2,it) = potWtxx(:,2,it)
     1     + b_nisj1Jgij1rd1 * fnsxx(:,it)  * frhotr(:,it)
     2     + b_nisj2Jgij1rd1 * fnsxx(:,itb) * frhotr(:,it)
        potWtxy(:,2,it) = potWtxy(:,2,it)
     1     + b_nisj1Jgij1rd1 * fnsxy(:,it)  * frhotr(:,it)
     2     + b_nisj2Jgij1rd1 * fnsxy(:,itb) * frhotr(:,it)
        potWtxz(:,2,it) = potWtxz(:,2,it)
     1     + b_nisj1Jgij1rd1 * fnsxz(:,it)  * frhotr(:,it)
     2     + b_nisj2Jgij1rd1 * fnsxz(:,itb) * frhotr(:,it)
        potWtyx(:,2,it) = potWtyx(:,2,it)
     1     + b_nisj1Jgij1rd1 * fnsyx(:,it)  * frhotr(:,it)
     2     + b_nisj2Jgij1rd1 * fnsyx(:,itb) * frhotr(:,it)
        potWtyy(:,2,it) = potWtyy(:,2,it)
     1     + b_nisj1Jgij1rd1 * fnsyy(:,it)  * frhotr(:,it)
     2     + b_nisj2Jgij1rd1 * fnsyy(:,itb) * frhotr(:,it)
        potWtyz(:,2,it) = potWtyz(:,2,it)
     1     + b_nisj1Jgij1rd1 * fnsyz(:,it)  * frhotr(:,it)
     2     + b_nisj2Jgij1rd1 * fnsyz(:,itb) * frhotr(:,it)
        potWtzx(:,2,it) = potWtzx(:,2,it)
     1     + b_nisj1Jgij1rd1 * fnszx(:,it)  * frhotr(:,it)
     2     + b_nisj2Jgij1rd1 * fnszx(:,itb) * frhotr(:,it)
        potWtzy(:,2,it) = potWtzy(:,2,it)
     1     + b_nisj1Jgij1rd1 * fnszy(:,it)  * frhotr(:,it)
     2     + b_nisj2Jgij1rd1 * fnszy(:,itb) * frhotr(:,it)
        potWtzz(:,2,it) = potWtzz(:,2,it)
     1     + b_nisj1Jgij1rd1 * fnszz(:,it)  * frhotr(:,it)
     2     + b_nisj2Jgij1rd1 * fnszz(:,itb) * frhotr(:,it)
c      enddo

c     .........................................................................
c     ................................. 4 body ................................
c     .........................................................................


c     .................................... 4body contribution to tilde(U) field
c      As the four-body pairing with four pairing densities should be outside
c      the loop on it, such terms are added a posteriori in add_4body2gap.
c      The other pairing terms can be compute here, but as MB prefers
c      all the 4 body to be compute simultaneously, all the following is
c      computed in add_4body2gap.

c      do it=1,2
c        itb = 3-it
c        potUt(:,1,it) = potUt(:,1,it)
c     1         + b_rg1rd1r2r2 * frhotr(:,it) * frho(:,itb) * frho(:,itb)
c        potUt(:,2,it) = potUt(:,2,it)
c     1         + b_rg1rd1r2r2 * frhoti(:,it) * frho(:,itb) * frho(:,itb)
c
c        potUt(:,1,it) = potUt(:,1,it)
c     1         + b_rg1rd1sj2sj2 * frhotr(:,it) * fsx(:,itb) * fsx(:,itb)
c     1         + b_rg1rd1sj2sj2 * frhotr(:,it) * fsy(:,itb) * fsy(:,itb)
c     1         + b_rg1rd1sj2sj2 * frhotr(:,it) * fsz(:,itb) * fsz(:,itb)
c        potUt(:,2,it) = potUt(:,2,it)
c     5         + b_rg1rd1sj2sj2 * frhoti(:,it) * fsx(:,itb) * fsx(:,itb)
c     5         + b_rg1rd1sj2sj2 * frhoti(:,it) * fsy(:,itb) * fsy(:,itb)
c     5         + b_rg1rd1sj2sj2 * frhoti(:,it) * fsz(:,itb) * fsz(:,itb)
c
c        potUt(:,1,it) = potUt(:,1,it)
c     1           + 2.0d0 * b_rg1rd1rg2rd2
c     2           * frhotr(:,it) * frhotr(:,itb) * frhotr(:,itb)
c     7           + 2.0d0 * b_rg1rd1rg2rd2
c     8           * frhotr(:,it) * frhoti(:,itb) * frhoti(:,itb)
c        potUt(:,2,it) = potUt(:,2,it)
c     5           + 2.0d0 * b_rg1rd1rg2rd2
c     6           * frhoti(:,it) * frhotr(:,itb) * frhotr(:,itb)
c     7           + 2.0d0 * b_rg1rd1rg2rd2
c     8           * frhoti(:,it) * frhoti(:,itb) * frhoti(:,itb)
c
c      enddo

c      JS : In the precedent version, pairing fields are multiplied by
c           an absolute factor 2, (because in qdelta a factor 2 is
c           missing?). Thus we used the same factor 2.
c      do it=1,2
        drhor(:,it) = 2.0d0 * potUt  (:,1,it)
        drhoi(:,it) = 2.0d0 * potUt  (:,2,it)
        dtaur(:,it) = 2.0d0 * potBt  (:,1,it)
        dtaui(:,it) = 2.0d0 * potBt  (:,2,it)
        dJxxr(:,it) = 2.0d0 * potWtxx(:,1,it)
        dJxxi(:,it) = 2.0d0 * potWtxx(:,2,it)
        dJxyr(:,it) = 2.0d0 * potWtxy(:,1,it)
        dJxyi(:,it) = 2.0d0 * potWtxy(:,2,it)
        dJxzr(:,it) = 2.0d0 * potWtxz(:,1,it)
        dJxzi(:,it) = 2.0d0 * potWtxz(:,2,it)
        dJyxr(:,it) = 2.0d0 * potWtyx(:,1,it)
        dJyxi(:,it) = 2.0d0 * potWtyx(:,2,it)
        dJyyr(:,it) = 2.0d0 * potWtyy(:,1,it)
        dJyyi(:,it) = 2.0d0 * potWtyy(:,2,it)
        dJyzr(:,it) = 2.0d0 * potWtyz(:,1,it)
        dJyzi(:,it) = 2.0d0 * potWtyz(:,2,it)
        dJzxr(:,it) = 2.0d0 * potWtzx(:,1,it)
        dJzxi(:,it) = 2.0d0 * potWtzx(:,2,it)
        dJzyr(:,it) = 2.0d0 * potWtzy(:,1,it)
        dJzyi(:,it) = 2.0d0 * potWtzy(:,2,it)
        dJzzr(:,it) = 2.0d0 * potWtzz(:,1,it)
        dJzzi(:,it) = 2.0d0 * potWtzz(:,2,it)

cfac2   drhor(:,it) = potUt  (:,1,it)
cfac2   drhoi(:,it) = potUt  (:,2,it)
cfac2   dtaur(:,it) = potBt  (:,1,it)
cfac2   dtaui(:,it) = potBt  (:,2,it)
cfac2   dJxxr(:,it) = potWtxx(:,1,it)
cfac2   dJxxi(:,it) = potWtxx(:,2,it)
cfac2   dJxyr(:,it) = potWtxy(:,1,it)
cfac2   dJxyi(:,it) = potWtxy(:,2,it)
cfac2   dJxzr(:,it) = potWtxz(:,1,it)
cfac2   dJxzi(:,it) = potWtxz(:,2,it)
cfac2   dJyxr(:,it) = potWtyx(:,1,it)
cfac2   dJyxi(:,it) = potWtyx(:,2,it)
cfac2   dJyyr(:,it) = potWtyy(:,1,it)
cfac2   dJyyi(:,it) = potWtyy(:,2,it)
cfac2   dJyzr(:,it) = potWtyz(:,1,it)
cfac2   dJyzi(:,it) = potWtyz(:,2,it)
cfac2   dJzxr(:,it) = potWtzx(:,1,it)
cfac2   dJzxi(:,it) = potWtzx(:,2,it)
cfac2   dJzyr(:,it) = potWtzy(:,1,it)
cfac2   dJzyi(:,it) = potWtzy(:,2,it)
cfac2   dJzzr(:,it) = potWtzz(:,1,it)
cfac2   dJzzi(:,it) = potWtzz(:,2,it)
c      enddo

      end subroutine compute_gaphf_f
c______________________________________________________________________________
c______________________________________________________________________________
      subroutine cpling_f

c..............................................................................
c     diagnostic printing of coupling constants                               .
c..............................................................................
      implicit real*8 (a-h,o-z)
C     include 'paramr8.h'
      character*4 afor

      common /force / t0_2b,x0_2b,t1_2b,x1_2b,t2_2b,x2_2b
     1               ,te_2b,to_2b,wso_2b
     2               ,u0_3b,u1_3b,y1_3b,u2_3b,y21_3b,y22_3b,v0_4b
     3               ,wsoq,t3a,x3a,yt3a,t3b,x3b,yt3b
     4               ,hbar,hbm(2),xm(3),afor
      common /fopt  / nfunc,ngal,njmunu,ncm2,nmass,ndd,nforce,ncoex
      common /noyau / nwaven,nwavep,nwave,npn,npp,npar(4,2),iit(2,2,2)
      common /coeff2/ b_r1r1, b_r1r2, b_sj1sj1, b_sj1sj2, b_t1r1,
     1                b_t1r2, b_Tj1sj1, b_Tj1sj2, b_nir1nir1,
     2                b_nir1nir2, b_nisj1nisj1, b_nisj1nisj2,
     3                b_ji1ji1, b_ji1ji2, b_Jij1Jij1, b_Jij1Jij2,
     4                b_r1naJbc1, b_r1naJbc2, b_ja1nbsc1, b_ja1nbsc2,
     5                b_Jii1Jjj1, b_Jii1Jjj2, b_Jij1Jji1, b_Jij1Jji2,
     6                b_nisi1njsj1, b_nisi1njsj2, b_Fj1sj1, b_Fj1sj2,
     7                b_rg1rd1, b_tg1rd1, b_td1rg1, b_nirg1nird1,
     8                b_Jgij1Jdij1, b_Jgii1Jdjj1, b_Jgij1Jdji1
      common /coeff3/ b_r1r1r2, b_sj1sj1r2, b_t1r1r1, b_t1r1r2,
     1                b_t1r2r2, b_Tj1sj1r2, b_Tj1sj2r1, b_t1sj1sj1,
     2                b_t1sj1sj2, b_t1sj2sj2, b_nir1nir1r1,
     3                b_nir1nir1r2, b_nir1nir2r1, b_nisj1nisj1r1,
     4                b_nisj1nisj1r2, b_nisj1nisj2r1, b_nir1nisj1sj1,
     5                b_nir1nisj1sj2, b_nir1nisj2sj1, b_nir1nisj2sj2,
     6                b_ji1ji1r1, b_ji1ji1r2, b_ji1ji2r1, b_Jij1Jij1r1,
     7                b_Jij1Jij1r2, b_Jij1Jij2r1, b_ji1Jij1sj1,
     8                b_ji1Jij1sj2, b_ji1Jij2sj1, b_ji1Jij2sj2,
     9                b_nisa1Jib1sc1, b_nisa1Jib1sc2, b_nisa1Jib2sc1,
     8                b_nisa1Jib2sc2, b_rg1rd1r2, b_t1rg1rd1,
     7                b_t2rg1rd1, b_tg1rd1r2, b_td1rg1r2,
     6                b_nirg1nird1r1, b_nirg1nird1r2, b_nirg1nir1rd1,
     5                b_nirg1nir2rd1, b_nird1nir1rg1, b_nird1nir2rg1,
     4                b_Jgij1Jdij1r1, b_Jgij1Jdij1r2, b_Jgij1Jij1rd1,
     3                b_Jgij1Jij2rd1, b_Jdij1Jij1rg1, b_Jdij1Jij2rg1,
     2                b_nirg1ji1rd1, b_nirg1ji2rd1, b_nird1ji1rg1,
     1                b_nird1ji2rg1, b_nirg1Jdij1sj1, b_nirg1Jdij1sj2,
     2                b_nird1Jgij1sj1, b_nird1Jgij1sj2, b_nisj1Jgij1rd1,
     3                b_nisj2Jgij1rd1, b_nisj1Jdij1rg1, b_nisj2Jdij1rg1,
     4                b_Jgia1Jdib1sc1, b_Jgia1Jdib1sc2
      common /coeff4/ b_r1r1r2r2, b_sj1sj1r2r2, b_si1si1sj2sj2,
     1                b_rg1rd1r2r2, b_rg1rd1sj2sj2, b_rg1rd1rg2rd2

          dimension x(16)

c..............................................................................
  101 format (/,' ',78('_'))
  103 format (/,' Skyrme force: ',a4)
  105 format (/,' ncm2    =',i5,/,
     1          ' ndd     =',i5,/,
     2          ' njmunu  =',i5,/,
     3          ' nfunc   =',i5,/,
     4          ' ngal    =',i5,/,
     5          ' ncoex   =',i5,/,
     6          ' nmass   =',i5,/,/,
     7          ' m_n         =',f14.7,/,
     8          ' m_p         =',f14.7,/,
     9          ' <m>         =',f14.7,/,
     1          ' hbar^2/2m_n =',f14.7,/,
     2          ' hbar^2/2m_n =',f14.7)
  110 format (/,' Coupling constants of the Skyrme interaction ',/)
  111 format (  '  t0  =',f13.6,' x0  =',f13.6)
  112 format (  '  t1  =',f13.6,' x1  =',f13.6)
  113 format (  '  t2  =',f13.6,' x2  =',f13.6)
  114 format (  '  W0  =',f13.6               )
  115 format (  '  te  =',f13.6,' to  =',f13.6)
  116 format (  '  u0  =',f13.6               )
  117 format (  '  u1  =',f13.6,' y1  =',f13.6)
  118 format (  '  u2  =',f13.6,' y21 =',f13.6)
  119 format (              20x,' y22 =',f13.6)
  120 format (  '  v0  =',f13.6               )
  210 format (/,' Two-body Skyrme functional coefficients',/,/,
     1     ' B rho_q1 rho_q1                              =',f13.6,5x
     2     ' B rho_q1 rho_q2                              =',f13.6,/,
     3     ' B s_q1,j s_q1,j                              =',f13.6,5x
     4     ' B s_q1,j s_q2,j                              =',f13.6,/,
     5     ' B tau_q1 rho_q1                              =',f13.6,5x
     6     ' B tau_q1 rho_q2                              =',f13.6,/,
     7     ' B T_q1,j s_q1,j                              =',f13.6,5x
     8     ' B T_q1,j s_q2,j                              =',f13.6,/,
     9     ' B (nabla_i rho_q1) (nabla_i rho_q1)          =',f13.6,5x
     8     ' B (nabla_i rho_q1) (nabla_i rho_q2)          =',f13.6,/,
     7     ' B (nabla_i s_q1,j) (nabla_i s_q1,j)          =',f13.6,5x
     6     ' B (nabla_i s_q1,j) (nabla_i s_q2,j)          =',f13.6,/,
     5     ' B j_q1,i j_q1,i                              =',f13.6,5x
     4     ' B j_q1,i j_q2,i                              =',f13.6,/,
     3     ' B J_q1,ij J_q1,ij                            =',f13.6,5x
     2     ' B J_q1,ij J_q2,ij                            =',f13.6,/,
     1     ' B rho_q1 (nabla_i J_q1,i)                    =',f13.6,5x
     2     ' B rho_q1 (nabla_i J_q2,i)                    =',f13.6,/,
     3     ' B j_q1,a (nabla_b s_q1,c) * e_abc            =',f13.6,5x
     4     ' B j_q1,a (nabla_b s_q2,c) * e_abc            =',f13.6,/,
     5     ' B (nabla_i s_q1,i) (nabla_j s_q1,j)          =',f13.6,5x
     6     ' B (nabla_i s_q1,i) (nabla_j s_q2,j)          =',f13.6,/,
     7     ' B J_q1,ii J_q1,jj                            =',f13.6,5x
     8     ' B J_q1,ii J_q2,jj                            =',f13.6,/,
     9     ' B J_q1,ij J_q1,ji                            =',f13.6,5x
     8     ' B J_q1,ij J_q2,ji                            =',f13.6,/,
     7     ' B F_q1,j s_q1,j                              =',f13.6,5x
     6     ' B F_q1,j s_q2,j                              =',f13.6,/,/,
     5     ' B rho-_q1 rho~_q1                            =',f13.6,/,
     4     ' B tau-_q1 rho~_q1                            =',f13.6,5x
     3     ' B rho-_q1 tau~_q1                            =',f13.6,/,
     2     ' B (nabla_i rho-_q1) (nabla_i rho~_q1)        =',f13.6,5x
     1     ' B J-_q1,ij J~_q1,ij                          =',f13.6,/,
     2     ' B J-_q1,ii J~_q1,jj                          =',f13.6,5x
     3     ' B J-_q1,ij J~_q1,ji                          =',f13.6,/)
  211 format (/,' Three-body Skyrme functional coefficients',/,/,
     1     ' B rho_q2 rho_q1 rho_q1                       =',f13.6,5x
     2     ' B s_q1,j s_q1,j rho_q2                       =',f13.6,/,
     3     ' B tau_q1 rho_q1 rho_q1                       =',f13.6,5x
     4     ' B tau_q1 rho_q1 rho_q2                       =',f13.6,/,
     5     ' B tau_q2 rho_q1 rho_q1                       =',f13.6,/,
     6     ' B T_q1,j s_q1,j rho_q2                       =',f13.6,5x
     7     ' B T_q1,j s_q2,j rho_q1                       =',f13.6,/,
     8     ' B tau_q1 s_q1,j s_q1,j                       =',f13.6,5x
     9     ' B tau_q1 s_q1,j s_q2,j                       =',f13.6,/,
     8     ' B tau_q2 s_q1,j s_q1,j                       =',f13.6,/,
     7     ' B (nabla_i rho_q1) (nabla_i rho_q1) rho_q1   =',f13.6,5x
     6     ' B (nabla_i rho_q1) (nabla_i rho_q1) rho_q2   =',f13.6,/,
     5     ' B (nabla_i rho_q1) (nabla_i rho_q2) rho_q1   =',f13.6,/,
     4     ' B (nabla_i s_q1,j) (nabla_i s_q1,j) rho_q1   =',f13.6,5x
     3     ' B (nabla_i s_q1,j) (nabla_i s_q1,j) rho_q2   =',f13.6,/,
     2     ' B (nabla_i s_q1,j) (nabla_i s_q2,j) rho_q1   =',f13.6,/,
     1     ' B (nabla_i rho_q1) (nabla_i s_q1,j) s_q1,j   =',f13.6,5x
     2     ' B (nabla_i rho_q1) (nabla_i s_q1,j) s_q2,j   =',f13.6,/,
     3     ' B (nabla_i rho_q1) (nabla_i s_q2,j) s_q1,j   =',f13.6,5x
     4     ' B (nabla_i rho_q2) (nabla_i s_q1,j) s_q1,j   =',f13.6,/,
     5     ' B j_q1,i j_q1,i rho_q1                       =',f13.6,5x
     6     ' B j_q1,i j_q1,i rho_q2                       =',f13.6,/,
     7     ' B j_q1,i j_q2,i rho_q1                       =',f13.6,/,
     8     ' B J_q1,ij J_q1,ij rho_q1                     =',f13.6,5x
     9     ' B J_q1,ij J_q1,ij rho_q2                     =',f13.6,/,
     8     ' B J_q1,ij J_q2,ij rho_q1                     =',f13.6,/,
     7     ' B j_q1,i J_q1,ij s_q1,j                      =',f13.6,5x
     6     ' B j_q1,i J_q1,ij s_q2,j                      =',f13.6,/,
     5     ' B j_q1,i J_q2,ij s_q1,j                      =',f13.6,5x
     4     ' B j_q2,i J_q1,ij s_q1,j                      =',f13.6,/,
     3     ' B (nabla_i s_q1,a) J_q1,ib s_q1,c * e_abc    =',f13.6,5x
     2     ' B (nabla_i s_q1,a) J_q1,ib s_q2,c * e_abc    =',f13.6,/,
     1     ' B (nabla_i s_q1,a) J_q2,ib s_q1,c * e_abc    =',f13.6,5x
     2     ' B (nabla_i s_q2,a) J_q1,ib s_q1,c * e_abc    =',f13.6,/,/,
     3     ' B rho-_q1 rho~_q1 rho_q2                     =',f13.6,/,
     4     '1B rho-_q1 rho~_q1 tau_q1                     =',f13.6,5x
     5     '2B rho-_q1 rho~_q1 tau_q2                     =',f13.6,/,
     6     '3B tau-_q1 rho~_q1 rho_q2                     =',f13.6,5x
     7     '4B rho-_q1 tau~_q1 rho_q2                     =',f13.6,/,
     8     '5B (nabla_i rho-_q1) (nabla_i rho~_q1) rho_q1 =',f13.6,5x
     9     '6B (nabla_i rho-_q1) (nabla_i rho~_q1) rho_q2 =',f13.6,/,
     8     '7B (nabla_i rho-_q1) rho~_q1 (nabla_i rho_q1) =',f13.6,5x
     7     '8B (nabla_i rho-_q1) rho~_q1 (nabla_i rho_q2) =',f13.6,/,
     6     '9B rho-_q1 (nabla_i rho~_q1) (nabla_i rho_q1) =',f13.6,5x
     5     '0B rho-_q1 (nabla_i rho~_q1) (nabla_i rho_q2) =',f13.6,/,
     4     'aB J-_q1,ij J~_q1,ij rho_q1                   =',f13.6,5x
     3     'bB J-_q1,ij J~_q1,ij rho_q2                   =',f13.6,/,
     2     'cB J-_q1,ij rho~_q1 J_q1,ij                   =',f13.6,5x
     1     'dB J-_q1,ij rho~_q1 J_q2,ij                   =',f13.6,/,
     2     'eB rho-_q1 J~_q1,ij J_q1,ij                   =',f13.6,5x
     3     'fB rho-_q1 J~_q1,ij J_q2,ij                   =',f13.6,/,
     4     ' B (nabla_i rho-_q1) rho~_q1 j_q1,i           =',f13.6,5x
     5     ' B (nabla_i rho-_q1) rho~_q1 j_q2,i           =',f13.6,/,
     6     ' B rho-_q1 (nabla_i rho~_q1) j_q1,i           =',f13.6,5x
     7     ' B rho-_q1 (nabla_i rho~_q1) j_q2,i           =',f13.6,/,
     8     ' B (nabla_i rho-_q1) J~_q1,ij s_q1,j          =',f13.6,5x
     9     ' B (nabla_i rho-_q1) J~_q1,ij s_q2,j          =',f13.6,/,
     8     ' B J-_q1,ij (nabla_i rho~_q1) s_q1,j          =',f13.6,5x
     7     ' B J-_q1,ij (nabla_i rho~_q1) s_q2,j          =',f13.6,/,
     6     ' B J-_q1,ij rho~_q1 (nabla_i s_q1,j)          =',f13.6,5x
     5     ' B J-_q1,ij rho~_q1 (nabla_i s_q2,j)          =',f13.6,/,
     4     ' B rho-_q1 J~_q1,ij (nabla_i s_q1,j)          =',f13.6,5x
     3     ' B rho-_q1 J~_q1,ij (nabla_i s_q2,j)          =',f13.6,/,
     2     ' B J-_q1,ia J~_q1,ib s_q1,c * e_abc           =',f13.6,5x
     1     ' B J-_q1,ia J~_q1,ib s_q2,c * e_abc           =',f13.6,/)
  212 format (/,' Four-body Skyrme functional coefficients',/,/,
     1     ' B rho_q1 rho_q1 rho_q2 rho_q2                =',f13.6,/,
     2     ' B s_q1,j s_q1,j rho_q2 rho_q2                =',f13.6,5x
     3     ' B s_q1,i s_q1,i s_q2,j s_q2,j                =',f13.6,/,/,
     4     ' B rho-_q1 rho~_q1 rho_q2 rho_q2              =',f13.6,5x
     5     ' B rho-_q1 rho~_q1 s_q2 s_q2                  =',f13.6,/,
     6     ' B rho-_q1 rho~_q1 rho-_q2 rho~_q2            =',f13.6,/)

c..............................................................................

c     ..................................................... NN pseudo-potential
      b_r1r1          = +  1.0d0 /  4.0d0 * t0_2b
     1                  -  1.0d0 /  4.0d0 * t0_2b * x0_2b
      b_r1r2          = +  1.0d0 /  2.0d0 * t0_2b
     1                  +  1.0d0 /  4.0d0 * t0_2b * x0_2b
      b_sj1sj1        = -  1.0d0 /  4.0d0 * t0_2b
     1                  +  1.0d0 /  4.0d0 * t0_2b * x0_2b
      b_sj1sj2        = +  1.0d0 /  4.0d0 * t0_2b * x0_2b
      b_t1r1          = +  1.0d0 /  8.0d0 * t1_2b
     1                  -  1.0d0 /  8.0d0 * t1_2b * x1_2b
     2                  +  3.0d0 /  8.0d0 * t2_2b
     3                  +  3.0d0 /  8.0d0 * t2_2b * x2_2b
      b_t1r2          = +  1.0d0 /  4.0d0 * t1_2b
     1                  +  1.0d0 /  8.0d0 * t1_2b * x1_2b
     2                  +  1.0d0 /  4.0d0 * t2_2b
     3                  +  1.0d0 /  8.0d0 * t2_2b * x2_2b
      b_Tj1sj1        = -  1.0d0 /  8.0d0 * t1_2b
     1                  +  1.0d0 /  8.0d0 * t1_2b * x1_2b
     2                  +  1.0d0 /  8.0d0 * t2_2b
     3                  +  1.0d0 /  8.0d0 * t2_2b * x2_2b
     4                  -  1.0d0 /  2.0d0 * to_2b
      b_Tj1sj2        = +  1.0d0 /  8.0d0 * t1_2b * x1_2b
     1                  +  1.0d0 /  8.0d0 * t2_2b * x2_2b
     2                  -  1.0d0 /  4.0d0 * te_2b
     3                  -  1.0d0 /  4.0d0 * to_2b
      b_nir1nir1      = +  3.0d0 / 32.0d0 * t1_2b
     1                  -  3.0d0 / 32.0d0 * t1_2b * x1_2b
     2                  -  3.0d0 / 32.0d0 * t2_2b
     3                  -  3.0d0 / 32.0d0 * t2_2b * x2_2b
      b_nir1nir2      = +  3.0d0 / 16.0d0 * t1_2b
     1                  +  3.0d0 / 32.0d0 * t1_2b * x1_2b
     2                  -  1.0d0 / 16.0d0 * t2_2b
     3                  -  1.0d0 / 32.0d0 * t2_2b * x2_2b
      b_nisj1nisj1    = -  3.0d0 / 32.0d0 * t1_2b
     1                  +  3.0d0 / 32.0d0 * t1_2b * x1_2b
     2                  -  1.0d0 / 32.0d0 * t2_2b
     3                  -  1.0d0 / 32.0d0 * t2_2b * x2_2b
     4                  +  1.0d0 /  8.0d0 * to_2b
      b_nisj1nisj2    = +  3.0d0 / 32.0d0 * t1_2b * x1_2b
     1                  -  1.0d0 / 32.0d0 * t2_2b * x2_2b
     2                  -  3.0d0 / 16.0d0 * te_2b
     3                  +  1.0d0 / 16.0d0 * to_2b
      b_ji1ji1        = -  1.0d0 /  8.0d0 * t1_2b
     1                  +  1.0d0 /  8.0d0 * t1_2b * x1_2b
     2                  -  3.0d0 /  8.0d0 * t2_2b
     3                  -  3.0d0 /  8.0d0 * t2_2b * x2_2b
      b_ji1ji2        = -  1.0d0 /  4.0d0 * t1_2b
     1                  -  1.0d0 /  8.0d0 * t1_2b * x1_2b
     2                  -  1.0d0 /  4.0d0 * t2_2b
     3                  -  1.0d0 /  8.0d0 * t2_2b * x2_2b
      b_Jij1Jij1      = +  1.0d0 /  8.0d0 * t1_2b
     1                  -  1.0d0 /  8.0d0 * t1_2b * x1_2b
     2                  -  1.0d0 /  8.0d0 * t2_2b
     3                  -  1.0d0 /  8.0d0 * t2_2b * x2_2b
     4                  +  1.0d0 /  2.0d0 * to_2b
      b_Jij1Jij2      = -  1.0d0 /  8.0d0 * t1_2b * x1_2b
     1                  -  1.0d0 /  8.0d0 * t2_2b * x2_2b
     2                  +  1.0d0 /  4.0d0 * te_2b
     3                  +  1.0d0 /  4.0d0 * to_2b
      b_r1naJbc1      = -  1.0d0 /  1.0d0 * wso_2b
      b_r1naJbc2      = -  1.0d0 /  2.0d0 * wso_2b
      b_ja1nbsc1      = -  1.0d0 /  1.0d0 * wso_2b
      b_ja1nbsc2      = -  1.0d0 /  2.0d0 * wso_2b
      b_nisi1njsj1    = -  3.0d0 /  8.0d0 * to_2b
      b_nisi1njsj2    = +  9.0d0 / 16.0d0 * te_2b
     1                  -  3.0d0 / 16.0d0 * to_2b
      b_Jii1Jjj1      = -  3.0d0 /  4.0d0 * to_2b
      b_Jii1Jjj2      = -  3.0d0 /  8.0d0 * te_2b
     1                  -  3.0d0 /  8.0d0 * to_2b
      b_Jij1Jji1      = -  3.0d0 /  4.0d0 * to_2b
      b_Jij1Jji2      = -  3.0d0 /  8.0d0 * te_2b
     1                  -  3.0d0 /  8.0d0 * to_2b
      b_Fj1sj1        = +  3.0d0 /  2.0d0 * to_2b
      b_Fj1sj2        = +  3.0d0 /  4.0d0 * te_2b
     1                  +  3.0d0 /  4.0d0 * to_2b
      b_rg1rd1        = +  1.0d0 /  4.0d0 * t0_2b
     1                  -  1.0d0 /  4.0d0 * t0_2b * x0_2b
      b_tg1rd1        = +  1.0d0 /  8.0d0 * t1_2b
     1                  -  1.0d0 /  8.0d0 * t1_2b * x1_2b
      b_td1rg1        = +  1.0d0 /  8.0d0 * t1_2b
     1                  -  1.0d0 /  8.0d0 * t1_2b * x1_2b
      b_nirg1nird1    = +  1.0d0 / 16.0d0 * t1_2b
     1                  -  1.0d0 / 16.0d0 * t1_2b * x1_2b
      b_Jgij1Jdij1    = +  1.0d0 /  4.0d0 * t2_2b
     1                  +  1.0d0 /  4.0d0 * t2_2b * x2_2b
     2                  +  1.0d0 /  2.0d0 * to_2b
      b_Jgii1Jdjj1    = +  1.0d0 /  2.0d0 * wso_2b
     1                  -  3.0d0 /  4.0d0 * to_2b
      b_Jgij1Jdji1    = -  1.0d0 /  2.0d0 * wso_2b
     1                  -  3.0d0 /  4.0d0 * to_2b

c     .................................................... NNN pseudo-potential
      b_r1r1r2        = +  3.0d0 /  4.0d0 * u0_3b
      b_sj1sj1r2      = -  3.0d0 /  4.0d0 * u0_3b
      b_t1r1r1        = +  3.0d0 / 16.0d0 * u2_3b
     1                  +  3.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  -  3.0d0 / 16.0d0 * u2_3b * y22_3b
      b_t1r1r2        = +  1.0d0 /  4.0d0 * u1_3b
     1                  -  1.0d0 / 16.0d0 * u1_3b * y1_3b
     2                  +  5.0d0 /  8.0d0 * u2_3b
     3                  +  1.0d0 /  2.0d0 * u2_3b * y21_3b
     4                  +  5.0d0 /  8.0d0 * u2_3b * y22_3b
      b_t1r2r2        = +  1.0d0 /  8.0d0 * u1_3b
     1                  +  1.0d0 / 16.0d0 * u1_3b * y1_3b
     2                  +  1.0d0 /  8.0d0 * u2_3b
     3                  +  1.0d0 / 16.0d0 * u2_3b * y21_3b
     4                  -  1.0d0 / 16.0d0 * u2_3b * y22_3b
      b_Tj1sj1r2      = -  1.0d0 /  4.0d0 * u1_3b
     1                  +  1.0d0 / 16.0d0 * u1_3b * y1_3b
     2                  +  1.0d0 /  8.0d0 * u2_3b
     3                  +  1.0d0 /  8.0d0 * u2_3b * y21_3b
     4                  +  1.0d0 /  4.0d0 * u2_3b * y22_3b
      b_Tj1sj2r1      = +  1.0d0 / 16.0d0 * u1_3b * y1_3b
     1                  +  1.0d0 /  8.0d0 * u2_3b * y21_3b
     2                  +  1.0d0 /  4.0d0 * u2_3b * y22_3b
      b_t1sj1sj1      = -  3.0d0 / 16.0d0 * u2_3b
     1                  -  3.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  +  3.0d0 / 16.0d0 * u2_3b * y22_3b
      b_t1sj1sj2      = -  1.0d0 / 16.0d0 * u1_3b * y1_3b
     1                  +  3.0d0 /  8.0d0 * u2_3b * y22_3b
      b_t1sj2sj2      = -  1.0d0 /  8.0d0 * u1_3b
     1                  -  1.0d0 / 16.0d0 * u1_3b * y1_3b
     2                  -  1.0d0 /  8.0d0 * u2_3b
     3                  -  1.0d0 / 16.0d0 * u2_3b * y21_3b
     4                  +  1.0d0 / 16.0d0 * u2_3b * y22_3b
      b_nir1nir1r1    = -  3.0d0 / 64.0d0 * u2_3b
     1                  -  3.0d0 / 64.0d0 * u2_3b * y21_3b
     2                  +  3.0d0 / 64.0d0 * u2_3b * y22_3b
      b_nir1nir1r2    = +  5.0d0 / 32.0d0 * u1_3b
     1                  -  1.0d0 / 16.0d0 * u1_3b * y1_3b
     2                  -  1.0d0 /  8.0d0 * u2_3b
     3                  -  7.0d0 / 64.0d0 * u2_3b * y21_3b
     4                  - 11.0d0 / 64.0d0 * u2_3b * y22_3b
      b_nir1nir2r1    = +  5.0d0 / 16.0d0 * u1_3b
     1                  +  1.0d0 / 16.0d0 * u1_3b * y1_3b
     2                  -  1.0d0 / 16.0d0 * u2_3b
     3                  -  1.0d0 / 32.0d0 * u2_3b * y21_3b
     4                  +  1.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nisj1nisj1r1  = -  3.0d0 / 64.0d0 * u2_3b
     1                  -  3.0d0 / 64.0d0 * u2_3b * y21_3b
     2                  +  3.0d0 / 64.0d0 * u2_3b * y22_3b
      b_nisj1nisj1r2  = -  5.0d0 / 32.0d0 * u1_3b
     1                  +  1.0d0 / 16.0d0 * u1_3b * y1_3b
     2                  -  1.0d0 / 16.0d0 * u2_3b
     3                  -  3.0d0 / 64.0d0 * u2_3b * y21_3b
     4                  -  3.0d0 / 64.0d0 * u2_3b * y22_3b
      b_nisj1nisj2r1  = +  1.0d0 / 16.0d0 * u1_3b * y1_3b
     1                  -  1.0d0 / 32.0d0 * u2_3b * y21_3b
     2                  +  1.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nir1nisj1sj1  = +  3.0d0 / 32.0d0 * u2_3b
     1                  +  3.0d0 / 32.0d0 * u2_3b * y21_3b
     2                  -  3.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nir1nisj1sj2  = -  1.0d0 / 32.0d0 * u2_3b * y21_3b
     1                  -  5.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nir1nisj2sj1  = -  1.0d0 / 16.0d0 * u1_3b * y1_3b
     1                  +  1.0d0 / 32.0d0 * u2_3b * y21_3b
     2                  -  1.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nir1nisj2sj2  = -  5.0d0 / 16.0d0 * u1_3b
     1                  -  1.0d0 / 16.0d0 * u1_3b * y1_3b
     2                  +  1.0d0 / 16.0d0 * u2_3b
     3                  +  1.0d0 / 32.0d0 * u2_3b * y21_3b
     4                  -  1.0d0 / 32.0d0 * u2_3b * y22_3b
      b_ji1ji1r1      = -  3.0d0 / 16.0d0 * u2_3b
     1                  -  3.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  +  3.0d0 / 16.0d0 * u2_3b * y22_3b
      b_ji1ji1r2      = -  1.0d0 /  8.0d0 * u1_3b
     1                  +  1.0d0 /  8.0d0 * u1_3b * y1_3b
     2                  -  1.0d0 /  2.0d0 * u2_3b
     3                  -  7.0d0 / 16.0d0 * u2_3b * y21_3b
     4                  - 11.0d0 / 16.0d0 * u2_3b * y22_3b
      b_ji1ji2r1      = -  1.0d0 /  4.0d0 * u1_3b
     1                  -  1.0d0 /  8.0d0 * u1_3b * y1_3b
     2                  -  1.0d0 /  4.0d0 * u2_3b
     3                  -  1.0d0 /  8.0d0 * u2_3b * y21_3b
     4                  +  1.0d0 /  8.0d0 * u2_3b * y22_3b
      b_Jij1Jij1r1    = -  3.0d0 / 16.0d0 * u2_3b
     1                  -  3.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  +  3.0d0 / 16.0d0 * u2_3b * y22_3b
      b_Jij1Jij1r2    = +  1.0d0 /  8.0d0 * u1_3b
     1                  -  1.0d0 /  8.0d0 * u1_3b * y1_3b
     2                  -  1.0d0 /  4.0d0 * u2_3b
     3                  -  3.0d0 / 16.0d0 * u2_3b * y21_3b
     4                  -  3.0d0 / 16.0d0 * u2_3b * y22_3b
      b_Jij1Jij2r1    = -  1.0d0 /  8.0d0 * u1_3b * y1_3b
     1                  -  1.0d0 /  8.0d0 * u2_3b * y21_3b
     2                  +  1.0d0 /  8.0d0 * u2_3b * y22_3b
      b_ji1Jij1sj1    = +  3.0d0 /  8.0d0 * u2_3b
     1                  +  3.0d0 /  8.0d0 * u2_3b * y21_3b
     2                  -  3.0d0 /  8.0d0 * u2_3b * y22_3b
      b_ji1Jij1sj2    = -  1.0d0 /  8.0d0 * u2_3b * y21_3b
     1                  -  5.0d0 /  8.0d0 * u2_3b * y22_3b
      b_ji1Jij2sj1    = +  1.0d0 /  8.0d0 * u1_3b * y1_3b
     1                  +  1.0d0 /  8.0d0 * u2_3b * y21_3b
     2                  -  1.0d0 /  8.0d0 * u2_3b * y22_3b
      b_ji1Jij2sj2    = +  1.0d0 /  4.0d0 * u1_3b
     1                  +  1.0d0 /  8.0d0 * u1_3b * y1_3b
     2                  +  1.0d0 /  4.0d0 * u2_3b
     3                  +  1.0d0 /  8.0d0 * u2_3b * y21_3b
     4                  -  1.0d0 /  8.0d0 * u2_3b * y22_3b
      b_nisa1Jib1sc1  = -  3.0d0 / 16.0d0 * u2_3b
     1                  -  3.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  +  3.0d0 / 16.0d0 * u2_3b * y22_3b
      b_nisa1Jib1sc2  = -  1.0d0 / 16.0d0 * u1_3b * y1_3b
     1                  -  1.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  +  1.0d0 / 16.0d0 * u2_3b * y22_3b
      b_nisa1Jib2sc1  = -  1.0d0 / 16.0d0 * u1_3b * y1_3b
     1                  -  1.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  +  1.0d0 / 16.0d0 * u2_3b * y22_3b
      b_nisa1Jib2sc2  = +  1.0d0 /  8.0d0 * u1_3b * y1_3b
     1                  -  1.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  +  1.0d0 / 16.0d0 * u2_3b * y22_3b
      b_rg1rd1r2      = +  3.0d0 /  4.0d0 * u0_3b
      b_tg1rd1r2      = +  3.0d0 / 16.0d0 * u1_3b
     1                  -  3.0d0 / 32.0d0 * u1_3b * y1_3b
      b_td1rg1r2      = +  3.0d0 / 16.0d0 * u1_3b
     1                  -  3.0d0 / 32.0d0 * u1_3b * y1_3b
      b_t1rg1rd1      = +  3.0d0 / 16.0d0 * u2_3b
     1                  +  3.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  -  3.0d0 / 16.0d0 * u2_3b * y22_3b
      b_t2rg1rd1      = +  1.0d0 /  8.0d0 * u1_3b
     1                  +  1.0d0 / 16.0d0 * u1_3b * y1_3b
     2                  +  1.0d0 /  8.0d0 * u2_3b
     3                  +  1.0d0 / 16.0d0 * u2_3b * y21_3b
     4                  -  1.0d0 / 16.0d0 * u2_3b * y22_3b
      b_nirg1nird1r1  = +  3.0d0 / 64.0d0 * u2_3b
     1                  +  3.0d0 / 64.0d0 * u2_3b * y21_3b
     2                  -  3.0d0 / 64.0d0 * u2_3b * y22_3b
      b_nirg1nird1r2  = +  1.0d0 /  8.0d0 * u1_3b
     1                  -  1.0d0 / 32.0d0 * u1_3b * y1_3b
     2                  +  1.0d0 / 32.0d0 * u2_3b
     3                  +  1.0d0 / 64.0d0 * u2_3b * y21_3b
     4                  -  1.0d0 / 64.0d0 * u2_3b * y22_3b
      b_nirg1nir1rd1  = -  3.0d0 / 64.0d0 * u2_3b
     1                  -  3.0d0 / 64.0d0 * u2_3b * y21_3b
     2                  +  3.0d0 / 64.0d0 * u2_3b * y22_3b
      b_nirg1nir2rd1  = +  5.0d0 / 32.0d0 * u1_3b
     1                  +  1.0d0 / 32.0d0 * u1_3b * y1_3b
     2                  -  1.0d0 / 32.0d0 * u2_3b
     3                  -  1.0d0 / 64.0d0 * u2_3b * y21_3b
     4                  +  1.0d0 / 64.0d0 * u2_3b * y22_3b
      b_nird1nir1rg1  = -  3.0d0 / 64.0d0 * u2_3b
     1                  -  3.0d0 / 64.0d0 * u2_3b * y21_3b
     2                  +  3.0d0 / 64.0d0 * u2_3b * y22_3b
      b_nird1nir2rg1  = +  5.0d0 / 32.0d0 * u1_3b
     1                  +  1.0d0 / 32.0d0 * u1_3b * y1_3b
     2                  -  1.0d0 / 32.0d0 * u2_3b
     3                  -  1.0d0 / 64.0d0 * u2_3b * y21_3b
     4                  +  1.0d0 / 64.0d0 * u2_3b * y22_3b
      b_Jgij1Jdij1r1  = +  3.0d0 / 16.0d0 * u2_3b
     1                  +  3.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  -  3.0d0 / 16.0d0 * u2_3b * y22_3b
      b_Jgij1Jdij1r2  = +  3.0d0 /  8.0d0 * u2_3b
     1                  +  5.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  +  7.0d0 / 16.0d0 * u2_3b * y22_3b
      b_Jgij1Jij1rd1  = -  3.0d0 / 16.0d0 * u2_3b
     1                  -  3.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  +  3.0d0 / 16.0d0 * u2_3b * y22_3b
      b_Jgij1Jij2rd1  = -  1.0d0 / 16.0d0 * u1_3b * y1_3b
     1                  -  1.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  +  1.0d0 / 16.0d0 * u2_3b * y22_3b
      b_Jdij1Jij1rg1  = -  3.0d0 / 16.0d0 * u2_3b
     1                  -  3.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  +  3.0d0 / 16.0d0 * u2_3b * y22_3b
      b_Jdij1Jij2rg1  = -  1.0d0 / 16.0d0 * u1_3b * y1_3b
     1                  -  1.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  +  1.0d0 / 16.0d0 * u2_3b * y22_3b
      b_Jgia1Jdib1sc1 = +  3.0d0 / 16.0d0 * u2_3b
     1                  +  3.0d0 / 16.0d0 * u2_3b * y21_3b
     2                  -  3.0d0 / 16.0d0 * u2_3b * y22_3b
      b_Jgia1Jdib1sc2 = -  1.0d0 / 16.0d0 * u2_3b * y21_3b
     1                  -  5.0d0 / 16.0d0 * u2_3b * y22_3b
      b_nirg1Jdij1sj1 = +  3.0d0 / 32.0d0 * u2_3b
     1                  +  3.0d0 / 32.0d0 * u2_3b * y21_3b
     2                  -  3.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nirg1Jdij1sj2 = +  1.0d0 / 32.0d0 * u1_3b * y1_3b
     1                  +  1.0d0 / 32.0d0 * u2_3b * y21_3b
     2                  -  1.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nirg1ji1rd1   = -  3.0d0 / 32.0d0 * u2_3b
     1                  -  3.0d0 / 32.0d0 * u2_3b * y21_3b
     2                  +  3.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nirg1ji2rd1   = -  1.0d0 / 16.0d0 * u1_3b
     1                  -  1.0d0 / 32.0d0 * u1_3b * y1_3b
     2                  -  1.0d0 / 16.0d0 * u2_3b
     3                  -  1.0d0 / 32.0d0 * u2_3b * y21_3b
     4                  +  1.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nird1Jgij1sj1 = -  3.0d0 / 32.0d0 * u2_3b
     1                  -  3.0d0 / 32.0d0 * u2_3b * y21_3b
     2                  +  3.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nird1Jgij1sj2 = -  1.0d0 / 32.0d0 * u1_3b * y1_3b
     1                  -  1.0d0 / 32.0d0 * u2_3b * y21_3b
     2                  +  1.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nisj1Jgij1rd1 = +  3.0d0 / 32.0d0 * u2_3b
     1                  +  3.0d0 / 32.0d0 * u2_3b * y21_3b
     2                  -  3.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nisj2Jgij1rd1 = -  1.0d0 / 16.0d0 * u1_3b * y1_3b
     1                  +  1.0d0 / 32.0d0 * u2_3b * y21_3b
     2                  -  1.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nird1ji1rg1   = +  3.0d0 / 32.0d0 * u2_3b
     1                  +  3.0d0 / 32.0d0 * u2_3b * y21_3b
     2                  -  3.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nird1ji2rg1   = +  1.0d0 / 16.0d0 * u1_3b
     1                  +  1.0d0 / 32.0d0 * u1_3b * y1_3b
     2                  +  1.0d0 / 16.0d0 * u2_3b
     3                  +  1.0d0 / 32.0d0 * u2_3b * y21_3b
     4                  -  1.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nisj1Jdij1rg1 = -  3.0d0 / 32.0d0 * u2_3b
     1                  -  3.0d0 / 32.0d0 * u2_3b * y21_3b
     2                  +  3.0d0 / 32.0d0 * u2_3b * y22_3b
      b_nisj2Jdij1rg1 = +  1.0d0 / 16.0d0 * u1_3b * y1_3b
     1                  -  1.0d0 / 32.0d0 * u2_3b * y21_3b
     2                  +  1.0d0 / 32.0d0 * u2_3b * y22_3b

c     ................................................... NNNN pseudo-potential
      b_r1r1r2r2      = +  3.0d0 /  8.0d0 * v0_4b
      b_si1si1sj2sj2  = +  3.0d0 /  8.0d0 * v0_4b
      b_sj1sj1r2r2    = -  3.0d0 /  4.0d0 * v0_4b
      b_rg1rd1r2r2    = +  3.0d0 /  4.0d0 * v0_4b
      b_rg1rd1sj2sj2  = -  3.0d0 /  4.0d0 * v0_4b
      b_rg1rd1rg2rd2  = +  3.0d0 /  8.0d0 * v0_4b

c     .........................................................................

              read (5,*) x

              b_t1rg1rd1     = b_t1rg1rd1      *  x(01)
              b_t2rg1rd1     = b_t2rg1rd1      *  x(02)
              b_tg1rd1r2     = b_tg1rd1r2      *  x(03)
              b_td1rg1r2     = b_td1rg1r2      *  x(04)
              b_nirg1nird1r1 = b_nirg1nird1r1  *  x(05)
              b_nirg1nird1r2 = b_nirg1nird1r2  *  x(06)
              b_nirg1nir1rd1 = b_nirg1nir1rd1  *  x(07)
              b_nirg1nir2rd1 = b_nirg1nir2rd1  *  x(08)
              b_nird1nir1rg1 = b_nird1nir1rg1  *  x(09)
              b_nird1nir2rg1 = b_nird1nir2rg1  *  x(10)
              b_Jgij1Jdij1r1 = b_Jgij1Jdij1r1  *  x(11)
              b_Jgij1Jdij1r2 = b_Jgij1Jdij1r2  *  x(12)
              b_Jgij1Jij1rd1 = b_Jgij1Jij1rd1  *  x(13)
              b_Jgij1Jij2rd1 = b_Jgij1Jij2rd1  *  x(14)
              b_Jdij1Jij1rg1 = b_Jdij1Jij1rg1  *  x(15)
              b_Jdij1Jij2rg1 = b_Jdij1Jij2rg1  *  x(16)

c     .........................................................................
      print 101
c     print 103,afor
c     print 105,ncm2,ndd,njmunu,nfunc,ngal,ncoex,nmass,
c    1          xm(1),xm(2),xm(3)/(1.0d0*(npn+npp)),
c    2          hbm(1)*0.5d0,hbm(2)*0.5d0
c
c     ................................................... Skyrme representation
      print 110
      print 111,t0_2b,x0_2b
      print 112,t1_2b,x1_2b
      print 113,t2_2b,x2_2b
      print 114,wso_2b
      print 115,te_2b,to_2b
      print 116,u0_3b
      print 117,u1_3b,y1_3b
      print 118,u2_3b,y21_3b
      print 119,y22_3b
      print 120,v0_4b

      print 210,b_r1r1, b_r1r2, b_sj1sj1, b_sj1sj2, b_t1r1,
     1          b_t1r2, b_Tj1sj1, b_Tj1sj2, b_nir1nir1,
     2          b_nir1nir2, b_nisj1nisj1, b_nisj1nisj2,
     3          b_ji1ji1, b_ji1ji2, b_Jij1Jij1, b_Jij1Jij2,
     4          b_r1naJbc1, b_r1naJbc2, b_ja1nbsc1, b_ja1nbsc2,
     5          b_nisi1njsj1, b_nisi1njsj2, b_Jii1Jjj1, b_Jii1Jjj2,
     6          b_Jij1Jji1, b_Jij1Jji2, b_Fj1sj1, b_Fj1sj2,
     7          b_rg1rd1, b_tg1rd1, b_td1rg1, b_nirg1nird1,
     8          b_Jgij1Jdij1, b_Jgii1Jdjj1, b_Jgij1Jdji1
      print 211,b_r1r1r2, b_sj1sj1r2, b_t1r1r1, b_t1r1r2,
     1          b_t1r2r2, b_Tj1sj1r2, b_Tj1sj2r1, b_t1sj1sj1,
     2          b_t1sj1sj2, b_t1sj2sj2, b_nir1nir1r1,
     3          b_nir1nir1r2, b_nir1nir2r1, b_nisj1nisj1r1,
     4          b_nisj1nisj1r2, b_nisj1nisj2r1, b_nir1nisj1sj1,
     5          b_nir1nisj1sj2, b_nir1nisj2sj1, b_nir1nisj2sj2,
     6          b_ji1ji1r1, b_ji1ji1r2, b_ji1ji2r1, b_Jij1Jij1r1,
     7          b_Jij1Jij1r2, b_Jij1Jij2r1, b_ji1Jij1sj1,
     8          b_ji1Jij1sj2, b_ji1Jij2sj1, b_ji1Jij2sj2,
     9          b_nisa1Jib1sc1, b_nisa1Jib1sc2, b_nisa1Jib2sc1,
     8          b_nisa1Jib2sc2, b_rg1rd1r2, b_t1rg1rd1,
     7          b_t2rg1rd1, b_tg1rd1r2, b_td1rg1r2,
     6          b_nirg1nird1r1, b_nirg1nird1r2, b_nirg1nir1rd1,
     5          b_nirg1nir2rd1, b_nird1nir1rg1, b_nird1nir2rg1,
     4          b_Jgij1Jdij1r1, b_Jgij1Jdij1r2, b_Jgij1Jij1rd1,
     3          b_Jgij1Jij2rd1, b_Jdij1Jij1rg1, b_Jdij1Jij2rg1,
     2          b_nirg1ji1rd1, b_nirg1ji2rd1, b_nird1ji1rg1,
     1          b_nird1ji2rg1, b_nirg1Jdij1sj1, b_nirg1Jdij1sj2,
     2          b_nird1Jgij1sj1, b_nird1Jgij1sj2, b_nisj1Jgij1rd1,
     3          b_nisj2Jgij1rd1, b_nisj1Jdij1rg1, b_nisj2Jdij1rg1,
     4          b_Jgia1Jdib1sc1, b_Jgia1Jdib1sc2
      print 212,b_r1r1r2r2, b_sj1sj1r2r2, b_si1si1sj2sj2,
     1          b_rg1rd1r2r2, b_rg1rd1sj2sj2, b_rg1rd1rg2rd2

      return
      end subroutine cpling_f

c______________________________________________________________________________
      end module hfodd_tgrad
