Télécharger la plaquette Cast3M


fr en

Télécharger trjflu.eso

Retour à la liste

Numérotation des lignes : 

trjflu

  1. C TRJFLU    SOURCE    CB215821  20/11/25    13:41:32     10792          
  2.       SUBROUTINE TRJFLU(IPTFL,ITR,MCHELM,IELTFA,MELEME,IZVIT)
  3. C
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  7. C
  8. C      MET LES FLUX SOUS UNE FORME AGREABLE POUR LE
  9. C        CALCUL DES TRAJECTOIRES (FORMULATION HYBRIDE)
  10. C
  11. C      ENTREES
  12. C          IPTFL = MCHPOI1 POINTEUR DU CHPOINT DES FLUX PAR FACES
  13. C                = MTABLE POINTEUR DE LA TABLE RESULTAT DU TRANSITOIRE
  14. C          ITR = 3 TRANSITOIRE
  15. C          MCHELM  POINTEUR DU MCHAML   CONTENANT L'ORIENTATION DU FLUX
  16. C          IELTFA  POINTEUR DU MAILLAGE FACES PAR ELEMENTS (ISSU DE DOMA)
  17. C          MELEME  POINTEUR DU MAILLAGE
  18. C
  19. C      SORTIES
  20. C          IZVIT  POINTEUR DU SEGMENT CONTENANT LES POINTEURS DES IZUN
  21. C
  22. C  ON SUPPOSE QUE NSOUPO=1   (CONTROLE EN AMONT)
  23. C
  24. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC SMELEME
  29. -INC SMTABLE
  30.       POINTEUR MTABTT.MTABLE,MTABFT.MTABLE
  31. -INC SMCHPOI
  32. -INC SMCHAML
  33. -INC SMCOORD
  34. -INC SMINTE
  35. C
  36.       SEGMENT IPMAHY
  37.          INTEGER MAHYBR(NSOUS)
  38.       ENDSEGMENT
  39.       SEGMENT HYBSTO
  40.          REAL*8  HYBASE(NDIM,NBDDL,NBPP)
  41.       ENDSEGMENT
  42. C
  43.       POINTEUR IELTFA.MELEME
  44.       SEGMENT IZVIT
  45.            REAL*8 TEMTRA(NVIPT)
  46.            INTEGER IPUN(NBS),IDUN(NBS),IPVPT(NVIPT),IFORML
  47.       ENDSEGMENT
  48. C
  49. C  IDUN(I) NOMBRE D'ELEMENTS AVANT LE SOUS-MAILLAGE I
  50. C  IPVPT   POINTEURS DE IZVPT POUR CHAQUE PAS DE TEMPS
  51. C
  52.       SEGMENT IZVPT
  53.            INTEGER IPUN1(NBS),IPUMAX
  54.  
  55.       ENDSEGMENT
  56.       SEGMENT IZUN
  57.            REAL*8 UN(I1,I2,I3)
  58.       ENDSEGMENT
  59.       POINTEUR IZUN1.IZUN ,IZUN2.IZUN
  60.       SEGMENT IZBID
  61.            INTEGER  ITBID(I2,I3)
  62.       ENDSEGMENT
  63.       SEGMENT IZPBID
  64.            INTEGER  IPBID(NBS)
  65.       ENDSEGMENT
  66. C
  67. C TABLEAU DE TRAVAIL POUR OPTIMISER LA CHOSE (ELOI JUIN 97)
  68. C
  69.       SEGMENT IZTRAV
  70.            INTEGER  ITRAV(NTRAV)
  71.       ENDSEGMENT
  72. C
  73.       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  74.       LOGICAL LOGRE
  75. C
  76.       SEGACT MELEME
  77.       SEGACT IELTFA
  78.       NBSOUS=IELTFA.LISOUS(/1)
  79.       NBSOUM=LISOUS(/1)
  80.       IF(NBSOUS.NE.NBSOUM)THEN
  81.         CALL ERREUR(21)
  82.         RETURN
  83.       ENDIF
  84.       NBS=NBSOUS
  85.       IF(NBSOUS.EQ.0)NBS=1
  86.       NVIPT=1
  87.       IF(ITR.EQ.3)THEN
  88. C
  89. C CAS D'UN TRANSITOIRE ON VA TROUVER UNE TABLE
  90. C
  91.         MTABLE=IPTFL
  92.         SEGACT MTABLE
  93.         IVALI=1
  94.         XVALI=0.D0
  95.         IRETI=0
  96.         IVALR=0
  97.         XVALR=0.D0
  98.         MTYPI='MOT'
  99.         CHARR='        '
  100.         MTYPR='TABLE'
  101.         CALL ACCTAB(MTABLE,MTYPI,IVALI,XVALI,'TEMPS',.TRUE.,IRETI,
  102.      #                              MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  103.         IF(IRETR.EQ.0) RETURN
  104.         MTABTT=IRETR
  105.         IVALI=1
  106.         XVALI=0.D0
  107.         IRETI=0
  108.         IVALR=0
  109.         XVALR=0.D0
  110.         MTYPI='MOT'
  111.         CHARR='        '
  112.         MTYPR='TABLE'
  113.         CALL ACCTAB(MTABLE,MTYPI,IVALI,XVALI,'FLUX',.TRUE.,IRETI,MTYPR,
  114.      #                                    IVALR,XVALR,CHARR,LOGRE,IRETR)
  115.         IF(IRETR.EQ.0) RETURN
  116.         MTABFT=IRETR
  117.         SEGACT MTABTT,MTABFT
  118.         NVIPT=MTABTT.MLOTAB
  119.       ENDIF
  120.       SEGINI IZVIT
  121.       SEGINI IZPBID
  122.       IFORML=2
  123.       CALL INITI(IDUN,NBS,0)
  124.       CALL INITI(IPUN,NBS,0)
  125.       CALL INITI(IPBID,NBS,0)
  126.       IPT1=IELTFA
  127.       IPT3=MELEME
  128.  
  129. C
  130. C  ON PREPARE LE MCHAML
  131. C
  132.       SEGACT MCHELM
  133.       MCHAML=ICHAML(1)
  134.       SEGACT MCHAML
  135.       MELVAL=IELVAL(1)
  136.       SEGACT MELVAL
  137. C
  138. C  ON PREPARE LE CHPOINT
  139. C
  140.       IF(ITR.NE.3) THEN
  141.         MCHPO1=IPTFL
  142.         SEGACT MCHPO1
  143.         MSOUPO=MCHPO1.IPCHP(1)
  144.         SEGACT MSOUPO
  145.         MPOVAL=IPOVAL
  146.         SEGACT MPOVAL
  147.         IPT2=IGEOC
  148.         SEGACT IPT2
  149.         NPGEO=IPT2.NUM(/2)
  150. C
  151. C  INITIALISATION ET REMPLISSAGE DU SEGMENT DE TRAVAIL (ELOI JUIN 97)
  152. C
  153.         NTRAV=NPGEO
  154.         SEGINI IZTRAV
  155. C
  156.         DO 1 I=1,NTRAV
  157.           ITRAV(I)=0
  158.    1    CONTINUE
  159.         DO 2 IPGEO=1,NPGEO
  160.           IP=IPT2.NUM(1,IPGEO)
  161.           IEMAX=ITRAV(/1)
  162.           IF (IP.GT.IEMAX) THEN
  163.             NTRAV=IP
  164.             SEGADJ IZTRAV
  165.             DO 3 I=IEMAX+1,NTRAV
  166.               ITRAV(I)=0
  167.    3        CONTINUE
  168.           ENDIF
  169.           ITRAV(IP)=IPGEO
  170.    2    CONTINUE
  171. C
  172.         NBREL=0
  173. C
  174. C  ON RECHERCHE LA POSITION DES DIFFERENTES VALEURS DU FLUX
  175. C
  176.         DO 4 ISOUS=1,NBS
  177.           IF(NBSOUS.GT.0)IPT1=IELTFA.LISOUS(ISOUS)
  178.           SEGACT IPT1
  179.           I2=IPT1.NUM(/1)
  180.           I3=IPT1.NUM(/2)
  181.           IDUN(ISOUS)=NBREL
  182.           ID1=NBREL
  183.           NBREL=NBREL+I3
  184.           SEGINI IZBID
  185.           IPBID(ISOUS)=IZBID
  186.           DO 5 IEL=1,I3
  187.             DO 6 ID=1,I2
  188.               NOE=IPT1.NUM(ID,IEL)
  189. C
  190. C  ON UTILISE ICI LE SEGMENT DE TRAVAIL POUR EVITER UNE DOUBLE BOUCLE
  191. C                                                         (ELOI JUIN 97)
  192. C
  193.               IF (ITRAV(NOE).EQ.0) THEN
  194.                 WRITE(6,*) 'PROBLEME POUR CONVERTIR LE TABLEAU DE FLUX'
  195.                 RETURN
  196.               ENDIF
  197.               ITBID(ID,IEL)=ITRAV(NOE)
  198.     6       CONTINUE
  199.     5     CONTINUE
  200.     4   CONTINUE
  201. C
  202. C  ON SUPPRIME LE SEGMENT DE TRAVAIL (ELOI JUIN 1997)
  203. C
  204.         SEGSUP IZTRAV
  205. C
  206.         SEGINI IZVPT
  207.         CALL TRJFL1(MCHPO1,IZPBID,MCHELM,IELTFA,MELEME,IZVPT,NBREL)
  208.  
  209.         IPVPT(1)=IZVPT
  210.         TEMTRA(1)=0.D0
  211.       ELSE
  212. C
  213. C  CAS D'UNE TABLE (TRANSITOIRE)
  214. C
  215.         DO 7 KPT=1,NVIPT
  216.           IVALI= KPT-1
  217.           XVALI=0.D0
  218.           IRETI=0
  219.           IVALR=0
  220.           XVALR=0.D0
  221.           IRETR=0
  222.           MTYPI='ENTIER'
  223.           CHARI='        '
  224.           CHARR='        '
  225.           MTYPR='        '
  226.           CALL ACCTAB(MTABTT,MTYPI,IVALI,XVALI,CHARI,.TRUE.,IRETI,
  227.      #                              MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  228.           TEMTRA(KPT)=XVALR
  229.           IVALI=KPT-1
  230.           XVALI=0.D0
  231.           IRETI=0
  232.           IVALR=0
  233.           XVALR=0.D0
  234.           MTYPI='ENTIER'
  235.           CHARI='        '
  236.           CHARR='        '
  237.           MTYPR='CHPOINT'
  238.           CALL ACCTAB(MTABFT,MTYPI,IVALI,XVALI,CHARI,.TRUE.,IRETI,
  239.      #                              MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  240.           MCHPO1=IRETR
  241.           SEGACT MCHPO1
  242.           IF(KPT.EQ.1)THEN
  243. C
  244. C  ON A CONTROLE PLUS HAUT QUE LES IGEOC SONT IDENTIQUES
  245. C
  246.             MSOUPO=MCHPO1.IPCHP(1)
  247.             SEGACT MSOUPO
  248.             MPOVAL=IPOVAL
  249.             SEGACT MPOVAL
  250.             IPT2=IGEOC
  251.             SEGACT IPT2
  252.             NPGEO=IPT2.NUM(/2)
  253. C
  254. C  INITIALISATION ET REMPLISSAGE DU SEGMENT DE TRAVAIL (ELOI JUIN 97)
  255. C
  256.             NTRAV=NPGEO
  257.             SEGINI IZTRAV
  258. C
  259.             DO 8 I=1,NTRAV
  260.               ITRAV(I)=0
  261.    8        CONTINUE
  262.             DO 9 IPGEO=1,NPGEO
  263.               IP=IPT2.NUM(1,IPGEO)
  264.               IEMAX=ITRAV(/1)
  265.               IF (IP.GT.IEMAX) THEN
  266.                 NTRAV=IP
  267.                 SEGADJ IZTRAV
  268.                 DO 10 I=IEMAX+1,NTRAV
  269.                   ITRAV(I)=0
  270.   10            CONTINUE
  271.               ENDIF
  272.               ITRAV(IP)=IPGEO
  273.    9        CONTINUE
  274. C
  275.             NBREL=0
  276. C
  277. C  ON RECHERCHE LA POSITION DES DIFFERENTES VALEURS DU FLUX
  278. C
  279.             DO 11 ISOUS=1,NBS
  280.               IF(NBSOUS.GT.0)IPT1=IELTFA.LISOUS(ISOUS)
  281.               SEGACT IPT1
  282.               I2=IPT1.NUM(/1)
  283.               I3=IPT1.NUM(/2)
  284.               IDUN(ISOUS)=NBREL
  285.               ID1=NBREL
  286.               NBREL=NBREL+I3
  287.               SEGINI IZBID
  288.               IPBID(ISOUS)=IZBID
  289.               DO 12 IEL=1,I3
  290.                 UE=0.D0
  291.                 DO 13 ID=1,I2
  292.                   NOE=IPT1.NUM(ID,IEL)
  293. C
  294. C  ON UTILISE ICI LE SEGMENT DE TRAVAIL POUR EVITER UNE DOUBLE BOUCLE
  295. C                                                         (ELOI JUIN 97)
  296. C
  297.                   IF (ITRAV(NOE).EQ.0) THEN
  298.                     WRITE(6,*)
  299.      #                      'PROBLEME POUR CONVERTIR LE TABLEAU DE FLUX'
  300.                     RETURN
  301.                   ENDIF
  302.                   ITBID(ID,IEL)=ITRAV(NOE)
  303.    13           CONTINUE
  304.    12         CONTINUE
  305.    11       CONTINUE
  306. C
  307. C  ON SUPPRIME LE SEGMENT DE TRAVAIL (ELOI JUIN 1997)
  308. C
  309.             SEGSUP IZTRAV
  310. C
  311.           ENDIF
  312.           SEGINI IZVPT
  313.           CALL TRJFL1(MCHPO1,IZPBID,MCHELM,IELTFA,MELEME,IZVPT,NBREL)
  314.           IPVPT(KPT)=IZVPT
  315.           SEGDES IZVPT
  316.     7   CONTINUE
  317.         SEGDES MTABTT,MTABFT,MTABLE
  318.       ENDIF
  319.       SEGDES MELVAL,MCHAML,MCHELM
  320.       IZVPT=IPVPT(1)
  321.       SEGACT IZVPT
  322.       DO 14 ISOUS=1,NBS
  323.         IZBID=IPBID(ISOUS)
  324.         SEGSUP IZBID
  325.         IZUN1=IPUN1(ISOUS)
  326.         SEGACT IZUN1
  327.         I1=IZUN1.UN(/1)
  328.         I2=IZUN1.UN(/2)
  329.         I3=IZUN1.UN(/3)
  330.         SEGINI IZUN
  331.         IPUN(ISOUS)=IZUN
  332.         SEGDES IZUN,IZUN1
  333.    14 CONTINUE
  334.       SEGSUP IZPBID
  335.       IF(NBSOUS.NE.0)SEGDES MELEME
  336.       SEGDES MPOVAL ,IPT2,MSOUPO,MCHPO1
  337.       SEGDES IZVIT
  338. C
  339.       RETURN
  340.       END
  341.  
  342.  
  343.  
  344.  
  345.  
  346.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales