1 : C PENT15 SOURCE CHAT 05/01/13 02:12:12 5004 2 : SUBROUTINE PENT15(IDOMA,IOP2,IOP3) 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : PENT15 8 : C 9 : C DESCRIPTION : Appellé par PENT 10 : C 11 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 12 : C 13 : C AUTEUR : A. BECCANTINI, R. MOREL, DRN/DMT/SEMT/LTMF 14 : C 15 : C************************************************************************ 16 : C 17 : C 18 : C PHRASE D'APPEL (GIBIANE) : 19 : C 20 : C 21 : C RCHPO1 RCHPO2 RCHELEM1 = 'PENT' 22 : C MCLE1 MCLE2 MCLE3 TABDO LMOT CHPO1 (MCLE4 CHPO2) ; 23 : C 24 : C ou 25 : C 26 : C RCHPO1 RCHPO2 = 'PENT' 27 : C MCLE1 MCLE2 MCLE3 TABDO LMOT CHPO1 (MCL4 CHPO2) 'GRADGEO' RCHELEM1 ; 28 : C 29 : C 30 : C Entrées: 31 : C 32 : C TABDO : Donnée de la table domaine; 33 : C 34 : C MCLE1 : type du champ par point CHPO1. Pour le moment, seul le type 35 : C 'CENTRE' est autorisé; 36 : C 37 : C MCLE2 : Traitement des éléments de bord et ordre de précision du 38 : C calcul de gradient . Options sont possibles : 'BORDNULL', 39 : C 'EULESCAL', 'EULEVECT', 'LINEXACT', 'QUADRATI' 40 : C 41 : C MCLE3 : Calcul ou non du limiteur : 'LIMITEUR' ou 'NOLIMITE'; 42 : C 43 : C LMOT : noms de composantes du chpoint 44 : C 45 : C CHPO1 : Donnée du Champ par point de type MCLE1; 46 : C 47 : C MCLE4 : Donnée ou non du CHPO2 48 : C 'CLIM' si donnée, vide sinon. 49 : C 50 : C CHPO2 : Donnée du Champ par point des conditions aux limites 51 : C 52 : C 53 : C 54 : C E/S : 55 : C 56 : C RCHELEM1: Champ par élément des coefficients géométriques pour le 57 : C calcul du gradient 58 : C (entrée si MCLE4 = 'GRADGEO', sinon sortie). 59 : C 60 : C 61 : C Sorties: 62 : C 63 : C RCHPO1 : Champ par point contenant le gradient de CHPO1 (toujours 64 : C calculé) ; 65 : C 66 : C RCHPO2 : Champ par point contenant le limiteur du gradient 67 : C (toujours calculé) ; 68 : C 69 : C 70 : C************************************************************************ 71 : C 72 : C HISTORIQUE (Anomalies et modifications éventuelles) 73 : C 74 : C HISTORIQUE : Recreé le 22/3/2000 75 : C 76 : C************************************************************************ 77 : C 78 : C 79 : IMPLICIT INTEGER(I-N) 80 : -INC CCOPTIO 81 : -INC SMCHPOI 82 : -INC SMLMOTS 83 : C 84 : C 85 : C**** Variables de COOPTIO 86 : C 87 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 88 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 89 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 90 : C & ,IECHO, IIMPI, IOSPI 91 : C & ,IDIM 92 : C & ,MCOORD 93 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 94 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 95 : C & ,NORINC,NORVAL,NORIND,NORVAD 96 : C & ,NUCROU, IPSAUV, IFICLE, IPREFI 97 : C & ,IREFOR, ISAFOR 98 : C 99 : INTEGER IDOMA, IRET1, ICEN, IFACEL, IELTFA 100 : & ,IOP2, IOP3 101 : & ,ICHPO, ICHGRA, IMCALP 102 : & ,NBCOMP 103 : & ,ICHCL, IFAC, INORM 104 : & ,NSOUPO, ICELL, LMOT, JGM, JGN, ICHAM 105 : 106 : C 107 : CHARACTER*(8) MOT 108 : C 109 : MOT=' ' 110 : C 111 : C************************************************* 112 : C**** TABLE DOMAINE **************************** 113 : C************************************************* 114 : C 115 : C**** Lecture du MELEME SPG des points CENTRE. 116 : C 116 : CALL LEKTAB(IDOMA,'CENTRE',ICEN) 117 : IF(IERR .NE. 0) GO TO 9999 118 : C 119 : C**** Lecture du MELEME de connect. FACEL 120 : C 120 : CALL LEKTAB(IDOMA,'FACEL',IFACEL) 121 : IF(IERR .NE. 0) GO TO 9999 122 : C 123 : C**** Lecture du MELEME de connect. ELTFA 124 : C 124 : CALL LEKTAB(IDOMA,'ELTFA',IELTFA) 125 : IF(IERR .NE. 0) GO TO 9999 126 : C 127 : C**** Lecture du MELEME de connect. FACEL 128 : C 128 : CALL LEKTAB(IDOMA,'FACE',IFAC) 129 : IF(IERR .NE. 0) GO TO 9999 130 : C 131 : C**** Lecture du MELEME de connect. FACEL 132 : C 132 : CALL LEKTAB(IDOMA,'XXNORMAF',INORM) 133 : IF(IERR .NE. 0) GO TO 9999 134 : JGN=4 135 : JGM=IDIM 136 : SEGINI MLMOT1 137 : MLMOT1.MOTS(1)='UX ' 138 : MLMOT1.MOTS(2)='UY ' 139 : IF(IDIM.EQ.3) MLMOT1.MOTS(3)='UZ ' 139 : CALL QUEPO1(INORM, IFAC, MLMOT1) 140 : IF (IERR .NE. 0) GOTO 9999 141 : SEGSUP MLMOT1 142 : C 143 : C**************************************************** 144 : C 145 : C 146 : C**** Lecture des noms des composantes du CHPOINT 147 : C 147 : CALL LIROBJ('LISTMOTS',LMOT,1,IRET1) 148 : IF(IERR .NE. 0) GOTO 9999 149 : C 150 : C**** Lecture du CHPOINT dont on veut calculer le gradient! 151 : C 151 : CALL LIROBJ('CHPOINT ',ICHPO,1,IRET1) 152 : IF(IERR .NE. 0) GOTO 9999 153 : C 154 : C**** Control du CHPOINT 155 : C 155 : CALL QUEPO1(ICHPO, ICEN, LMOT) 156 : IF (IERR .NE. 0) GOTO 9999 157 : C 158 : MLMOTS=LMOT 159 : SEGACT MLMOTS 160 : NBCOMP = MLMOTS.MOTS(/2) 161 : SEGDES MLMOTS 162 : IF(NBCOMP .GT. 9)THEN 163 : C 164 : C******* Message d'erreur standard 165 : C -301 0 %m1:40 166 : C 167 : MOTERR(1:40) = 'NBCOMP > 9 ' 168 : WRITE(IOIMP,*) MOTERR(1:40) 168 : CALL ERREUR(22) 169 : GOTO 9999 170 : ENDIF 171 : C 172 : C**** Lecture du CHPOINT du conditions aux limites (optionel) 173 : C 174 : IRET1=0 174 : CALL LIRCHA(MOT,0,IRET1) 175 : IF(IERR .NE. 0) GOTO 9999 176 : IF(IRET1.NE.0)THEN 177 : IF(MOT .EQ. 'CLIM') THEN 177 : CALL LIROBJ('CHPOINT ',ICHCL,1,ICELL) 178 : IF(IERR .NE. 0) GOTO 9999 179 : MCHPOI = ICHCL 180 : SEGACT MCHPOI 181 : NSOUPO = MCHPOI.IPCHP(/1) 182 : IF(NSOUPO .EQ. 0) ICHCL=0 183 : SEGDES MCHPOI 184 : ELSE 185 : C 186 : C******* Je la remets dans la pile 187 : C 187 : CALL ECRCHA(MOT) 188 : IF(IERR .NE. 0) GOTO 9999 189 : ICHCL=0 190 : ENDIF 191 : ELSE 192 : ICHCL=0 193 : ENDIF 194 : C 195 : C**** Control du CHPOIT 196 : C N.B.: MLMOTS contient les composantes de ICHPO 197 : C 198 : IF(ICHCL .GT. 0)THEN 199 : ICELL = 0 199 : CALL QUEPO1(ICHCL, ICELL, MLMOTS) 200 : IF (IERR .NE. 0) GOTO 9999 201 : ENDIF 202 : C 203 : C**** Lecture du MCHAMLs qui contiennent les elements de matrice 204 : C pour le calcul du gradient 205 : C 206 : C Si MOT = 'GRADGEO', on a ces MCHAMLs; sinon il faut le calculer 207 : C 207 : CALL LIRCHA(MOT,0,IRET1) 208 : IF(IERR .NE. 0) GOTO 9999 209 : C 210 : C******* IOP2 1 2 211 : C 'EULESCAL','EULEVECT' 212 : C 213 : IF(MOT .NE. 'GRADGEO') THEN 214 : IF (IOP2.LE.3) THEN 214 : C CALL GRADGE(IDOMA,IOP2,ICHCL,MCHEL7) 214 : CALL GRADGE(ICEN,IELTFA,IFAC,IFACEL,INORM,ICHCL,ICHAM) 215 : IF (IERR .NE. 0) GOTO 9999 216 : ELSE 216 : CALL ERREUR(5) 217 : GOTO 9999 218 : ENDIF 219 : ELSE 219 : CALL LIROBJ('MCHAML ',ICHAM,1,IRET1) 220 : IF (IERR .NE. 0) GOTO 9999 221 : ENDIF 222 : C 223 : C**** Calcul de gradient 224 : C 224 : CALL PENTE1(ICEN,IFAC,IFACEL,INORM,IOP2,IOP3,ICHAM,ICHPO, 225 : & ICHCL,ICHGRA,IMCALP) 226 : C 227 : C**** Anomalie in PENTE1 228 : C 229 : IF(IERR .NE. 0) GOTO 9999 230 : C 231 : C**** Ecriture de gradient, limiteur, 232 : C (MCHAMLs pour le calcul de gradient) 233 : C 234 : IF(MOT .NE. 'GRADGEO') THEN 234 : CALL ECROBJ('MCHAML',ICHAM) 235 : IF(IERR .NE. 0) GOTO 9999 236 : ENDIF 237 : IF(IERR .NE. 0) GOTO 9999 237 : CALL ECROBJ ('CHPOINT',IMCALP) 238 : IF(IERR .NE. 0) GOTO 9999 239 : C 239 : CALL ECROBJ('CHPOINT',ICHGRA) 240 : IF(IERR .NE. 0) GOTO 9999 241 : C 242 : C**** Sortie du programme 243 : C 244 : 9999 CONTINUE 245 : C 246 : RETURN 247 : END 248 : 249 : 250 : 251 : 252 : 253 : 254 : 255 : 256 : 257 : 258 : 259 : 260 : 261 : 262 :
© Cast3M 2003 - All rights reserved.
Disclaimer