1 : C DEFCAR SOURCE PV 09/03/12 21:19:07 6325 2 : SUBROUTINE DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR, 3 : . WRK1) 4 : * 5 : ******************************************************** 6 : * ENTREES 7 : ******************************************************** 8 : * 9 : * NCARR : nombre de composantes des caractéristiques géométriques 10 : * ICARA : dimension de XCAR 11 : * IB : numéro de l'élément 12 : * IGAU : numéro du point de Gauss 13 : * MFR : formulation de l'élément 14 : * MELE : numéro de l'element fini 15 : * IVACAR : pointeur sur un segment mptval de caracteristiques geometrique 16 : * 17 : ******************************************************* 18 : * SORTIES 19 : ******************************************************* 20 : * 21 : * XCAR(ICARA) : caractéristiques géométriques (WRK1) 22 : * 23 : ******************************************************* 24 : * 25 : IMPLICIT INTEGER(I-N) 26 : IMPLICIT REAL*8(A-H,O-Z) 27 : * 28 : -INC CCOPTIO 29 : -INC SMCHAML 30 : -INC SMCOORD 31 : * 32 : SEGMENT MPTVAL 33 : INTEGER IPOS(NS) ,NSOF(NS) 34 : INTEGER IVAL(NCOSOU) 35 : CHARACTER*16 TYVAL(NCOSOU) 36 : ENDSEGMENT 37 : * 38 : SEGMENT WRK1 39 : REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS) 40 : REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI) 41 : REAL*8 DEFP(NSTRS),XCAR(ICARA) 42 : ENDSEGMENT 43 : * 44 : SEGMENT WRKTRA 45 : REAL*8 TTRAV(NTTRAV) 46 : ENDSEGMENT 47 : * 48 : ICARA=XCAR(/1) 49 : IF(IVACAR.NE.0)THEN 50 : MPTVAL=IVACAR 51 : * 52 : * cas des tuyaux 53 : * 54 : IF(MFR.EQ.13)THEN 55 : DO 2106 IC=1,5 56 : MELVAL=IVAL(IC) 57 : IAUX=MELVAL 58 : IF(IAUX.NE.0)THEN 59 : IBMN=MIN(IB,VELCHE(/2)) 60 : IGMN=MIN(IGAU,VELCHE(/1)) 61 : XCAR(IC)=VELCHE(IGMN,IBMN) 62 : ELSE 63 : XCAR(IC)=0.D0 64 : ENDIF 65 : 2106 continue 66 : DO 2107 IC=6,NCARR-1 67 : MELVAL=IVAL(IC) 68 : IAUX=MELVAL 69 : IF(IAUX.NE.0)THEN 70 : IBMN=MIN(IB,VELCHE(/2)) 71 : IGMN=MIN(IGAU,VELCHE(/1)) 72 : XCAR(IC)=VELCHE(IGMN,IBMN) 73 : ELSE 74 : XCAR(IC)=-1.D0 75 : ENDIF 76 : 2107 continue 77 : IF(IVAL(NCARR).NE.0)THEN 78 : MELVAL=IVAL(NCARR) 79 : IBMN=MIN(IB,IELCHE(/2)) 80 : IGMN=MIN(IGAU,IELCHE(/1)) 81 : IP=IELCHE(IGMN,IBMN) 82 : IREF=(IP-1)*(IDIM+1) 83 : DO 2108 IC=1,IDIM 84 : XCAR(NCARR+IC-1)=XCOOR(IREF+IC) 85 : 2108 continue 86 : ELSE 87 : DO 2109 IC=1,IDIM 88 : XCAR(NCARR+IC-1)=0.D0 89 : 2109 continue 90 : ENDIF 91 : C 92 : C Poutre 3D 93 : C 94 : ELSE IF(MFR.EQ.7.AND.IDIM.EQ.3)THEN 95 : DO 1107 IC=1,NCARR-1 96 : MELVAL=IVAL(IC) 97 : IAUX=MELVAL 98 : IF(IAUX.NE.0)THEN 99 : IBMN=MIN(IB,VELCHE(/2)) 100 : IGMN=MIN(IGAU,VELCHE(/1)) 101 : XCAR(IC)=VELCHE(IGMN,IBMN) 102 : ELSE 103 : XCAR(IC)=0.D0 104 : ENDIF 105 : 1107 continue 106 : IF(IVAL(NCARR).NE.0)THEN 107 : MELVAL=IVAL(NCARR) 108 : IBMN=MIN(IB,IELCHE(/2)) 109 : IGMN=MIN(IGAU,IELCHE(/1)) 110 : IP=IELCHE(IGMN,IBMN) 111 : IREF=(IP-1)*(IDIM+1) 112 : DO 1108 IC=1,IDIM 113 : XCAR(NCARR+IC-1)=XCOOR(IREF+IC) 114 : 1108 continue 115 : ELSE 116 : DO 1109 IC=1,IDIM 117 : XCAR(NCARR+IC-1)=0.D0 118 : 1109 continue 119 : ENDIF 120 : C distinction entre poutre bernouilli et poutre timo en ce qui 121 : C concerne le defaut pour les sections reduites de l'effort tranchant 122 : IF(MFR.EQ.7.AND.MELE.EQ.84)THEN 123 : SD=XCAR(4) 124 : SREDY=XCAR(5) 125 : SREDZ=XCAR(6) 126 : IF(SREDY.EQ.0) XCAR(5)=SD 127 : IF(SREDZ.EQ.0) XCAR(6)=SD 128 : ENDIF 129 : C 130 : C Poutre 2D 131 : C 132 : ELSEIF(IDIM.EQ.2)THEN 133 : DO 1106 IC=1,NCARR 134 : MELVAL=IVAL(IC) 135 : IAUX=MELVAL 136 : IF(IAUX.NE.0)THEN 137 : IBMN=MIN(IB,VELCHE(/2)) 138 : IGMN=MIN(IGAU,VELCHE(/1)) 139 : XCAR(IC)=VELCHE(IGMN,IBMN) 140 : ELSE 141 : * cas des coques minces : défaut de alfah 142 : IF(IC.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN 143 : XCAR(IC)=0.66666666666666D0 144 : ELSE 145 : XCAR(IC)=0.D0 146 : ENDIF 147 : ENDIF 148 : 1106 continue 149 : C distinction entre poutre bernouilli et poutre timo en ce qui 150 : C concerne le defaut pour les sections reduites de l'effort tranchant 151 : SD=XCAR(1) 152 : if (ncarr.ge.3) then 153 : SREDY=XCAR(3) 154 : IF(SREDY.EQ.0) XCAR(3)=SD 155 : endif 156 : C 157 : ELSE 158 : DO 1110 IC=1,ICARA 159 : MELVAL=IVAL(IC) 160 : IAUX=MELVAL 161 : IF(IAUX.NE.0)THEN 162 : IBMN=MIN(IB,VELCHE(/2)) 163 : IGMN=MIN(IGAU,VELCHE(/1)) 164 : XCAR(IC)=VELCHE(IGMN,IBMN) 165 : ELSE 166 : * cas des coques minces : défaut de alfah 167 : IF (IC.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN 168 : XCAR(IC)=0.66666666666666D0 169 : ELSE 170 : XCAR(IC)=0.D0 171 : ENDIF 172 : ENDIF 173 : 1110 continue 174 : ENDIF 175 : * 176 : * rearrangement du tableau xcar pour qu'on ait le meme ordre 177 : * que l'ancien chamelem 178 : * 179 : IF(MFR.EQ.7.AND.IDIM.EQ.3)THEN 180 : VX=XCAR(ICARA-5) 181 : VY=XCAR(ICARA-4) 182 : VZ=XCAR(ICARA-3) 183 : XCAR(ICARA-5)=XCAR(ICARA-2) 184 : XCAR(ICARA-4)=XCAR(ICARA-1) 185 : XCAR(ICARA-3)=XCAR(ICARA) 186 : XCAR(ICARA-2)=VX 187 : XCAR(ICARA-1)=VY 188 : XCAR(ICARA)=VZ 189 : * 190 : ELSE IF(MFR.EQ.13)THEN 191 : NTTRAV = 7 192 : SEGINI WRKTRA 193 : DO 1111 IC=4,10 194 : TTRAV(IC-3)=XCAR(IC) 195 : 1111 continue 196 : IF(IDIM.EQ.2)THEN 197 : XCAR(4)=XCAR(ICARA-1) 198 : XCAR(5)=XCAR(ICARA) 199 : DO 1112 IC=1,NTTRAV 200 : XCAR(IC+5)=TTRAV(IC) 201 : 1112 continue 202 : ELSE IF(IDIM.EQ.3)THEN 203 : XCAR(4)=XCAR(ICARA-2) 204 : XCAR(5)=XCAR(ICARA-1) 205 : XCAR(6)=XCAR(ICARA) 206 : DO 1113 IC=1,NTTRAV 207 : XCAR(IC+6)=TTRAV(IC) 208 : 1113 continue 209 : ENDIF 210 : SEGSUP WRKTRA 211 : ENDIF 212 : ENDIF 213 : RETURN 214 : END 215 : 216 : 217 : 218 : 219 : 220 : 221 : 222 : 223 :
© Cast3M 2003 - All rights reserved.
Disclaimer