1 : C XNUAGE SOURCE CHAT 05/01/13 04:14:49 5004 2 : 3 : SUBROUTINE XNUAGE(WRK0,JC,WR11,NTABO3,NTABO4,KERRE) 4 : C 5 : C CE PROGRAMME RANGE DANS 2 TABLEAUX LES INFOS RELATIVES A UNE 6 : C COMPOSANTE DE MATERIAU DE TYPE NUAGE 7 : C IL EST UTILISE POUR LES MATR. ENDOMMAGEABLES DE LEMAITRE (26 OU 29) 8 : C 9 : C ENTREES: 10 : C ------- 11 : C WRK0 = POINTEUR SUR LE SEGMENT CONTENANT LE TABLEAU XMAT DU MATR. 12 : C JC = NUMERO DE COMPOSANTE REPRESENTANT LA COURBE DE TRACTION 13 : C OU LA COURBE k(X) RESPECTIVEMENT POUR MATR. 26 OU 29 14 : C XMAT(JC) = POINTEUR SUR UN OBJET DE TYPE NUAGE REPRESENTANT : 15 : C -LA COURBE DE TRACTION EN FONCTION DE LA TEMPERATURE T 16 : C POUR MATR. 26 17 : C -LA COURBE k(X) EN FONCTION DE LA TEMPERATURE T 18 : C POUR MATR. 29 (k=PARAMETRE X=CONTR.) 19 : C NTABO3 = 0 20 : C NTABO4 = 0 21 : C 22 : C SORTIES: 23 : C ------- 24 : C NTABO3 = NBR. DE COURBES 25 : C IABLO3 = TABLEAU CONTENANT POUR CHAQUE COURBE LE NBR. DE PTS. QUI LA 26 : C DEFINIT 27 : C NTABO4 = DIMENSION DU TABLEAU TABLO4 28 : C TABLO4 = TABLEAU CONTENANT : 29 : C T1 EPS11 SIG11 EPS12 SIG12 ... T2 EPS21 SIG21 EPS22 SIG22 ... 30 : C T3 .... POUR MATR. 26 31 : C T1 X11 k11 X12 k12 ... T2 X21 k21 X22 k22 ... T3 ... 32 : C POUR MATR. 29 33 : C 34 : IMPLICIT INTEGER(I-N) 35 : IMPLICIT REAL*8(A-H,O-Z) 36 : -INC CCOPTIO 37 : -INC SMNUAGE 38 : -INC SMEVOLL 39 : -INC SMLREEL 40 : SEGMENT WRK0 41 : REAL*8 XMAT(NCXMAT) 42 : ENDSEGMENT 43 : * 44 : SEGMENT WR11 45 : INTEGER IABLO3(NTABO3) 46 : REAL*8 TABLO4(NTABO4) 47 : ENDSEGMENT 48 : * 49 : KERRE=0 50 : MNUAGE=XMAT(JC) 51 : SEGACT MNUAGE 52 : IF(MNUAGE.EQ.0) THEN 53 : MOTERR(1:8)='NUAGE ' 53 : CALL ERREUR(37) 54 : KERRE=37 55 : RETURN 56 : ENDIF 57 : NVAR=NUANOM(/2) 58 : IF(NVAR.LE.1) THEN 59 : SEGDES MNUAGE 60 : INTERR(1)=MNUAGE 61 : INTERR(2)=2 62 : INTERR(3)=2 62 : CALL ERREUR(628) 63 : KERRE=628 64 : RETURN 65 : ENDIF 66 : DO 203 IA=1,NVAR 67 : IF (NUATYP(IA).EQ.'FLOTTANT') GOTO 204 68 : 203 CONTINUE 69 : SEGDES MNUAGE 70 : INTERR(1)=MNUAGE 71 : MOTERR(1:8)='FLOTTANT' 71 : CALL ERREUR(629) 72 : KERRE=629 73 : RETURN 74 : 204 CONTINUE 75 : DO 205 IB=1,NVAR 76 : IF (NUATYP(IB).EQ.'EVOLUTIO') GOTO 206 77 : 205 CONTINUE 78 : SEGDES MNUAGE 79 : INTERR(1)=MNUAGE 80 : MOTERR(1:8)='EVOLUTIO' 80 : CALL ERREUR(629) 81 : KERRE=629 82 : RETURN 83 : 206 CONTINUE 84 : NUAVFL=NUAPOI(IA) 85 : NUAVIN=NUAPOI(IB) 86 : SEGACT NUAVFL 87 : SEGACT NUAVIN 88 : NBC1=NUAFLO(/1) 89 : NBC2=NUAINT(/1) 90 : IF (NBC1.NE.NBC2) THEN 91 : SEGDES MNUAGE,NUAVFL,NUAVIN 91 : CALL ERREUR(625) 92 : KERRE=625 93 : RETURN 94 : ENDIF 95 : IF (NBC1.LE.1) THEN 96 : SEGDES MNUAGE,NUAVFL,NUAVIN 97 : INTERR(1)=MNUAGE 98 : INTERR(2)=2 99 : INTERR(3)=2 99 : CALL ERREUR(628) 100 : KERRE=628 101 : RETURN 102 : ENDIF 103 : NTABO3=NBC1 104 : J0=1 105 : NTABO4=J0 106 : SEGADJ WR11 107 : DO 301 I=1,NBC1 108 : MEVOLL=NUAINT(I) 109 : IF(MEVOLL.EQ.0) THEN 110 : MOTERR(1:8)='EVOLUTIO' 110 : CALL ERREUR(37) 111 : KERRE=37 112 : RETURN 113 : ENDIF 114 : SEGACT MEVOLL 115 : KEVOLL=IEVOLL(1) 116 : SEGACT KEVOLL 117 : MLREEL=IPROGX 118 : MLREE1=IPROGY 119 : SEGDES KEVOLL 120 : SEGACT MLREEL,MLREE1 121 : NBPOIX=PROG(/1) 122 : IABLO3(I)=NBPOIX 123 : TABLO4(J0)=NUAFLO(I) 124 : DO 298 J=1,NBPOIX 125 : NTABO4=J0+(2*J) 126 : SEGADJ WR11 127 : TABLO4(J0+(2*J-1))=PROG(J) 128 : TABLO4(J0+2*J)=MLREE1.PROG(J) 129 : 298 CONTINUE 130 : IF (I.LT.NBC1) THEN 131 : J0=J0+1+(2*NBPOIX) 132 : NTABO4=J0 133 : SEGADJ WR11 134 : ENDIF 135 : SEGDES MLREEL,MLREE1 136 : SEGDES MEVOLL 137 : 301 CONTINUE 138 : SEGDES NUAVFL 139 : SEGDES NUAVIN 140 : SEGDES MNUAGE 141 : RETURN 142 : END 143 :
© Cast3M 2003 - All rights reserved.
Disclaimer