Esope source files

   1 : C TRJVIT    SOURCE    CHAT      05/01/13    03:51:51     5004           
   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'
  72 :            CALL ACCTAB(MTABLE,MTYPI,IVALI,XVALI,'TEMPS',.TRUE.,
  73 :      *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  74 :            IF(IRETR.EQ.0)RETURN
  75 :            MTABTT=IRETR
  76 :            IVALI=1
  77 :            XVALI=0.D0
  78 :            IRETI=0
  79 :            IVALR=0
  80 :            XVALR=0.D0
  81 :            MTYPI='MOT'
  82 :            CHARR='        '
  83 :            MTYPR='TABLE'
  83 :            CALL ACCTAB(MTABLE,MTYPI,IVALI,XVALI,'VITESSE',.TRUE.,
  84 :      *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  85 :            IF(IRETR.EQ.0)RETURN
  86 :            MTABFT=IRETR
  87 :            SEGACT MTABTT,MTABFT
  88 :            NVIPT=MTABTT.MLOTAB
  89 :       ENDIF
  90 :       SEGINI IZVIT
  91 :       SEGINI IZPBID
  92 :       IFORML=1
  92 :       CALL INITI(IDUN,NBS,0)
  92 :       CALL INITI(IPUN,NBS,0)
  92 :       CALL INITI(IPBID,NBS,0)
  93 :       IPT1=MELEME
  94 :       NBREL=0
  95 :       IF(ITR.NE.3)THEN
  96 :       MCHPO1=IPTVIT
  97 :       SEGACT MCHPO1
  98 :       SEGINI IZVPT
  99 :       IPVPT(1)=IZVPT
 100 :       NBREL=1
 101 :       SEGINI IZUMAX
 102 :       NBREL=0
 103 :       DO 50 ISOUS=1,NBS
 104 :       IF(NBSOUS.GT.0)IPT1=LISOUS(ISOUS)
 105 :       SEGACT IPT1
 106 :       MSOUPO=MCHPO1.IPCHP(1)
 107 :       SEGACT MSOUPO
 108 :       MPOVAL=IPOVAL
 109 :       SEGACT MPOVAL
 110 :       IPT2=IGEOC
 111 :       SEGACT IPT2
 112 :       NPGEO=IPT2.NUM(/2)
 113 :       I1= VPOCHA(/2)
 114 :       I2=IPT1.NUM(/1)
 115 :       I3=IPT1.NUM(/2)
 116 : C     WRITE(6,*) ' I1 I2 I3 ', I1,I2,I3
 117 :       IDUN(ISOUS)=NBREL
 118 :       ID1=NBREL
 119 :        NBREL=NBREL+I3
 120 :       SEGINI IZBID
 121 :       IPBID(ISOUS)=IZBID
 122 : C     ON A DEJA VERIFIE DANS TRJCN3 QUE LES MAILLAGES COINCIDENT
 123 :       DO 35 IEL=1,I3
 124 :       DO 30 ID=1,I2
 125 :       IBID(ID,IEL)=0
 126 :       NOE=IPT1.NUM(ID,IEL)
 127 : C      write(6,*)' noe ',noe
 128 :       DO 20 IP=1,NPGEO
 129 :       IF(NOE.EQ.IPT2.NUM(1,IP))THEN
 130 :           IBID(ID,IEL)=IP
 131 :           GO TO 25
 132 :       ENDIF
 133 :    20 CONTINUE
 134 :    25 CONTINUE
 135 :    30 CONTINUE
 136 :    35 CONTINUE
 137 :       SEGINI IZUN
 138 :       IPUN1(ISOUS)=IZUN
 139 :       SEGADJ IZUMAX
 140 :       DO 40 IEL=1,I3
 141 :       UE=0.D0
 142 :       DO 45 ID=1,I2
 143 :       IP=IBID(ID,IEL)
 144 :            DO 10 I=1,I1
 145 :            UN(I,ID,IEL)=VPOCHA(IP,I)
 146 :    10      CONTINUE
 147 :       U=0.D0
 148 :       DO 27 K=1,I1
 149 :           U=U+UN(K,ID,IEL)*UN(K,ID,IEL)
 150 :    27 CONTINUE
 151 :       U=SQRT(U)
 152 :       IF(U.GT.UE)UE=U
 153 :    45 CONTINUE
 154 :       UMAX(IEL+ID1)=UE
 155 :    40 CONTINUE
 156 : C      WRITE(6,100)(((UN(I,J,K),I=1,I1),J=1,I2),K=1,I3)
 157 :   100 FORMAT(1X,10E12.5)
 158 :        SEGDES IPT1 ,IZUN
 159 :        SEGSUP IZBID
 160 :    50 CONTINUE
 161 :       IPUMAX=IZUMAX
 162 :       SEGDES IZUMAX
 163 :       SEGDES MPOVAL ,IPT2,MSOUPO,MCHPO1,IZVPT
 164 : C     write(6,*)' idun ',(idun(i),i=1,nbs)
 165 : C
 166 :       ELSE
 167 : C                CAS D'UNE TABLE
 168 :            DO 90 KPT=1,NVIPT
 169 :            IVALI= KPT-1
 170 :            XVALI=0.D0
 171 :            IRETI=0
 172 :            IVALR=0
 173 :            XVALR=0.D0
 174 :            IRETR=0
 175 :            MTYPI='ENTIER'
 176 :            CHARI='        '
 177 :            CHARR='        '
 178 :            MTYPR='        '
 178 :            CALL ACCTAB(MTABTT,MTYPI,IVALI,XVALI,CHARI,.TRUE.,
 179 :      *      IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
 180 :            TEMTRA(KPT)=XVALR
 181 :            IVALI=KPT-1
 182 :            XVALI=0.D0
 183 :            IRETI=0
 184 :            IVALR=0
 185 :            XVALR=0.D0
 186 :            MTYPI='ENTIER'
 187 :            CHARI='        '
 188 :            CHARR='        '
 189 :            MTYPR='CHPOINT'
 189 :            CALL ACCTAB(MTABFT,MTYPI,IVALI,XVALI,CHARI,.TRUE.,
 190 :      *      IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
 191 :            MCHPO1=IRETR
 192 :            SEGACT MCHPO1
 193 :            MSOUPO=MCHPO1.IPCHP(1)
 194 :            SEGACT MSOUPO
 195 :            MPOVAL=IPOVAL
 196 :            SEGACT MPOVAL
 197 :            SEGINI IZVPT
 198 :            IPVPT(KPT)=IZVPT
 199 :            IF(KPT.EQ.1)THEN
 200 : C   DANS CETTE BOUCLE ON INITIALISE LES TABLEAUX DE TRAVAIL
 201 :                   DO 80 ISOUS=1,NBS
 202 :                   IF(NBSOUS.GT.0)IPT1=LISOUS(ISOUS)
 203 :                   SEGACT IPT1
 204 :                   IPT2=IGEOC
 205 :                   SEGACT IPT2
 206 :                   NPGEO=IPT2.NUM(/2)
 207 :                   I1=VPOCHA(/2)
 208 :                   I2=IPT1.NUM(/1)
 209 :                   I3=IPT1.NUM(/2)
 210 :                   IDUN(ISOUS)=NBREL
 211 :                   ID1=NBREL
 212 :                    NBREL=NBREL+I3
 213 :                   SEGINI IZBID
 214 :                   IPBID(ISOUS)=IZBID
 215 :                   SEGINI IZUN
 216 :                   IPUN(ISOUS)=IZUN
 217 :                   SEGDES IZUN
 218 :             
 219 : C     ON A DEJA VERIFIE DANS TRJCN3 QUE LES MAILLAGES COINCIDENT
 220 :                   DO 65 IEL=1,I3
 221 :                   DO 60 ID=1,I2
 222 :                   IBID(ID,IEL)=0
 223 :                   NOE=IPT1.NUM(ID,IEL)
 224 :                   DO 70 IP=1,NPGEO
 225 :                   IF(NOE.EQ.IPT2.NUM(1,IP))THEN
 226 :                       IBID(ID,IEL)=IP
 227 :                       GO TO 55
 228 :                   ENDIF
 229 :    70             CONTINUE
 230 :    55             CONTINUE
 231 :    60             CONTINUE
 232 :    65             CONTINUE
 233 :                   SEGDES IPT1
 234 :    80             CONTINUE
 235 :             ENDIF
 236 :             SEGINI IZUMAX
 237 :             DO 85 ISOUS=1,NBS
 238 :             ID1=IDUN(ISOUS)
 239 :             SEGINI IZUN
 240 :             IPUN1(ISOUS)=IZUN
 241 :             DO 140 IEL=1,I3
 242 :             UE=0.D0
 243 :             DO 145 ID=1,I2
 244 :             IP=IBID(ID,IEL)
 245 :                  DO 110 I=1,I1
 246 :                  UN(I,ID,IEL)=VPOCHA(IP,I)
 247 :   110            CONTINUE
 248 :             U=0.D0
 249 :             DO 127 K=1,I1
 250 :                 U=U+UN(K,ID,IEL)*UN(K,ID,IEL)
 251 :   127       CONTINUE
 252 :             U=SQRT(U)
 253 :             IF(U.GT.UE)UE=U
 254 :   145       CONTINUE
 255 :             UMAX(IEL+ID1)=UE
 256 :   140       CONTINUE
 257 : C      WRITE(6,100)(((UN(I,J,K),I=1,I1),J=1,I2),K=1,I3)
 258 :              SEGDES IZUN
 259 :    85       CONTINUE
 260 :             IPUMAX=IZUMAX
 261 :             SEGDES IZUMAX
 262 :             SEGDES MPOVAL ,IPT2,MSOUPO,MCHPO1
 263 :             SEGDES IZVPT
 264 :    90       CONTINUE
 265 :             DO 150 ISOUS=1,NBS
 266 :             IZBID=IPBID(ISOUS)
 267 :              SEGSUP IZBID
 268 :   150       CONTINUE
 269 :            SEGDES MTABTT,MTABFT,MTABLE
 270 :       ENDIF
 271 :       IF(NBSOUS.NE.0)SEGDES MELEME
 272 :       SEGDES IZVIT
 273 :       SEGSUP IZPBID
 274 :       RETURN
 275 :       END
 276 :  
 277 :   
 278 :