1 : C TOCONV SOURCE CHAT 09/10/09 21:25:31 6519 2 : SUBROUTINE TOCONV (IPTAB1) 3 : C 4 : C*********************************************************************** 5 : C 6 : C 7 : C FONCTION: 8 : C --------- 9 : C 10 : C en "0D/1D" sur des éléments de type POINT. 11 : C 12 : C 13 : C ENTREE : 14 : C ------- 15 : C 16 : C TAB1 : TABLE de pointeur IPTAB1 (soustype 'OPER_0D') 17 : C contenant les indices suivants : 18 : C 19 : C TAB1 . 'GEOINF' : TABLE des informations géométriques de soustype 20 : C 'GEOINF' (type ENTIER). 21 : C TAB1 . 'INCO' : TABLE de soustype 'INCO' contenant l'ensemble 22 : C des champs à l'itération précédant l'itération 23 : C courante (type ENTIER). 24 : C TAB1 . 'MULT1' : Valeurs du champ multiplicateur (type CHPOINT ou 25 : C MOT) (de support 'CELL') 26 : C TAB1 . 'FLUX' : Nom de la composante débit de masse (type MOT) 27 : C (doit être un indice de la table 'INCO'). 28 : C (de support 'JUNCTION' ou 'JULIQ') 29 : C TAB1 . 'OPTION' : Traitement centré ou décentré de l'opération 30 : C (type MOT = 'CENTRE' ou 'DECENTRE') 31 : C TAB1 . 'DUAL' : Nom de l'inconnue duale (doit être un indice de 32 : C la table de soustype 'INCO') (type MOT). 33 : C (de support 'CELL') 34 : C (TAB1 . 'PRIMAL'): Nom de l'inconnue primale (doit être un indice 35 : C de la table de soustype 'INCO') 36 : C (type MOT) (indice facultatif). 37 : C (de support 'CELL') 38 : C 39 : C 40 : C RESULTAT : 41 : C --------- 42 : C 43 : C TAB1 . 'LHS' : Matrice élémentaire associée à l'opération 44 : C (type RIGIDITE). 45 : C 46 : C AUTEUR, DATE DE CREATION: 47 : C ------------------------- 48 : C 49 : C Laurent DADA décembre 1996 50 : C 51 : C 52 : C LANGAGE: 53 : C -------- 54 : C 55 : C ESOPE + FORTRAN77 56 : C 57 : C 58 : C SUBROUTINES APPELEES : 59 : C --------------------- 60 : C 61 : C TCONVC, TCONVD 62 : C 63 : C*********************************************************************** 64 : C 65 : C Variables internes : 66 : C ------------------- 67 : C 68 : C MPOVA1 : pointeur sur MPOVAL du CHPO MULT1 69 : C MPOVA2 : pointeur sur MPOVAL du CHPO FLUX 70 : C IPTJUN : pointeur sur maillage JUNCTION ou JULIQ 71 : C IPTD1 : pointeur sur maillage DUAL 72 : C IPTP1 : pointeur sur maillage PRIMAL 73 : C IPJUCE : pointeur sur maillage des connectivités JUNCTION/CELL 74 : C NOMDU1 : nom de l'inconnue DUAL 75 : C NOMPR1 : nom de l'inconnue PRIMAL 76 : C NOMFL1 : nom de l'inconnue FLUX 77 : C 78 : C*********************************************************************** 79 : C 80 : IMPLICIT INTEGER(I-N) 81 : IMPLICIT REAL*8 (A-H,O-Z) 82 : C 83 : -INC CCOPTIO 84 : -INC SMTABLE 85 : -INC SMCHPOI 86 : -INC SMELEME 87 : POINTEUR IPTD1.MELEME,IPTJUN.MELEME,IPJUCE.MELEME 88 : -INC SMRIGID 89 : 90 : C 91 : CHARACTER*8 TYPE,MOTI,MOT1,NOMPR1,NOMDU1,NOSUP1,NOSUD1,NOMMU1 92 : CHARACTER*8 NOMFL1,NOSUF1,NOOPT1,JCEL 93 : LOGICAL LPRIMA 94 : C 95 : C Lecture de la table GEOINF dans la table OPER_0D 96 : C 97 : TYPE = 'TABLE ' 97 : CALL ACMO (IPTAB1,'GEOINF',TYPE,IPTABG) 98 : IF (IERR.NE.0) RETURN 99 : C 100 : MOTI = 'SOUSTYPE' 100 : CALL ACMM (IPTABG,MOTI,MOT1) 101 : IF (IERR.NE.0) RETURN 102 : IF (MOT1(1:6).NE.'GEOINF') THEN 103 : MOTERR(1:8) = 'GEOINF ' 104 : MOTERR(9:16) = 'GEOINF ' 104 : CALL ERREUR (790) 105 : RETURN 106 : ENDIF 107 : C 108 : C Lecture de la table INCO dans la table OPER_0D 109 : C 110 : TYPE = 'TABLE ' 110 : CALL ACMO (IPTAB1,'INCO',TYPE,IPTAB2) 111 : IF (IERR.NE.0) RETURN 112 : C 113 : MOTI = 'SOUSTYPE' 113 : CALL ACMM (IPTAB2,MOTI,MOT1) 114 : IF (IERR.NE.0) RETURN 115 : IF (MOT1(1:4).NE.'INCO') THEN 116 : MOTERR(1:8) = 'INCO ' 117 : MOTERR(9:16) = 'INCO ' 117 : CALL ERREUR (790) 118 : RETURN 119 : ENDIF 120 : C 121 : C Lecture de la table SUPPORT dans la table INCO 122 : C 123 : TYPE = 'TABLE ' 123 : CALL ACMO (IPTAB2,'SUPPORT',TYPE,IPTABS) 124 : IF (IERR.NE.0) RETURN 125 : C 126 : C Récupération du CHPOINT multiplicateur 127 : C 128 : TYPE = ' ' 128 : CALL ACMO (IPTAB1,'MULT1',TYPE,IPR1) 129 : IF (IERR.NE.0) RETURN 130 : IF (TYPE.EQ.'MOT ') THEN 130 : CALL ACMM (IPTAB1,'MULT1',NOMMU1) 131 : IF (IERR.NE.0) RETURN 132 : C récupération du CHPOINT multiplicateur dans la table INCO 133 : TYPE = 'CHPOINT ' 133 : CALL ACMO (IPTAB2,NOMMU1,TYPE,IPCH1) 134 : IF (IERR.NE.0) RETURN 135 : ELSEIF (TYPE.EQ.'CHPOINT ') THEN 136 : IPCH1 = IPR1 137 : ELSE 138 : MOTERR(1:8) = 'MULT1 ' 139 : MOTERR(9:16) = TYPE 139 : CALL ERREUR (787) 140 : RETURN 141 : ENDIF 142 : C 143 : C Test du CHPOINT multiplicateur 144 : C 145 : MCHPOI = IPCH1 146 : SEGACT MCHPOI 147 : MSOUPO = IPCHP(1) 148 : SEGDES MCHPOI 149 : SEGACT MSOUPO 150 : NC = NOHARM(/1) 151 : IF (NC.NE.1) THEN 152 : MOTERR(1:8) = 'MULT1 ' 153 : MOTERR(9:16) = 'CHPOINT ' 153 : CALL ERREUR (784) 154 : SEGDES MSOUPO 155 : RETURN 156 : ENDIF 157 : IPT1 = IGEOC 158 : MPOVA1 = IPOVAL 159 : SEGDES MSOUPO 160 : C 161 : C Lecture de la composante FLUX 162 : C 163 : TYPE = ' ' 163 : CALL ACMO (IPTAB1,'FLUX',TYPE,IFLU1) 164 : IF (TYPE.EQ.'MOT ') THEN 164 : CALL ACMM (IPTAB1,'FLUX',NOMFL1) 165 : IF (IERR.NE.0) RETURN 166 : ELSE 167 : MOTERR(1:8) = 'FLUX ' 168 : MOTERR(9:16) = TYPE 168 : CALL ERREUR (787) 169 : RETURN 170 : ENDIF 171 : C 172 : C Lecture de l'inconnue DUAL 173 : C 174 : TYPE = ' ' 174 : CALL ACMO (IPTAB1,'DUAL',TYPE,IDU1) 175 : IF (TYPE.EQ.'MOT ') THEN 175 : CALL ACMM (IPTAB1,'DUAL',NOMDU1) 176 : IF (IERR.NE.0) RETURN 177 : ELSE 178 : MOTERR(1:8) = 'DUAL ' 179 : MOTERR(9:16) = TYPE 179 : CALL ERREUR (787) 180 : RETURN 181 : ENDIF 182 : C 183 : C Lecture éventuelle de l'inconnue PRIMAL 184 : C 185 : NOMPR1 = ' ' 186 : LPRIMA = .FALSE. 187 : TYPE = ' ' 187 : CALL ACMO (IPTAB1,'PRIMAL',TYPE,IPR1) 188 : IF (TYPE.EQ.'MOT ') THEN 189 : LPRIMA = .TRUE. 189 : CALL ACMM (IPTAB1,'PRIMAL',NOMPR1) 190 : IF (IERR.NE.0) RETURN 191 : ENDIF 192 : C 193 : C Lecture du nom du support de la composante FLUX 194 : C Arrêt si différent de 'JUNCTION' ou de 'JULIQ' 195 : C Lecture du MAILLAGE de l'inconnue FLUX 196 : C Lecture des valeurs CHPOINT de composante FLUX 197 : C 197 : CALL ACMM (IPTABS,NOMFL1,NOSUF1) 198 : IF (IERR.NE.0) RETURN 199 : IF (NOSUF1.EQ.'JUNCTION') THEN 200 : JCEL = 'JUNCEL ' 201 : ELSEIF (NOSUF1.EQ.'JULIQ ') THEN 202 : JCEL = 'JULCEL ' 203 : ELSE 204 : MOTERR(1:8) = 'FLUX ' 205 : MOTERR(9:16) = 'CHPOINT ' 205 : CALL ERREUR (788) 206 : RETURN 207 : ENDIF 208 : C 209 : C TYPE = 'MAILLAGE' 209 : C CALL ACMO (IPTABG,NOSUF1,TYPE,IPTJUN) 210 : C IF (IERR.NE.0) RETURN 211 : C 212 : TYPE = 'CHPOINT ' 212 : CALL ACMO (IPTAB2,NOMFL1,TYPE,IPCH2) 213 : IF (IERR.NE.0) RETURN 214 : MCHPOI = IPCH2 215 : SEGACT MCHPOI 216 : MSOUPO = IPCHP(1) 217 : SEGDES MCHPOI 218 : SEGACT MSOUPO 219 : IPTJUN = IGEOC 220 : MPOVA2 = IPOVAL 221 : SEGDES MSOUPO 222 : C 223 : C Lecture du nom du support de l'inconnue DUAL 224 : C Lecture du MAILLAGE de l'inconnue DUAL 225 : C 225 : CALL ACMM (IPTABS,NOMDU1,NOSUD1) 226 : IF (IERR.NE.0) RETURN 227 : C 228 : TYPE = 'MAILLAGE' 228 : CALL ACMO (IPTABG,NOSUD1,TYPE,IPTD1) 229 : IF (IERR.NE.0) RETURN 230 : C 231 : C Lecture éventuelle du nom du support de l'inconnue PRIMAL 232 : C 233 : NOSUP1 = ' ' 234 : IF (LPRIMA) THEN 234 : CALL ACMM (IPTABS,NOMPR1,NOSUP1) 235 : IF (IERR.NE.0) RETURN 236 : C 237 : TYPE = 'MAILLAGE' 237 : CALL ACMO (IPTABG,NOSUP1,TYPE,IPTP1) 238 : IF (IERR.NE.0) RETURN 239 : ENDIF 240 : C 241 : C Lecture du MAILLAGE des connectivités JCEL de la table GEOINF 242 : C Arrêt si les éléments ne sont pas des SEG3 243 : C 244 : TYPE = 'MAILLAGE' 244 : CALL ACMO (IPTABG,JCEL,TYPE,IPJUCE) 245 : IF (IERR.NE.0) RETURN 246 : SEGACT IPJUCE 247 : IF ((IPJUCE.ITYPEL).NE.3) THEN 248 : MOTERR(1:8) = JCEL(1:8) 249 : MOTERR(9:16) = 'MAILLAGE' 249 : CALL ERREUR (787) 250 : SEGDES IPJUCE 251 : RETURN 252 : ENDIF 253 : SEGDES IPJUCE 254 : C 255 : C Lecture de l'option centrée ou décentrée 256 : C 257 : TYPE = ' ' 257 : CALL ACMO (IPTAB1,'OPTION',TYPE,IOP1) 258 : IF (TYPE.EQ.'MOT ') THEN 258 : CALL ACMM (IPTAB1,'OPTION',NOOPT1) 259 : IF (IERR.NE.0) RETURN 260 : ELSE 261 : MOTERR(1:8) = 'OPTION ' 262 : MOTERR(9:16) = TYPE 262 : CALL ERREUR (787) 263 : RETURN 264 : ENDIF 265 : C 266 : C Calcul de la RIGIDITE 267 : C 268 : IF (NOOPT1.EQ.'CENTRE') THEN 268 : CALL TCONVC (MRIGID,LPRIMA,IPTD1,NOMPR1,NOMDU1,IPJUCE, 269 : & MPOVA1,IPT1,IPTP1,MPOVA2,NOMFL1,IPTJUN, 270 : & NOSUP1,NOSUD1) 271 : ELSEIF (NOOPT1.EQ.'DECENTRE') THEN 272 : C Arrêt si supports DUAL et PRIMAL différents de 'CELL' 273 : IF (NOSUD1.NE.'CELL') THEN 274 : MOTERR(1:8) = 'DUAL ' 275 : MOTERR(9:16) = 'CHPOINT ' 275 : CALL ERREUR (788) 276 : RETURN 277 : ENDIF 278 : IF (LPRIMA) THEN 279 : IF (NOSUP1.NE.'CELL') THEN 280 : MOTERR(1:8) = 'PRIMAL ' 281 : MOTERR(9:16) = 'CHPOINT ' 281 : CALL ERREUR (788) 282 : RETURN 283 : ENDIF 284 : ENDIF 285 : C 285 : CALL TCONVD (MRIGID,IPTD1,LPRIMA,NOMPR1,NOMDU1,IPJUCE,MPOVA1, 286 : &IPT1,IPTJUN,MPOVA2) 287 : ELSE 288 : MOTERR(1:8) = 'OPTION ' 289 : MOTERR(9:16) = NOOPT1 289 : CALL ERREUR (787) 290 : RETURN 291 : ENDIF 292 : C 293 : C Ecriture du résultat 294 : C 295 : TYPE = 'RIGIDITE' 295 : CALL ECMO (IPTAB1,'LHS',TYPE,MRIGID) 296 : IF (IERR.NE.0) RETURN 297 : C 298 : END 299 : 300 : 301 : 302 : 303 : 304 : 305 : 306 : 307 :
© Cast3M 2003 - All rights reserved.
Disclaimer