Esope source files

   1 : C DEDU1     SOURCE    CHAT      05/01/12    22:39:40     5004           
   2 : C DEDU1
   3 : C
   4 : C IDENTIFIE LE CHPOINT MCHPO4 PERMETTANT DE PASSER D'UNE GEOMETRIE
   5 : C    IPT1 A UNE SECONDE IPT2 ET POINTE LES NOEUDS DE IPT1 DANS ICP1
   6 : C    ITABEL ET INOUVEL ENREGISTRENT LA CORRESPONDANCE POUR LES MELEME
   7 : C  FINALEMENT, MCHPO4 RANGE DANS IPOIN1
   8 : C APPELE PAR PROPER, POUR EXECUTION OPTIONS 'TRANS' ET 'ROTA' DE DEDU
   9 : C
  10 : C  11/97 : KICH
  11 : C---------------------------------------------------------------------
  12 :       SUBROUTINE DEDU1(IPT1,IPT2,ICP1,ITABEL,INOUVEL,IPOIN1)
  13 :       IMPLICIT INTEGER(I-N)
  14 :       IMPLICIT REAL*8 (A-H,O-Z)
  15 : -INC CCOPTIO
  16 : -INC SMCOORD
  17 : -INC SMELEME
  18 : -INC SMCHPOI
  19 :       SEGMENT ICP1(XCOOR(/1)/(IDIM+1))
  20 :       SEGMENT ITABEL(0)
  21 :       SEGMENT INOUVEL(0)
  22 : 
  23 :       SEGINI ITABEL,INOUVEL
  24 :       SEGINI ICP1
  25 :       SEGDES ICP1  
  26 :       SEGACT IPT1,IPT2
  27 :       NBSOUS1 = IPT1.LISOUS(/1)
  28 :       NBSOUS2 = IPT2.LISOUS(/1)
  29 :       NBREF1 = IPT1.LISREF(/1)
  30 :       NBREF2 = IPT2.LISREF(/1)
  31 :       IF (NBSOUS1.NE.NBSOUS2) GOTO 5397
  32 : C pas de verification sur les references. kich
  33 : c      IF (NBREF1.NE.NBREF2) GOTO 5397
  34 :       IF (NBSOUS1.EQ.0) THEN
  35 :         IF (IPT1.ITYPEL.NE.IPT2.ITYPEL) GOTO 5397
  36 :         IF (IPT1.NUM(/1).NE.IPT2.NUM(/1)) GOTO 5397
  37 :         IF (IPT1.NUM(/2).NE.IPT2.NUM(/2)) GOTO 5397
  38 :         SEGDES IPT1,IPT2
  38 :         CALL PROCHP(IPT1,IPT2,IPOIN1,ICP1)
  39 :         IF (IERR.NE.0) GOTO 5397
  40 :         ITABEL(**) = IPT1
  41 :         INOUVEL(**) = IPT2
  42 :       ELSE IF (NBSOUS1.NE.0) THEN
  43 :         DO 5310 J=1,NBSOUS1
  44 :            IPT3 = IPT1.LISOUS(J)
  45 :            IPT4 = IPT2.LISOUS(J)
  46 :            SEGACT IPT3,IPT4
  47 :            NBSOUS3 = IPT3.LISOUS(/1) 
  48 :            NBSOUS4 = IPT4.LISOUS(/1)
  49 :            NBREF3 = IPT3.LISREF(/1)
  50 :            NBREF4 = IPT4.LISREF(/1)
  51 :            IF (NBSOUS3.NE.NBSOUS4) GOTO 5396
  52 : C pas de verification sur les references. kich
  53 : c           IF (NBREF3.NE.NBREF4) GOTO 5396
  54 :            IF (IPT3.ITYPEL.NE.IPT4.ITYPEL) GOTO 5396
  55 :            IF (IPT3.NUM(/1).NE.IPT4.NUM(/1)) GOTO 5396
  56 :            IF (IPT3.NUM(/2).NE.IPT4.NUM(/2)) GOTO 5396
  57 :            SEGDES IPT3,IPT4
  57 :            CALL PROCHP(IPT3,IPT4,MCHPO4,ICP1)
  58 :            IF (IERR.NE.0) GOTO 5396
  59 :            ITABEL(**) = IPT3
  60 :            INOUVEL(**) = IPT4
  61 :            IF(J.EQ.1) THEN
  62 :              IPCHP0 = MCHPO4
  63 :            ELSE
  63 :              CALL FUCHPO(IPCHP0,MCHPO4,IPRET)
  64 :              IPCHP0 = IPRET
  65 :            ENDIF
  66 :            IF (IERR.NE.0) GOTO 5396
  67 :  5310   CONTINUE
  68 :         IPOIN1 = IPCHP0
  69 :         IF ((NBREF1.NE.0).AND.(NBREF1.EQ.NBREF2)) THEN
  70 :           DO 5317 J=1,NBREF1
  71 :             DO 5316 K=1,ITABEL(/1)
  72 :               IF (ITABEL(K).EQ.IPT1.LISREF(J)) GOTO 5317
  73 :  5316         CONTINUE
  74 :               ITABEL(**) = IPT1.LISREF(J)
  75 :               INOUVEL(**) = IPT2.LISREF(J)
  76 :  5317     CONTINUE
  77 :         ENDIF
  78 :         SEGDES IPT1,IPT2
  79 :       ENDIF
  80 :       SEGDES ICP1,ITABEL,INOUVEL 
  81 :       RETURN
  82 : 
  83 :  5396 CONTINUE
  84 :       SEGDES IPT3,IPT4
  85 :  5397 CONTINUE
  86 :       SEGDES IPT1,IPT2
  87 :       SEGSUP ITABEL,INOUVEL,ICP1
  88 : *  erreur dans le calcul du CHPOINT, verifier les donnees
  88 :       CALL ERREUR(878)
  89 :       RETURN
  90 :       END
  91 : 
  92 :  
  93 :  
  94 :