Télécharger la plaquette Cast3M


fr en

Télécharger intop1.eso

Retour à la liste

Numérotation des lignes : 

intop1

  1. C INTOP1    SOURCE    CB215821  26/10/26    21:15:40     12682          
  2. C   INTERFACE ENTRE LES LECTURES DE DONNEES D'OPERATIONS ELEMENTAIRES
  3. C   ET LES PROGRAMMES D'EXECUTIONS
  4. C
  5.       SUBROUTINE INTOP1(IP2,IP1)
  6.       IMPLICIT INTEGER(I-N)
  7.       IMPLICIT REAL*8 (A-H,O-Z)
  8.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11. -INC SMELEME
  12. -INC SMCOORD
  13. -INC SMCHPOI
  14.       SEGMENT ICPR(nbpts)
  15.       DIMENSION X(3)
  16.       SEGMENT ITABEL(2)
  17.       SEGINI ITABEL
  18.       ITABEL(1)=IP1
  19.       ITABEL(2)=IP2
  20.       SEGINI ICPR
  21.       DO 1 I=1,ICPR(/1)
  22.       ICPR(I)=0
  23.    1  CONTINUE
  24.       NBELT=ITABEL(/1)
  25.       DO 7 IITT=1,NBELT
  26.       IF (IITT .EQ. 1) THEN
  27.         IPCH1 = ITABEL(NBELT+1-IITT)
  28.         CALL COPIE2(IPCH1,IPCH)
  29.         MCHPOI = IPCH
  30.         SEGACT MCHPOI
  31.         NSOUPO=IPCHP(/1)
  32.         DO 9 IC =1,NSOUPO
  33.           MSOUPO = IPCHP(IC)
  34.           SEGACT MSOUPO*MOD
  35.           IF ( NOCOMP(/2) .NE. 1) THEN
  36.               CALL ERREUR (251)
  37.               SEGSUP MSOUPO
  38.               SEGSUP MCHPOI
  39.               SEGSUP ICPR,ITABEL
  40.               RETURN
  41.           ENDIF
  42.           MELEME = IGEOC
  43.           CALL ADDITI(X,MELEME,NOUV,ICPR)
  44.           IF (IERR.NE.0) THEN
  45.               SEGSUP MSOUPO
  46.               SEGSUP MCHPOI
  47.               SEGSUP ICPR,ITABEL
  48.               RETURN
  49.           ENDIF
  50.           IGEOC = NOUV
  51.           SEGDES MSOUPO
  52.     9   CONTINUE
  53.         CALL   ECROBJ('CHPOINT',IPCH)
  54.         SEGDES MCHPOI
  55.         GOTO 8
  56.       ENDIF
  57.       MELEME=ITABEL(NBELT+1-IITT)
  58.       SEGACT MELEME
  59.       IF (LISOUS(/1).NE.0) GOTO 15
  60.       CALL ADDITI(X,MELEME,NOUV,ICPR)
  61.       IF (IERR.NE.0) RETURN
  62.       MELEME=NOUV
  63.       SEGDES MELEME
  64.  20   CALL ECROBJ('MAILLAGE',MELEME)
  65.       GOTO 8
  66.   15  CONTINUE
  67.       NBSOUS=LISOUS(/1)
  68.       NBREF=LISREF(/1)
  69.       NBNN=0
  70.       NBELEM=0
  71.       SEGINI IPT1
  72.       DO 30 I=1,LISOUS(/1)
  73.       ILIS=LISOUS(I)
  74.       CALL ADDITI(X,ILIS,NOUV,ICPR)
  75.       IF (IERR.NE.0) RETURN
  76.       IPT1.LISOUS(I)=NOUV
  77.   30  CONTINUE
  78.       IF (LISREF(/1).EQ.0) GOTO 32
  79.       DO 31 I=1,LISREF(/1)
  80.       ILIS=LISREF(I)
  81.       CALL ADDITI(X,ILIS,NOUV,ICPR)
  82.       IF (IERR.NE.0) RETURN
  83.       IPT1.LISREF(I)=NOUV
  84.   31  CONTINUE
  85.   32  CONTINUE
  86.       SEGDES MELEME
  87.       MELEME=IPT1
  88.       GOTO 20
  89.    8  CONTINUE
  90.    7  CONTINUE
  91.       SEGSUP ICPR,ITABEL
  92.       RETURN
  93.       END
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  

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