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