Télécharger enlev7.eso

Retour à la liste

Numérotation des lignes :

  1. C ENLEV7 SOURCE MB234859 16/06/02 21:15:00 8940
  2. ************************************************************************
  3. *
  4. * E N L E V 7
  5. * -----------
  6. *
  7. * FONCTION:
  8. * ---------
  9. *
  10. * ENLEVER UNE FORMULATION OU UN COMPORTEMENT A UN "MMODEL".
  11. *
  12. *
  13. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  14. * -----------
  15. *
  16. * MOD2 = ENLE MOD1 | 'FORM' | MOT1 ;
  17. * | 'COMP' |
  18. *
  19. * MOD2 (S) OBJET RESULTAT DE TYPE MMODEL DE POINTEUR MMODEL
  20. *
  21. * MOD1 (E) OBJET DE TYPE MMODEL FOURNIT EN ENTREE DE
  22. * POINTEUR IPMOD1
  23. *
  24. * 'FORM' | -> MOT CLE SPECIFIE SI LE MOT A RETIRER EST A CHERCHER
  25. * 'COMP' | -> DANS FORMULATION (FORMOD) OU COMPORTEMENT (MATMOD)
  26. *
  27. *
  28. * MOT1 OBJET DE TYPE MOT DONNANT LA PARTIE DU MMODEL MOD1
  29. * QUE L'ON SOUHAITE RETIRER
  30. *
  31. ************************************************************************
  32. SUBROUTINE ENLEV7(IPMOD1,IPMOD2)
  33. C
  34. IMPLICIT REAL*8(A-H,O-Z)
  35. IMPLICIT INTEGER (I-N)
  36. C
  37. -INC CCOPTIO
  38. -INC SMMODEL
  39. C
  40. CHARACTER*4 NONOM(2)
  41. SEGMENT LIMOTS
  42. CHARACTER*16 MOTEMP(NBFORM)
  43. END SEGMENT
  44. SEGMENT LIMOD1(NBMODI), LIMOD2(NBMODI)
  45. LOGICAL TROUVE, FIRST
  46. C
  47. DATA NONOM /'FORM','COMP'/
  48. C
  49. C LECTURE D'UN MOT CLE
  50. C
  51. CALL LIRMOT(NONOM,2,INOM,1)
  52. C
  53. C LECTURE DU OU DES MOTS FOURNIS PAR L'UTILISATEUR
  54. C
  55. NBFORM = 15
  56. SEGINI LIMOTS
  57. ICOND = 1
  58. INFOR = 1
  59. 10 CALL LIRCHA(MOTEMP(INFOR),ICOND,IRETOU)
  60. IF (IERR.NE.0) RETURN
  61. ICOND = 0
  62. IF (IRETOU.NE.0) THEN
  63. INFOR = INFOR + 1
  64. GOTO 10
  65. ENDIF
  66. NBFORM = INFOR - 1
  67. SEGADJ LIMOTS
  68. C
  69. C ACTIVATION DU MODELE
  70. C
  71. MMODE1 = IPMOD1
  72. SEGACT MMODE1
  73. NSOUS = MMODE1.KMODEL(/1)
  74. C
  75. IF (NSOUS.EQ.0) THEN
  76. IPMOD2 = IPMOD1
  77. GOTO 1000
  78. ENDIF
  79. C
  80. C BOUCLE SUR LES SOUS-MODELES
  81. C
  82. FIRST = .TRUE.
  83. NBMODI = 15
  84. SEGINI LIMOD1, LIMOD2
  85. INDD = 1
  86. NBCL = NSOUS
  87. 20 ISEG = 0
  88. DO 30 III = 1,NBCL
  89. IF (FIRST) THEN
  90. IMODE1 = MMODE1.KMODEL(III)
  91. ELSE
  92. IMODE1 = LIMOD1(III)
  93. ENDIF
  94. SEGACT IMODE1
  95. IF (IMODE1.FORMOD(1)(1:8).EQ.'MELANGE') THEN
  96. MOTERR(1:8)=IMODE1.FORMOD(1)
  97. CALL ERREUR(39)
  98. GOTO 900
  99. ENDIF
  100. NFOR = IMODE1.FORMOD(/2)
  101. NMAT = IMODE1.MATMOD(/2)
  102. IF (INOM.EQ.1) THEN
  103. DO IV = 1,NFOR
  104. IF (IMODE1.FORMOD(IV)(1:8).EQ.MOTEMP(INDD)(1:8)) THEN
  105. ISEG = ISEG + 1
  106. IF (ISEG.GT.NBMODI) THEN
  107. NBMODI = NBMODI + 15
  108. SEGADJ LIMOD2
  109. ENDIF
  110. LIMOD2(ISEG) = IMODE1
  111. GOTO 30
  112. ENDIF
  113. ENDDO
  114. ELSE IF (INOM.EQ.2) THEN
  115. DO IV = 1,NMAT
  116. IF (IMODE1.MATMOD(IV)(1:8).EQ.MOTEMP(INDD)(1:8)) THEN
  117. ISEG = ISEG + 1
  118. IF (ISEG.GT.NBMODI) THEN
  119. NBMODI = NBMODI + 15
  120. SEGADJ LIMOD2
  121. ENDIF
  122. LIMOD2(ISEG) = IMODE1
  123. GOTO 30
  124. ENDIF
  125. ENDDO
  126. ENDIF
  127. SEGDES IMODE1
  128. 30 CONTINUE
  129. C
  130. IF (LIMOD2(/1).EQ.0.AND.LIMOD1(/1).EQ.0) THEN
  131. IPMOD2 = IPMOD1
  132. GOTO 900
  133. ENDIF
  134. C
  135. NBMODI = ISEG
  136. SEGADJ LIMOD1, LIMOD2
  137. NBCL = NBMODI
  138. DO II = 1, NBCL
  139. LIMOD1(II) = LIMOD2(II)
  140. ENDDO
  141. C
  142. IF ((MOTEMP(/2).GT.1).AND.(INDD.LT.MOTEMP(/2))) THEN
  143. FIRST = .FALSE.
  144. INDD = INDD + 1
  145. NBMODI = 0
  146. SEGADJ LIMOD2
  147. GOTO 20
  148. ENDIF
  149. C
  150. N1 = NSOUS - LIMOD1(/1)
  151. C
  152. C CREATION DU NOUVEAU MMODEL
  153. C
  154. SEGINI MMODEL
  155. IPMOD2 = MMODEL
  156. IA = 0
  157. DO 100 III = 1, NSOUS
  158. IMODE1 = MMODE1.KMODEL(III)
  159. TROUVE = .FALSE.
  160. DO 200 IV = 1, LIMOD1(/1)
  161. IF (IMODE1.EQ.LIMOD1(IV)) THEN
  162. TROUVE = .TRUE.
  163. GOTO 100
  164. ENDIF
  165. 200 CONTINUE
  166. IA = IA + 1
  167. KMODEL(IA) = IMODE1
  168. 100 CONTINUE
  169. SEGDES MMODEL
  170. C
  171. C MENAGE AVANT DE QUITTER
  172. C
  173. 900 SEGDES IMODE1
  174. SEGDES MMODE1
  175. SEGSUP LIMOD1, LIMOD2
  176. SEGSUP LIMOTS
  177. C
  178. 1000 RETURN
  179. END
  180.  
  181.  

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