1 : C VFSYM SOURCE LEPOTIER 09/10/12 21:15:20 6527 2 : C NORV SOURCE PV 07/11/23 21:18:24 5978 3 : SUBROUTINE VFSYM(IDOMA) 4 : C************************************************************************ 5 : C 6 : C PROJET : CASTEM 2000 7 : C 8 : C NOM : NORV (OPERATEUR GIBIANE) 9 : C 10 : C DESCANDRIPTION : Calcul du gradient d'un CHPOINT 2D de type CENTRE 11 : C Avec tenseur dispersif hétérogène 12 : C Référence : Discretization on unstructured grids for 13 : C inhomogenous, anisotropic media. Part 1:derivation of the 14 : C methods, 15 : C I AAVATSMARK, T. BARKVE, O BOE, AND T. MANNSETH 16 : C SIAM JCP, VOL 19, n0 5, pp 1700-1716, Septembre 1998 17 : C 18 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 19 : C 20 : C AUTEUR : C. LE POTIER, DM2S/SFME/MTMS 21 : C 22 : C************************************************************************ 23 : C 24 : C 25 : C************************************************************************ 26 : C 27 : C PHRASE D'APPEL (GIBIANE) : 28 : C 29 : C 30 : C RCHPO1 RCHELEM1 = 'PENT' 31 : C MCLE1 MCLE2 TABDO CHPO1 (MCLE6 CHPO3) (MCLE4 CHPO2) ; 32 : C 33 : C ou 34 : C 35 : C RCHPO1 = 'PENT' 36 : C MCLE1 MCLE2 TABDO CHPO1 (MCLE6 CHPO3) (MCL4 CHPO2) MCLE5 RCHELEM1 ; 37 : C 38 : C 39 : C Entrées: 40 : C 41 : C TABDO : Donnée de la table domaine; 42 : C 43 : C MCLE1 : type du champ par point CHPO1. Pour le moment, seul le type 44 : C 'FACE' est autorisé; 45 : C 46 : C MCLE2 : Traitement des éléments de bord et ordre de précision du 47 : C calcul de gradient . Options sont possibles : 'NORVEGE' 48 : C 49 : C 50 : C CHPO1 : Donnée du Champ par point de type MCLE1; 51 : C 52 : C MCLE6 : Donnée ou non de CHPO3 53 : C 'DISPDIF' si donnée, vide sinon 54 : C 55 : C CHPO3 : Donnée du Champ par point du tenseur de diffusion dispersion 56 : C 57 : C MCLE4 : Donnée ou non du CHPO2 58 : C 'TIMP' si donnée, vide sinon. 59 : C 60 : C CHPO2 : Donnée du Champ par point des conditions aux limites 61 : C 62 : C MCLE5 : Donnée ou non du RCHELEM1: 63 : C 'GRADGEO' si donnée, vide sinon. 64 : C 65 : C 66 : C E/S : 67 : C 68 : C RCHELEM1: Champ par élément des coefficients géométriques pour le 69 : C calcul du gradient (et du hessien) 70 : C (entrée si MCLE4 = 'GRADGEO', sinon sortie). 71 : C 72 : C 73 : C Sorties: 74 : C 75 : C RCHPO1 : Champ par point contenant le gradient de CHPO1 (toujours 76 : C calculé) ; 77 : C 78 : C************************************************************************ 79 : C 80 : C HISTORIQUE (Anomalies et modifications éventuelles) 81 : C 82 : C HISTORIQUE : Creé le 2/3/2001 83 : C HISTORIQUE : 11/02/2003 Ajout d'une option Neuman et d'une option MIXTE 84 : C : Prise en compte de plusieurs sous domaines, Optimisation 85 : C : des paramètres NBMAX,NBNN de manière à optimiser la place 86 : C : mémoire et le temps calcul 87 : C 88 : C************************************************************************ 89 : C 90 : C 91 : 92 : C 93 : C 94 : C 95 : IMPLICIT INTEGER(I-N) 96 : IMPLICIT REAL*8 (a-h,o-z) 97 : -INC CCOPTIO 98 : -INC SMCHPOI 99 : -INC SMLMOTS 100 : C 101 : C**** Variables de COOPTIO 102 : C 103 : INTEGER ICOND, IDOMA, IRET1, ICEN, IFACEL, IFACEP, ICELL, ISOMM 104 : & ,NBOPT, IOPPOS, IOPMET, IOPLIM 105 : & ,ICHPO, ICHGRA, IMCALP, ICOEFF 106 : & ,NBCOMP 107 : & ,ICHCL, ICHCLG, ICHHES, IFAC, INORM, IVOLUM, ISURF 108 : & ,NSOUPO, IMAIL, ISGLIM,IELTFA,ICHTE 109 : 110 : C 111 : CHARACTER*(8) MOT,MTYPR 112 : CHARACTER*(7) GRAD(2) 113 : REAL*8 XKT 114 : INTEGER LOGBOR,LOGCOE,LOGCCL 115 : DATA GRAD/'GRADGEO','GRADGCL'/ 116 : C 117 : C 118 : C**** Lecture du MELEME SPG des points CENTRE. 119 : C 119 : c CALL GIBTEM(XKT) 120 : c WRITE(6,*) 'PENT XKT=',XKT 120 : CALL LEKTAB(IDOMA,'CENTRE',ICEN) 121 : IF(IERR .NE. 0) GOTO 9999 122 : C 123 : C**** Lecture du MELEME SPG des points SOMMET 124 : C 124 : CALL LEKTAB(IDOMA,'SOMMET',ISOMM) 125 : IF(IERR .NE. 0) GOTO 9999 126 : C 127 : C**** Lecture du MELEME de connect. FACEL 128 : C 128 : CALL LEKTAB(IDOMA,'FACEL',IFACEL) 129 : IF(IERR .NE. 0) GOTO 9999 130 : C 131 : C**** Lecture du MELEME de connect. FACEP 132 : C 132 : CALL LEKTAB(IDOMA,'FACEP',IFACEP) 133 : IF(IERR .NE. 0) GOTO 9999 134 : C 135 : C**** Lecture du MELEME des points FACE 136 : C 136 : CALL LEKTAB(IDOMA,'FACE',IFAC) 137 : IF (IERR .NE. 0) GOTO 9999 138 : 139 : C 140 : C**** Lecture du MELEME de connect. IELTFA 141 : C 141 : CALL LEKTAB(IDOMA,'ELTFA',IELTFA) 142 : IF (IERR .NE. 0) GOTO 9999 143 : 144 : C 145 : C**** Lecture du MELEME MAILLAGE 146 : C 146 : CALL LEKTAB(IDOMA,'MAILLAGE',IMAIL) 147 : IF(IERR .NE. 0) GOTO 9999 148 : C 149 : C**** Lecture du CHPOINT contenant les normales aux faces 150 : C 150 : CALL LEKTAB(IDOMA,'XXNORMAF',INORM) 151 : IF (IERR .NE. 0) GOTO 9999 152 : C 153 : C 154 : C**** Lecture du CHPOINT contenant les surfaces 155 : C 155 : CALL LEKTAB(IDOMA,'XXSURFAC',ISURF) 156 : IF (IERR .NE. 0) GOTO 9999 157 : 158 : 159 : C 160 : C**** Lecture du CHPOINT dont on veut calculer le gradient! 161 : C 161 : CALL LIROBJ('CHPOINT ',ICHPO,1,IRET1) 162 : IF(IERR .NE. 0) GOTO 9999 163 : 164 : C**** Control du CHPOINT 165 : C 166 : MLMOTS=0 166 : CALL QUEPO1(ICHPO, ICEN, MLMOTS) 167 : IF (IERR .NE. 0) GOTO 9999 168 : C En sortie, MLMOTS contient le nom de composantes de ICHPO 169 : SEGACT MLMOTS 170 : NBCOMP = MLMOTS.MOTS(/2) 171 : SEGDES MLMOTS 172 : IF(NBCOMP .GT. 9)THEN 173 : C 174 : C******* Message d'erreur standard 175 : C -301 0 %m1:40 176 : C 177 : MOTERR(1:40) = 'NBCOMP > 9 ' 178 : WRITE(IOIMP,*) MOTERR(1:40) 178 : CALL ERREUR(22) 179 : GOTO 9999 180 : ENDIF 181 : 182 : C LECTURE DES TENSEURS DE DIFFUSIONS 183 : IRET1=0 183 : CALL LIRCHA(MOT,0,IRET1) 184 : IF(IERR .NE. 0) GOTO 9999 185 : IF(IRET1.NE.0)THEN 186 : IF(MOT .EQ. 'DISPDIF') THEN 186 : CALL LIROBJ('CHPOINT ',ICHTE,1,ICELL) 187 : MCHPOI = ICHTE 188 : SEGACT MCHPOI 189 : NSOUPO = MCHPOI.IPCHP(/1) 190 : IF(NSOUPO .EQ. 0) ICHTE=0 191 : SEGDES MCHPOI 192 : ELSE 193 : C 194 : C******* Je la remets dans la pile 195 : C 195 : CALL ECRCHA(MOT) 196 : ICHTE=0 197 : ENDIF 198 : ELSE 199 : ICHTE=0 200 : ENDIF 201 : C 202 : C**** Lecture du CHPOINT du conditions aux limites dirichlet(optionel) 203 : C 204 : IRET1=0 204 : CALL LIRCHA(MOT,0,IRET1) 205 : IF(IERR .NE. 0) GOTO 9999 206 : IF(IRET1.NE.0)THEN 207 : IF(MOT .EQ. 'TIMP') THEN 207 : CALL LIROBJ('CHPOINT ',ICHCL,1,ICELL) 208 : MCHPOI = ICHCL 209 : SEGACT MCHPOI 210 : NSOUPO = MCHPOI.IPCHP(/1) 211 : IF(NSOUPO .EQ. 0) ICHCL=0 212 : SEGDES MCHPOI 213 : ELSE 214 : C 215 : C******* Je la remets dans la pile 216 : C 216 : CALL ECRCHA(MOT) 217 : ICHCL=0 218 : ENDIF 219 : ELSE 220 : ICHCL=0 221 : ENDIF 222 : C**** Control du CHPOIT 223 : C N.B.: MLMOTS contient les composantes de ICHPO 224 : C 225 : IF(ICHCL .GT. 0)THEN 226 : ICELL = 0 226 : CALL QUEPO1(ICHCL, ICELL, MLMOTS) 227 : IF (IERR .NE. 0) GOTO 9999 228 : ENDIF 229 : C 230 : C 231 : C**** Lecture du CHPOINT du conditions aux limites Neuman (optionel) 232 : C 233 : IRET1=0 233 : CALL LIRCHA(MOT,0,IRET1) 234 : IF(IERR .NE. 0) GOTO 9999 235 : IF(IRET1.NE.0)THEN 236 : IF(MOT .EQ. 'QIMP') THEN 236 : CALL LIROBJ('CHPOINT ',ICHNE,1,ICELL) 237 : MCHPOI = ICHNE 238 : SEGACT MCHPOI 239 : NSOUPO = MCHPOI.IPCHP(/1) 240 : IF(NSOUPO .EQ. 0) ICHNE=0 241 : SEGDES MCHPOI 242 : ELSE 243 : C 244 : C******* Je la remets dans la pile 245 : C 245 : CALL ECRCHA(MOT) 246 : ICHNE=0 247 : ENDIF 248 : ELSE 249 : ICHNE=0 250 : ENDIF 251 : 252 : C 253 : C**** Lecture du CHPOINT du conditions aux limites mixtes (optionel) 254 : C 255 : IRET1=0 255 : CALL LIRCHA(MOT,0,IRET1) 256 : IF(IERR .NE. 0) GOTO 9999 257 : IF(IRET1.NE.0)THEN 258 : IF(MOT .EQ. 'MIXT') THEN 258 : CALL LIROBJ('CHPOINT ',ICHMI,1,ICELL) 259 : MCHPOI = ICHMI 260 : SEGACT MCHPOI 261 : NSOUPO = MCHPOI.IPCHP(/1) 262 : IF(NSOUPO .EQ. 0) ICHMI=0 263 : SEGDES MCHPOI 264 : ELSE 265 : C 266 : C******* Je la remets dans la pile 267 : C 267 : CALL ECRCHA(MOT) 268 : ICHMI=0 269 : ENDIF 270 : ELSE 271 : ICHMI=0 272 : ENDIF 273 : 274 : IRET1=0 275 : IOP = 0 275 : CALL LIRCHA(MOT,0,IRET1) 276 : IF(IERR .NE. 0) GOTO 9999 277 : IF(IRET1.NE.0)THEN 278 : IF ((MOT .EQ. 'UPWIND') 279 : & .OR.(MOT .EQ. 'CENTERED') 280 : & .OR.(MOT .EQ. 'UPWICENT')) THEN 281 : IF (MOT .EQ. 'UPWIND') THEN 282 : IOP = 1 283 : ELSEIF (MOT .EQ. 'CENTERED') THEN 284 : IOP = 2 285 : ELSEIF (MOT .EQ. 'UPWICENT') THEN 286 : IOP = 3 287 : ENDIF 287 : CALL LIROBJ('CHPOINT ',ICHCO,1,ICELL) 288 : MCHPOI = ICHCO 289 : SEGACT MCHPOI 290 : NSOUPO = MCHPOI.IPCHP(/1) 291 : IF(NSOUPO .EQ. 0) ICHCO=0 292 : SEGDES MCHPOI 293 : ELSE 294 : C 295 : C******* Je la remets dans la pile 296 : C 296 : CALL ECRCHA(MOT) 297 : ICHCO=0 298 : ENDIF 299 : ELSE 300 : ICHCO=0 301 : ENDIF 302 : C 303 : C**** Lecture du MCHAMLs qui contiennent les elements de matrice 304 : C pour le calcul du gradient et (eventuelment) de l'hessian 305 : C 306 : C Si MOT = 'GRADGEO', on a ces MCHAMLs; sinon il faut le calculer 307 : C 308 : LOGCOE = 1 309 : LOGCCL = 1 310 : LOGBOR = 1 310 : CALL LIRCHA(MOT,0,IRET1) 310 : c CALL LIRMOT(GRAD,2,ICELL,1) 311 : IF(IERR .NE. 0) GOTO 9999 312 : IF(IRET1 .EQ. 0)THEN 313 : LOGCOE = 1 314 : LOGCCL = 1 315 : LOGBOR = 1 316 : ELSEIF( (MOT .NE. 'GRADGEO') .AND. 317 : & (MOT .NE. 'GRADGCL') .AND. 318 : & (MOT .NE. 'GRADBOR')) THEN 318 : CALL ECRCHA(MOT) 319 : c IF(IERR .NE. 0) GOTO 9999 320 : LOGCOE = 1 321 : LOGCCL = 1 322 : LOGBOR = 1 323 : ELSEIF (MOT .EQ. 'GRADGEO') THEN 324 : LOGCOE = 0 324 : CALL LIROBJ('MCHAML ',ICOEFF,1,IRET1) 325 : c IF(IERR .NE. 0) GOTO 9999 326 : ELSEIF (MOT .EQ. 'GRADGCL') THEN 327 : LOGCCL = 0 327 : CALL LIROBJ('MCHAML ',ICOEFF,1,IRET1) 328 : c IF(IERR .NE. 0) GOTO 9999 329 : ELSEIF (MOT .EQ. 'GRADBOR') THEN 330 : LOGBOR = 0 330 : CALL LIROBJ('MCHAML ',ICOEFF,1,IRET1) 331 : ENDIF 332 : 333 : c IF(IERR .NE. 0)GOTO 9999 334 : c IF(ICELL .EQ. 1)THEN 335 : c LOGCOE = 0 335 : c CALL LIROBJ('MCHAML ',ICOEFF,1,IRET1) 336 : c IF(IERR .NE. 0) GOTO 9999 337 : c ELSEIF(ICELL .EQ. 2)THEN 338 : c LOGCL = 0 338 : c CALL LIROBJ('MCHAML ',ICOEFF,1,IRET1) 339 : c IF(IERR .NE. 0) GOTO 9999 340 : c ENDIF 341 : 342 : 343 : 344 : 345 : 345 : CALL VFSYM1(IOPPOS,ICEN,ISOMM,IFAC,IFACEL,IFACEP,IELTFA,IMAIL, 346 : & INORM,ISURF,ICHPO,ICHTE,ICHCL,ICHNE,ICHMI,ICHCO, 347 : & IOP,ICHGRA,MPOGRA,ICOEFF,LOGBOR,LOGCOE,LOGCCL) 348 : 349 : 350 : IF(IERR .NE. 0) GOTO 9999 351 : C 352 : C**** Ecriture de gradient, (hessian), (limiteur), 353 : C (MCHAMLs pour le calcul de gradient et/ou du hessian) 354 : C 355 : IF( (MOT .NE. 'GRADGEO') .AND. (MOT .NE.'GRADGCL') 356 : & .AND. (MOT .NE.'GRADBOR') ) THEN 356 : CALL ECROBJ('MCHAML',ICOEFF) 357 : IF(IERR .NE. 0) GOTO 9999 358 : ENDIF 358 : CALL ECROBJ('CHPOINT',ICHGRA) 359 : IF(IERR .NE. 0) GOTO 9999 360 : C 361 : SEGSUP MLMOTS 362 : C 363 : C**** Sortie du programme 364 : C 365 : 9999 CONTINUE 366 : C 367 : RETURN 368 : END 369 : 370 : 371 : 372 : 373 : 374 : 375 : 376 : 377 : 378 : 379 : 380 : 381 : 382 : 383 : 384 :
© Cast3M 2003 - All rights reserved.
Disclaimer