1 : C FRIGTA SOURCE CHAT 11/03/16 21:23:33 6902 2 : SUBROUTINE FRIGTA(IPMODL,IPCAR,IPVARI,CRIGI) 3 : ********************************************************************** 4 : * 5 : * COMPOSANTES DE LA RIGIDITE (HOOK) TANGENTE 6 : * CONTRIBUTION DES ELEMENTS DE CHAQUE SS_ZONE DU MODELE DE 7 : * SECTION 8 : * 9 : ********************************************************************** 10 : * 11 : * ENTREES: 12 : * 13 : * IPMODL = POINTEUR SUR UN OBJET MMODEL 14 : * IPCAR = POINTEUR SUR UN MCHAML DE CARACTERISTIQUES 15 : * IPVARI = POINTEUR SUR UN MCHAML DE VARIABLE INTERNE 16 : * 17 : * SORTIES: 18 : * 19 : * 20 : ************************************************************************ 21 : * Pierre Pegon (ISPRA) Juillet/Aout 1993 22 : *********************************************************************** 23 : IMPLICIT INTEGER(I-N) 24 : IMPLICIT REAL*8(A-H,O-Z) 25 : * 26 : -INC CCOPTIO 27 : -INC SMCHAML 28 : -INC SMELEME 29 : -INC SMCOORD 30 : -INC SMMODEL 31 : -INC SMINTE 32 : -INC CCHAMP 33 : C 34 : DIMENSION CRIGI(12) 35 : * 36 : SEGMENT NOTYPE 37 : CHARACTER*16 TYPE(NBTYPE) 38 : ENDSEGMENT 39 : * 40 : SEGMENT MPTVAL 41 : INTEGER IPOS(NS) ,NSOF(NS) 42 : INTEGER IVAL(NCOSOU) 43 : CHARACTER*16 TYVAL(NCOSOU) 44 : ENDSEGMENT 45 : * 46 : CHARACTER*8 CMATE 47 : CHARACTER*(NCONCH) CONM 48 : CHARACTER*16 MOMODL(10) 49 : PARAMETER ( NINF=3 ) 50 : INTEGER INFOS(NINF) 51 : LOGICAL lsupva,lsupma,lsupca 52 : C 53 : NHRM=NIFOUR 54 : C 55 : C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES 56 : C 56 : CALL QUESUP(IPMODL,IPCAR,5,0,ISUP5,IRETCA) 57 : IF (ISUP5.GT.1) RETURN 58 : * 59 : * VERIFICATION DU LIEU SUPPORT DU MCHAML DE VARIABLES INTERNES 60 : * 60 : CALL QUESUP(IPMODL,IPVARI,5,0,ISUP5,IRETVI) 61 : IF (ISUP5.GT.1) RETURN 62 : C 63 : C ACTIVATION DU MODELE 64 : C 65 : MMODEL=IPMODL 66 : SEGACT MMODEL 67 : NSOUS=KMODEL(/1) 68 : C 69 : C MISE A ZERO DES RIGIDITES 70 : C 71 : DO IE1=1,12 72 : CRIGI(IE1)=0.D0 73 : ENDDO 74 : C____________________________________________________________________ 75 : C 76 : C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES 77 : C____________________________________________________________________ 78 : C 79 : DO 1000 ISOUS=1,NSOUS 80 : * 81 : * INITIALISATION 82 : * 83 : NMATF=0 84 : NMATR=0 85 : MOMATR=0 86 : IVAMAT=0 87 : NCARA=0 88 : NCARF=0 89 : MOCARA=0 90 : IVACAR=0 91 : MOVARI=0 92 : IVARI=0 93 : IPMINT=0 94 : C 95 : C ON RECUPERE L INFORMATION GENERALE 96 : C 97 : IMODEL=KMODEL(ISOUS) 98 : SEGACT IMODEL 99 : IPMAIL=IMAMOD 100 : CONM =CONMOD 101 : * 102 : MELE=NEFMOD 103 : MELEME=IMAMOD 104 : SEGACT MELEME 105 : NBNN=NUM(/1) 106 : NBELEM=NUM(/2) 107 : C+PPf 108 : C ON EVACUE LE CAS DU SEGS EN 3D 109 : IF(MELE.EQ.166.AND.IDIM.EQ.3)THEN 109 : CALL ERREUR(832) 110 : GOTO 9990 111 : ENDIF 112 : C+PPf 113 : C 114 : C TRAITEMENT DU MODELE 115 : C 116 : NFOR=FORMOD(/2) 117 : NMAT=MATMOD(/2) 118 : C 119 : C NATURE DU MATERIAU 120 : C 120 : CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INFIBR) 121 : IF (CMATE.EQ.' ')THEN 121 : CALL ERREUR(251) 122 : GOTO 9990 123 : ENDIF 124 : IF(MATE.NE.1)THEN 124 : CALL ERREUR(635) 125 : GOTO 9990 126 : ENDIF 126 : CALL TEMANF(INFIBR,NIFIBR) 127 : IF((NIFIBR.EQ.0).AND.(INFIBR.NE.0))THEN 127 : CALL ERREUR(636) 128 : GOTO 9990 129 : ENDIF 130 : INFIBR=NIFIBR 131 : * 132 : C____________________________________________________________________ 133 : C 134 : C INFORMATION SUR L'ELEMENT FINI 135 : C____________________________________________________________________ 136 : C 137 : MFR =INFELE(13) 138 : IPPORE=0 139 : IF(MFR.EQ.33) IPPORE=NBNN 140 : IF (MFR.NE.47)THEN 140 : CALL ERREUR(637) 141 : GOTO 9990 142 : ENDIF 143 : NBG =INFELE(6) 144 : NBGS =INFELE(4) 145 : LRE =INFELE(9) 146 : * MINTE=INFELE(11) 147 : MINTE=INFMOD(7) 148 : IPMINT=MINTE 149 : SEGACT,MINTE 150 : C 151 : C CREATION DU TABLEAU INFOS 152 : C 152 : CALL IDENT(IPMAIL,CONM,IPCAR,IPCAR,INFOS,IRTD) 153 : IF (IRTD.EQ.0) GOTO 9990 154 : * 155 : * TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES 156 : if(lnomid(6).ne.0) then 157 : nomid=lnomid(6) 158 : segact nomid 159 : momatr=nomid 160 : nmatr=lesobl(/2) 161 : nmatf=lesfac(/2) 162 : lsupma=.false. 163 : else 164 : lsupma=.true. 164 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) 165 : endif 166 : IF (MOMATR.EQ.0) THEN 167 : MOTERR(1:4)='MATE' 168 : MOTERR(5:8)=NOMTP(MELE) 168 : CALL ERREUR (76) 169 : GOTO 9990 170 : ENDIF 171 : * 172 : IF (NIFIBR.NE.8) THEN 173 : NBTYPE=1 174 : SEGINI NOTYPE 175 : MOTYPE=NOTYPE 176 : TYPE(1)='REAL*8' 177 : * 178 : ELSE 179 : NBTYPE=13 180 : SEGINI NOTYPE 181 : MOTYPE=NOTYPE 182 : DO I=1,NBTYPE 183 : TYPE(I)='REAL*8' 184 : ENDDO 185 : TYPE(10)='POINTEUREVOLUTIO' 186 : TYPE(11)='POINTEUREVOLUTIO' 187 : * 188 : ENDIF 189 : * 189 : CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1, 190 : & INFOS,3,IVAMAT) 191 : SEGSUP NOTYPE 192 : IF (IERR.NE.0) GOTO 9990 193 : NMATT=NMATR+NMATF 194 : * 195 : IF (ISUP5.EQ.1) THEN 195 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE) 196 : IF(IERR.NE.0)THEN 197 : ISUP5=0 198 : GOTO 9990 199 : ENDIF 200 : ENDIF 201 : * 202 : * TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES 203 : * 204 : if(lnomid(7).ne.0) then 205 : nomid=lnomid(7) 206 : segact nomid 207 : mocara=nomid 208 : ncara=lesobl(/2) 209 : ncarf=lesfac(/2) 210 : lsupca=.false. 211 : else 212 : lsupca=.true. 212 : CALL IDCARB(MELE,IFOUR,MOCARA,NCARA,NCARF) 213 : endif 214 : * 215 : NBTYPE=1 216 : SEGINI NOTYPE 217 : MOTYPE=NOTYPE 218 : TYPE(1)='REAL*8' 219 : * 219 : CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1, 220 : & INFOS,3,IVACAR) 221 : SEGSUP NOTYPE 222 : IF (IERR.NE.0) GOTO 9990 223 : NCARR=NCARA+NCARF 224 : * 225 : IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN 225 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE) 226 : IF(IERR.NE.0)THEN 227 : ISUP5=0 228 : GOTO 9990 229 : ENDIF 230 : ENDIF 231 : * 232 : * TRAITEMENT DU CHAMP DE VARIABLES INTERNES 233 : * 234 : if(lnomid(10).ne.0) then 235 : nomid=lnomid(10) 236 : segact nomid 237 : movari=nomid 238 : nvari=lesobl(/2) 239 : nvarf=lesfac(/2) 240 : lsupva=.false. 241 : else 242 : lsupva=.true. 242 : CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF) 243 : endif 244 : * 245 : NBTYPE=1 246 : SEGINI NOTYPE 247 : MOTYPE=NOTYPE 248 : TYPE(1)='REAL*8' 249 : * 249 : CALL KOMCHA(IPVARI,IPMAIL,CONM,MOVARI,MOTYPE,1,INFOS,3,IVARI) 250 : SEGSUP NOTYPE 251 : IF (IERR.NE.0) GOTO 9990 252 : NVART=NVARI+NVARF 253 : * 254 : * APPEL AU CALCUL PROPREMENT DIT 255 : * 256 : IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN 256 : CALL FRI2T2(INFIBR,MELE,IPMAIL,IPMINT,NBGS, 257 : 1 IVAMAT,IVACAR,IVARI,NMATT,NCARR,NVART, 258 : 2 CRIGI) 259 : ELSE 259 : CALL FRIGT2(INFIBR,MELE,IPMAIL,IPMINT,NBGS, 260 : 1 IVAMAT,IVACAR,IVARI,NMATT,NCARR,NVART, 261 : 2 CRIGI) 262 : ENDIF 263 : * 264 : 9990 CONTINUE 265 : * 266 : * DESACTIVATION DES SEGMENTS 267 : * 268 : SEGDES,MELEME,IMODEL 269 : * 270 : IF (IPMINT.NE.0) SEGDES,MINTE 271 : IF(ISUP5.EQ.1)THEN 271 : CALL DTMVAL (IVAMAT,3) 271 : CALL DTMVAL (IVACAR,3) 272 : ELSE 272 : CALL DTMVAL (IVAMAT,1) 272 : CALL DTMVAL (IVACAR,1) 273 : ENDIF 274 : * 275 : IF (MOCARA.NE.0) THEN 276 : NOMID=MOCARA 277 : if(lsupca)SEGSUP NOMID 278 : END IF 279 : IF (MOVARI.NE.0) THEN 280 : NOMID=MOVARI 281 : if(lsupva)SEGSUP NOMID 282 : END IF 283 : * 284 : IF (MOMATR.NE.0) THEN 285 : NOMID=MOMATR 286 : if(lsupma)SEGSUP NOMID 287 : END IF 288 : * 289 : IF (IERR.NE.0) GO TO 888 290 : * 291 : 1000 CONTINUE 292 : * 293 : 888 CONTINUE 294 : SEGDES MMODEL 295 : RETURN 296 : END 297 : 298 : 299 :
© Cast3M 2003 - All rights reserved.
Disclaimer