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