Esope source files

   1 : C TRJFL1    SOURCE    PV        09/03/13    21:17:07     6328           
   2 :       SUBROUTINE TRJFL1(MCHPO1,IZPBID,MCHELM,IELTFA,MELEME,IZVPT,NBREL)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   6 : C
   7 : C           MET LES FLUX SOUS UNE FORME AGREABLE POUR LE
   8 : C                 CALCUL DES TRAJECTOIRES( FORMULATION HYBRIDE)
   9 : C             appelé par TRJFLU pour chaque pas de temps transitoire
  10 : C      ENTREES
  11 : C          MCHPO1 POINTEUR DU CHAMPOIN DES FLUX PAR FACES
  12 : C          IZPBID POINTEUR DES CORRESPONDANCES ELEMENTS FLUX
  13 : C          MCHELM POINTEUR DU CHAMELEM CONTENANT L ORIENTATION DU FLUX
  14 : C          IELTFA POINTEUR DU MAILLAGE FACES PAR ELEMENTS(ISSU DE KDOM)
  15 : C          MELEME POINTEUR DU MAILLAGE
  16 : C      SORTIE
  17 : C          IZVPT  POINTEUR DU SEGMENT CONTENANT LES POINTEURS
  18 : C                  DES IZUN POUR UN PAS DE TEMPS DONNE
  19 : C
  20 : C  on suppose que NSOUPO=1   ( controlé en amont)
  21 : C
  22 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  23 : -INC CCOPTIO
  24 : -INC SMELEME
  25 : -INC SMCHPOI
  26 : -INC SMCHAML
  27 : -INC SMCOORD
  28 : -INC SMINTE
  29 : C
  30 :       SEGMENT IPMAHY
  31 :          INTEGER MAHYBR(NSOUS)
  32 :       ENDSEGMENT
  33 :       SEGMENT HYBSTO
  34 :          REAL*8  HYBASE(NDIM,NBDDL,NBPP)
  35 :       ENDSEGMENT
  36 :       SEGMENT TRAV
  37 :          REAL*8  XE(3,NBNN)
  38 :          REAL*8  SHP(6,NBNN) , SHY(IDIM,NBDDL)
  39 :          REAL*8  ZJAC(IDIM,IDIM) , VECT(IDIM),VN(IDIM)
  40 :       ENDSEGMENT
  41 : *
  42 :       POINTEUR IELTFA.MELEME
  43 :       SEGMENT IZVPT
  44 :            INTEGER IPUN1(NBS),IPUMAX
  45 :       ENDSEGMENT
  46 :       SEGMENT IZUN
  47 :            REAL*8 UN(I1,I2,I3)
  48 :       ENDSEGMENT
  49 :       POINTEUR IZUN1.IZUN ,IZUN2.IZUN
  50 :       SEGMENT IZBID
  51 :            INTEGER  ITBID(I2,I3)
  52 :       ENDSEGMENT
  53 :       SEGMENT IZPBID
  54 :            INTEGER  IPBID(NBS)
  55 :       ENDSEGMENT
  56 : C         UMAX norme de la vitesse au centre de chaque element
  57 : C                     utilsee dans TRJCOU
  58 :       SEGMENT IZUMAX
  59 :            REAL*8 UMAX(NBREL)
  60 :       ENDSEGMENT
  61 : C
  62 : C     SEGACT MCHPO1
  63 :       SEGACT MELEME
  64 :       NBSOUS=LISOUS(/1)
  65 :       IPT3=MELEME
  66 :       SEGACT IELTFA
  67 :       NBS=IPBID(/1)
  68 : C
  69 :       SEGINI IZUMAX
  70 : C      write(6,*)'SEGINI IZUMAX ',IZUMAX
  71 : C                     ON PREPARE  LE CHPOIN
  72 :       MSOUPO=MCHPO1.IPCHP(1)
  73 :       SEGACT MSOUPO
  74 :       MPOVAL=IPOVAL
  75 :       SEGACT MPOVAL
  76 :       IPT2=IGEOC
  77 :       SEGACT IPT2
  78 :       NPGEO=IPT2.NUM(/2)
  79 :       I1=VPOCHA(/2)
  80 :       IPT1=IELTFA
  81 :       ID2=0
  82 : C
  83 :       DO 50 ISOUS=1,NBS
  84 :       IF(NBSOUS.GT.0)IPT1=IELTFA.LISOUS(ISOUS)
  85 :       IZBID= IPBID(ISOUS)
  86 :       SEGACT IZBID
  87 :       MCHAML=ICHAML(ISOUS)
  88 :       SEGACT MCHAML
  89 :       MELVAL=IELVAL(1)
  90 :       SEGACT MELVAL
  91 :       SEGACT IPT1
  92 :       I2=IPT1.NUM(/1)
  93 :       I3=IPT1.NUM(/2)
  94 :       ID1=ID2
  95 :       ID2=ID2+I3
  96 : C     WRITE(6,*) ' I1 I2 I3 ', I1,I2,I3
  97 :       SEGINI IZUN
  98 : C     write(6,*)'SEGINI IZUN',izun
  99 :       IPUN1(ISOUS)=IZUN
 100 :       DO 40 IEL=1,I3
 101 :       DO 30 ID=1,I2
 102 :       IP=ITBID(ID,IEL)
 103 :            UN(1,ID,IEL)=VPOCHA(IP,1)*VELCHE(ID,IEL)
 104 :    30 CONTINUE
 105 :    40 CONTINUE
 106 : C                         CALCUL DU MODULE DE LA VITESSE AU CENTRE
 107 : C     WRITE(6,*)' CALCUL DU MODULE DE LA VITESSE AU CENTRE'
 108 :       IF(NBSOUS.GT.0)IPT3=LISOUS(ISOUS)
 109 :       SEGACT IPT3
 110 :       NBNN=IPT3.NUM(/1)
 111 :       NBDDL=I2
 112 :       SEGINI TRAV
 113 :       ITYP=IPT3.ITYPEL
 114 :       NTYP=NUMHYB(ITYP)
 115 : C     WRITE(6,*)' RESHPT',NBNN,NTYP,ITYP,IPT3.ITYPEL
 115 :       CALL RESHPT(1,NBNN,ITYP,ITYP,0,IPINTE,IRT1)
 116 : C     WRITE(6,*)' HYSHPT',IPT3.ITYPEL,I2,IPINTE
 116 :       CALL HYSHPT(NTYP,I2,IPINTE,IPTHYB)
 117 : C     WRITE(6,*)' HYSHPT',IPT3.ITYPEL,I2,IPINTE,IPTHYB
 118 :       MINTE=IPINTE
 119 :       SEGACT MINTE
 120 :       HYBSTO=IPTHYB
 121 :       SEGACT HYBSTO
 122 :       NDIM=IDIM*(IDIM+1)
 123 :       DO 60 IEL=1,I3
 123 :       CALL INITD(VN,IDIM,0.D0)
 123 :       CALL DOXE(XCOOR,IDIM,NBNN,IPT3.NUM,IEL,XE)
 123 :       CALL MHYBR3(1,NBNN,I2,NDIM,IDIM,IDIM,XE,HYBASE,SHPTOT,
 124 :      *                  SHY,SHP,ZJAC,DJAC)
 125 :           DO 65 IDDL=1,I2
 125 :                  CALL INITD(VECT,IDIM,0.D0)
 126 :                  DO 75 J=1,IDIM
 127 :                     DO 80 I=1,IDIM
 128 :                        VECT(I)=VECT(I)+ZJAC(I,J)*SHY(J,IDDL)
 129 :    80               CONTINUE
 130 :    75            CONTINUE
 131 : C             write(6,*)' vect',(vect(i),i=1,idim)
 132 :                  COEF=UN(1,IDDL,IEL)/DJAC
 133 : C       write(6,*)' coef ',coef,DJAC
 134 :                   DO 85 I=1,IDIM
 135 :                   VN(I)=VN(I)+COEF*VECT(I)
 136 :    85             CONTINUE
 137 :    65     CONTINUE
 138 : C             write(6,*)' vn',(vn(i),i=1,idim)
 139 :       UE=0.D0
 140 :       DO 90 I=1,IDIM
 141 :            UE=UE+VN(I)*VN(I)
 142 :    90 CONTINUE
 143 :       UMAX(IEL+ID1)=SQRT(UE)
 144 :    60 CONTINUE
 145 : C      write(6,*)' TRJFLU ',i2,i3,idun(isous)
 146 : C      WRITE(6,100)(((UN(I,J,K),I=1,I1),J=1,I2),K=1,I3)
 147 :   100 FORMAT(1X,10E12.5)
 148 : C      write(6,*)' TRJFLU UMAX'
 149 : C      WRITE(6,100)(UMAX(K+ID1),K=1,I3)
 150 :        SEGDES IPT1 ,IZUN ,IZBID
 151 :        SEGSUP TRAV ,MINTE,HYBSTO
 152 :       SEGDES MCHAML
 153 :       SEGDES MELVAL
 154 :    50 CONTINUE
 155 :       IPUMAX=IZUMAX
 156 : C     write(6,*)' idun ',(idun(i),i=1,nbs)
 157 : C
 158 :       IF(NBSOUS.NE.0)SEGDES MELEME
 159 :       SEGDES MPOVAL ,IPT2,MSOUPO,MCHPO1
 160 :       SEGDES IZUMAX
 161 :       RETURN
 162 :       END
 163 :  
 164 :  
 165 :  
 166 :