1 : C DIVUFN SOURCE PV 09/03/12 21:19:22 6325 2 : SUBROUTINE DIVUFN(ICHP2,ICLIM,IPFACE,IFACEL,IRE1,IRE2,IPFONC) 3 : C----------------------------------------------------------------------- 4 : C----------------------------------------------------------------------- 5 : 6 : C----------------------------------------------------------------------- 7 : C Calcul d'un flux decentre. 8 : C Le CHAMPOINT résultat est de support FACE. 9 : C----------------------------------------------------------------------- 10 : C 11 : C--------------------------- 12 : C Parametres Entree/Sortie : 13 : C--------------------------- 14 : 15 : C E/ ICHP2 : CHPOIN DES VALEURS F(THETA) 16 : C E/ ICLIM : CHPOIN DES CONDITIONS AUX LIMITES IMPOSEES 17 : C E/ IPFACE : MELEME DES POINTS FACE 18 : C E/ IFACEL : MELEME DES POINTS FACE POUR LES C.L. 19 : C E/ IRE1 : Champoint de type FLUX 20 : C E/ IRE2 : Mchaml des orientation de normale (1=out,-1=in) 21 : C S/ IPFONC : CHAMPOIN RESULTAT DES F(\THETA) DECENTRE 22 : C 23 : C---------------------- 24 : C Tableaux de travail : 25 : C---------------------- 26 : C 27 : C 28 : C---------------------- 29 : C Variables en COMMON : 30 : C---------------------- 31 : C 32 : C IFOMOD : cf CCOPTIO.INC 33 : C 34 : C----------------------------------------------------------------------- 35 : C 36 : C Langage : ESOPE + FORTRAN77 37 : C 38 : C Auteurs : C. LE POTIER ET F. AURIOL 20/00 39 : C 40 : C----------------------------------------------------------------------- 41 : 42 : IMPLICIT INTEGER(I-N) 43 : IMPLICIT REAL*8 (A-H,O-Z) 44 : * 45 : -INC CCOPTIO 46 : -INC SMELEME 47 : -INC SMCHPOI 48 : -INC SMCHAML 49 : -INC SMCOORD 50 : * 51 : SEGMENT ICCPR 52 : INTEGER ICPR(NNGOT) 53 : ENDSEGMENT 54 : 55 : SEGMENT ICCPR1 56 : INTEGER ICPR1(NNGOT) 57 : ENDSEGMENT 58 : 59 : 60 : C 61 : C= INITIALISATIONS 62 : C 63 : MCHPO1 = IRE1 64 : MCHELM = IRE2 65 : IPT1 = IPFACE 66 : 67 : NNGOT = XCOOR(/1)/(IDIM+1) 68 : SEGINI ICCPR1 69 : 70 : * 71 : *= Creation des tableaux ICPR et INUI pour le maillage IPT1 des FACES 72 : * 73 : * WRITE(6,*) 'AVANT SEGACT' 74 : SEGACT IPT1 75 : * WRITE(6,*) 'ON A PASSE LE PREMER SEGACT' 76 : N2 = IPT1.NUM(/2) 77 : IK = 0 78 : DO 109 I2=1,N2 79 : K = IPT1.NUM(1,I2) 80 : IF (ICPR1(K).EQ.0) THEN 81 : IK = IK + 1 82 : ICPR1(K) = IK 83 : ENDIF 84 : 109 CONTINUE 85 : SEGDES IPT1 86 : 87 : * WRITE(6,*) 'APRES SEDDES IPT1' 88 : C 89 : C- Récupération du pointeur MPOVAL des flux 90 : C 91 : SEGACT MCHPO1 92 : MSOUP1 = MCHPO1.IPCHP(1) 93 : SEGACT MSOUP1 94 : MPOVA1 = MSOUP1.IPOVAL 95 : SEGDES MSOUP1 96 : SEGDES MCHPO1 97 : 98 : * WRITE(6,*) 'APRES RECUPERATION DU FLUX' 99 : C 100 : C DEFINITION DU CHPOIN RESULTAT 101 : C 102 : NAT=1 103 : NSOUPO=1 104 : SEGINI MCHPOI 105 : * WRITE(6,*) 'MCHPOI' 106 : IPFONC=MCHPOI 107 : IFOPOI = IFOMOD 108 : JATTRI(1)=2 109 : NC=1 110 : SEGINI MSOUPO 111 : * WRITE(6,*) 'MSOUPO' 112 : NOCOMP(1)='SCAL' 113 : IPCHP(1)=MSOUPO 114 : IGEOC=IPFACE 115 : IPT1=IPFACE 116 : SEGACT IPT1 117 : N=IPT1.NUM(/2) 118 : SEGINI MPOVAL 119 : IPOVAL=MPOVAL 120 : NOHARM(1)=NIFOUR 121 : * SEGDES MCHPOI 122 : * SEGDES MSOUPO 123 : * SEGDES IPT1 124 : * WRITE(6,*) 'DEFINITION DU CHAMPOIN' 125 : C 126 : IPT3=IFACEL 127 : SEGACT IPT3 128 : NBFACE=IPT3.NUM(/2) 129 : MCHPO2=ICHP2 130 : SEGACT MCHPO2 131 : MSOUP2=MCHPO2.IPCHP(1) 132 : SEGACT MSOUP2 133 : MPOVA2=MSOUP2.IPOVAL 134 : SEGACT MPOVA2 135 : NPCENT=MPOVA2.VPOCHA(/1) 136 : IPT2=MSOUP2.IGEOC 137 : SEGACT IPT2 138 : C On sait que le support de MCHPO2 est le maillage IPCENT (déja vérifié) 139 : NNGOT=XCOOR(/1)/(IDIM+1) 140 : SEGINI ICCPR 141 : DO 10 I=1,NPCENT 142 : K=IPT2.NUM(1,I) 143 : ICPR(K)=I 144 : 10 CONTINUE 145 : 146 : 147 : * WRITE(6,*) 'BOUCLE SUR LES ELEMENTS' 148 : C 149 : C------------------------------------------------ 150 : C= Boucle sur les ZONES ELEMENTAIRES du MCHAML 151 : C------------------------------------------------ 152 : C 153 : ITELEM = 0 154 : SEGACT MCHELM 155 : SEGACT MPOVA1 156 : NRIGEL = IMACHE(/1) 157 : DO 409 IRI=1,NRIGEL 158 : C 159 : C Recuperation du MELEME et activation 160 : C 161 : MELEME = IMACHE(IRI) 162 : SEGACT MELEME 163 : N1 = NUM(/1) 164 : N2 = NUM(/2) 165 : C 166 : C Récupération du pointeur MELVAL du MCHAML d'orientation 167 : C 168 : MCHAML = ICHAML(IRI) 169 : SEGACT MCHAML 170 : MELVAL = IELVAL(1) 171 : SEGDES MCHAML 172 : SEGACT MELVAL 173 : C 174 : C------------------------------ 175 : C= Boucle 30 sur les ELEMENTs. 176 : C------------------------------ 177 : C 178 : C CALCUL DE f(THETA) DECENTRE 179 : DO 309 I2=1,N2 180 : ITELEM = ITELEM + 1 181 : DO 209 IN=1,N1 182 : VALIN1 = MPOVA1.VPOCHA(ICPR1(NUM(IN,I2)),1)*VELCHE(IN,I2) 183 : IFACE = ICPR1(NUM(IN,I2)) 184 : IP = ICPR(IPT3.NUM(1,IFACE)) 185 : ID = ICPR(IPT3.NUM(3,IFACE)) 186 : * write(6,*) 'I2=',I2,'IP=',IP, 'ID=', ID 187 : IF (ID.EQ.I2) THEN 188 : ID = IP 189 : IP = I2 190 : ENDIF 191 : IF (VALIN1.LT.0) THEN 192 : VPOCHA(IFACE,1) = MPOVA2.VPOCHA(IP,1) 193 : ELSE 194 : VPOCHA(IFACE,1) = MPOVA2.VPOCHA(ID,1) 195 : ENDIF 196 : 209 CONTINUE 197 : 309 CONTINUE 198 : SEGDES MELVAL, MELEME 199 : 409 CONTINUE 200 : 201 : 202 : IF(ICLIM.NE.0)THEN 203 : MCHPO4=ICLIM 204 : SEGACT MCHPO4 205 : NSOUP4=MCHPO4.IPCHP(/1) 205 : CALL INITI(ICPR,NNGOT,0) 206 : IPT4=IPFACE 207 : DO 30 I=1,NBFACE 208 : K=IPT4.NUM(1,I) 209 : ICPR(K)=I 210 : 30 CONTINUE 211 : DO 40 I=1,NSOUP4 212 : MSOUP4=MCHPO4.IPCHP(I) 213 : SEGACT MSOUP4 214 : IPT5=MSOUP4.IGEOC 215 : MPOVA5=MSOUP4.IPOVAL 216 : SEGACT IPT5,MPOVA5 217 : NBP5=IPT5.NUM(/2) 218 : DO 50 J=1,NBP5 219 : NUMP=IPT5.NUM(1,J) 220 : VPOCHA(ICPR(NUMP),1)=MPOVA5.VPOCHA(J,1) 221 : 50 CONTINUE 222 : SEGDES IPT5,MPOVA5,MSOUP4 223 : 40 CONTINUE 224 : SEGDES MCHPO4,IPT2 225 : 226 : ENDIF 227 : 228 : 229 : SEGDES MCHELM 230 : SEGDES MPOVA1 231 : SEGDES MPOVAL 232 : 233 : SEGSUP ICCPR 234 : SEGSUP ICCPR1 235 : C 236 : RETURN 237 : END 238 : 239 : 240 : 241 :
© Cast3M 2003 - All rights reserved.
Disclaimer