Télécharger la plaquette Cast3M


fr en

Télécharger enlev5.eso

Retour à la liste

Numérotation des lignes : 

enlev5

  1. C ENLEV5    SOURCE    FANDEUR   22/01/19    21:15:05     11256          
  2.       SUBROUTINE ENLEV5(IPOIN1,MSWMIL,IPOIN2)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5.  
  6. -INC PPARAM
  7. -INC CCOPTIO
  8. -INC SMCHPOI
  9. -INC SMCOORD
  10. -INC SMELEME
  11. -INC TMTRAV
  12.       SEGMENT MSWMIL
  13.         CHARACTER*(LOCOMP) MOTDDL(IAAA)
  14.       ENDSEGMENT
  15.       SEGMENT/MTRA/(ICPR(nbpts))
  16.       SEGMENT MTR1
  17.         CHARACTER*(LOCOMP) IPCOM(0)
  18.       ENDSEGMENT
  19.       SEGMENT/MTR2/(IPHAR(0))
  20. C
  21.       SEGACT MSWMIL
  22.       IBDDL=MOTDDL(/2)
  23.       IF(IBDDL.EQ.0) THEN
  24.          IPOIN2=IPOIN1
  25.          RETURN
  26.       ENDIF
  27.       IF(IBDDL.EQ.1) THEN
  28.          MCHPOI=IPOIN1
  29.          SEGACT MCHPOI
  30.          NSOUPO=IPCHP(/1)
  31.          ITOT=0
  32.          ISOU=0
  33.          DO 4 IA=1,NSOUPO
  34.             MSOUPO=IPCHP(IA)
  35.             SEGACT MSOUPO
  36.             NCBBB=NOCOMP(/2)
  37.             IEXT=0
  38.             DO 5 IB=1,NCBBB
  39.                IF(NOCOMP(IB).EQ.MOTDDL(1)) THEN
  40.                   IEXT=IA
  41.                   ITOT=ITOT+1
  42.                ENDIF
  43.  5          CONTINUE
  44.  4       CONTINUE
  45.          IF(ITOT.NE.1)    GO TO 2876
  46.          IF(IEXT.EQ.0)    GO TO 2876
  47.          MSOUPO=IPCHP(IEXT)
  48.          IF(NOCOMP(/2).NE.1) GO TO 2876
  49.          NSOUPO=NSOUPO-1
  50.          NC=IBDDL
  51.          NAT=MAX ( JATTRI(/1) , 1)
  52.          SEGINI MCHPO1
  53.          MCHPO1.MTYPOI=MTYPOI
  54.          MCHPO1.MOCHDE=MOCHDE
  55.          IF ( JATTRI(/1) .GE. 1 ) THEN
  56.             MCHPO1.JATTRI(1) = JATTRI(1)
  57.          ELSE
  58.             MCHPO1.JATTRI(1) = 0
  59.          ENDIF
  60.          MCHPO1.IFOPOI=IFOPOI
  61.          IBB=0
  62.          DO 7 IA=1,IPCHP(/1)
  63.             MSOUPO=IPCHP(IA)
  64.             IF ( IEXT.NE.IA) THEN
  65.                SEGINI,MSOUP1=MSOUPO
  66.                IBB=IBB+1
  67.                IPT1=IGEOC
  68.                SEGACT IPT1
  69. **             SEGINI,MELEME=IPT1
  70.                MELEME=IPT1
  71.                MPOVAL=IPOVAL
  72.                SEGACT MPOVAL
  73.                SEGINI,MPOVA1=MPOVAL
  74.                MSOUP1.IGEOC=MELEME
  75.                MSOUP1.IPOVAL=MPOVA1
  76.                MCHPO1.IPCHP(IBB)=MSOUP1
  77.             ENDIF
  78.  7       CONTINUE
  79.          IPOIN2 = MCHPO1
  80.          RETURN
  81.       ENDIF
  82.  2876 CONTINUE
  83. C
  84.       SEGINI MTRA,MTR1,MTR2
  85. C
  86.       NC=0
  87.       IK=0
  88.       MCHPOI=IPOIN1
  89.       SEGACT MCHPOI
  90.       NSOUPO=IPCHP(/1)
  91. C
  92. C     BOUCLE SUR LES SOUS REFERENCES DU CHPOINT
  93. C
  94.       DO 350 IA=1,NSOUPO
  95.          MSOUPO=IPCHP(IA)
  96.          SEGACT MSOUPO
  97.          NCBBB=NOCOMP(/2)
  98.          MILCO=0
  99. C
  100.          DO 330 IB=1,NCBBB
  101.             DO 344 MIK=1,IBDDL
  102.                IF(NOCOMP(IB).EQ.MOTDDL(MIK)) GO TO 330
  103.  344        CONTINUE
  104.             NC=IPCOM(/2)
  105.             DO 320 IC=1,NC
  106.                IF(IPCOM(IC).NE.NOCOMP(IB)) GO TO 320
  107.                IF(IPHAR(IC).EQ.NOHARM(IB))  GO TO 331
  108.  320        CONTINUE
  109.             IPCOM(**)=NOCOMP(IB)
  110.             IPHAR(**)=NOHARM(IB)
  111.             NC=NC+1
  112.  331        MILCO=MILCO+1
  113.  330     CONTINUE
  114. C
  115.          IF(MILCO.NE.0) THEN
  116.             MELEME=IGEOC
  117.             SEGACT MELEME
  118.             NBELEM=NUM(/2)
  119.             DO 310 IB=1,NBELEM
  120.                K=NUM(1,IB)
  121.                IF(ICPR(K).NE.0) GO TO 310
  122.                IK=IK+1
  123.                ICPR(K)=IK
  124.  310        CONTINUE
  125.          ENDIF
  126.  350  CONTINUE
  127. C
  128.       NNIN=NC
  129.       NNNOE=IK
  130.       SEGINI MTRAV
  131. C
  132. C     REMPLISSAGE DES TABLEAUX DU SEGMENT MTRAV
  133. C
  134.       DO 380 IA=1,NNIN
  135.          INCO(IA)=IPCOM(IA)
  136.          NHAR(IA)=IPHAR(IA)
  137.  380  CONTINUE
  138. C
  139.       DO 430 IA=1,NSOUPO
  140.          MSOUPO=IPCHP(IA)
  141.          SEGACT MSOUPO
  142.          MELEME=IGEOC
  143.          SEGACT MELEME
  144.          MPOVAL=IPOVAL
  145.          SEGACT MPOVAL
  146.          NBELEM=NUM(/2)
  147. C
  148.          DO 420 IB=1,NOCOMP(/2)
  149.             DO 390 IC=1,NNIN
  150.                IF(NOCOMP(IB).NE.IPCOM(IC)) GO TO 390
  151.                IF(NOHARM(IB).EQ.IPHAR(IC)) GO TO 400
  152.  390        CONTINUE
  153.             GO TO 420
  154.  400        CONTINUE
  155.             DO 410 ID=1,NBELEM
  156.                KI=ICPR(NUM(1,ID))
  157.                IF(KI.EQ.0) GO TO 410
  158.                IGEO(KI)=NUM(1,ID)
  159.                IBIN(IC,KI)=1
  160.                BB(IC,KI)=VPOCHA(ID,IB)
  161.  410        CONTINUE
  162.  420     CONTINUE
  163.  430  CONTINUE
  164. C
  165.       ITRAV=MTRAV
  166. C
  167.       CALL CRECHP(ITRAV,IPOIN2)
  168. C      ATTRIBUTION D'UNE NATURE A IPOIN2 IDENTIQUE AU CHPO IPOIN1
  169.       MCHPO1 = IPOIN2
  170.       SEGACT MCHPO1
  171.       NAT = MAX ( MCHPO1.JATTRI(/1) , 1)
  172.       NSOUPO = MCHPO1.IPCHP(/1)
  173.       SEGADJ MCHPO1
  174.       IF ( JATTRI(/1) .GE. 1 ) THEN
  175.          MCHPO1.JATTRI(1) = JATTRI(1)
  176.       ELSE
  177.          MCHPO1.JATTRI(1) = 0
  178.       ENDIF
  179.       MCHPO1.IFOPOI = MCHPOI.IFOPOI
  180. *      SEGACT,MCHPO1*NOMOD
  181.  
  182.       SEGSUP MTRAV,MTRA,MTR1,MTR2
  183.       END
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  

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