1 : C BNPORJ SOURCE CHAT 05/01/12 21:41:52 5004 2 : SUBROUTINE BNPORJ(IGAU,NBNO,NBBB,LRE,IFOU,NSTB,NSTN,XE,XEL, 3 : . SHPTOT,SHP,BPSS,BGENE,XGENE,DJAC,ICLE) 4 : C----------------------------------------------------------------------- 5 : C 6 : C CALCULE LES MATRICES N, NP ET dNP DU JOINT POREUX 7 : C 8 : C LE RESULTAT EST DANS BGENE ET / OU XGENE 9 : C 10 : C BGENE(NSTB,LRE) XGENE(NSTN,LRN) 11 : C 12 : C----------------------------------------------------------------------- 13 : C ENTREE : 14 : C IGAU =NUMERO DU POINT DE GAUSS 15 : C NBNO =NOMBRE DE FONCTIONS DE FORME 16 : C NBBB =NOMBRE DE NOEUDS 17 : C LRE =NOMBRE DE COLONNES DE LA MATRICE N 18 : C IFOU =IFOUR DE CCOPTIO 19 : C NSTB =NOMBRE DE LIGNES DE LA MATRICE N 20 : C NSTN =NOMBRE DE LIGNES DE LA MATRICE NP 21 : C XE =COORDONNEES GLOBALES DE L ELEMENT 22 : C XEL =COORDONNEES LOCALES DE L ELEMENT 23 : C SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES 24 : C SHP(6,NBNO) =TABLEAU DE TRAVAIL 25 : C BPSS=MATRICE DE PASSAGE REPERE GLOBAL/REPERE LOCAL 26 : C ICLE INDICATEUR DE CALCUL 27 : C = 1 ON CALCULE N (bgene) ET NP (xgene) 28 : C = 2 ON CALCULE N (bgene) 29 : C = 3 ON CALCULE NP (xgene) ET dNP (bgene) 30 : C SORTIE : 31 : C BGENE(NSTB,LRE)=MATRICE N OU dNP 32 : C XGENE(NSTN,LRN)=MATRICE NP 33 : C DJAC=JACOBIEN 34 : C----------------------------------------------------------------------- 35 : IMPLICIT INTEGER(I-N) 36 : IMPLICIT REAL*8(A-H,O-Z) 37 : DIMENSION XEL(3,*),BGENE(NSTB,*),SHP(6,*),SHPTOT(6,NBNO,*) 38 : DIMENSION XGENE(NSTN,*),BPSS(3,3),XE(3,*) 39 : C 40 : JCLE1=0 41 : JCLE2=0 42 : JCLE3=0 43 : LRN=(NBNO-NBBB)*3/2 44 : NBNB=(3*NBBB-NBNO)/2 45 : NFAC=NBNB/2 46 : NB1=NBNB+1 47 : IF(ICLE.EQ.1) THEN 48 : JCLE1=1 49 : JCLE2=1 50 : ENDIF 51 : IF(ICLE.EQ.2) THEN 52 : JCLE1=1 53 : ENDIF 54 : IF(ICLE.EQ.3) THEN 55 : JCLE2=1 56 : JCLE3=1 57 : ENDIF 58 : C 58 : CALL ZERO(BGENE,NSTB,LRE) 58 : CALL ZERO(XGENE,NSTN,LRN) 59 : C 60 : IFR=IFOU+4 61 : GOTO (666,10,10,10,666,40) ,IFR 62 : GOTO 666 63 : C 64 : C CONT PLANES, DEF PLANES OU AXISYMETRIQUE 65 : C 66 : 10 CONTINUE 67 : C 68 : DO 101 NP=1,NBNO 69 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 70 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 71 : 101 CONTINUE 72 : C 72 : CALL DEVOLJ(XE,XEL,SHP,NBBB,NBNO,IFOU,DJAC) 73 : C 74 : IF(JCLE1.NE.0) THEN 75 : DO 110 I=1,NSTB 76 : DO 111 J=1,NFAC 77 : DO 112 K=1,NSTB 78 : L=NSTB*(J-1)+K 79 : M=L+NSTB*(2*(NFAC-J)+1) 80 : BGENE(I,L)=BPSS(I,K)*SHP(1,J) 81 : BGENE(I,M)=-BGENE(I,L) 82 : 112 CONTINUE 83 : 111 CONTINUE 84 : 110 CONTINUE 85 : ENDIF 86 : C 87 : IF(JCLE2.NE.0) THEN 88 : K=1 89 : DO 113 NP=NB1,NBNO 90 : XGENE(1,K)=SHP(1,NP) 91 : K=K+1 92 : 113 CONTINUE 93 : ENDIF 94 : C 95 : IF(JCLE3.NE.0) THEN 96 : K=1 97 : DO 114 NP=NB1,NBNO 98 : BGENE(1,K)=SHP(2,NP) 99 : K=K+1 100 : 114 CONTINUE 101 : ENDIF 102 : GOTO 666 103 : C 104 : C TRIDIMMENSIONNEL 105 : C 106 : 40 CONTINUE 107 : C 108 : DO 201 NP=1,NBNO 109 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 110 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 111 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 112 : 201 CONTINUE 113 : C 113 : CALL DEVOLJ(XE,XEL,SHP,NBBB,NBNO,IFOU,DJAC) 114 : C 115 : IF(JCLE1.NE.0) THEN 116 : DO 210 I=1,NSTB 117 : DO 211 J=1,NFAC 118 : DO 212 K=1,NSTB 119 : L=NSTB*(J-1)+K 120 : M=L+NFAC*NSTB 121 : BGENE(I,L)=BPSS(I,K)*SHP(1,J) 122 : BGENE(I,M)=-BGENE(I,L) 123 : 212 CONTINUE 124 : 211 CONTINUE 125 : 210 CONTINUE 126 : ENDIF 127 : C 128 : IF(JCLE2.NE.0) THEN 129 : K=1 130 : DO 213 NP=NB1,NBNO 131 : XGENE(1,K)=SHP(1,NP) 132 : K=K+1 133 : 213 CONTINUE 134 : ENDIF 135 : C 136 : IF(JCLE3.NE.0) THEN 137 : K=1 138 : DO 214 NP=NB1,NBNO 139 : BGENE(1,K)=SHP(2,NP) 140 : BGENE(2,K)=SHP(3,NP) 141 : K=K+1 142 : 214 CONTINUE 143 : ENDIF 144 : GOTO 666 145 : C 146 : 666 CONTINUE 147 : RETURN 148 : END 149 : 150 : 151 :
© Cast3M 2003 - All rights reserved.
Disclaimer