Sources Esope | Cast3M

trjini
C TRJINI    SOURCE    CB215821  23/01/25    21:15:37     11573          
      SUBROUTINE TRJINI(IZREF,IZCOU,IZLAC,MELEME,IZVIT,IZCENT,IELTFA,
     * IZSH,TMIN)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C    appelé par TRJPAR
C    appelle TRJPEL qui localise les particules dans le maillage general
C     Initialise le calcul des trajectoires
C     ICI ON CONSTRUIT  IZREF ( COORDONNEES DE REFERENCES )
C     IZCOU  segment créé dans TRJCOU
C     IZLAC maillage constitué par la position initales des particules
C     MELEME maillage du domaine
C     IZVIT segment créé dans TRJVIT ou TRJFLU
C     IZCENT maillage des points centres de la table DOMAINE
C     IELTFA  maillage des connectivitées faces elements ( cf DOMAINE)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMELEME
-INC SMCHPOI
C
      POINTEUR IZLAC.MELEME,IZCENT.MELEME,IELTFA.MELEME
      SEGMENT IZPART
           INTEGER NLEPA(NPART),NUMPA(NPART)
           REAL*8  COORPA(NDIM,NPART)
      ENDSEGMENT
      POINTEUR IZREF.IZPART
      SEGMENT  IZCOU
           REAL*8 DTCO(NEL),COU
      ENDSEGMENT
      SEGMENT IZSH
            REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
      ENDSEGMENT
C
      SEGMENT IZVIT
           REAL*8 TEMTRA(NVIPT)
           INTEGER IPUN(NBS),IDUN(NBS),IPVPT(NVIPT),IFORML
      ENDSEGMENT
C             IDUN(I) nombre d elements avant le sous maillage I
C             IPVPT  pointeurs de izvpt pour chaque pas de temps
      SEGMENT IZVPT
           INTEGER IPUN1(NBS),IPUMAX
      ENDSEGMENT
      SEGMENT IZUN
           REAL*8 UN(I1,I2,I3)
      ENDSEGMENT
      POINTEUR IZUN1.IZUN ,IZUN2.IZUN
C
      SEGACT IZLAC
      NPART=IZLAC.NUM(/2)
      NDIM=IDIM
      SEGINI IZPART
C      write(6,*)' ini izpart ',izpart
      SEGINI IZREF
C      write(6,*)' ini izref ',izref
      SEGACT,MCOORD
      DO 10 I=1,NPART
        IP=IZLAC.NUM(1,I)
        COORPA(1,I)=XCOOR((IP-1)*(IDIM+1)+1)
        COORPA(2,I)=XCOOR((IP-1)*(IDIM+1)+2)
        IF(IDIM.EQ.3) COORPA(3,I)=XCOOR((IP-1)*(IDIM+1)+3)
        NUMPA(I)=I
   10 CONTINUE
C
      CALL TRJPEL(IZPART,IZREF,MELEME,IZVIT,IZCOU,IZCENT,IELTFA,IZSH,
     * TMIN)
      IF(IERR.GT.0)RETURN
C
      K=0
      DO 30 IPART=1,NPART
C          on ne conserve que les particules qui sont effectivement
C                       dans le domaine (sinon on ecrit un message)
        IF(NLEPA(IPART).EQ.0) THEN
               INTERR(1)=IPART
               REAERR(3)=0.0
               DO 55 I=1,NDIM
                     REAERR(I)=REAL(COORPA(I,IPART))
   55          CONTINUE
               CALL ERREUR(-299)
        ELSE
          K=K+1
          NLEPA(K)=NLEPA(IPART)
          IZREF.NLEPA(K)=IZREF.NLEPA(IPART)
          NUMPA(K)=NUMPA(IPART)
          IZREF.NUMPA(K)=IZREF.NUMPA(IPART)
          DO 20 I=1,NDIM
            COORPA(I,K)=COORPA(I,IPART)
            IZREF.COORPA(I,K)=IZREF.COORPA(I,IPART)
  20      CONTINUE
C     write(6,*)' nlepa ',nlepa(k),numpa(k),(coorpa(i,k),i=1,ndim),
C    *                                (izref.coorpa(i,k),i=1,ndim)
        ENDIF
  30  CONTINUE
      NPART=K
      SEGADJ IZREF
C      write(6,*)' adj izref ',izref
C      write(6,*)' sup izpart ',izpart
      SEGSUP IZPART
      SEGDES IZLAC
      RETURN
C
C
      END