1 : C HVIT1 SOURCE CHAT 11/03/16 21:25:00 6902 2 : SUBROUTINE HVIT1(IPMODE,IPMAHY,IPGEOC,ICHP1,IPCHEL,IPGEOM,IRET) 3 : C----------------------------------------------------------------------- 4 : C Calcul de la vitesse au centre de chaque maille 5 : C----------------------------------------------------------------------- 6 : C 7 : C--------------------------- 8 : C Parametres Entree/Sortie : 9 : C--------------------------- 10 : C 11 : C E/ IPMODE : Pointeur vers l'objet MODELE 12 : C E/ IPMAHY : Segment contenant le pointeur vers le meleme des 13 : C connectivites elements/faces pour les zones du MMODEL 14 : C ou on a defini DARCY. 15 : C E/ IPGEOC : Pointeur vers l'objet maillage CENTRE 16 : C E/ ICHP1 : Champoint des debits orientes 17 : C E/ IPCHEL : Mchaml des orientations de normale (1=out,-1=in) 18 : C E/ IPGEOM : Pointeur vers l'objet maillage sommet (MAILLAGE) 19 : C /S IRET : Champoint resultat de composante SCAL 20 : C 21 : C---------------------- 22 : C Tableaux de travail : 23 : C---------------------- 24 : C 25 : C ICPR(I)=J : Le noeud I a le numero local J 26 : C Correspondance numerotation globale/locale 27 : C NNGOT : Nombre de noeuds total du domaine 28 : C 29 : C----------------------------------------------------------------------- 30 : C 31 : C Langage : ESOPE + FORTRAN77 32 : C 33 : C Auteurs : F.DABBENE 09/93 34 : C 35 : C----------------------------------------------------------------------- 36 : IMPLICIT INTEGER(I-N) 37 : IMPLICIT REAL*8 (A-H,O-Z) 38 : * 39 : -INC CCOPTIO 40 : -INC SMCHAML 41 : -INC SMCHPOI 42 : -INC SMCOORD 43 : -INC SMELEME 44 : -INC SMINTE 45 : -INC SMMODEL 46 : * 47 : CHARACTER*1 BLAN1 48 : * 49 : SEGMENT ICCPR 50 : INTEGER ICPR(NNGOT) 51 : ENDSEGMENT 52 : SEGMENT IPMAHY 53 : INTEGER MAHYBR(NSOUS) 54 : ENDSEGMENT 55 : SEGMENT HYBSTO 56 : REAL*8 HYBASE(NDIM,NBDDL,NBPP) 57 : ENDSEGMENT 58 : SEGMENT TRAV 59 : REAL*8 XE(3,NBNN) 60 : REAL*8 SHP(6,NBNN) , SHY(IDIM,NBDDL) 61 : REAL*8 ZJAC(IDIM,IDIM) , VECT(IDIM) 62 : ENDSEGMENT 63 : * 64 : BLAN1=' ' 65 : * 66 : *= Creation des tableaux ICPR et INUI pour le CHAMPOINT d'entree 67 : * 68 : IK = 0 69 : NNGOT = XCOOR(/1)/(IDIM+1) 70 : SEGINI ICCPR 71 : MCHPOI = ICHP1 72 : SEGACT MCHPOI 73 : MSOUPO = IPCHP(1) 74 : SEGDES MCHPOI 75 : SEGACT MSOUPO 76 : NUMHAR = NOHARM(1) 77 : MPOVA1 = IPOVAL 78 : MELEME = IGEOC 79 : SEGACT MELEME 80 : N2 = NUM(/2) 81 : DO 10 I2=1,N2 82 : K = NUM(1,I2) 83 : IF (ICPR(K).EQ.0) THEN 84 : IK = IK + 1 85 : ICPR(K) = IK 86 : ENDIF 87 : 10 CONTINUE 88 : SEGDES MELEME 89 : SEGDES MSOUPO 90 : * 91 : *= Initialisation du CHAMPOINT resultat de nature DIFFUS 92 : * 93 : NSOUPO = 1 94 : NAT = 1 95 : SEGINI MCHPOI 96 : IRET = MCHPOI 97 : MTYPOI = 'CENTRE ' 98 : DO 11 ITIT=1,72 99 : MOCHDE(ITIT:ITIT)=BLAN1 100 : 11 CONTINUE 101 : IFOPOI = IFOMOD 102 : JATTRI(1) = 1 103 : NC = IDIM 104 : SEGINI MSOUPO 105 : IPCHP(1) = MSOUPO 106 : SEGDES MCHPOI 107 : DO 20 I=1,NC 108 : NOHARM(I) = NUMHAR 109 : 20 CONTINUE 110 : IGEOC = IPGEOC 111 : NOCOMP(1) = 'VX ' 112 : NOCOMP(2) = 'VY ' 113 : IF (IDIM.EQ.3) NOCOMP(3) = 'VZ ' 114 : IPT2 = IPGEOC 115 : SEGACT IPT2 116 : N = IPT2.NUM(/2) 117 : SEGDES IPT2 118 : SEGINI MPOVAL 119 : IPOVAL = MPOVAL 120 : SEGDES MSOUPO 121 : * 122 : *= Activation des segments MCHELM et MMODEL 123 : * 124 : MCHELM = IPCHEL 125 : SEGACT MCHELM 126 : MMODEL = IPMODE 127 : SEGACT MMODEL 128 : NBMAIL = KMODEL(/1) 129 : SEGACT MPOVA1 130 : * 131 : *--------------------------------------- 132 : *= Boucle sur les maillages elementaires 133 : *--------------------------------------- 134 : * 135 : ITELEM = 0 136 : SEGACT IPMAHY 137 : DO 90 IMAIL=1,NBMAIL 138 : IF (MAHYBR(IMAIL).EQ.0) GOTO 90 139 : * 140 : * Recuperation des informations issues du MODELE et du MCHAML 141 : * et du maillage sommet 142 : * 143 : IMODEL = KMODEL(IMAIL) 144 : SEGACT IMODEL 145 : IPT2 = IPGEOM 146 : IPT3 = IPGEOM 147 : IF(NBMAIL.GT.1) THEN 148 : SEGACT IPT3 149 : IPT2= IPT3.LISOUS(IMAIL) 150 : SEGDES IPT3 151 : ENDIF 152 : NEFHYB = NEFMOD 153 : NEF = NUMGEO(NEFHYB) 154 : SEGDES IMODEL 155 : * 156 : MELEME = MAHYBR(IMAIL) 157 : SEGACT MELEME 158 : NBDDL = NUM(/1) 159 : NBELEM = NUM(/2) 160 : SEGACT IPT2 161 : NBNN = IPT2.NUM(/1) 162 : * 163 : *- Récupération des fonctions de forme au centre de l'élément 164 : * 165 : SEGINI TRAV 165 : CALL RESHPT(1,NBNN,NEF,NEF,0,IPINTE,IRT1) 165 : CALL HYSHPT(NEFHYB,NBDDL,IPINTE,IPTHYB) 166 : MINTE = IPINTE 167 : SEGACT MINTE 168 : HYBSTO = IPTHYB 169 : SEGACT HYBSTO 170 : *----------------------------------------- 171 : *- Boucle sur les elements du sous domaine 172 : *----------------------------------------- 173 : MCHAML = ICHAML(IMAIL) 174 : SEGACT MCHAML 175 : MELVAL = IELVAL(1) 176 : SEGDES MCHAML 177 : SEGACT MELVAL 178 : NDIM = IDIM * (IDIM + 1) 179 : IGAU = 1 180 : DO 80 IEL=1,NBELEM 181 : ITELEM = ITELEM + 1 181 : CALL DOXE(XCOOR,IDIM,NBNN,IPT2.NUM,IEL,XE) 181 : CALL MHYBR3(IGAU,NBNN,NBDDL,NDIM,IDIM,IDIM,XE,HYBASE, 182 : S SHPTOT,SHY,SHP,ZJAC,DJAC) 183 : DO 70 IDDL=1,NBDDL 184 : DO 30 I=1,IDIM 185 : VECT(I) = 0.D0 186 : 30 CONTINUE 187 : DO 50 J=1,IDIM 188 : DO 40 I=1,IDIM 189 : VECT(I) = VECT(I) + ZJAC(I,J) * SHY(J,IDDL) 190 : 40 CONTINUE 191 : 50 CONTINUE 192 : QDDL = MPOVA1.VPOCHA(ICPR(NUM(IDDL,IEL)),1) 193 : ORIEN = VELCHE(IDDL,IEL) 194 : COEF = QDDL * ORIEN / ABS(DJAC) 195 : DO 60 I=1,IDIM 196 : VPOCHA(ITELEM,I) = VPOCHA(ITELEM,I) + COEF * VECT(I) 197 : 60 CONTINUE 198 : 70 CONTINUE 199 : 80 CONTINUE 200 : SEGSUP TRAV, HYBSTO, MINTE 201 : SEGDES MELVAL 202 : SEGDES MELEME, IPT2 203 : 90 CONTINUE 204 : SEGDES MPOVAL 205 : SEGDES MPOVA1, MCHELM, MMODEL, IPMAHY 206 : SEGSUP ICCPR 207 : * 208 : RETURN 209 : END 210 : 211 : 212 : 213 : 214 : 215 : 216 : 217 : 218 : 219 :
© Cast3M 2003 - All rights reserved.
Disclaimer