1 : C TRJAPF SOURCE CHAT 05/01/13 03:48:32 5004 2 : SUBROUTINE TRJAPF(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL, 3 : * INOELO,IZPART,IZUN,IZCOU,ITP,IFORML,IZSH) 4 : C 5 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 6 : C 7 : C LORSQU UNE PARTICULE EST LACHEE SUR UNE FACE DU MAILLAGE 8 : C GEOMETRIQUE ON DETERMINE SI ELLE EST OU NON DANS L ELEMENT IEL1 9 : C 10 : C IZUN VITESSE OU FLUX 11 : C 12 : C IAPAR(1,IPART) NO DE L ELEMENT AUQUEL APPARTIENT LA PARTICULE 13 : C IAPAR(2,IPART) NO DE LA FACE 3D A LAQUELLE APPARTIENT LA PARTICULE 14 : C IAPAR(3,IPART) NO DE L ARETE A LAQUELLE APPARTIENT LA PARTICULE 15 : C IAPAR(4,IPART) NO DU NOEUD AUQUEL APPARTIENT LA PARTICULE 16 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 17 : C 18 : C 19 : IMPLICIT INTEGER(I-N) 20 : IMPLICIT REAL*8 (A-H,O-Z) 21 : C 22 : -INC CCOPTIO 23 : C 24 : C 25 : SEGMENT IZPART 26 : INTEGER NLEPA(NPART),NUMPA(NPART) 27 : REAL*8 COORPA(NDIM,NPART) 28 : ENDSEGMENT 29 : SEGMENT IZCOU 30 : REAL*8 DTCO(NEL),COU 31 : ENDSEGMENT 32 : C 33 : SEGMENT IZSH 34 : REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9) 35 : ENDSEGMENT 36 : C 37 : SEGMENT IZTRAV 38 : REAL*8 COOR(NDIM,NPART) 39 : ENDSEGMENT 40 : SEGMENT IZNOEU 41 : REAL*8 XELE(IDIM,NOEL) 42 : INTEGER NOEGLO(NOEL) 43 : ENDSEGMENT 44 : SEGMENT IZAPAR 45 : INTEGER IAPAR(4,NPART) 46 : ENDSEGMENT 47 : SEGMENT IZUN 48 : REAL*8 UN(I1,I2,I3) 49 : ENDSEGMENT 50 : C 51 : C 52 : DIMENSION XYREF(3),ZXY(3),UELEM(3) 53 : DIMENSION TLJ(4) 54 : C 55 : C 56 : NDIM=COORPA(/1) 57 : IF(IFORML.EQ.1)THEN 58 : C FORMULATION ELEMENTS FINIS ON DEPLACE UN PEUT LA PARTICULE 59 : C POUR VOIR SI RESTERA DANS CET ELEMENT 60 : COUR=0.001D0 60 : CALL TRJVLO(IZNOEU,IZUN,IZTRAV,ITP,UELEM,IPART,IEL,IZSH) 61 : DO 6 ID=1,NDIM 62 : COOR(ID,IPART)=COORPA(ID,IPART)+ 63 : * UELEM(ID)*DTCO(IEL1)*COUR 64 : C write(6,*)' coor', COOR(ID,IPART),COORPA(ID,IPART), 65 : C * UELEM(ID),DTCO(IEL1),COUR 66 : 6 CONTINUE 66 : CALL INITI(IAPAR(1,IPART),4,0) 67 : C*** TRIANGLES 68 : C 69 : IF(ITP.EQ.4.OR.ITP.EQ.6.OR.ITP.EQ.7)THEN 69 : CALL TRJTRI(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1, 70 : * INOELO,TLJ) 71 : C 72 : C*** QUADRANGLES 73 : C 74 : ELSEIF(ITP.EQ.8.OR.ITP.EQ.11)THEN 74 : CALL TRJQUA(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1, 75 : * INOELO,TLJ) 76 : C*** PRISMES 77 : C 78 : ELSEIF(ITP.EQ.16)THEN 78 : CALL TRJPRI(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL, 79 : * INOELO,TLJ,ITRI) 80 : C 81 : C*** CUBES 82 : C 83 : ELSEIF(ITP.EQ.14)THEN 83 : CALL TRJCUB(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL, 84 : * INOELO,TLJ) 85 : C 86 : C*** TETRAEDRE 87 : C 88 : ELSEIF(ITP.EQ.23)THEN 88 : CALL TRJTET(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL, 89 : * INOELO,TLJ) 90 : ELSE 90 : CALL ERREUR(16) 91 : ENDIF 92 : C 93 : ELSEIF(IFORML.EQ.2)THEN 94 : C FORMULATION HYBRIDE LA PARTICULE SERA DANS CET ELEMENT 95 : C SI LE FLUX EST NEGATIF POUR LA FACE CONSIDEREE 96 : NF=IAPAR(3,IPART) 97 : IF(NDIM.EQ.3)NF=IAPAR(2,IPART) 98 : IF(UN(1,NF,IEL).LE.0)THEN 99 : NPAPAR=NPAPAR+1 100 : ELSE 100 : CALL INITI(IAPAR(1,IPART),4,0) 101 : ENDIF 102 : C write(6,*)'trjapf ',iel,nf,UN(1,NF,IEL),coorpa(1,ipart), 103 : C * coorpa(2,ipart) 104 : ENDIF 105 : DO 28 ID=1,NDIM 106 : COOR(ID,IPART)=COORPA(ID,IPART) 107 : 28 CONTINUE 108 : RETURN 109 : END 110 : 111 :
© Cast3M 2003 - All rights reserved.
Disclaimer