1 : C RENOEU SOURCE CHAT 07/10/29 21:28:09 5940 2 : SUBROUTINE RENOEU(IELE,MELE,NBSH,IPT,IRET) 3 : C======================================================================= 4 : C 5 : C MET LES VALEURS DES FONCTIONS DE FORMES DANS SHPTOT 6 : C ET LES COORDOONEES REDUITES LES POIDS D INTEGRATION 7 : C DANS QSIGAU ETAGAU DZEGAU POIGAU ; LE TOUT EST 8 : C MIS DANS LE POINTEUR MINTE SON POINTEUR EST IPT 9 : C IELE =NUMERO DE L ELEMENT DANS NOMS (VOIR CCGEOME ) 10 : C MELE =NUMERO DE L ELEMENT DANS NOMTP 11 : C NBSH =NOMBRE DE FONCTIONS D'INTERPOLATION 12 : C IPT = POINTEUR SUR MINTE 13 : C IRET=1 OU 0 SUIVANT QUE MINTE A ETE CREEE OU PAS 14 : C 15 : C CETTE ROUTINE GERE LES MESSAGES D ERREURS 16 : C PROVENANT DE L INCOMPATIBILTE ENTRE NOMS 17 : C D ELEMENTS,NOMBRE DE POINTS DE GAUSS,ET FONCTIONS DE FORME 18 : C 19 : C======================================================================= 20 : IMPLICIT INTEGER(I-N) 21 : IMPLICIT REAL*8(A-H,O-Z) 22 : -INC CCGEOME 23 : -INC SMINTE 24 : -INC CCOPTIO 25 : SEGMENT/SHXX/(SHPXXX(6,NBB)*D) 26 : DIMENSION IMIPOR(5) 27 : C 28 : DATA IMIPOR/4,8,14,23,16/ 29 : C 30 : IRET=1 31 : NBBB=NBNNE(IELE) 32 : * 33 : * CAS PARTICULIER ELEMENT TUYO 34 : * 35 : IF(MELE.EQ.96) NBBB=24 36 : * 37 : * 38 : * CAS PARTICULIER ELEMENT POLYGONE 39 : * 40 : IF(MELE.GE.111.AND.MELE.LE.122) NBBB=NBSH 41 : * 42 : NBNO=NBSH 42 : CALL DONOEU(IELE,MELE,NBSH,NBBB,IPT1,IRT1) 43 : IF (IRT1.EQ.1) GOTO 10 44 : C 45 : C MESSAGE D ERREUR ELEMENT IELE NON IMPLEMENTE DANS DONOEU 46 : C 47 : MOTERR(1:4)=NOMS(IELE) 47 : CALL ERREUR(74) 48 : IRET=0 49 : GOTO 666 50 : 10 CONTINUE 51 : MINTE=IPT1 52 : SEGACT MINTE*MOD 53 : C 54 : DO 110 IA=1,NBBB 55 : DO 110 IB=1,6 56 : DO 110 IC=1,NBNO 57 : SHPTOT(IB,IC,IA)=0.D0 58 : 110 CONTINUE 59 : NBB=NBNO 60 : SEGINI SHXX 61 : DO 100 II=1,NBBB 62 : C INSERER EVENTUELLEMENT UN INDICATEUR DE SUCCES 63 : XX=QSIGAU(II) 64 : YY=ETAGAU(II) 65 : ZZ=DZEGAU(II) 66 : IF(MELE.EQ.96) THEN 66 : CALL SHAP96(XX,YY,ZZ,IELE,SHPXXX,IRT2) 67 : ELSEIF ((MELE.GE.111).AND.(MELE.LE.122)) THEN 67 : CALL SHPOLY(XX,YY,ZZ,II,MELE,SHPXXX,IRT2) 68 : ELSEIF(mele.eq.260) then 68 : call shshb8(xx,shpxxx) 69 : irt2=1 70 : ELSE 70 : CALL SHAPE(XX,YY,ZZ,IELE,SHPXXX,IRT2) 71 : ENDIF 72 : C 73 : C TRAITEMENT SPECIAL MILIEU POREUX 74 : C 75 : IF(MELE.GE.79.AND.MELE.LE.83) THEN 75 : CALL SHAPE(XX,YY,ZZ,IMIPOR(MELE-78), 76 : . SHPXXX(1,NBBB+1),IRT2) 77 : * 78 : ELSE IF(MELE.GE.173.AND.MELE.LE.177) THEN 78 : CALL SHAPE(XX,YY,ZZ,IMIPOR(MELE-172), 79 : . SHPXXX(1,NBBB+1),IRT2) 80 : * 81 : ELSE IF(MELE.GE.178.AND.MELE.LE.182) THEN 81 : CALL SHAPE(XX,YY,ZZ,IMIPOR(MELE-177), 82 : . SHPXXX(1,NBBB+1),IRT2) 83 : * 84 : ENDIF 85 : C 86 : DO 200 ID=1,6 87 : DO 200 NO=1,NBNO 88 : SHPTOT(ID,NO,II)=SHPXXX(ID,NO) 89 : 200 CONTINUE 90 : 100 CONTINUE 91 : C 92 : C APPEL AU CALCULE DES FONCTIONS D EXTRAPOLATIONS 93 : C 93 : if(mele.ne.260) CALL EXTRAP(SHPTOT,NBBB,NBBB,NBNO) 94 : C 95 : SEGSUP SHXX 96 : IF (IRT2.EQ.1) GOTO 20 97 : C 98 : C ERREUR LES FONCTIONS DE FORME PAS ENCORE IMPLEMENTEES 99 : C 100 : MOTERR(1:4)=NOMS(IELE) 100 : CALL ERREUR(68) 101 : IRET=0 102 : SEGSUP MINTE 103 : GOTO 666 104 : 20 IPT=IPT1 105 : SEGDES MINTE 106 : 666 CONTINUE 107 : RETURN 108 : END 109 : 110 : 111 : 112 : 113 : 114 : 115 : 116 : 117 : 118 : 119 :
© Cast3M 2003 - All rights reserved.
Disclaimer