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  20/11/25    13:30:23     10792          
  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.    1  ICPR(I)=0
  23.       NBELT=ITABEL(/1)
  24.       DO 7 IITT=1,NBELT
  25.       IF (IITT .EQ. 1) THEN
  26.         IPCH1 = ITABEL(NBELT+1-IITT)
  27.         CALL COPIE2(IPCH1,IPCH)
  28.         MCHPOI = IPCH
  29.         SEGACT MCHPOI
  30.         NSOUPO=IPCHP(/1)
  31.         DO 9 IC =1,NSOUPO
  32.           MSOUPO = IPCHP(IC)
  33.           SEGACT MSOUPO*MOD
  34.           IF ( NOCOMP(/2) .NE. 1) THEN
  35.               CALL ERREUR (251)
  36.               SEGSUP MSOUPO
  37.               SEGSUP MCHPOI
  38.               SEGSUP ICPR,ITABEL
  39.               RETURN
  40.           ENDIF
  41.           MELEME = IGEOC
  42.           CALL ADDITI(X,MELEME,NOUV,ICPR)
  43.           IF (IERR.NE.0) THEN
  44.               SEGSUP MSOUPO
  45.               SEGSUP MCHPOI
  46.               SEGSUP ICPR,ITABEL
  47.               RETURN
  48.           ENDIF
  49.           IGEOC = NOUV
  50.           SEGDES MSOUPO
  51.     9   CONTINUE
  52.         CALL   ECROBJ('CHPOINT',IPCH)
  53.         SEGDES MCHPOI
  54.         GOTO 8
  55.       ENDIF
  56.       MELEME=ITABEL(NBELT+1-IITT)
  57.       SEGACT MELEME
  58.       IF (LISOUS(/1).NE.0) GOTO 15
  59.       CALL ADDITI(X,MELEME,NOUV,ICPR)
  60.       IF (IERR.NE.0) RETURN
  61.       MELEME=NOUV
  62.       SEGDES MELEME
  63.  20   CALL ECROBJ('MAILLAGE',MELEME)
  64.       GOTO 8
  65.   15  CONTINUE
  66.       NBSOUS=LISOUS(/1)
  67.       NBREF=LISREF(/1)
  68.       NBNN=0
  69.       NBELEM=0
  70.       SEGINI IPT1
  71.       DO 30 I=1,LISOUS(/1)
  72.       ILIS=LISOUS(I)
  73.       CALL ADDITI(X,ILIS,NOUV,ICPR)
  74.       IF (IERR.NE.0) RETURN
  75.       IPT1.LISOUS(I)=NOUV
  76.   30  CONTINUE
  77.       IF (LISREF(/1).EQ.0) GOTO 32
  78.       DO 31 I=1,LISREF(/1)
  79.       ILIS=LISREF(I)
  80.       CALL ADDITI(X,ILIS,NOUV,ICPR)
  81.       IF (IERR.NE.0) RETURN
  82.       IPT1.LISREF(I)=NOUV
  83.   31  CONTINUE
  84.   32  CONTINUE
  85.       SEGDES MELEME
  86.       MELEME=IPT1
  87.       GOTO 20
  88.    8  CONTINUE
  89.    7  CONTINUE
  90.       SEGSUP ICPR,ITABEL
  91.       RETURN
  92.       END
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  

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