Télécharger la plaquette Cast3M


fr en

Télécharger evnumo.eso

Retour à la liste

Numérotation des lignes : 

evnumo

  1. C EVNUMO    SOURCE    BP208322  22/09/09    21:15:02     11448          
  2.       SUBROUTINE EVNUMO(ITYPE,IRET,NOMCO,IBOO)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C=======================================================================
  6. C   CHERCHE DANS L'OBJET IRET DE TYPE ITYPE LA LISTE DES POINTS ET
  7. C   REMPLIT LE TABLEAU NUMOO
  8. C   APPELE PAR EVSOLU
  9. C   APPELLE CHANGE,LIRE,REFUS,ERREUR(66)
  10. C   ECRIT PAR FARVACQUE LE 24/10/85
  11. C=======================================================================
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC SMSOLUT
  16. -INC SMATTAC
  17. -INC SMELEME
  18. -INC SMCHPOI
  19.       SEGMENT ITRAV1(0)
  20.       SEGMENT STRAV2
  21.        CHARACTER*(LOCOMP) ITRAV2(0)
  22.       ENDSEGMENT
  23.       SEGMENT NUMOO
  24.        INTEGER NUMO(N),KLIST(N)
  25.        CHARACTER*(LOCHPO) NUDDL(N)
  26.       ENDSEGMENT
  27.       LOGICAL L0,L1
  28.       CHARACTER*8 ITYPE,TYPRET,CHARRE
  29.       CHARACTER*(LOCOMP) NOMCO
  30. *
  31.       IF (ITYPE.EQ.'POINT   ') THEN
  32.          N=1
  33.          SEGINI NUMOO
  34.          NUMO(1)=IRET
  35.          NUDDL(1)=NOMCO
  36. *
  37.       ELSE IF (ITYPE.EQ.'MAILLAGE') THEN
  38.          MELEME= IRET
  39.          SEGACT MELEME
  40.          IF(ITYPEL.NE.1) CALL CHANGE (IRET,1)
  41.          MELEME=IRET
  42.          SEGACT MELEME
  43.          N=NUM(/2)
  44.          SEGINI NUMOO
  45.          DO 10 I=1,N
  46.             NUMO(I)=NUM(1,I)
  47.             NUDDL(I)=NOMCO
  48.  10      CONTINUE
  49.          SEGDES MELEME
  50. *
  51.       ELSE IF (ITYPE.EQ.'CHPOINT ') THEN
  52.          MCHPOI=IRET
  53.          SEGACT MCHPOI
  54.          NSOUPO=IPCHP(/1)
  55.          SEGINI ITRAV1
  56.          SEGINI STRAV2
  57.          DO 20 I=1,NSOUPO
  58.             MSOUPO=IPCHP(I)
  59.             SEGACT MSOUPO
  60.             MELEME=IGEOC
  61.             SEGACT MELEME
  62.             NP=NUM(/2)
  63.             NC=NOCOMP(/2)
  64.             MPOVAL=IPOVAL
  65.             SEGACT MPOVAL
  66.             DO J1=1,NP
  67.                DO J2=1,NC
  68.                   ITRAV1(**)=NUM(1,J1)
  69.                   ITRAV2(**)=NOCOMP(J2)
  70.                ENDDO
  71.             ENDDO
  72.             SEGDES MELEME,MPOVAL,MSOUPO
  73.  20      CONTINUE
  74.          SEGDES MCHPOI
  75.          N=ITRAV1(/1)
  76.          SEGINI NUMOO
  77.          DO 24 I=1,N
  78.             NUMO(I)=ITRAV1(I)
  79.             NUDDL(I)=ITRAV2(I)
  80.  24      CONTINUE
  81.          SEGSUP ITRAV1,STRAV2
  82. *
  83.       ELSE IF (ITYPE.EQ.'ATTACHE ') THEN
  84.          MATTAC=IRET
  85.          SEGACT MATTAC
  86.          NSOU=LISATT(/1)
  87.          N=0
  88.          NI=0
  89.          SEGINI NUMOO
  90.          DO 30 I=1,NSOU
  91.             MSOUMA=LISATT(I)
  92.             SEGACT MSOUMA
  93.             MJONCT=IATREL(1)
  94.             SEGDES MSOUMA
  95.             SEGACT MJONCT
  96.             MCHPOI=MJOPOI
  97.             SEGDES MJONCT
  98.             SEGACT MCHPOI
  99.             MSOUPO=IPCHP(1)
  100.             SEGDES MCHPOI
  101.             SEGACT MSOUPO
  102.             MELEME=IGEOC
  103.             SEGDES MSOUPO
  104.             SEGACT MELEME
  105.             NM=NUM(/2)
  106.             N=N+NM
  107.             SEGADJ NUMOO
  108.             DO 32 J=1,NM
  109.                NUMO(NI+J)=NUM(1,J)
  110.                NUDDL(NI+J)=NOMCO
  111.  32         CONTINUE
  112.             NI=N
  113.             SEGDES MELEME
  114.  30      CONTINUE
  115.          SEGDES MATTAC
  116. *
  117.       ELSE IF (ITYPE.EQ.'SOLUTION') THEN
  118.          MSOLUT=IRET
  119.          SEGACT MSOLUT
  120.          IF (MSOLIS(3).EQ.0) THEN
  121.             MOTERR(1:8)='SOLUTION'
  122.             MOTERR(9:16)='MODE'
  123.             CALL ERREUR(66)
  124. *           ON ATTEND UN MODE
  125.             SEGDES MSOLUT
  126.             GOTO 5000
  127.          ELSE
  128.            MELEME=MSOLIS(3)
  129.            SEGDES MSOLUT
  130.            SEGACT MELEME
  131.            N=NUM(/2)
  132.            SEGINI NUMOO
  133.            DO 40 I=1,N
  134.               NUMO(I)=NUM(1,I)
  135.               NUDDL(I)=NOMCO
  136.  40        CONTINUE
  137.            SEGDES MELEME
  138.          ENDIF
  139. *
  140.       ELSE IF (ITYPE.EQ.'TABLE   ') THEN
  141.          CALL ACCTAB(IRET,'MOT',I0,X0,'MODES',L0,IP0,
  142.      &                  'TABLE',I1,X1,' ',L1,IBAS)
  143.          IB = 0
  144.          NBMODE = 0
  145.  50      CONTINUE
  146.          IB = IB + 1
  147.          TYPRET = ' '
  148.          CALL ACCTAB(IBAS,'ENTIER',IB,X0,' ',L0,IP0,
  149.      &                      TYPRET,I1,X1,CHARRE,L1,IBBB)
  150.          IF (IBBB.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  151.             NBMODE = NBMODE + 1
  152.             GOTO 50
  153.          ENDIF
  154.          N = NBMODE
  155.          SEGINI NUMOO
  156.          DO 52 IB = 1,NBMODE
  157.             CALL ACCTAB(IBAS,'ENTIER',IB,X0,' ',L0,IP0,
  158.      &                      TYPRET,I1,X1,TYPRET,L1,IBBB)
  159.             CALL ACCTAB(IBBB,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  160.      &                     'POINT',I1,X1,' ',L1,IPTR)
  161.             NUMO(IB)=IPTR
  162.             NUDDL(IB)=NOMCO
  163.  52      CONTINUE
  164.       ENDIF
  165.       IBOO=NUMOO
  166.       IF(IIMPI.NE.0)WRITE(6,1700)(NUMO(I),NUDDL(I),I=1,NUMO(/1))
  167.  1700 FORMAT('   COUPLES NUMO-NUDDL ',10(I5,A8,1X))
  168.  5000 CONTINUE
  169.       RETURN
  170.       END
  171.  
  172.  
  173.  
  174.  
  175.  

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