Sources Esope | Cast3M

cvecfl
C CVECFL    SOURCE    KK2000    14/04/09    21:15:11     8027
 
      SUBROUTINE C_VECFLMAC (X,NDIMX,VECM,NMODEL)
      IMPLICIT INTEGER(I-N)
      integer ndimx,nmodel,ndims,npcon,npcap,i,ndimv,kdummy
      complex*16 x(ndimx),vecm(ndimx),p,aux
      real*8    exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco,
     .          exl,xnn,aaa,bbb,pc0,exr,cca,phi,alp,pcc2,paa2,qaa2,
     .          exm2,eww2,cpr,cpm,cfr
      common /MRScone/ exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco,
     .                 exl,xnn,aaa,bbb
      common /MRScapp/ pc0,exr,cca,phi,alp,pcc2,paa2,qaa2,exm2,eww2,
     .                 cpr,cpm,cfr
      ndims=ndimx-2
      npcon=ndimx-1
      npcap=ndimx
      ndimv=2
      kdummy=nmodel
      if (nmodel.eq.22) kdummy=23
      call c_vflsigMAC(x,ndims,x(npcon),ndimv,vecm,kdummy)
      aux=(0.D0,0.D0)
      do i=1,3
        aux=aux+(x(i)+CMPLX(pcc))*vecm(i)
      enddo
      do i=4,ndims
c        aux=aux+2.D0*x(i)*vecm(i)
        aux=aux+x(i)*vecm(i)
      enddo
      if (abs(aux).eq.0.D0) then
        write(*,*)' Trabj plas negativo:',aux
        aux=0.D0
      endif
      p=-(x(1)+x(2)+x(3))/(3.D0,0.D0)
      vecm(npcon)=-aux*((p-CMPLX(pcc))/CMPLX(paa))**
     &      (CMPLX(-exl))/(CMPLX(paa)*CMPLX(cco))
      vecm(npcap)=-aux*CMPLX(pc0/paa)**CMPLX(-abs(exr))/CMPLX(cca*paa)
      return
      end