1 : C CALJCC SOURCE CHAT 05/01/12 21:46:46 5004 2 : SUBROUTINE CALJCC(FN,GR,PG,XYZ,HR,PGSQ,RPG,IES,ND,NP,NPG,IAXI, 3 : &AIRE,AJ,HHR) 4 : C************************************************************************ 5 : C 6 : C CE SP DIFFERRE DE CALICC PAR LE RANGEMENT DE HR 7 : C 8 : C HR(IES,NP,1) 9 : C HHR(ND,NP,1) 10 : C 11 : C DANS LE CAS DES ELEMENTS COQUES LE CHANGEMENT DE REPERE SE FAIT EN 12 : C TEMPS 1/ DANS LE PLAN DE L'ELEMENT : HHR 13 : C 2/ ROTATION 3D : HR 14 : C 15 : C CALCUL DE L'INVERSE DU JACOBIEN AJ=1/J 16 : C CALCUL DE L'AIRE OU VOLUME AIRE 17 : C CALCUL DE PGSQ(L) 18 : C CALCUL DE RPG(L) 19 : C CALCUL DE DES GRADIENTS HR(ND,NP) 20 : C CALCUL INTERMEDIAIRE DE L'ELEMENT D'AIRE SQ=DET(J) 21 : C DANS LES CAS 2D ET 3D 22 : C 23 : C IES DIMENSION ESPACE 24 : C ND DIMENSION ESPACE DE L'ELEMENT 25 : C NP NOMBRE DE NOEUDS DE L'ELEMENT 26 : C NPG NOMBRE DE POINTS D'INTEGRATION 27 : C 28 : C XYZ COORDONNEES 29 : C GR GRADIENT 30 : C B & KAUX TABLEAUX DE TRAVAIL 31 : C************************************************************************ 32 : IMPLICIT INTEGER(I-N) 33 : IMPLICIT REAL*8 (A-H,O-Z) 34 : C 35 : -INC CCREEL 36 : C 37 : REAL*8 FN(NP,NPG),GR(ND,NP,1),HR(IES,NP,1),HHR(ND,NP,1) 38 : REAL*8 PG(NPG),XYZ(IES,NP),PGSQ(NPG),RPG(NPG),XY(2,9) 39 : REAL*8 SQ(9),B(3),AJ(IES,IES,NPG),AJJ(3,3,9) 40 : C 41 : DIMENSION KAUX(3) 42 : C 43 : C*** 44 : C WRITE(6,*) ' *** SUB CALJCC *** IES=',IES 45 : 46 : IF(IES.NE.2)GO TO 30 47 : 48 : C ---------- 2D ---------- 49 : C CAS DES ELEMENTS POUTRE 2D 50 : 51 : TX=XYZ(1,NP)-XYZ(1,1) 52 : TY=XYZ(2,NP)-XYZ(2,1) 53 : 54 : AIRE=TX*TX+TY*TY 55 : AIRE=SQRT(AIRE) 56 : 57 : TX=TX/AIRE 58 : TY=TY/AIRE 59 : 60 : PX=-TY 61 : PY=TX 62 : 63 : C WRITE(6,*)' TX,TY=',TX,TY 64 : C WRITE(6,*)' PX,PY=',PX,PY 65 : C WRITE(6,*)' AIRE =',AIRE,' NPG=',NPG 66 : C WRITE(6,*)' PG =',PG 67 : C WRITE(6,*)' GR =',GR 67 : C CALL ARRET(0) 68 : 69 : 70 : 71 : DO 20 L=1,NPG 72 : 73 : AJ(1,1,L)=TX 74 : AJ(1,2,L)=TY 75 : AJ(2,1,L)=PX 76 : AJ(2,2,L)=PY 77 : PGSQ(L)=PG(L)*AIRE 78 : 79 : DO 20 I=1,NP 80 : HR(1,I,L)=AJ(1,1,L)*GR(1,I,L)/PGSQ(L) 81 : HR(2,I,L)=AJ(1,2,L)*GR(1,I,L)/PGSQ(L) 82 : 20 CONTINUE 83 : 84 : IF(IAXI.EQ.0)RETURN 85 : C 86 : ID=3-IAXI 86 : IF(IAXI.EQ.3)CALL ARRET(0) 87 : DO 25 L=1,NPG 88 : RPG(L)=XZERO 89 : DO 26 I=1,NP 90 : RPG(L)=RPG(L)+XYZ(ID,I)*FN(I,L) 91 : 26 CONTINUE 92 : 25 CONTINUE 93 : C 94 : AIRE=XZERO 95 : DO 27 L=1,NPG 96 : PGSQ(L)=PGSQ(L)*2.0D0*XPI*RPG(L) 97 : AIRE=AIRE+PGSQ(L) 98 : 27 CONTINUE 99 : RETURN 100 : 101 : 30 CONTINUE 102 : C ---------- 3D ---------- 103 : IF(ND.NE.1)GO TO 40 104 : C CAS DES ELEMENTS POUTRE 3D 105 : 106 : TX=XYZ(1,NP)-XYZ(1,1) 107 : TY=XYZ(2,NP)-XYZ(2,1) 108 : TZ=XYZ(3,NP)-XYZ(3,1) 109 : 110 : AIRE=TX*TX+TY*TY+TZ*TZ 111 : AIRE=SQRT(AIRE) 112 : 113 : TX=TX/AIRE 114 : TY=TY/AIRE 115 : TZ=TZ/AIRE 116 : 117 : QX=3*TY-2*TZ 118 : QY=TZ-3*TX 119 : QZ=2*TX-TY 120 : 121 : QQ=QX*QX+QY*QY+QZ*QZ 122 : QQ=SQRT(QQ) 123 : 124 : QX=QX/QQ 125 : QY=QY/QQ 126 : QZ=QZ/QQ 127 : 128 : PX=QY*TZ-QZ*TY 129 : PY=QZ*TX-QX*TZ 130 : PZ=QX*TY-QY*TX 131 : 132 : 133 : DO 31 L=1,NPG 134 : 135 : AJ(1,1,L)=TX 136 : AJ(1,2,L)=TY 137 : AJ(1,3,L)=TZ 138 : AJ(2,1,L)=PX 139 : AJ(2,2,L)=PY 140 : AJ(2,3,L)=PZ 141 : AJ(3,1,L)=QX 142 : AJ(3,2,L)=QY 143 : AJ(3,3,L)=QZ 144 : PGSQ(L)=PG(L)*AIRE 145 : 146 : DO 31 I=1,NP 147 : C HR(1,I,L)=AJ(1,1,L)*GR(1,I,L) 148 : HR(1,I,L)=GR(1,I,L)/AIRE 149 : C HR(2,I,L)=AJ(1,2,L)*GR(1,I,L) 150 : HR(2,I,L)=XZERO 151 : C HR(3,I,L)=AJ(1,3,L)*GR(1,I,L) 152 : HR(3,I,L)=XZERO 153 : 31 CONTINUE 154 : RETURN 155 : 156 : 40 CONTINUE 157 : C WRITE(6,*)' *** CAS DES ELEMENTS COQUES 3D ***' 158 : 159 : 159 : CALL CALJQB(XYZ,AJJ,3,NP) 159 : CALL CALJXY(XYZ,AJJ,IES,XY,ND,NP) 160 : 161 : 162 : 163 : C WRITE(6,*)' SUB CALJCC : APPEL A CALJ22 ' 164 : C WRITE(6,*)' ND,NP,NPG,IAXI=',ND,NP,NPG,IAXI 165 : 166 : C DO 441 L=1,NPG 167 : C WRITE(6,*)' L=',L 168 : C WRITE(6,1002) (GR(1,I,L),I=1,NP) 169 : C WRITE(6,1002) (GR(2,I,L),I=1,NP) 170 : C441 CONTINUE 171 : 171 : CALL CALJ22(FN,GR,PG,XY,HHR,PGSQ,RPG,ND,NP,NPG,IAXI,AIRE,AJ) 172 : 173 : DO 41 L=1,NPG 174 : PGSQ(L)=PG(L)*AIRE 175 : DO 41 I=1,NP 176 : DO 41 N=1,IES 177 : HR(N,I,L)=XZERO 178 : DO 41 M=1,ND 179 : HR(N,I,L)=HR(N,I,L)+AJJ(M,N,1)*HHR(M,I,L) 180 : 41 CONTINUE 181 : 182 : RETURN 183 : 1002 FORMAT(10(1X,1PE11.4)) 184 : 1001 FORMAT(20(1X,I5)) 185 : END 186 : 187 : 188 : 189 :
© Cast3M 2003 - All rights reserved.
Disclaimer