1 : C SORE1 SOURCE CHAT 11/03/16 21:31:39 6902 2 : 3 : SUBROUTINE SORE1 (IPMODE,IPCHEL,IPCHE4,IPCHP1,IPRIGI) 4 : ************************************************************************ 5 : * 6 : * SORE1 ----- 7 : * _____ 8 : * FONCTION: 9 : * --------- 10 : * CREATION DE LA MATRICE DE CONDUCTIVITE N DIV(GRAD T) 11 : * POUR DES ELMENTS MASSIFS UNIQUEMENT 12 : * GESTION DES SEGMENTS ET TESTS DE COMPATIBILITE 13 : * 14 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+)=CONTENU DANS UN COMMUN 15 : * ----------- 16 : * 17 : * IPMODE (E) POINTEUR SUR LE SEGMENT MMODEL 18 : * IPCHEL (E) POINTEUR SUR LE CHAMP CARACTERISTIQUES (MATER) 19 : * IPCHE4 (E) POINTEUR SUR LE CHAMP FACTEUR DE GRAD T 20 : * IPCHP1 (E) POINTEUR SUR LE CHPOINT T 21 : * IPRIGI (S) POINTEUR SUR LE SEGMENT MRIGID 22 : * 23 : * VARIABLES: 24 : * ---------- 25 : * 26 : * NBNN NOMBRE DE NOEUDS DANS L'ELEMENT CONSIDERE 27 : * NEF NUMERO DE L'ELEMENT FINI DANS NOMTP 28 : * NBMAIL NOMBRE DE MAILLAGES ELEMENTAIRES 29 : * NBELEM NOMBRE D'ELEMENTS DANS LE MAILLAGE ELEMENTAIRE 30 : * 31 : * 32 : * AUTEUR, DATE DE CREATION: 33 : * ------------------------- 34 : * 35 : * J.M.BAZE AVRIL 97 36 : * 37 : * LANGAGE: 38 : * -------- 39 : * 40 : * ESOPE + FORTRAN77 41 : * 42 : ************************************************************************ 43 : 44 : IMPLICIT INTEGER(I-N) 45 : -INC CCOPTIO 46 : -INC CCHAMP 47 : -INC SMRIGID 48 : -INC SMCHAML 49 : -INC SMELEME 50 : -INC SMMODEL 51 : -INC SMCHPOI 52 : 53 : CHARACTER*4 MOTHER,MOCHAL 54 : PARAMETER ( MOTHER='T ' ) 55 : PARAMETER ( MOCHAL='Q ' ) 56 : 57 : * VERIFICATION DU LIEU SUPPORT DU CHAMELEM DE CARACTERISTIQUES 57 : * CALL QUESUP(IPMODE,IPCHEL,6,0,ISUP,IRETCA) 57 : CALL QUESUP(IPMODE,IPCHEL,3,0,ISUP,IRETCA) 58 : IF(ISUP.GT.1)RETURN 59 : * 60 : * SI LE CHAMELEM EST APPUYE AUX NOEUDS ,ON CHANGE LE SUPPORT 61 : * POUR LES POINTS DE GAUSS 62 : * 63 : IF(ISUP.EQ.1)THEN 63 : CALL CHASUP(IPMODE,IPCHEL,IPCHE1,IRET,6) 64 : IF(IRET.NE.0)THEN 64 : CALL ERREUR(IRET) 65 : RETURN 66 : ENDIF 67 : ELSE 68 : IPCHE1=IPCHEL 69 : ENDIF 70 : 71 : * 72 : * CHPOINT TYPE TEMPERATURE ---> CHAMELEM AUX NOEUDS 72 : CALL CHAME1(0,IPMODE,IPCHP1,' ',IPCHE2,1) 73 : IF (IERR.NE.0) RETURN 74 : ICHCAR = 0 75 : * GRADIENT 75 : CALL GRAD1(IPMODE,IPCHE2,ICHCAR,IPCHE3,IRET) 76 : IF(IRET.NE.1) RETURN 77 : 78 : 79 : * VERIFICATION DES SUPPORTS 80 : * 81 : MCHELM=IPCHE1 82 : SEGACT,MCHELM 83 : NBMAIC=IMACHE(/1) 84 : SEGDES MCHELM 85 : 86 : MMODEL=IPMODE 87 : SEGACT,MMODEL 88 : NBMAIM=KMODEL(/1) 89 : IF (NBMAIM.GT.NBMAIC) THEN 90 : * 91 : * IL MANQUE LES CARACTERISTIQUES D'UNE OU PLUSIEURS PARTIES 92 : * DU MODELE 93 : * 93 : CALL ERREUR(404) 94 : SEGDES,MMODEL*NOMOD 95 : RETURN 96 : ENDIF 97 : * 98 : NBMAIL=NBMAIM 99 : * 100 : * INITIALISATION DU CHAPEAU DE L'OBJET RIGIDITE 101 : * 102 : NRIGE=8 103 : NRIGEL=NBMAIL 104 : SEGINI,MRIGID 105 : IPRIGI=MRIGID 106 : ICHOLE=0 107 : IMGEO1=0 108 : IMGEO2=0 109 : IFORIG=IFOUR 110 : ISUPEQ=0 111 : MTYMAT='RIGIDITE' 112 : NBGEOR=0 113 : * 114 : DO 40 IA=1,NBMAIL 115 : IRIGEL(4,IA)=0 116 : COERIG(IA)=1.D0 117 : 40 CONTINUE 118 : * END DO 119 : IFOI=0 120 : * 121 : * BOUCLE SUR LES MAILLAGES ELEMENTAIRES,ZONE IMAIL 122 : * 123 : DO 50 IMAIL=1,NBMAIL 124 : * 125 : IFOI=IFOI+1 126 : IMODEL=KMODEL(IMAIL) 127 : SEGACT,IMODEL 128 : * 129 : NEF=NEFMOD 130 : NF1=FORMOD(/2) 131 : MELEME=IMAMOD 132 : 133 : 134 : SEGACT,MELEME 135 : * 136 : NBNN=NUM(/1) 137 : NBELEM=NUM(/2) 138 : * 139 : * 140 : * REMPLIR LE SEGMENT DESCRIPTEUR DE L'OBJET RIGIDITE 141 : * 142 : NLIGRP=NBNN 143 : NLIGRD=NBNN 144 : SEGINI,DESCR 145 : DO 1 IB=1,NLIGRP 146 : LISINC(IB)=MOTHER 147 : LISDUA(IB)=MOCHAL 148 : NOELEP(IB)=IB 149 : NOELED(IB)=IB 150 : 1 CONTINUE 151 : * 152 : IDESCR=DESCR 153 : SEGDES,DESCR 154 : * 155 : IF(IMAIL.GT.1)THEN 156 : MRIGID=IPRIGI 157 : SEGACT,MRIGID*MOD 158 : ENDIF 159 : * 160 : NLIGRE=NBNN 161 : LVAL=(NBNN*(NBNN+1))/2 162 : * 163 : * 164 : NELRIG=NBELEM 165 : SEGINI,xMATRI 166 : IRIGEL(1,IMAIL)=IMAMOD 167 : IRIGEL(2,IMAIL)=0 168 : IRIGEL(3,IMAIL)=IDESCR 169 : IRIGEL(4,IMAIL)=xMATRI 170 : IRIGEL(5,IMAIL)=0 171 : IRIGEL(6,IMAIL)=0 172 : IRIGEL(7,IMAIL)=2 173 : IRIGEL(8,IMAIL)=0 174 : * 175 : SEGDES,xMATRI,MRIGID 176 : SEGDES,MELEME*NOMOD 177 : 177 : CALL SORE2(NEF,IMAIL,IMODEL,IPCHE1,IPCHE3,IPCHE4,IPRIGI) 178 : IF (IERR.NE.0) RETURN 179 : 180 : 50 CONTINUE 181 : * END DO 182 : 99 CONTINUE 183 : DO 60 I=1,IFOI 184 : IMODEL=KMODEL(I) 185 : SEGDES,IMODEL*NOMOD 186 : 60 CONTINUE 187 : * END DO 188 : 189 : SEGDES,MMODEL*NOMOD 190 : * 191 : MCHELM = IPCHE2 192 : SEGSUP,MCHELM 193 : MCHELM = IPCHE3 194 : SEGSUP,MCHELM 195 : 196 : * 197 : RETURN 198 : END 199 : 200 : 201 :
© Cast3M 2003 - All rights reserved.
Disclaimer