1 : C TRJINI SOURCE CHAT 06/03/29 21:36:38 5360 2 : SUBROUTINE TRJINI(IZREF,IZCOU,IZLAC,MELEME,IZVIT,IZCENT,IELTFA, 3 : * IZSH,TMIN) 4 : C 5 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 6 : C 7 : C appelé par TRJPAR 8 : C appelle TRJPEL qui localise les particules dans le maillage general 9 : C Initialise le calcul des trajectoires 10 : C ICI ON CONSTRUIT IZREF ( COORDONNEES DE REFERENCES ) 11 : C IZCOU segment créé dans TRJCOU 12 : C IZLAC maillage constitué par la position initales des particules 13 : C MELEME maillage du domaine 14 : C IZVIT segment créé dans TRJVIT ou TRJFLU 15 : C IZCENT maillage des points centres de la table DOMAINE 16 : C IELTFA maillage des connectivitées faces elements ( cf DOMAINE) 17 : C 18 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 19 : C 20 : IMPLICIT INTEGER(I-N) 21 : IMPLICIT REAL*8 (A-H,O-Z) 22 : C 23 : -INC CCOPTIO 24 : -INC SMCOORD 25 : -INC SMELEME 26 : -INC SMCHPOI 27 : C 28 : POINTEUR IZLAC.MELEME,IZCENT.MELEME,IELTFA.MELEME 29 : SEGMENT IZPART 30 : INTEGER NLEPA(NPART),NUMPA(NPART) 31 : REAL*8 COORPA(NDIM,NPART) 32 : ENDSEGMENT 33 : POINTEUR IZREF.IZPART 34 : SEGMENT IZCOU 35 : REAL*8 DTCO(NEL),COU 36 : ENDSEGMENT 37 : SEGMENT IZSH 38 : REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9) 39 : ENDSEGMENT 40 : C 41 : SEGMENT IZVIT 42 : REAL*8 TEMTRA(NVIPT) 43 : INTEGER IPUN(NBS),IDUN(NBS),IPVPT(NVIPT),IFORML 44 : ENDSEGMENT 45 : C IDUN(I) nombre d elements avant le sous maillage I 46 : C IPVPT pointeurs de izvpt pour chaque pas de temps 47 : SEGMENT IZVPT 48 : INTEGER IPUN1(NBS),IPUMAX 49 : ENDSEGMENT 50 : SEGMENT IZUN 51 : REAL*8 UN(I1,I2,I3) 52 : ENDSEGMENT 53 : POINTEUR IZUN1.IZUN ,IZUN2.IZUN 54 : C 55 : SEGACT IZLAC 56 : NPART=IZLAC.NUM(/2) 57 : NDIM=IDIM 58 : SEGINI IZPART 59 : C write(6,*)' ini izpart ',izpart 60 : SEGINI IZREF 61 : C write(6,*)' ini izref ',izref 62 : DO 10 I=1,NPART 63 : IP=IZLAC.NUM(1,I) 64 : COORPA(1,I)=XCOOR((IP-1)*(IDIM+1)+1) 65 : COORPA(2,I)=XCOOR((IP-1)*(IDIM+1)+2) 66 : IF(IDIM.EQ.3) COORPA(3,I)=XCOOR((IP-1)*(IDIM+1)+3) 67 : NUMPA(I)=I 68 : 10 CONTINUE 69 : C 69 : CALL TRJPEL(IZPART,IZREF,MELEME,IZVIT,IZCOU,IZCENT,IELTFA,IZSH, 70 : * TMIN) 71 : IF(IERR.GT.0)RETURN 72 : C 73 : K=0 74 : DO 30 IPART=1,NPART 75 : C on ne conserve que les particules qui sont effectivement 76 : C dans le domaine (sinon on ecrit un message) 77 : IF(NLEPA(IPART).EQ.0) THEN 78 : INTERR(1)=IPART 79 : REAERR(3)=0.0 80 : DO 55 I=1,NDIM 81 : REAERR(I)=REAL(COORPA(I,IPART)) 82 : 55 CONTINUE 82 : CALL ERREUR(-299) 83 : ELSE 84 : K=K+1 85 : NLEPA(K)=NLEPA(IPART) 86 : IZREF.NLEPA(K)=IZREF.NLEPA(IPART) 87 : NUMPA(K)=NUMPA(IPART) 88 : IZREF.NUMPA(K)=IZREF.NUMPA(IPART) 89 : DO 20 I=1,NDIM 90 : COORPA(I,K)=COORPA(I,IPART) 91 : IZREF.COORPA(I,K)=IZREF.COORPA(I,IPART) 92 : 20 CONTINUE 93 : C write(6,*)' nlepa ',nlepa(k),numpa(k),(coorpa(i,k),i=1,ndim), 94 : C * (izref.coorpa(i,k),i=1,ndim) 95 : ENDIF 96 : 30 CONTINUE 97 : NPART=K 98 : SEGADJ IZREF 99 : C write(6,*)' adj izref ',izref 100 : C write(6,*)' sup izpart ',izpart 101 : SEGSUP IZPART 102 : SEGDES IZLAC 103 : RETURN 104 : C 105 : C 106 : END 107 : 108 : 109 : 110 :
© Cast3M 2003 - All rights reserved.
Disclaimer