Sources Esope | Cast3M

trjfl1
C TRJFL1    SOURCE    CB215821  23/01/25    21:15:36     11573          
      SUBROUTINE TRJFL1(MCHPO1,IZPBID,MCHELM,IELTFA,MELEME,IZVPT,NBREL)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C           MET LES FLUX SOUS UNE FORME AGREABLE POUR LE
C                 CALCUL DES TRAJECTOIRES( FORMULATION HYBRIDE)
C             appelé par TRJFLU pour chaque pas de temps transitoire
C      ENTREES
C          MCHPO1 POINTEUR DU CHAMPOIN DES FLUX PAR FACES
C          IZPBID POINTEUR DES CORRESPONDANCES ELEMENTS FLUX
C          MCHELM POINTEUR DU CHAMELEM CONTENANT L ORIENTATION DU FLUX
C          IELTFA POINTEUR DU MAILLAGE FACES PAR ELEMENTS(ISSU DE KDOM)
C          MELEME POINTEUR DU MAILLAGE
C      SORTIE
C          IZVPT  POINTEUR DU SEGMENT CONTENANT LES POINTEURS
C                  DES IZUN POUR UN PAS DE TEMPS DONNE
C
C  on suppose que NSOUPO=1   ( controlé en amont)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMCHPOI
-INC SMCHAML
-INC SMCOORD
-INC SMINTE
C
      SEGMENT IPMAHY
         INTEGER MAHYBR(NSOUS)
      ENDSEGMENT
      SEGMENT HYBSTO
         REAL*8  HYBASE(NDIM,NBDDL,NBPP)
      ENDSEGMENT
      SEGMENT TRAV
         REAL*8  XE(3,NBNN)
         REAL*8  SHP(6,NBNN) , SHY(IDIM,NBDDL)
         REAL*8  ZJAC(IDIM,IDIM) , VECT(IDIM),VN(IDIM)
      ENDSEGMENT
*
      POINTEUR IELTFA.MELEME
      SEGMENT IZVPT
           INTEGER IPUN1(NBS),IPUMAX
      ENDSEGMENT
      SEGMENT IZUN
           REAL*8 UN(I1,I2,I3)
      ENDSEGMENT
      POINTEUR IZUN1.IZUN ,IZUN2.IZUN
      SEGMENT IZBID
           INTEGER  ITBID(I2,I3)
      ENDSEGMENT
      SEGMENT IZPBID
           INTEGER  IPBID(NBS)
      ENDSEGMENT
C         UMAX norme de la vitesse au centre de chaque element
C                     utilsee dans TRJCOU
      SEGMENT IZUMAX
           REAL*8 UMAX(NBREL)
      ENDSEGMENT
C
C     SEGACT MCHPO1
      SEGACT MELEME
      NBSOUS=LISOUS(/1)
      IPT3=MELEME
      SEGACT IELTFA
      NBS=IPBID(/1)
C
      SEGINI IZUMAX
C      write(6,*)'SEGINI IZUMAX ',IZUMAX
C                     ON PREPARE  LE CHPOIN
      MSOUPO=MCHPO1.IPCHP(1)
      SEGACT MSOUPO
      MPOVAL=IPOVAL
      SEGACT MPOVAL
      IPT2=IGEOC
      SEGACT IPT2
      NPGEO=IPT2.NUM(/2)
      I1=VPOCHA(/2)
      IPT1=IELTFA
      ID2=0
C
      SEGACT,MCOORD
      DO 50 ISOUS=1,NBS
      IF(NBSOUS.GT.0)IPT1=IELTFA.LISOUS(ISOUS)
      IZBID= IPBID(ISOUS)
      SEGACT IZBID
      MCHAML=ICHAML(ISOUS)
      SEGACT MCHAML
      MELVAL=IELVAL(1)
      SEGACT MELVAL
      SEGACT IPT1
      I2=IPT1.NUM(/1)
      I3=IPT1.NUM(/2)
      ID1=ID2
      ID2=ID2+I3
C     WRITE(6,*) ' I1 I2 I3 ', I1,I2,I3
      SEGINI IZUN
C     write(6,*)'SEGINI IZUN',izun
      IPUN1(ISOUS)=IZUN
      DO 40 IEL=1,I3
      DO 30 ID=1,I2
      IP=ITBID(ID,IEL)
           UN(1,ID,IEL)=VPOCHA(IP,1)*VELCHE(ID,IEL)
   30 CONTINUE
   40 CONTINUE
C                         CALCUL DU MODULE DE LA VITESSE AU CENTRE
C     WRITE(6,*)' CALCUL DU MODULE DE LA VITESSE AU CENTRE'
      IF(NBSOUS.GT.0)IPT3=LISOUS(ISOUS)
      SEGACT IPT3
      NBNN=IPT3.NUM(/1)
      NBDDL=I2
      SEGINI TRAV
      ITYP=IPT3.ITYPEL
      NTYP=NUMHYB(ITYP)
C     WRITE(6,*)' RESHPT',NBNN,NTYP,ITYP,IPT3.ITYPEL
      CALL RESHPT(1,NBNN,ITYP,ITYP,0,IPINTE,IRT1)
C     WRITE(6,*)' HYSHPT',IPT3.ITYPEL,I2,IPINTE
      CALL HYSHPT(NTYP,I2,IPINTE,IPTHYB)
C     WRITE(6,*)' HYSHPT',IPT3.ITYPEL,I2,IPINTE,IPTHYB
      MINTE=IPINTE
      SEGACT MINTE
      HYBSTO=IPTHYB
      SEGACT HYBSTO
      NDIM=IDIM*(IDIM+1)
      DO 60 IEL=1,I3
      CALL INITD(VN,IDIM,0.D0)
      CALL DOXE(XCOOR,IDIM,NBNN,IPT3.NUM,IEL,XE)
      CALL MHYBR3(1,NBNN,I2,NDIM,IDIM,IDIM,XE,HYBASE,SHPTOT,
     *                  SHY,SHP,ZJAC,DJAC)
          DO 65 IDDL=1,I2
                 CALL INITD(VECT,IDIM,0.D0)
                 DO 75 J=1,IDIM
                    DO 80 I=1,IDIM
                       VECT(I)=VECT(I)+ZJAC(I,J)*SHY(J,IDDL)
   80               CONTINUE
   75            CONTINUE
C             write(6,*)' vect',(vect(i),i=1,idim)
                 COEF=UN(1,IDDL,IEL)/DJAC
C       write(6,*)' coef ',coef,DJAC
                  DO 85 I=1,IDIM
                  VN(I)=VN(I)+COEF*VECT(I)
   85             CONTINUE
   65     CONTINUE
C             write(6,*)' vn',(vn(i),i=1,idim)
      UE=0.D0
      DO 90 I=1,IDIM
           UE=UE+VN(I)*VN(I)
   90 CONTINUE
      UMAX(IEL+ID1)=SQRT(UE)
   60 CONTINUE
C      write(6,*)' TRJFLU ',i2,i3,idun(isous)
C      WRITE(6,100)(((UN(I,J,K),I=1,I1),J=1,I2),K=1,I3)
  100 FORMAT(1X,10E12.5)
C      write(6,*)' TRJFLU UMAX'
C      WRITE(6,100)(UMAX(K+ID1),K=1,I3)
       SEGSUP TRAV ,MINTE,HYBSTO
   50 CONTINUE
      IPUMAX=IZUMAX
C     write(6,*)' idun ',(idun(i),i=1,nbs)
C
      RETURN
      END