1 : C CQTGR1 SOURCE CHAT 05/01/12 22:27:34 5004 2 : SUBROUTINE CQTGR1(IGAU,MELE,NBNN,LRE,IFOU,NGRA,XE,SHPTOT, 3 : 1 XDDL,SHP,BGR,DJAC,GRADI) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : ***************************************************************** 7 : * SOUS-PROGRAMME DE L'OPERATEUR GRADIENT 8 : * 9 : * CALCUL DES GRADIENTS DE TEMPERATURE POUR LES ELEMENTS COQ2,COQ3 10 : * 11 : * 12 : * ENTREES : 13 : * 14 : * IGAU NUMERO DU POINT DE GAUSS 15 : * MELE NUMERO DE L'ELEMENT DANS NOMTP 16 : * NBNN NOMBRE DE NOEUDS 17 : * LRE NOMBRE DE COLONNES DE LA MATRICE BGR 18 : * IFOU IFOUR DE CCOPTIO 19 : * NGRA NOMBRE DE COMPOSANTES DE GRADIENTS 20 : * XE COORDONNEES DE L'ELEMENT 21 : * SHPTOT FONCTIONS DE FORMES ET DERIVEES 22 : * SHP TABLEAU DE TRAVAIL 23 : * BGR TABLEAU DE TRAVAIL 24 : * 25 : * SORTIES : 26 : * 27 : * GRADI TABLEAU CONTENANT LES COMPOSANTES DU GRADIENT 28 : * DJAC JACOBIEN 29 : * 30 : * AUTEUR : P.DOWLATYARI 27/05/91 31 : ************************************************************************ 32 : -INC CCOPTIO 33 : DIMENSION XE(3,*),BGR(NGRA,*),SHP(6,*),SHPTOT(6,NBNN,*) 34 : DIMENSION XDDL(*),GRADI(*) 35 : DIMENSION COSD1(3),COSD2(3),COSD3(3),XE1(3,3) 36 : * 36 : CALL ZERO(BGR,NGRA,LRE) 37 : * 38 : IF(MELE.EQ.44)THEN 39 : * 40 : * COQ2 41 : * 42 : IF(IFOU.EQ.0)THEN 43 : * 44 : * LA LONGUEUR DE L'ELEMENT 45 : * 46 : D=SQRT((XE(1,2)-XE(1,1))**2.D0 +(XE(2,2)-XE(2,1))**2.D0) 47 : DJAC=D 48 : IF (D.EQ.0.D0) RETURN 49 : BGR(1,1)=-1.D0/D 50 : BGR(1,2)= 1.D0/D 51 : ELSE 52 : * 53 : * ELEMENT AXISYM. DE FOURIER OU AUTRE 54 : * OPTION NON DISPONIBLE ACTUELLEMENT 55 : * 55 : CALL ERREUR(19) 56 : RETURN 57 : ENDIF 58 : ELSE 59 : * 60 : * COQ3 61 : * 62 : * 63 : * CALCUL DES COORDONNEES DES NOEUDS DANS LE REPERE LOCAL DE L' 64 : * ELEMENT COQUE 65 : * 65 : CALL ZERO(XE1,3,3) 66 : DO 10 I=1,3 67 : COSD1(I)=XE(I,2)-XE(I,1) 68 : COSD2(I)=XE(I,3)-XE(I,1) 69 : 10 CONTINUE 70 : * 71 : COSD3(1)=COSD1(2)*COSD2(3)-COSD1(3)*COSD2(2) 72 : COSD3(2)=COSD1(3)*COSD2(1)-COSD1(1)*COSD2(3) 73 : COSD3(3)=COSD1(1)*COSD2(2)-COSD1(2)*COSD2(1) 74 : * 75 : COSD1L=SQRT(COSD1(1)*COSD1(1)+COSD1(2)*COSD1(2)+ 76 : . COSD1(3)*COSD1(3)) 77 : COSD3L=SQRT(COSD3(1)*COSD3(1)+COSD3(2)*COSD3(2)+ 78 : . COSD3(3)*COSD3(3)) 79 : * 80 : DO 20 I=1,3 81 : COSD1(I)=COSD1(I)/COSD1L 82 : COSD3(I)=COSD3(I)/COSD3L 83 : 20 CONTINUE 84 : * 85 : COSD2(1)=COSD3(2)*COSD1(3)-COSD3(3)*COSD1(2) 86 : COSD2(2)=COSD3(3)*COSD1(1)-COSD3(1)*COSD1(3) 87 : COSD2(3)=COSD3(1)*COSD1(2)-COSD3(2)*COSD1(1) 88 : * 89 : DO 30 NOE=1,NBNN 90 : DO 30 I=1,3 91 : XE1(1,NOE)=XE1(1,NOE)+XE(I,NOE)*COSD1(I) 92 : XE1(2,NOE)=XE1(2,NOE)+XE(I,NOE)*COSD2(I) 93 : 30 CONTINUE 94 : * 95 : DO 40 NP=1,NBNN 96 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 97 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 98 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 99 : 40 CONTINUE 100 : * 100 : CALL JACOBI(XE1,SHP,2,NBNN,DJAC) 101 : K=1 102 : DO 50 NP=1,NBNN 103 : BGR(1,K)=SHP(2,NP) 104 : BGR(2,K)=SHP(3,NP) 105 : K=K+1 106 : 50 CONTINUE 107 : * 108 : ENDIF 109 : * 110 : * CALCUL DES COMPOSANTES DU GRADIENT 111 : * 112 : LRE1=LRE/3 113 : DO 60 IA=1,NGRA 114 : CC=0.D0 115 : DO 70 IB=1,LRE1 116 : IBB=(IB-1)*3+2 117 : CC=CC+XDDL(IBB)*BGR(IA,IB) 118 : 70 CONTINUE 119 : GRADI(IA)=CC 120 : 60 CONTINUE 121 : * 122 : RETURN 123 : END 124 : 125 :
© Cast3M 2003 - All rights reserved.
Disclaimer