Download trjcn6.eso

Back to the list

   1 : C TRJCN6    SOURCE    CHAT      05/01/13    03:49:17     5004           
   2 :       SUBROUTINE TRJCN6(IPTVIT,MELEME,NCC)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   6 : C                                                                                     A
   7 : C         CONTROLE QUE LES DONNEES SERVANT A CALCULER LES VITESSES
   8 : C          SONT COHERENTES ( cas transitoire )
   9 : C                 CALCUL DES TRAJECTOIRES
  10 : C      ENTREES
  11 : C          MELEME POINTEUR DU MAILLAGE
  12 : C          IPTVIT POINTEUR DE LA TABLE DES VITESSES OU FLUX
  13 : C          NCC NOMBRE DE COMPOSANTES ATTENDUES POUR LE CHPOIN
  14 : C
  15 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  16 :       CHARACTER*4 NOMTOT
  17 : -INC SMELEME
  18 : -INC SMTABLE
  19 : -INC SMCHPOI
  20 : -INC CCOPTIO
  21 :        CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  22 : C
  23 :       MTABLE=IPTVIT
  24 :       SEGACT MTABLE
  25 :       NVIPT= MLOTAB
  26 :       SEGACT MELEME
  27 : 
  28 :            IVALI=0
  29 :            XVALI=0.D0
  30 :            IRETI=0
  31 :            IVALR=0
  32 :            XVALR=0.D0
  33 :            MTYPI='ENTIER'
  34 :            CHARI='        '
  35 :            CHARR='        '
  36 :            MTYPR='CHPOINT'
  36 :            CALL ACCTAB(MTABLE,MTYPI,IVALI,XVALI,CHARI,.TRUE.,
  37 :      *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  38 :            MCHPO1=IRETR
  39 :            SEGACT MCHPO1
  40 :       NBCOMP=-1
  41 :       NOMTOT='    '
  42 :       INDIC=0
  42 :       CALL QUEPOI(MCHPO1,MELEME,INDIC,NBCOMP,NOMTOT)
  43 :       IF(INDIC.LT.0)THEN
  43 :           CALL ERREUR(21)
  44 :           RETURN
  45 :       ENDIF
  46 :       SEGACT MCHPO1
  47 :       MSOUPO=MCHPO1.IPCHP(1)
  48 :       SEGACT MSOUPO
  49 :       MPOVAL=IPOVAL
  50 :       SEGACT MPOVAL
  51 :       NC=VPOCHA(/2)
  52 :       IF(NC.NE.NCC)THEN
  53 :             MOTERR(1:8)='TRJCN3  '
  53 :             CALL ERREUR(178)
  54 :             RETURN
  55 :       ENDIF
  56 :       IGEOC1= IGEOC
  57 :       SEGDES MPOVAL,MSOUPO,MCHPO1
  58 :       DO 10 IVPT=2,NVIPT
  59 :            IVALI=IVPT-1
  60 :            XVALI=0.D0
  61 :            IRETI=0
  62 :            IVALR=0
  63 :            XVALR=0.D0
  64 :            MTYPI='ENTIER'
  65 :            CHARI='        '
  66 :            CHARR='        '
  67 :            MTYPR='CHPOINT'
  67 :            CALL ACCTAB(MTABLE,MTYPI,IVALI,XVALI,CHARI,.TRUE.,
  68 :      *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  69 :            MCHPO2=IRETR
  70 :            SEGACT MCHPO2
  71 : C
  72 :       NBCOMP=-1
  73 :       NOMTOT='    '
  74 :       INDIC=1
  74 :       CALL QUEPOI(MCHPO2,IGEOC1,INDIC,NBCOMP,NOMTOT)
  75 :       IF(INDIC.LT.0)THEN
  75 :           CALL ERREUR(21)
  76 :           RETURN
  77 :       ENDIF
  78 :       SEGACT MCHPO2
  79 :       MSOUPO=MCHPO2.IPCHP(1)
  80 :       SEGACT MSOUPO
  81 :       IF (IGEOC.NE.IGEOC1)THEN
  81 :           CALL ERREUR(348)
  82 :           RETURN
  83 :       ENDIF
  84 :       SEGDES MSOUPO,MCHPO2
  85 :    10 CONTINUE
  86 : C     SEGDES MELEME
  87 :       RETURN
  88 :       END
  89 :  
  90 :  

© Cast3M 2003 - All rights reserved.
Disclaimer