1 : C TRJAV2 SOURCE CHAT 05/01/13 03:48:41 5004 2 : SUBROUTINE TRJAV2(IZVIT,IZPART,IZN3,IPART,TMIN,TMAX, 3 : * MELEME,IELTFA,IZCENT,IFACEL,DELTAT,IZSH) 4 : C 5 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 6 : C Issu du sp TRJAVA cas du calcul analytique 7 : C 8 : C FAIT AVANCER UNE PARTICULE ( COORDONNEES DE REFERENCES ) 9 : C JUSQU'A L'INSTANT TMAX OU A L'INSTANT DE SORTIE 10 : C IZVIT SEGMENT DECRIVANT LES VITESSES ( <--- TRJVIT TRJFLU) 11 : C IZPART POSITIONS INITIALES DES PARTICULES 12 : C IZN3 SEGMENT RESULTANT (AJUSTE ICI) 13 : C IPART NUMERO DE LA PARTICULE 14 : C TMIN INSTANT DE DEPART 15 : C TMAX INSTANT A NE PAS DEPASSER 16 : C 17 : C MELEME POINTEUR DU MAILLAGE 18 : C IELTFA POINTEUR DE DOMAINE.ELTFA 19 : C IZCENT POINTEUR DE DOMAINE.CENTRE 20 : C IFACEL POINTEUR DE DOMAINE.FACEL 21 : C DELTAT PAS DE TEMPS AVEC LEQUEL ON CONSERVE LES RESULTATS 22 : C 23 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 24 : C 25 : IMPLICIT INTEGER(I-N) 26 : IMPLICIT REAL*8 (A-H,O-Z) 27 : C 28 : -INC CCOPTIO 29 : -INC SMCOORD 30 : -INC SMELEME 31 : -INC SMCHPOI 32 : C 33 : POINTEUR IZCENT.MELEME,IELTFA.MELEME,IZFAC1.MELEME 34 : POINTEUR IFACEL.MELEME 35 : C 36 : SEGMENT IZPART 37 : INTEGER NLEPA(NPART),NUMPA(NPART) 38 : REAL*8 COORPA(NDIM,NPART) 39 : ENDSEGMENT 40 : C 41 : SEGMENT IZN3 42 : INTEGER NAPAR3(NPOS),NUM3(NPOS) 43 : REAL*8 CREF3(NDIM,NPOS),TPAR(NPOS) 44 : ENDSEGMENT 45 : C 46 : SEGMENT IZSH 47 : REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9) 48 : ENDSEGMENT 49 : C 50 : SEGMENT IZVIT 51 : REAL*8 TEMTRA(NVIPT) 52 : INTEGER IPUN(NBS),IDUN(NBS),IPVPT(NVIPT),IFORML 53 : ENDSEGMENT 54 : C IDUN(I) nombre d elements avant le sous maillage I 55 : C IPVPT pointeurs de izvpt pour chaque pas de temps 56 : SEGMENT IZVPT 57 : INTEGER IPUN1(NBS),IPUMAX 58 : ENDSEGMENT 59 : C 60 : SEGMENT IZUN 61 : REAL*8 UN(I1,I2,I3) 62 : ENDSEGMENT 63 : POINTEUR IZUN1.IZUN,IZUN2.IZUN 64 : C 65 : DIMENSION UELEM(3),XARI(3),XDEP(3),XINT(3) 66 : C 67 : C*** 68 : C 69 : NDIM=IDIM 70 : NPOS=50 71 : SEGINI IZN3 72 : SEGACT IZVIT 73 : IFORMU=IFORML 74 : IEL1=NLEPA(IPART) 75 : C 76 : DO 2 ID1=1,NDIM 77 : XDEP(ID1)=COORPA(ID1,IPART) 78 : 2 CONTINUE 79 : C 80 : ITER=2 81 : NAPAR3(1)=IEL1 82 : C 83 : DO 3 ID1=1,NDIM 84 : CREF3(ID1,1)=XDEP(ID1) 85 : 3 CONTINUE 86 : C 87 : TCOUR=TMIN 88 : TPAR(1)=TMIN 89 : NUAPAR=IEL1 90 : C 91 : SEGACT IELTFA,IZCENT,IFACEL 92 : SEGACT IZSH 93 : NVIPT=TEMTRA(/1) 94 : 1 CONTINUE 95 : C IVPT VAUT 1 EN PERMANENT 96 : IVPT=1 97 : C MELNEL PERMET D'AVOIR LE NUMERO DE L'ELEMENT DANS UN SOUS MAILLAGE 97 : CALL MELNEL(IEL1,MELEME,IPT1,NEL0,0) 98 : NOEL1=IPT1.NUM(/1) 99 : IELL=IEL1-NEL0 100 : C ON RECUPERE LES COORDONEES DES NOEUDS DE L'ELEMENT 100 : CALL DOXE(XCOOR,IDIM,NOEL1,IPT1.NUM,IELL,XYZL) 101 : ITY1=IPT1.ITYPEL 102 : TTEMP=TCOUR 103 : C ON ACTIVE LE SEGMENT DES FLUX AUX FACES 103 : CALL TRJVEL(IZVIT,IZUN,IEL1,IVPT,TTEMP) 104 : ITYG=NUMGEO(ITY1) 105 : C ON DETERMINE LA TRAJECTOIRE LE TEMPS DE PARCOURS ET LA FACE DE SORTIE 105 : CALL TRJMA2(XARI,XDEP,UN(1,1,IELL),DTINT,NDIM,ICONT 106 : * ,ITYG,IART,INOEU) 107 : 4 CONTINUE 108 : C 109 : C*** ON CALCULE LE JACOBIEN DE LA TRANSFORMATION EN XDEP 110 : C 110 : CALL DETJAC(XYZL,XDEP,ITY1,NDIM,NOEL1,IFORMU,SHP,DET) 111 : C 112 : C*** POUR LES ELEMENTS NON TRIANGULAIRE LE JACOBIEN N'EST PAS CONSTANT 113 : C 114 : IF(((ITYG-4)*(ITYG-23)).NE.0)THEN 115 : C 116 : C*** ON CALCULE PLUSIEURS JACOBIENS ET ON FAIT LA MOYENNE 117 : C 117 : CALL DETJAC(XYZL,XARI,ITY1,NDIM,NOEL1,IFORMU,SHP,DET1) 118 : DTS=DTINT/10 119 : DO 12 ID1=1,9 120 : C CETTE ROUTINE PEUT ETRE FUSIONNEE AVEC TRJLDC 120 : CALL TRJSAU(XINT,XDEP,UN(1,1,IELL),DTS,NDIM,ITYG) 120 : CALL DETJAC(XYZL,XINT,ITY1,NDIM,NOEL1,IFORMU,SHP,DETINT) 121 : DET=DET+2*DETINT 122 : DO 14 ID2=1,NDIM 123 : XDEP(ID2)=XINT(ID2) 124 : 14 CONTINUE 125 : 12 CONTINUE 126 : DET=(DET+DET1)/20 127 : ENDIF 128 : DT=DTINT*DET 129 : C 130 : C*** TRAITEMENT DES CAS PARTICULIERS 131 : C 132 : IF(INOEU.NE.0)THEN 133 : C 134 : C*** RATRAPAGE A UN NOEUD DU MAILLLAGE 135 : C 136 : TCOUR=TCOUR+DT 136 : CALL TRJRND(IZN3,IZVIT,MELEME,TCOUR,INOEU,IEL1,NDIM,ITER, 137 : * IEL2,XARI,DTINT,ICONT,INOEU) 138 : C INOEU=INOE 139 : IEL1=IEL2 140 : C CAS OU ON SORT PAR UN NOEUD EN BORD DE MAILLAGE 141 : IF(DTINT.EQ.0.D0)THEN 142 : DT=DTINT 143 : C ON VA EN 10 STOCKER LES RESULTATS ET ON SORT 144 : GOTO 10 145 : ENDIF 146 : GOTO 4 147 : C 148 : C*** RATRAPAGE A UNE ARETE 149 : C 150 : ELSEIF(IART.NE.0)THEN 151 : C 152 : C*** ON CHERCHE LES FACES QUI SE COUPENT EN FORMANT L'ARETE 153 : C 153 : CALL TRJARF(IART,NF1,NF2,ITYG) 154 : C ON CHOISIT UNE FACE AYANT UN FLUX SORTANT 155 : IF(UN(1,NF1,IELL).GT.0.D0)THEN 156 : ICONT=NF1 157 : GOTO 7 158 : ELSEIF(UN(1,NF2,IELL).GT.0.D0)THEN 159 : ICONT=NF2 160 : GOTO 7 161 : C 162 : C*** SINON ON EST EN BORD DE DOMAINE ON STOCKE LES RESULTATS EN 10 163 : C 164 : ELSE 165 : DT=0.D0 166 : GOTO 10 167 : ENDIF 168 : ENDIF 169 : C 170 : C************* RECHERCHE DES VOISINS ET SCKAGE DES RESULTATS********* 171 : C 172 : C*** LA PARTICULE SORT DE L'ELEMENT COURANT ON CHERCHE LE VOISIN 173 : C 174 : 7 CONTINUE 174 : CALL TRJIEL(IEL1,IEL2,ICONT,NF,IFACEL,IZCENT,IELTFA) 175 : C 176 : C*** SI ON EST EN BORD DE DOMAINE ON ARRETE LE CALCUL 177 : C 178 : IF(IEL2.EQ.0)GO TO 10 179 : C 180 : C*** ON ARRETE LE CALCUL PAR DEPASSEMENT DU TEMPS IMPOSE 181 : C 182 : IF((TMAX-TCOUR).LE.0.D0)GOTO 21 183 : C 184 : C*** ON N'EST PAS EN BORD DE DOMAINE ET ON A TROUVE UN VOISIN 185 : C 186 : C ON COMMENCE PAR LOCALISER LE NOUVEL ELEMENT 186 : CALL MELNEL(IEL2,MELEME,IPT2,NEL2,1) 187 : IELL2=IEL2-NEL2 188 : JTY=IPT2.ITYPEL 189 : C ON CHERCHE LA FACE COMMUNE ENTRE IEL1 ET IEL2 189 : CALL TRJFAC(IEL2,NF,JFA,IELTFA) 190 : IOR=1 190 : IF(NDIM.EQ.3)CALL TRJIOR(IELL,IELL2,IPT1,IPT2,ICONT,JFA,IOR) 191 : ITYG=NUMGEO(ITY1) 192 : JTYG=NUMGEO(JTY) 193 : C ON TRANSFORME LES COOR DE SORTIE DE IEL1 EN COOR D'ENTREE DANS IEL2 193 : CALL TRJTRJ(XDEP,XARI,ITYG,JTYG,JFA,ICONT,IOR) 194 : TCOUR=TCOUR+DT 195 : NUAPAR=IEL2 196 : 13 CONTINUE 197 : C 198 : C*** ON STOCKE LES RESULTATS 199 : C 200 : DO 22 ID1=1,NDIM 201 : CREF3(ID1,ITER)=XDEP(ID1) 202 : 22 CONTINUE 203 : TPAR(ITER)=TCOUR 204 : NAPAR3(ITER)=NUAPAR 205 : IEL1=NUAPAR 206 : IF ((NPOS-ITER).LE.1) THEN 207 : NPOS=NPOS+50 208 : SEGADJ IZN3 209 : ENDIF 210 : ITER=ITER+1 211 : C 212 : C*** ON RETOURNE EN 1 POUR ITERER LE PROCEDER AVEC UN NOUVEL ELEMENT 213 : C 214 : GO TO 1 215 : C 216 : C*** LA PARTICULE I EST SORTIE DU DOMAINE DE CALCUL 217 : C ON STOCKE LES RESULTATS ET ON SORT 218 : 10 CONTINUE 219 : DO 23 ID1=1,NDIM 220 : XDEP(ID1)=XARI(ID1) 221 : 23 CONTINUE 222 : TCOUR=TCOUR+DT 223 : NUAPAR=IEL1 224 : 21 CONTINUE 225 : DO 20 ID1=1,NDIM 226 : CREF3(ID1,ITER)=XDEP(ID1) 227 : 20 CONTINUE 228 : TPAR(ITER)=TCOUR 229 : NAPAR3(ITER)=NUAPAR 230 : NPOS=ITER 231 : SEGADJ IZN3 232 : C 233 : c 999 FORMAT('PARTICULE',I4,': PROBLEMES DANS LE COIN D''UN ELEMENT !!', 234 : c * 2I7 ) 235 : C 236 : END 237 : 238 :
© Cast3M 2003 - All rights reserved.
Disclaimer