Sources Esope | Cast3M

caljcc
C CALJCC    SOURCE    CB215821  26/08/24    21:15:23     12622          
      SUBROUTINE CALJCC(FN,GR,PG,XYZ,HR,PGSQ,RPG,IES,ND,NP,NPG,IAXI,
     &AIRE,AJ,HHR)
C************************************************************************
C
C          CE SP DIFFERRE DE CALICC PAR LE RANGEMENT DE HR
C
C                        HR(IES,NP,1)
C                        HHR(ND,NP,1)
C
C     DANS LE CAS DES ELEMENTS COQUES LE CHANGEMENT DE REPERE SE FAIT EN
C     TEMPS 1/ DANS LE PLAN DE L'ELEMENT : HHR
C           2/ ROTATION 3D               : HR
C
C     CALCUL DE L'INVERSE DU JACOBIEN  AJ=1/J
C     CALCUL DE L'AIRE OU VOLUME       AIRE
C     CALCUL DE                        PGSQ(L)
C     CALCUL DE                        RPG(L)
C     CALCUL DE DES GRADIENTS          HR(ND,NP)
C     CALCUL INTERMEDIAIRE DE L'ELEMENT D'AIRE       SQ=DET(J)
C     DANS LES CAS 2D ET 3D
C
C     IES  DIMENSION ESPACE
C     ND   DIMENSION ESPACE DE L'ELEMENT
C     NP   NOMBRE DE NOEUDS DE L'ELEMENT
C     NPG  NOMBRE DE POINTS D'INTEGRATION
C
C     XYZ  COORDONNEES
C     GR   GRADIENT
C     B & KAUX  TABLEAUX DE TRAVAIL
C************************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
-INC CCREEL
C
      REAL*8 FN(NP,NPG),GR(ND,NP,1),HR(IES,NP,1),HHR(ND,NP,1)
      REAL*8 PG(NPG),XYZ(IES,NP),PGSQ(NPG),RPG(NPG),XY(2,9)
      REAL*8 SQ(9),B(3),AJ(IES,IES,NPG),AJJ(3,3,9)
C
      DIMENSION KAUX(3)
C
C***
C     WRITE(6,*) ' *** SUB CALJCC *** IES=',IES
 
      IF(IES.NE.2)GO TO 30
 
C                ----------   2D   ----------
C CAS DES ELEMENTS POUTRE 2D
 
      TX=XYZ(1,NP)-XYZ(1,1)
      TY=XYZ(2,NP)-XYZ(2,1)
 
      AIRE=TX*TX+TY*TY
      AIRE=SQRT(AIRE)
 
      TX=TX/AIRE
      TY=TY/AIRE
 
      PX=-TY
      PY=TX
 
C     WRITE(6,*)' TX,TY=',TX,TY
C     WRITE(6,*)' PX,PY=',PX,PY
C     WRITE(6,*)' AIRE =',AIRE,'  NPG=',NPG
C     WRITE(6,*)' PG   =',PG
C     WRITE(6,*)' GR   =',GR
C     CALL ARRET(0)
 
 
 
      DO 1003 L=1,NPG
 
      AJ(1,1,L)=TX
      AJ(1,2,L)=TY
      AJ(2,1,L)=PX
      AJ(2,2,L)=PY
      PGSQ(L)=PG(L)*AIRE
 
      DO 20 I=1,NP
      HR(1,I,L)=AJ(1,1,L)*GR(1,I,L)/PGSQ(L)
      HR(2,I,L)=AJ(1,2,L)*GR(1,I,L)/PGSQ(L)
 20   CONTINUE
 1003 CONTINUE
 
      IF(IAXI.EQ.0)RETURN
C
      ID=3-IAXI
      IF(IAXI.EQ.3)CALL ARRET(0)
      DO 25 L=1,NPG
      RPG(L)=XZERO
      DO 26 I=1,NP
      RPG(L)=RPG(L)+XYZ(ID,I)*FN(I,L)
 26   CONTINUE
 25   CONTINUE
C
      AIRE=XZERO
      DO 27 L=1,NPG
      PGSQ(L)=PGSQ(L)*2.0D0*XPI*RPG(L)
      AIRE=AIRE+PGSQ(L)
 27   CONTINUE
      RETURN
 
 30   CONTINUE
C                ----------   3D   ----------
      IF(ND.NE.1)GO TO 40
C CAS DES ELEMENTS POUTRE 3D
 
      TX=XYZ(1,NP)-XYZ(1,1)
      TY=XYZ(2,NP)-XYZ(2,1)
      TZ=XYZ(3,NP)-XYZ(3,1)
 
      AIRE=TX*TX+TY*TY+TZ*TZ
      AIRE=SQRT(AIRE)
 
      TX=TX/AIRE
      TY=TY/AIRE
      TZ=TZ/AIRE
 
      QX=3*TY-2*TZ
      QY=TZ-3*TX
      QZ=2*TX-TY
 
      QQ=QX*QX+QY*QY+QZ*QZ
      QQ=SQRT(QQ)
 
      QX=QX/QQ
      QY=QY/QQ
      QZ=QZ/QQ
 
      PX=QY*TZ-QZ*TY
      PY=QZ*TX-QX*TZ
      PZ=QX*TY-QY*TX
 
 
      DO 1004 L=1,NPG
 
      AJ(1,1,L)=TX
      AJ(1,2,L)=TY
      AJ(1,3,L)=TZ
      AJ(2,1,L)=PX
      AJ(2,2,L)=PY
      AJ(2,3,L)=PZ
      AJ(3,1,L)=QX
      AJ(3,2,L)=QY
      AJ(3,3,L)=QZ
      PGSQ(L)=PG(L)*AIRE
 
      DO 31 I=1,NP
C     HR(1,I,L)=AJ(1,1,L)*GR(1,I,L)
      HR(1,I,L)=GR(1,I,L)/AIRE
C     HR(2,I,L)=AJ(1,2,L)*GR(1,I,L)
      HR(2,I,L)=XZERO
C     HR(3,I,L)=AJ(1,3,L)*GR(1,I,L)
      HR(3,I,L)=XZERO
 31   CONTINUE
 1004 CONTINUE
      RETURN
 
 40   CONTINUE
C     WRITE(6,*)' *** CAS DES ELEMENTS COQUES 3D ***'
 
 
      CALL CALJQB(XYZ,AJJ,3,NP)
      CALL CALJXY(XYZ,AJJ,IES,XY,ND,NP)
 
 
 
C     WRITE(6,*)' SUB CALJCC : APPEL A CALJ22 '
C     WRITE(6,*)' ND,NP,NPG,IAXI=',ND,NP,NPG,IAXI
 
C     DO 441 L=1,NPG
C     WRITE(6,*)' L=',L
C     WRITE(6,1002) (GR(1,I,L),I=1,NP)
C     WRITE(6,1002) (GR(2,I,L),I=1,NP)
C441  CONTINUE
 
      CALL CALJ22(FN,GR,PG,XY,HHR,PGSQ,RPG,ND,NP,NPG,IAXI,AIRE,AJ)
 
      DO 1007 L=1,NPG
      PGSQ(L)=PG(L)*AIRE
      DO 1006 I=1,NP
      DO 1005 N=1,IES
      HR(N,I,L)=XZERO
      DO 41 M=1,ND
      HR(N,I,L)=HR(N,I,L)+AJJ(M,N,1)*HHR(M,I,L)
 41   CONTINUE
 1005 CONTINUE
 1006 CONTINUE
 1007 CONTINUE
 
      RETURN
 1002 FORMAT(10(1X,1PE11.4))
 1001 FORMAT(20(1X,I5))
      END