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