Télécharger la plaquette Cast3M


fr en

Télécharger nbcomp.eso

Retour à la liste

Numérotation des lignes : 

nbcomp

  1. C NBCOMP    SOURCE    CB215821  23/12/07    21:15:05     11805          
  2.       SUBROUTINE NBCOMP(IPOI1,CTYP,NBCO)
  3.  
  4. C-----------------------------------------------------------------------
  5. C     Cette SUBROUTINE donne le nombre de composante d'un objet
  6. C       CHPOINT si CTYP='CHPOINT '
  7. C       MCHAML  si CTYP='MCHAML  '
  8. C
  9. C     Travaille a SEGMENTS ouverts !
  10. C-----------------------------------------------------------------------
  11.  
  12.       IMPLICIT INTEGER(I-N)
  13.       IMPLICIT REAL*8(A-H,O-Z)
  14.  
  15. -INC SMCHAML
  16. -INC SMLMOTS
  17. -INC SMCHPOI
  18. -INC PPARAM
  19.  
  20.       CHARACTER*(*)    CTYP
  21.       PARAMETER       (NCOPRE=100,IDEC=50,IMUL=2)
  22. C                      NCOPRE : Nombre de composantes preconditionnees (Pour éviter SEGINI)
  23. C                      IDEC   : Partie arithmetique de l'augmentation du SEGADJ
  24. C                      IMUL   : Partie geometrique  de l'augmentation du SEGADJ
  25.       CHARACTER*(LOCOMP) CLIST(NCOPRE),MOTn
  26.  
  27.       MLMOTS = 0
  28.       NBCO   = 0
  29.       IF    (CTYP .EQ. 'CHPOINT')THEN
  30.         MCHPOI=IPOI1
  31.         NSOUPO=IPCHP(/1)
  32.         DO I=1,NSOUPO
  33.           MSOUPO=IPCHP(I)
  34.           DO 40 K=1,MSOUPO.NOCOMP(/2)
  35.             MOTn=MSOUPO.NOCOMP(K)
  36.             IF(MLMOTS .EQ. 0)THEN
  37.               DO J=1,NBCO
  38.                 IF (CLIST(J).EQ.MOTn) GOTO 40
  39.               ENDDO
  40.             ELSE
  41.               DO J=1,NBCO
  42.                 IF (MLMOTS.MOTS(J).EQ.MOTn) GOTO 40
  43.               ENDDO
  44.             ENDIF
  45.             NBCO = NBCO + 1
  46.  
  47.             IF (NBCO .GT. NCOPRE)THEN
  48.               IF(MLMOTS .EQ. 0)THEN
  49.                 JGN=LOCOMP
  50.                 JGM=NBCO*IMUL + IDEC
  51.                 SEGINI,MLMOTS
  52.                 DO ii=1,NCOPRE
  53.                   MLMOTS.MOTS(ii)=CLIST(ii)
  54.                 ENDDO
  55.  
  56.               ELSEIF(NBCO .GT. JGM)THEN
  57.                 JGM=NBCO*IMUL + IDEC
  58.                 SEGADJ,MLMOTS
  59.               ENDIF
  60.               MLMOTS.MOTS(NBCO)=MOTn
  61.  
  62.             ELSE
  63.               CLIST(NBCO)=MOTn
  64.             ENDIF
  65.  40       CONTINUE
  66.         ENDDO
  67.  
  68.       ELSEIF(CTYP .EQ. 'MCHAML')THEN
  69.         MCHELM=IPOI1
  70.         N1    =MCHELM.ICHAML(/1)
  71.         DO IN1=1,N1
  72.           MCHAML=MCHELM.ICHAML(IN1)
  73.           N2    =MCHAML.NOMCHE(/2)
  74.           DO 60 IN2=1,N2
  75.             MOTn=MCHAML.NOMCHE(IN2)
  76.             IF(MLMOTS .EQ. 0)THEN
  77.               DO J=1,NBCO
  78.                 IF (CLIST(J).EQ.MOTn) GOTO 60
  79.               ENDDO
  80.             ELSE
  81.               DO J=1,NBCO
  82.                 IF (MLMOTS.MOTS(J).EQ.MOTn) GOTO 60
  83.               ENDDO
  84.             ENDIF
  85.             NBCO = NBCO + 1
  86.  
  87.             IF (NBCO .GT. NCOPRE)THEN
  88.               IF(MLMOTS .EQ. 0)THEN
  89.                 JGN=LOCOMP
  90.                 JGM=NBCO*IMUL + IDEC
  91.                 SEGINI,MLMOTS
  92.                 DO ii=1,NCOPRE
  93.                   MLMOTS.MOTS(ii)=CLIST(ii)
  94.                 ENDDO
  95.  
  96.               ELSEIF(NBCO .GT. JGM)THEN
  97.                 JGM=NBCO*IMUL + IDEC
  98.                 SEGADJ,MLMOTS
  99.               ENDIF
  100.               MLMOTS.MOTS(NBCO)=MOTn
  101.  
  102.             ELSE
  103.               CLIST(NBCO)=MOTn
  104.             ENDIF
  105.  60       CONTINUE
  106.         ENDDO
  107.  
  108.       ELSE
  109.         CALL ERREUR(21)
  110.         RETURN
  111.       ENDIF
  112.  
  113.       END
  114.  
  115.  

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