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