1 : C TRAJEC SOURCE CHAT 11/03/16 21:32:36 6902 2 : SUBROUTINE TRAJEC 3 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4 : C 5 : C CE SOUS PROGRAMME GERE L'OPERATEUR TRAJ DE CALCUL DE TRAJECTOIRES 6 : C ( cf Rapport DMT/94/707) 7 : C 8 : C Appelé par PILOT 9 : C lit les données CHPOIN des vitesses ou des flux 10 : C ou tables transitoires 11 : C MODELE ou TABLE domaine 12 : C TABLE de lacher 13 : C appelle : TRJCN1 et TRJCN3 qui controlent les données 14 : C : TRJFLU et TRJVIT qui preparent les données relatives 15 : C au flux ou à la vitesse. 16 : C : TRJPAR qui décode la table de lacher et 17 : C pilote le calcul 18 : C 19 : C Auteur : F Auriol 20 : C 21 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8 (A-H,O-Z) 24 : -INC SMTABLE 25 : -INC SMELEME 26 : -INC SMCHPOI 27 : -INC SMLREEL 28 : -INC CCOPTIO 29 : -INC SMCHAML 30 : -INC SMMODEL 31 : CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR 32 : POINTEUR IZLAC.MELEME,IELTFA.MELEME,IZCENT.MELEME,IFACEL.MELEME 33 : POINTEUR IZFACE.MELEME 34 : POINTEUR MTABTR.MTABLE 35 : CHARACTER*20 MOCAL(3) 36 : SEGMENT IZVIT 37 : REAL*8 TEMTRA(NVIPT) 38 : INTEGER IPUN(NBS),IDUN(NBS),IPVPT(NVIPT),IFORML 39 : ENDSEGMENT 40 : C IDUN(I) nombre d elements avant le sous maillage I 41 : C IPVPT pointeurs de izvpt pour chaque pas de temps 42 : SEGMENT IZVPT 43 : INTEGER IPUN1(NBS),IPUMAX 44 : ENDSEGMENT 45 : SEGMENT IZUN 46 : REAL*8 UN(I1,I2,I3) 47 : ENDSEGMENT 48 : POINTEUR IZUN1.IZUN ,IZUN2.IZUN 49 : SEGMENT IZUMAX 50 : REAL*8 UMAX(NBREL) 51 : ENDSEGMENT 52 : DATA MOCAL/'CONVECTION_EXPLICITE','CONVECTION_ANALYTIQU', 53 : * 'CONVECTION_DIFFUSION'/ 54 : C 55 : IRETOU=0 56 : 57 : C LECTURE DU TYPE DE CALCUL 58 : IRAN=0 58 : CALL LIRMOT(MOCAL,3,IRAN,0) 59 : IICAL=IRAN 60 : IF(IRAN.EQ.0)IICAL=1 61 : 62 : C LA VITESSE 62 : CALL LIROBJ('CHPOINT',MCHPOI,0,IRETOU) 63 : IF(IRETOU.NE.0)THEN 64 : IPTVIT=MCHPOI 65 : ITR=1 66 : SEGACT MCHPOI 67 : NSOUPO=IPCHP(/1) 68 : IF(NSOUPO.NE.1)THEN 68 : CALL ERREUR(21) 69 : RETURN 70 : ENDIF 71 : MSOUPO=IPCHP(1) 72 : SEGACT MSOUPO 73 : C ON VA TESTER LE NOM DES COMPOSANTES POUR DETERMINER 74 : C LA FORMULATION : ELEM FINIS OU MIXTE HYBRIDES 75 : IF(IIMPI.GT.0) WRITE(IOIMP,*)NOCOMP(1) 76 : IF(NOCOMP(1).EQ.'FLUX')THEN 77 : IFORMU=2 78 : IF(IIMPI.GT.0)WRITE(IOIMP,*)' FORMULATION HYBRIDE ' 79 : ELSEIF(NOCOMP(1).EQ.'VX ' )THEN 80 : IFORMU=1 81 : IF(IIMPI.GT.0) 82 : * WRITE(IOIMP,*)' FORMULATION ELEMENTS FINIS ',NOCOMP(2) 83 : IF(NOCOMP(2).NE.'VY ')THEN 84 : MOTERR(1:4)=NOCOMP(2) 84 : CALL ERREUR(197) 85 : RETURN 86 : ENDIF 87 : ELSE 88 : MOTERR(1:4)=NOCOMP(1) 88 : CALL ERREUR(197) 89 : RETURN 90 : ENDIF 91 : ELSE 91 : CALL LIRTAB('DARCY_TRANSITOIRE',MTABTR,0,IRETOU) 92 : IF (IRETOU.NE.0)THEN 93 : ITR=3 94 : IFORMU=2 95 : IPTVIT=MTABTR 96 : ELSE 96 : CALL LIRTAB('TRANSITOIRE',MTABTR,1,IRETOU) 97 : IF (IRETOU.EQ.0)RETURN 98 : ITR=3 99 : IFORMU=1 100 : IPTVIT=MTABTR 101 : ENDIF 102 : ENDIF 103 : 104 : C MODELE OU TABLE DOMAINE 105 : C LE TYPE DU MODELE EST TESTE DANS LEKMOD 106 : IRETOU=0 107 : MTAB1=0 108 : MCHELM=0 108 : CALL LIROBJ('MMODEL',IPMODE,0,IRET) 109 : IF(IRET.NE.0)THEN 109 : CALL LEKMOD(IPMODE,MTAB1,INEFMD) 110 : ELSE 110 : CALL LIRTAB('DOMAINE',MTAB1,1,IRETOU) 111 : IF(IRETOU.EQ.0)THEN 112 : MOTERR(1:40)=' ' 113 : MOTERR(1:8)='MODELE ' 114 : MOTERR(9:16) =' TABLE' 115 : MOTERR(17:24)='_DOMAINE' 115 : CALL ERREUR(471) 116 : RETURN 117 : ENDIF 118 : ENDIF 119 : 120 : C LECTURE DES MCHAML 121 : IZPOR=0 122 : IZDIFF=0 123 : IZDISP=0 124 : 20 CONTINUE 124 : CALL LIRCHA(CHARI(1:4),0,IRET) 125 : IF(IRET.NE.0)THEN 126 : IF(CHARI(1:4).EQ.'PORO')THEN 126 : CALL LIROBJ('MCHAML ',IRET1,1,IRET2) 127 : IF(IRET2.EQ.0)THEN 128 : MOTERR(1:8)='PORO ' 129 : MOTERR(9:16)='MCHAML ' 129 : CALL ERREUR(929) 130 : RETURN 131 : ENDIF 132 : IZPOR=IRET1 133 : GO TO 20 134 : ELSEIF(CHARI(1:4).EQ.'DISP')THEN 134 : CALL LIROBJ('MCHAML ',IRET1,1,IRET2) 135 : IF(IRET2.EQ.0)THEN 136 : MOTERR(1:8)='DISP ' 137 : MOTERR(9:16)='MCHAML ' 137 : CALL ERREUR(929) 138 : RETURN 139 : ENDIF 140 : IZDISP=IRET1 141 : IICAL=3 142 : GO TO 20 143 : ELSEIF(CHARI(1:4).EQ.'DIFF')THEN 143 : CALL LIROBJ('MCHAML ',IRET1,1,IRET2) 144 : IF(IRET2.EQ.0)THEN 145 : MOTERR(1:8)='DIFF ' 146 : MOTERR(9:16)='MCHAML ' 146 : CALL ERREUR(929) 147 : RETURN 148 : ENDIF 149 : IZDIFF=IRET1 150 : IICAL=3 151 : GO TO 20 152 : ENDIF 153 : ENDIF 154 : 155 : C LE MAILLAGE 156 : SEGACT MTAB1 157 : IRETR=0 158 : CHARI='MAILLAGE' 158 : CALL LEKTAB(MTAB1,CHARI,IRETR) 159 : MELEME=IRETR 160 : 160 : CALL TRJCN1(MELEME) 161 : IF(IERR.NE.0)RETURN 162 : SEGACT MELEME 163 : C ON RECUPERE LE MAILLAGE DES POINTS CENTRES 164 : IRETR=0 164 : CALL LEKTAB(MTAB1,'CENTRE',IRETR) 165 : IZCENT=IRETR 166 : C ON RECUPERE LE MAILLAGE DES FACES PAR ELEMENTS 167 : IRETR=0 167 : CALL LEKTAB(MTAB1,'ELTFA',IRETR) 168 : IELTFA=IRETR 169 : C ON RECUPERE LE LAISONS FACES CENTRES 170 : IRETR=0 170 : CALL LEKTAB(MTAB1,'FACEL',IRETR) 171 : IFACEL=IRETR 172 : C controle de la coherence vitesse maillage 173 : MCHPO1=MCHPOI 174 : IF(IFORMU.EQ.1)THEN 175 : NCC=IDIM 176 : IF(ITR.NE.3)THEN 176 : CALL TRJCN3(MCHPO1,MELEME,NCC) 177 : ELSE 178 : IVALI=1 179 : XVALI=0.D0 180 : IRETI=0 181 : IVALR=0 182 : XVALR=0.D0 183 : MTYPI='MOT' 184 : CHARR=' ' 185 : MTYPR='TABLE' 185 : CALL ACCTAB(IPTVIT,MTYPI,IVALI,XVALI,'VITESSE',.TRUE., 186 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 187 : MTABFT=IRETR 187 : CALL TRJCN6(MTABFT,MELEME,NCC) 188 : ENDIF 189 : IF(IERR.NE.0)RETURN 189 : CALL TRJVIT(IPTVIT,ITR,MELEME,IZVIT) 190 : IF(IERR.NE.0)RETURN 191 : ELSEIF(IFORMU.EQ.2)THEN 192 : C ON RECUPERE LE MAILLAGE FACES 193 : IVALI=0 194 : XVALI=0.D0 195 : IRETI=0 196 : IVALR=0 197 : XVALR=0.D0 198 : IRETR=0 199 : MTYPI='MOT ' 200 : MTYPR='MAILLAGE' 201 : CHARR='MAILLAGE' 201 : CALL LEKTAB(MTAB1,'FACE',IRETR) 202 : IZFACE=IRETR 203 : NCC=1 204 : SEGACT IZFACE 205 : IF(ITR.NE.3)THEN 205 : CALL TRJCN3(MCHPO1,IZFACE,NCC) 206 : ELSE 207 : IVALI=1 208 : XVALI=0.D0 209 : IRETI=0 210 : IVALR=0 211 : XVALR=0.D0 212 : MTYPI='MOT' 213 : CHARR=' ' 214 : MTYPR='TABLE' 214 : CALL ACCTAB(IPTVIT,MTYPI,IVALI,XVALI,'FLUX',.TRUE., 215 : * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 216 : MTABFT=IRETR 216 : CALL TRJCN6(MTABFT,IZFACE,NCC) 217 : ENDIF 218 : SEGDES IZFACE 219 : IF(IERR.NE.0)RETURN 219 : CALL LEKTAB(MTAB1,'XXNORMAE',MCHELM) 220 : IF(IERR.NE.0)RETURN 220 : CALL TRJFLU(IPTVIT,ITR,MCHELM,IELTFA,MELEME,IZVIT) 221 : IF(IERR.NE.0)RETURN 222 : ENDIF 223 : 224 : C LA TABLE DE LACHER 224 : CALL LIROBJ('TABLE',MTAB2,1,IRETOU) 225 : IF(IRETOU.EQ.0)RETURN 226 : 227 : C ON CREE LA PILE RESULTAT 227 : CALL CRTABL(MTAB3) 228 : C 229 : IERR=0 229 : CALL TRJPAR(MELEME,IZVIT,IZCENT,IELTFA,IFACEL,MTAB2,IICAL,IZPOR, 230 : * IZDIFF,IZDISP,MCHEL1,MMODE1 ) 231 : IF(IERR.NE.0)RETURN 232 : 233 : SEGDES IZCENT,IFACEL 234 : NBS=IELTFA.LISOUS(/1) 235 : IF(NBS.NE.0)THEN 236 : DO 81 I=1,NBS 237 : IPT1=IELTFA.LISOUS(I) 238 : SEGDES IPT1 239 : 81 CONTINUE 240 : ENDIF 241 : SEGDES IELTFA 242 : NBS=LISOUS(/1) 243 : IF(NBS.NE.0)THEN 244 : DO 83 I=1,NBS 245 : IPT1=LISOUS(I) 246 : SEGDES IPT1 247 : 83 CONTINUE 248 : ENDIF 249 : SEGDES MELEME 250 : SEGDES MTAB2 251 : SEGDES MTAB1 252 : IF(IERR.NE.0)RETURN 253 : SEGACT IZVIT 254 : NBS=IPUN(/1) 255 : DO 80 I=1,NBS 256 : IZUN=IPUN(I) 257 : SEGSUP IZUN 258 : 80 CONTINUE 259 : NVIPT= IPVPT(/1) 260 : DO 85 J=1,NVIPT 261 : IZVPT=IPVPT(J) 262 : SEGACT IZVPT 263 : DO 82 I=1,NBS 264 : IZUN1=IPUN1(I) 265 : IF(IZUN1.NE.0)SEGSUP IZUN1 266 : 82 CONTINUE 267 : IZUMAX=IPUMAX 268 : SEGSUP IZUMAX 269 : SEGSUP IZVPT 270 : 85 CONTINUE 271 : SEGSUP IZVIT 272 : 273 : C ON SAUVEGARDE LES RESULTATS 273 : CALL ECROBJ('MCHAML ',MCHEL1) 273 : CALL ECROBJ('MMODEL ',MMODE1) 274 : SEGDES MCHEL1,MMODE1 275 : 276 : RETURN 277 : END 278 : 279 : 280 : 281 : 282 :
© Cast3M 2003 - All rights reserved.
Disclaimer