1 : C CVECFL SOURCE CHAT 05/01/12 22:33:07 5004 2 : 3 : SUBROUTINE C_VECFLMAC (X,NDIMX,VECM,NMODEL) 4 : IMPLICIT INTEGER(I-N) 5 : integer ndimx,nmodel,ndims,npcon,npcap,i,ndimv,kdummy 6 : complex*16 x(ndimx),vecm(ndimx),p,aux 7 : real*8 exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco, 8 : . exl,xnn,aaa,bbb,pc0,exr,cca,phi,alp,pcc2,paa2,qaa2, 9 : . exm2,eww2,cpr,cpm,cfr 10 : common /MRScone/ exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco, 11 : . exl,xnn,aaa,bbb 12 : common /MRScapp/ pc0,exr,cca,phi,alp,pcc2,paa2,qaa2,exm2,eww2, 13 : . cpr,cpm,cfr 14 : ndims=ndimx-2 15 : npcon=ndimx-1 16 : npcap=ndimx 17 : ndimv=2 18 : kdummy=nmodel 19 : if (nmodel.eq.22) kdummy=23 19 : call c_vflsigMAC(x,ndims,x(npcon),ndimv,vecm,kdummy) 20 : aux=0.D0 21 : do i=1,3 22 : aux=aux+(x(i)+pcc)*vecm(i) 23 : enddo 24 : do i=4,ndims 25 : c aux=aux+2.D0*x(i)*vecm(i) 26 : aux=aux+x(i)*vecm(i) 27 : enddo 28 : if (abs(aux).eq.0.D0) then 29 : write(*,*)' Trabj plas negativo:',aux 30 : aux=0.D0 31 : endif 32 : p=-(x(1)+x(2)+x(3))/3.D0 33 : vecm(npcon)=-aux*((p-pcc)/paa)**(-exl)/(paa*cco) 34 : vecm(npcap)=-aux*(pc0/paa)**(-abs(exr))/cca/paa 35 : return 36 : end 37 : 38 : 39 :
© Cast3M 2003 - All rights reserved.
Disclaimer