Numérotation des lignes :

effi2
C EFFI2     SOURCE    CHAT      05/01/12    23:28:26     5004      SUBROUTINE EFFI2(VALCAR,TYVAL,NCA1,NCAR1,REL,LRE,IB,IGAU,XATEF1,     &NSTEP,DREND,CELEM)**************************************************************** calcule la matrice d efficacite directionnelle* puis transforme la matrice elementaire par blocs***************************************************************      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8(A-H,O-Z)      DIMENSION VALCAR(*),REL(LRE,LRE)      CHARACTER*16 TYVAL(*)      CHARACTER*8 CELEM      dimension xatef1(3,3),xmat1(3,3),tq(3,3),xres(3,3)      dimension xmat2(3,3), q(3,3),xmat3(3,3)      logical drend       if (drend) goto 1000* matrice de rotation      w1x = valcar(ncar1+1)      w1y = valcar(ncar1+2)      w1z = valcar(ncar1+3)      w2x = valcar(ncar1+4)      w2y = valcar(ncar1+5)      w2z = valcar(ncar1+6)      tq(1,1) = w1x      tq(2,1) = w1y      tq(1,2) = w2x      tq(2,2) = w2y      if (nstep.gt.2) then        w3x = w1y*w2z - w1z*w2y        w3y = w2x*w1z - w2z*w1x        w3z = w1x*w2y - w1y*w2x        tq(3,1) = w1z        tq(3,2) = w2z        tq(1,3) = w3x        tq(2,3) = w3y        tq(3,3) = w3z      endif      do i = 1,nstep        do j = 1, nstep           q(i,j) = tq(j,i)        enddo      enddo * efficacite* produit      do i = 1,nstep        do j = 1, nstep         cc= 0.d0            do k1 = 1,nstep                cc = cc + tq(i,k1)*xatef1(k1,j)            enddo         xmat2(i,j) = cc        enddo      enddo      do i = 1,nstep        do j = 1, nstep         cc= 0.d0            do k1 = 1,nstep                cc = cc + xmat2(i,k1)*q(k1,j)            enddo         xatef1(i,j) = cc        enddo      enddo    1000 CONTINUE* affecte la rigidite elementairec ----------------------------------------c  elements massifsc ----------------------------------------      if (CELEM.NE.'MASSIF  ') goto 2000      kind = int(LRE/NSTEP)      DO jind1 = 1,kind        DO jind2 =1,kind * decoupe un bloc         do in1 = 1,nstep           do in2 = 1, nstep                xmat1(in1,in2) =     &         REL((jind1 - 1)*nstep + in1,(jind2 - 1)*nstep + in2)*         if (ib.eq.1.and.igau.eq.1.and.jind1.eq.1.and.jind2.eq.2)*     & write(6,*) in1,in2,xmat1(in1,in2) ,*     & ((jind1 - 1)*nstep + in1), ((jind2 - 1)*nstep + in2)           enddo         enddo* multiplie et range         do in1 = 1,nstep           do in2 = 1, nstep             cc = 0.D0              do k1 = 1,nstep                 cc = cc + (xatef1(in1,k1) * xmat1(k1,in2))*       if (igau.eq.5.and.jind1.eq.6.and.jind2.eq.7)*     &write(6,*) in1,in2,xatef1(in1,k1) ,  xmat1(k1,in2)              enddo            REL((jind1 - 1)*nstep + in1,(jind2 - 1)*nstep + in2) = cc*         if (ib.eq.1.and.igau.eq.5.and.jind1.eq.6.and.jind2.eq.7)*     & write(6,*) ((jind1 - 1)*nstep + in1),((jind2 - 1)*nstep + in2),*     & in1,in2, cc*      if (ib.eq.1.and.igau.eq.5.and.jind1.eq.5)*     & write(6,*) ((jind1 - 1)*nstep + in1),((jind2 - 1)*nstep + in2),*     & in1,in2, xmat1(in1,in2),cc           enddo         enddo          ENDDO      ENDDO      RETURN  2000 CONTINUEc ----------------------------------------c  elementsc ----------------------------------------      RETURN      END  

© Cast3M 2003 - Tous droits réservés.
Mentions légales