Télécharger la plaquette Cast3M


fr en

Télécharger trjvit.eso

Retour à la liste

Numérotation des lignes : 

trjvit

  1. C TRJVIT    SOURCE    CB215821  20/11/25    13:41:40     10792          
  2.       SUBROUTINE TRJVIT(IPTVIT,ITR,MELEME,IZVIT)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C
  7. C           MET LES VITESSES SOUS UNE FORME AGREABLE POUR LE
  8. C                 CALCUL DES TRAJECTOIRES
  9. C      ENTREES
  10. C          IPTVIT= MCHPOI1 POINTEUR DU CHAMPOIN DES VITESSES INITIALES
  11. C                        (  EN PERMANENT)
  12. C                = POINTEUR DE LA TABLE DES CHAMPOIN DES VITESSES
  13. C                 INITIALES ( EN TRANSITOIRE)
  14. C          ITR  = 3  TRANSITOIRE
  15. C          MELEME POINTEUR DU MAILLAGE
  16. C      SORTIE
  17. C          IZVIT  POINTEUR DU SEGMENT CONTENANT LES POINTEURS
  18. C                  DES IZUN
  19. C
  20. C  on suppose que NSOUPO=1 et qu en transitoire les vitesses sont
  21. C       donnees aux memes noeuds ( controlé en amont)
  22. C
  23. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  24. -INC SMELEME
  25. -INC SMCHPOI
  26. -INC SMTABLE
  27.       POINTEUR MTABTT.MTABLE,MTABFT.MTABLE
  28. C
  29.       SEGMENT IZVIT
  30.            REAL*8 TEMTRA(NVIPT)
  31.            INTEGER IPUN(NBS),IDUN(NBS),IPVPT(NVIPT),IFORML
  32.       ENDSEGMENT
  33. C             IDUN(I) nombre d elements avant le sous maillage I
  34. C             IPVPT  pointeurs de izvpt pour chaque pas de temps
  35.       SEGMENT IZVPT
  36.            INTEGER IPUN1(NBS),IPUMAX
  37.       ENDSEGMENT
  38.       SEGMENT IZUN
  39.            REAL*8 UN(I1,I2,I3)
  40.       ENDSEGMENT
  41.       POINTEUR IZUN1.IZUN ,IZUN2.IZUN
  42. C         UMAX vitesse max dans chaque element utilsee dans TRJCOU
  43.       SEGMENT IZUMAX
  44.            REAL*8 UMAX(NBREL)
  45.       ENDSEGMENT
  46.       SEGMENT IZBID
  47.            INTEGER  IBID(I2,I3)
  48.       ENDSEGMENT
  49.       SEGMENT IZPBID
  50.            INTEGER  IPBID(NBS)
  51.       ENDSEGMENT
  52.       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  53.       LOGICAL LOGRE
  54. C
  55. C
  56.       SEGACT MELEME
  57.       NBSOUS=LISOUS(/1)
  58.       NBS=NBSOUS
  59.       IF(NBSOUS.EQ.0)NBS=1
  60.       NVIPT=1
  61.       IF(ITR.EQ.3)THEN
  62. C TRANSITOIRE ON VA TROUVER UNE TABLE
  63.            MTABLE=IPTVIT
  64.            SEGACT MTABLE
  65.            IVALI=1
  66.            XVALI=0.D0
  67.            IRETI=0
  68.            IVALR=0
  69.            XVALR=0.D0
  70.            MTYPI='MOT'
  71.            CHARR='        '
  72.            MTYPR='TABLE'
  73.            CALL ACCTAB(MTABLE,MTYPI,IVALI,XVALI,'TEMPS',.TRUE.,
  74.      *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  75.            IF(IRETR.EQ.0)RETURN
  76.            MTABTT=IRETR
  77.            IVALI=1
  78.            XVALI=0.D0
  79.            IRETI=0
  80.            IVALR=0
  81.            XVALR=0.D0
  82.            MTYPI='MOT'
  83.            CHARR='        '
  84.            MTYPR='TABLE'
  85.            CALL ACCTAB(MTABLE,MTYPI,IVALI,XVALI,'VITESSE',.TRUE.,
  86.      *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  87.            IF(IRETR.EQ.0)RETURN
  88.            MTABFT=IRETR
  89.            SEGACT MTABTT,MTABFT
  90.            NVIPT=MTABTT.MLOTAB
  91.       ENDIF
  92.       SEGINI IZVIT
  93.       SEGINI IZPBID
  94.       IFORML=1
  95.       CALL INITI(IDUN,NBS,0)
  96.       CALL INITI(IPUN,NBS,0)
  97.       CALL INITI(IPBID,NBS,0)
  98.       IPT1=MELEME
  99.       NBREL=0
  100.       IF(ITR.NE.3)THEN
  101.       MCHPO1=IPTVIT
  102.       SEGACT MCHPO1
  103.       SEGINI IZVPT
  104.       IPVPT(1)=IZVPT
  105.       NBREL=1
  106.       SEGINI IZUMAX
  107.       NBREL=0
  108.       DO 50 ISOUS=1,NBS
  109.       IF(NBSOUS.GT.0)IPT1=LISOUS(ISOUS)
  110.       SEGACT IPT1
  111.       MSOUPO=MCHPO1.IPCHP(1)
  112.       SEGACT MSOUPO
  113.       MPOVAL=IPOVAL
  114.       SEGACT MPOVAL
  115.       IPT2=IGEOC
  116.       SEGACT IPT2
  117.       NPGEO=IPT2.NUM(/2)
  118.       I1= VPOCHA(/2)
  119.       I2=IPT1.NUM(/1)
  120.       I3=IPT1.NUM(/2)
  121. C     WRITE(6,*) ' I1 I2 I3 ', I1,I2,I3
  122.       IDUN(ISOUS)=NBREL
  123.       ID1=NBREL
  124.        NBREL=NBREL+I3
  125.       SEGINI IZBID
  126.       IPBID(ISOUS)=IZBID
  127. C     ON A DEJA VERIFIE DANS TRJCN3 QUE LES MAILLAGES COINCIDENT
  128.       DO 35 IEL=1,I3
  129.       DO 30 ID=1,I2
  130.       IBID(ID,IEL)=0
  131.       NOE=IPT1.NUM(ID,IEL)
  132. C      write(6,*)' noe ',noe
  133.       DO 20 IP=1,NPGEO
  134.       IF(NOE.EQ.IPT2.NUM(1,IP))THEN
  135.           IBID(ID,IEL)=IP
  136.           GO TO 25
  137.       ENDIF
  138.    20 CONTINUE
  139.    25 CONTINUE
  140.    30 CONTINUE
  141.    35 CONTINUE
  142.       SEGINI IZUN
  143.       IPUN1(ISOUS)=IZUN
  144.       SEGADJ IZUMAX
  145.       DO 40 IEL=1,I3
  146.       UE=0.D0
  147.       DO 45 ID=1,I2
  148.       IP=IBID(ID,IEL)
  149.            DO 10 I=1,I1
  150.            UN(I,ID,IEL)=VPOCHA(IP,I)
  151.    10      CONTINUE
  152.       U=0.D0
  153.       DO 27 K=1,I1
  154.           U=U+UN(K,ID,IEL)*UN(K,ID,IEL)
  155.    27 CONTINUE
  156.       U=SQRT(U)
  157.       IF(U.GT.UE)UE=U
  158.    45 CONTINUE
  159.       UMAX(IEL+ID1)=UE
  160.    40 CONTINUE
  161. C      WRITE(6,100)(((UN(I,J,K),I=1,I1),J=1,I2),K=1,I3)
  162.   100 FORMAT(1X,10E12.5)
  163.        SEGDES IPT1 ,IZUN
  164.        SEGSUP IZBID
  165.    50 CONTINUE
  166.       IPUMAX=IZUMAX
  167.       SEGDES IZUMAX
  168.       SEGDES MPOVAL ,IPT2,MSOUPO,MCHPO1,IZVPT
  169. C     write(6,*)' idun ',(idun(i),i=1,nbs)
  170. C
  171.       ELSE
  172. C                CAS D'UNE TABLE
  173.            DO 90 KPT=1,NVIPT
  174.            IVALI= KPT-1
  175.            XVALI=0.D0
  176.            IRETI=0
  177.            IVALR=0
  178.            XVALR=0.D0
  179.            IRETR=0
  180.            MTYPI='ENTIER'
  181.            CHARI='        '
  182.            CHARR='        '
  183.            MTYPR='        '
  184.            CALL ACCTAB(MTABTT,MTYPI,IVALI,XVALI,CHARI,.TRUE.,
  185.      *      IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  186.            TEMTRA(KPT)=XVALR
  187.            IVALI=KPT-1
  188.            XVALI=0.D0
  189.            IRETI=0
  190.            IVALR=0
  191.            XVALR=0.D0
  192.            MTYPI='ENTIER'
  193.            CHARI='        '
  194.            CHARR='        '
  195.            MTYPR='CHPOINT'
  196.            CALL ACCTAB(MTABFT,MTYPI,IVALI,XVALI,CHARI,.TRUE.,
  197.      *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  198.            MCHPO1=IRETR
  199.            SEGACT MCHPO1
  200.            MSOUPO=MCHPO1.IPCHP(1)
  201.            SEGACT MSOUPO
  202.            MPOVAL=IPOVAL
  203.            SEGACT MPOVAL
  204.            SEGINI IZVPT
  205.            IPVPT(KPT)=IZVPT
  206.            IF(KPT.EQ.1)THEN
  207. C   DANS CETTE BOUCLE ON INITIALISE LES TABLEAUX DE TRAVAIL
  208.                   DO 80 ISOUS=1,NBS
  209.                   IF(NBSOUS.GT.0)IPT1=LISOUS(ISOUS)
  210.                   SEGACT IPT1
  211.                   IPT2=IGEOC
  212.                   SEGACT IPT2
  213.                   NPGEO=IPT2.NUM(/2)
  214.                   I1=VPOCHA(/2)
  215.                   I2=IPT1.NUM(/1)
  216.                   I3=IPT1.NUM(/2)
  217.                   IDUN(ISOUS)=NBREL
  218.                   ID1=NBREL
  219.                    NBREL=NBREL+I3
  220.                   SEGINI IZBID
  221.                   IPBID(ISOUS)=IZBID
  222.                   SEGINI IZUN
  223.                   IPUN(ISOUS)=IZUN
  224.                   SEGDES IZUN
  225.  
  226. C     ON A DEJA VERIFIE DANS TRJCN3 QUE LES MAILLAGES COINCIDENT
  227.                   DO 65 IEL=1,I3
  228.                   DO 60 ID=1,I2
  229.                   IBID(ID,IEL)=0
  230.                   NOE=IPT1.NUM(ID,IEL)
  231.                   DO 70 IP=1,NPGEO
  232.                   IF(NOE.EQ.IPT2.NUM(1,IP))THEN
  233.                       IBID(ID,IEL)=IP
  234.                       GO TO 55
  235.                   ENDIF
  236.    70             CONTINUE
  237.    55             CONTINUE
  238.    60             CONTINUE
  239.    65             CONTINUE
  240.                   SEGDES IPT1
  241.    80             CONTINUE
  242.             ENDIF
  243.             SEGINI IZUMAX
  244.             DO 85 ISOUS=1,NBS
  245.             ID1=IDUN(ISOUS)
  246.             SEGINI IZUN
  247.             IPUN1(ISOUS)=IZUN
  248.             DO 140 IEL=1,I3
  249.             UE=0.D0
  250.             DO 145 ID=1,I2
  251.             IP=IBID(ID,IEL)
  252.                  DO 110 I=1,I1
  253.                  UN(I,ID,IEL)=VPOCHA(IP,I)
  254.   110            CONTINUE
  255.             U=0.D0
  256.             DO 127 K=1,I1
  257.                 U=U+UN(K,ID,IEL)*UN(K,ID,IEL)
  258.   127       CONTINUE
  259.             U=SQRT(U)
  260.             IF(U.GT.UE)UE=U
  261.   145       CONTINUE
  262.             UMAX(IEL+ID1)=UE
  263.   140       CONTINUE
  264. C      WRITE(6,100)(((UN(I,J,K),I=1,I1),J=1,I2),K=1,I3)
  265.              SEGDES IZUN
  266.    85       CONTINUE
  267.             IPUMAX=IZUMAX
  268.             SEGDES IZUMAX
  269.             SEGDES MPOVAL ,IPT2,MSOUPO,MCHPO1
  270.             SEGDES IZVPT
  271.    90       CONTINUE
  272.             DO 150 ISOUS=1,NBS
  273.             IZBID=IPBID(ISOUS)
  274.              SEGSUP IZBID
  275.   150       CONTINUE
  276.            SEGDES MTABTT,MTABFT,MTABLE
  277.       ENDIF
  278.       IF(NBSOUS.NE.0)SEGDES MELEME
  279.       SEGDES IZVIT
  280.       SEGSUP IZPBID
  281.       RETURN
  282.       END
  283.  
  284.  
  285.  
  286.  
  287.  

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