Sources Esope | Cast3M

caljq
C CALJQ     SOURCE    CHAT      05/01/12    21:46:56     5004
      SUBROUTINE CALJQ(XYZ,XY,IES,ND,NP)
C***********************************************************************
C   CE SP CALCULE
C    1/ LES COORDONNEES D UN ELEMENT COQUE DANS LE PLAN ASSOCIE A CET
C       ELEMENT A PARTIR DE SES COORDONNEES 3D
C    2/ LES COORDONNEES D UN ELEMENT 1D  A PARTIR DE SES COORDONNEES
C       2D OU 3D
C   |||| CES ELEMENTS SONT SUPPOSES DROITS
C***********************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 XYZ(IES,NP),XY(ND,NP)
      IF(ND.NE.2)GOTO 10
      TX=XYZ(1,2)-XYZ(1,1)
      TY=XYZ(2,2)-XYZ(2,1)
      TZ=XYZ(3,2)-XYZ(3,1)
      TT=TX*TX+TY*TY+TZ*TZ
      TT=SQRT(TT)
      TX=TX/TT
      TY=TY/TT
      TZ=TZ/TT
C     WRITE(6,*)TX,TY,TZ,TT
      UX=(XYZ(2,NP)-XYZ(2,1))*TZ-(XYZ(3,NP)-XYZ(3,1))*TY
      UY=(XYZ(3,NP)-XYZ(3,1))*TX-(XYZ(1,NP)-XYZ(1,1))*TZ
      UZ=(XYZ(1,NP)-XYZ(1,1))*TY-(XYZ(2,NP)-XYZ(2,1))*TX
      UU=UX*UX+UY*UY+UZ*UZ
      UU=SQRT(UU)
      UX=-UX/UU
      UY=-UY/UU
      UZ=-UZ/UU
C     WRITE(6,*)'UX,UY,UZ,UU',UX,UY,UZ,UU
      VX=+UY*TZ-UZ*TY
      VY=+UZ*TX-UX*TZ
      VZ=+UX*TY-UY*TX
C     WRITE(6,*)VX,VY,VZ
C
      DO 1 I=1,NP
      XY(1,I)=(XYZ(1,I)-XYZ(1,1))*TX+(XYZ(2,I)-XYZ(2,1))*TY
     *+(XYZ(3,I)-XYZ(3,1))*TZ
      XY(2,I)=(XYZ(1,I)-XYZ(1,1))*VX+(XYZ(2,I)-XYZ(2,1))*VY
     *+(XYZ(3,I)-XYZ(3,1))*VZ
 1    CONTINUE
      RETURN
C
 10   CONTINUE
      IF(IES.NE.3)GOTO 20
      DO 11 I=1,NP
      TX=XYZ(1,I)-XYZ(1,1)
      TY=XYZ(2,I)-XYZ(2,1)
      TZ=XYZ(3,I)-XYZ(3,1)
      TT=TX*TX+TY*TY+TZ*TZ
      TT=SQRT(TT)
      XY(1,I)=TT
 11   CONTINUE
      RETURN
 20   CONTINUE
      DO 12 I=1,NP
      TX=XYZ(1,I)-XYZ(1,1)
      TY=XYZ(2,I)-XYZ(2,1)
      TT=TX*TX+TY*TY
      TT=SQRT(TT)
      XY(1,I)=TT
C     WRITE(6,3000) XYZ(1,I),XYZ(2,I),TT
C3000 FORMAT(2X,' X Y TT ',3E12.5)
 12   CONTINUE
C
      RETURN
      END