1 : C NORV5 SOURCE PV 09/03/12 21:29:49 6325 2 : SUBROUTINE NORV5(NFAC,MPOGRA,ICOEFF,MELVA1,MELEFL, 3 : & MLECEN,MLEFA,MPOCHP,MLENCL,MPOVCL, 4 : & MLENNE,MPOVNE,MLENMI,MPOVMI, 5 : & LOGBOR,LOGCCL,LOGCOE) 6 : C 7 : C************************************************************************ 8 : C 9 : C PROJET : CASTEM 2000 10 : C 11 : C NOM : NORV1 12 : C 13 : C DESCRIPTION : Appelle par NORV 14 : C 15 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 16 : C 17 : C AUTEUR : C. LE POTIER, DM2S/SFME/MTMS 18 : C 19 : C************************************************************************ 20 : C 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT real*8 (a-h,o-z) 23 : -INC SMLENTI 24 : -INC SMELEME 25 : -INC SMCHPOI 26 : -INC CCOPTIO 27 : -INC SMCOORD 28 : -INC SMLREEL 29 : POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME, 30 : & MELTFA.MELEME 31 : POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL, 32 : & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL, 33 : & MPOGRA.MPOVAL,MPOTEN.MPOVAL,MPOVNE.MPOVAL,MPOVMI.MPOVAL 34 : POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI, 35 : & MLEFA.MLENTI,MLENNE.MLENTI,MLENMI.MLENTI, 36 : & MLEFA2.MLENTI 37 : -INC SMCHAML 38 : INTEGER NBNN,NBREF 39 : 40 : 41 : 42 : C 43 : C**** Variables de COOPTIO 44 : C 45 : C 46 : C**** Variables de COOPTIO 47 : C 48 : INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 49 : & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 50 : & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 51 : & ,IECHO, IIMPI, IOSPI 52 : & ,IDIM 53 : C & ,MCOORD 54 : & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 55 : & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 56 : & ,NORINC,NORVAL,NORIND,NORVAD 57 : & ,NUCROU, IPSAUV 58 : 59 : C**** Variable de SMLENTI, SMCHPOI 60 : C 61 : INTEGER JG, N, NC, NSOUPO, NAT, NBSOUS, NBNO,NBELEM 62 : C 63 : C**** Les includes 64 : C 65 : INTEGER I1,ICOMP,ICOMGR,IGEOM 66 : & ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM 67 : & ,ISURF,IMAIL,ICHPO,ICHCL,ICHNE,ICHGRA,ICOEFF 68 : & ,NTOT,NSOMM,NCOMP,NFAC,NCEN 69 : & ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2 70 : & ,NLS1,NLS2,NLFCL 71 : & ,ISOUS,IELEM,INOEUD,ICELL 72 : INTEGER ICEN2 73 : REAL*8 SCNX,SCNY,SCNZ,SURF,VOL,VAL,VALX,VALY,XG,XD,XF,XS1,XS2 74 : & ,YG,YD,YF,YS1,YS2,PSCA,XNORM,VECX,VECY,PSCAGX,PSCAGY, 75 : & PSCADX,PSCADY,K11G,K22G,K21G,K11D,K22D,K21D,VXG1,VXG2, 76 : & VXAU,VYAU,VXD1,VXD2,VYG1,VYG2,TRG1,TRG2, 77 : & TRD1,TRD2,TRG,TRD 78 : REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2, 79 : & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,SCN1Z,VX,VY,COEF1X,COEF2X, 80 : & COEF1Y,COEF2Y,CX,CY,ANCX,ANCY,DIFFX,DIFFY,XLONGG,XLONGD 81 : & VALD,VALG,COEF,GX,GY,XMINK11,XMAXK11,XMINK22,XMAXK22 82 : & QIMPX,QIMPY,QIMPZ 83 : 84 : REAL*8 EPS 85 : INTEGER ICRIT 86 : CHARACTER*(4) NOMCOM(18),NOMCOM3(9) 87 : CHARACTER*8 TYPE 88 : INTEGER LOGBOR,LOGCOE,LOGCCL 89 : C 90 : DATA NOMCOM /'P1DX','P1DY', 91 : & 'P2DX','P2DY', 92 : & 'P3DX','P3DY', 93 : & 'P4DX','P4DY', 94 : & 'P5DX','P5DY', 95 : & 'P6DX','P6DY', 96 : & 'P7DX','P7DY', 97 : & 'P8DX','P8DY', 98 : & 'P9DX','P9DY'/ 99 : 100 : DATA NOMCOM3 /'P1DX','P1DY','P1DZ', 101 : & 'P2DX','P2DY','P2DZ', 102 : & 'P3DX','P3DY','P3DZ'/ 103 : 104 : 105 : MCHELM = ICOEFF 106 : SEGACT MCHELM 107 : NBSOUS=MCHELM.IMACHE(/1) 108 : 109 : 110 : IF (LOGBOR.EQ.0) THEN 111 : DO ISOUS=1,NBSOUS,1 112 : MELEME=MCHELM.IMACHE(ISOUS) 113 : MCHAM1=MCHELM.ICHAML(ISOUS) 114 : SEGACT MELEME 115 : SEGACT MCHAM1 116 : MELVA1=MCHAM1.IELVAL(1) 117 : SEGACT MELVA1 118 : C 119 : NBNN=MELEME.NUM(/1) 120 : NFAC=MELEME.NUM(/2) 121 : C 122 : DO IELEM = 1,NFAC 123 : NGF=MELEME.NUM(1,IELEM) 124 : NLCF=MLEFA.LECT(NGF) 125 : MPOGRA.VPOCHA(NLCF,1) = 0.D0 126 : NGCF=MELEFL.NUM(2,NLCF) 127 : DO IVOI=2,NBNN 128 : ICENT = MELEME.NUM(IVOI,IELEM) 129 : ICEN = MLECEN.LECT(ICENT) 130 : VAL = 0.0D0 131 : IF (ICEN.EQ.0) THEN 132 : c WRITE(6,*) 'INTERIEUR' 133 : c VAL = MPOCHP.VPOCHA(ICEN,1) 134 : c ELSE 135 : ICENL = MLENCL.LECT(ICENT) 136 : IF (ICENL.GT.0) THEN 137 : c WRITE(6,*) 'DIRICHLET' 138 : VAL = MPOVCL.VPOCHA(ICENL,1) 139 : c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENL,'VAL= ',VAL 140 : ELSE 141 : C CONDITIONS DE FLUX 142 : c WRITE(6,*) 'FLUX' 143 : ICENNE = MLENNE.LECT(ICENT) 144 : IF (ICENNE.GT.0) THEN 145 : QIMPX = MPOVNE.VPOCHA(ICENNE,1) 146 : VAL = (QIMPX) 147 : ELSE 148 : ICENMI = MLENMI.LECT(ICENT) 149 : IF (ICENMI .EQ.0) THEN 150 : WRITE(IOIMP,*) 151 : & 'PROBLEME DANS LES CONDITIONS AUX LIMITES' 152 : 153 : ELSE 154 : IND = MLEFA.LECT(ICENT) 155 : QIMPX = MPOVMI.VPOCHA(ICENMI,3) 156 : VAL = (QIMPX) 157 : 158 : ENDIF 159 : ENDIF 160 : ENDIF 161 : 162 : 163 : c WRITE(6,*) 'NLCF= ',NLCF,'VAL= ',VAL 164 : c WRITE(6,*) 'IVOI= ',IVOI,'MELEME= ', MELEME.NUM(IVOI,NLCF), 165 : c & 'COEF1 = ',COEF1 166 : 167 : COEF1 = MELVA1.VELCHE(IVOI,IELEM) 168 : MPOGRA.VPOCHA(NLCF,1)= MPOGRA.VPOCHA(NLCF,1) + 169 : & (COEF1 * VAL) 170 : ENDIF 171 : ENDDO 172 : c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',NGCF 173 : c WRITE(6,*) 'MPOGRA1= ', MPOGRA.VPOCHA(NLCF,1) 174 : c WRITE(6,*) 'MPOGRA2= ', MPOGRA.VPOCHA(NLCF,2) 175 : c WRITE(6,*) 'MPOGRA3= ', MPOGRA.VPOCHA(NLCF,3) 176 : c ENDIF 177 : ENDDO 178 : ENDDO 179 : 180 : C ON CONNAIT LES COEFFICIENTS : ON EN DEDUIT LE GRADIENT 181 : 182 : 183 : ELSEIF (LOGCOE.EQ.0) THEN 184 : DO ISOUS=1,NBSOUS,1 185 : MELEME=MCHELM.IMACHE(ISOUS) 186 : MCHAM1=MCHELM.ICHAML(ISOUS) 187 : SEGACT MELEME 188 : SEGACT MCHAM1 189 : MELVA1=MCHAM1.IELVAL(1) 190 : SEGACT MELVA1 191 : C 192 : NBNN=MELEME.NUM(/1) 193 : NFAC=MELEME.NUM(/2) 194 : C 195 : DO IELEM = 1,NFAC 196 : NGF=MELEME.NUM(1,IELEM) 197 : NLCF=MLEFA.LECT(NGF) 198 : MPOGRA.VPOCHA(NLCF,1) = 0.D0 199 : NGCF=MELEFL.NUM(2,NLCF) 200 : NGCG=MELEFL.NUM(1,NLCF) 201 : NGCD=MELEFL.NUM(3,NLCF) 202 : c IF (NGCG.EQ.NGCD) THEN 203 : DO IVOI=2,NBNN 204 : ICENT = MELEME.NUM(IVOI,IELEM) 205 : c WRITE(6,*) 'ISOUS= ',ISOUS 206 : c WRITE(6,*) 'IELEM= ',IELEM,'IVOI= ',IVOI 207 : c WRITE(6,*) 'ICENT= ',ICENT 208 : ICEN = MLECEN.LECT(ICENT) 209 : VAL = 0.0D0 210 : IF (ICEN.NE.0) THEN 211 : c WRITE(6,*) 'INTERIEUR' 212 : VAL = MPOCHP.VPOCHA(ICEN,1) 213 : ELSE 214 : ICENL = MLENCL.LECT(ICENT) 215 : c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENL 216 : IF (ICENL.GT.0) THEN 217 : c WRITE(6,*) 'DIRICHLET' 218 : VAL = MPOVCL.VPOCHA(ICENL,1) 219 : c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENL,'VAL= ',VAL 220 : ELSE 221 : C CONDITIONS DE FLUX 222 : c WRITE(6,*) 'FLUX' 223 : ICENNE = MLENNE.LECT(ICENT) 224 : IF (ICENNE.GT.0) THEN 225 : c WRITE(6,*) 'NLCF= ',NLCF,'SCN1X= ',SCN1X 226 : c WRITE(6,*) 'NLCF= ',NLCF,'SCN1Y= ',SCN1Y 227 : QIMPX = MPOVNE.VPOCHA(ICENNE,1) 228 : c WRITE(6,*) 'NLCF= ',NLCF,'QIMPX= ',QIMPX 229 : c WRITE(6,*) 'NLCF= ',NLCF,'QIMPY= ',QIMPY 230 : VAL = (QIMPX) 231 : c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENT,'VAL= ',VAL 232 : ELSE 233 : ICENMI = MLENMI.LECT(ICENT) 234 : IF (ICENMI .EQ.0) THEN 235 : WRITE(IOIMP,*) 236 : & 'PROBLEME DANS LES CONDITIONS AUX LIMITES' 237 : 238 : ELSE 239 : QIMPX = MPOVMI.VPOCHA(ICENMI,3) 240 : VAL = (QIMPX) 241 : 242 : ENDIF 243 : ENDIF 244 : ENDIF 245 : 246 : ENDIF 247 : 248 : c WRITE(6,*) 'NLCF= ',NLCF,'VAL= ',VAL 249 : c WRITE(6,*) 'IVOI= ',IVOI,'MELEME= ', MELEME.NUM(IVOI,NLCF), 250 : c & 'COEF1 = ',COEF1,'COEF2= ',COEF2,'COEF3= ',COEF3 251 : 252 : COEF1 = MELVA1.VELCHE(IVOI,IELEM) 253 : MPOGRA.VPOCHA(NLCF,1)= MPOGRA.VPOCHA(NLCF,1) + 254 : & (COEF1 * VAL) 255 : ENDDO 256 : C ENDIF 257 : c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',NGCF 258 : c WRITE(6,*) 'MPOGRA1= ', MPOGRA.VPOCHA(NLCF,1) 259 : c WRITE(6,*) 'MPOGRA2= ', MPOGRA.VPOCHA(NLCF,2) 260 : c WRITE(6,*) 'MPOGRA3= ', MPOGRA.VPOCHA(NLCF,3) 261 : ENDDO 262 : ENDDO 263 : ELSEIF (LOGCCL.EQ.0) THEN 264 : 265 : 266 : DO ISOUS=1,NBSOUS,1 267 : MELEME=MCHELM.IMACHE(ISOUS) 268 : MCHAM1=MCHELM.ICHAML(ISOUS) 269 : SEGACT MELEME 270 : SEGACT MCHAM1 271 : MELVA1=MCHAM1.IELVAL(1) 272 : SEGACT MELVA1 273 : C 274 : NBNN=MELEME.NUM(/1) 275 : NFAC=MELEME.NUM(/2) 276 : C 277 : DO IELEM = 1,NFAC 278 : NGF=MELEME.NUM(1,IELEM) 279 : NLCF=MLEFA.LECT(NGF) 280 : MPOGRA.VPOCHA(NLCF,1) = 0.D0 281 : NGCF=MELEFL.NUM(2,NLCF) 282 : NGCG=MELEFL.NUM(1,NLCF) 283 : NGCD=MELEFL.NUM(3,NLCF) 284 : IF (NGCG.EQ.NGCD) THEN 285 : DO IVOI=2,MELEME.NUM(/1) 286 : ICENT = MELEME.NUM(IVOI,IELEM) 287 : ICEN = MLECEN.LECT(ICENT) 288 : VAL = 0.0D0 289 : IF (ICEN.NE.0) THEN 290 : c WRITE(6,*) 'INTERIEUR' 291 : VAL = MPOCHP.VPOCHA(ICEN,1) 292 : ELSE 293 : ICENL = MLENCL.LECT(ICENT) 294 : c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENL 295 : IF (ICENL.GT.0) THEN 296 : c WRITE(6,*) 'DIRICHLET' 297 : VAL = MPOVCL.VPOCHA(ICENL,1) 298 : c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENL,'VAL= ',VAL 299 : ELSE 300 : C CONDITIONS DE FLUX 301 : c WRITE(6,*) 'FLUX' 302 : ICENNE = MLENNE.LECT(ICENT) 303 : IF (ICENNE.GT.0) THEN 304 : c WRITE(6,*) 'NLCF= ',NLCF,'SCN1X= ',SCN1X 305 : c WRITE(6,*) 'NLCF= ',NLCF,'SCN1Y= ',SCN1Y 306 : QIMPX = MPOVNE.VPOCHA(ICENNE,1) 307 : c WRITE(6,*) 'NLCF= ',NLCF,'QIMPX= ',QIMPX 308 : c WRITE(6,*) 'NLCF= ',NLCF,'QIMPY= ',QIMPY 309 : VAL = (QIMPX) 310 : c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENT,'VAL= ',VAL 311 : ELSE 312 : ICENMI = MLENMI.LECT(ICENT) 313 : IF (ICENMI .EQ.0) THEN 314 : WRITE(IOIMP,*) 315 : & 'PROBLEME DANS LES CONDITIONS AUX LIMITES' 316 : 317 : ELSE 318 : QIMPX = MPOVMI.VPOCHA(ICENMI,3) 319 : VAL = (QIMPX) 320 : 321 : ENDIF 322 : ENDIF 323 : ENDIF 324 : 325 : ENDIF 326 : 327 : c WRITE(6,*) 'NLCF= ',NLCF,'VAL= ',VAL 328 : c WRITE(6,*) 'IVOI= ',IVOI,'MELEME= ', MELEME.NUM(IVOI,NLCF), 329 : c & 'COEF1 = ',COEF1,'COEF2= ',COEF2,'COEF3= ',COEF3 330 : 331 : COEF1 = MELVA1.VELCHE(IVOI,IELEM) 332 : MPOGRA.VPOCHA(NLCF,1)= MPOGRA.VPOCHA(NLCF,1) + 333 : & (COEF1 * VAL) 334 : ENDDO 335 : ENDIF 336 : c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',NGCF 337 : c WRITE(6,*) 'MPOGRA1= ', MPOGRA.VPOCHA(NLCF,1) 338 : c WRITE(6,*) 'MPOGRA2= ', MPOGRA.VPOCHA(NLCF,2) 339 : c WRITE(6,*) 'MPOGRA3= ', MPOGRA.VPOCHA(NLCF,3) 340 : ENDDO 341 : ENDDO 342 : ENDIF 343 : SEGDES MCHAM1 344 : SEGDES MELVA1 345 : SEGDES MELEME 346 : SEGDES MCHELM 347 : SEGDES MPOGRA 348 : 349 : 350 : C 351 : 352 : 353 : 354 : 355 : RETURN 356 : END 357 : 358 : 359 : 360 : 361 : 362 : 363 : 364 : 365 : 366 : 367 : 368 :
© Cast3M 2003 - All rights reserved.
Disclaimer