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.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. -INC SMMODEL
  41. C
  42. CHARACTER*4 NONOM(2)
  43. SEGMENT LIMOTS
  44. CHARACTER*16 MOTEMP(NBFORM)
  45. END SEGMENT
  46. SEGMENT LIMOD1(NBMODI), LIMOD2(NBMODI)
  47. LOGICAL TROUVE, FIRST
  48. C
  49. DATA NONOM /'FORM','COMP'/
  50. C
  51. C LECTURE D'UN MOT CLE
  52. C
  53. CALL LIRMOT(NONOM,2,INOM,1)
  54. C
  55. C LECTURE DU OU DES MOTS FOURNIS PAR L'UTILISATEUR
  56. C
  57. NBFORM = 15
  58. SEGINI LIMOTS
  59. ICOND = 1
  60. INFOR = 1
  61. 10 CALL LIRCHA(MOTEMP(INFOR),ICOND,IRETOU)
  62. IF (IERR.NE.0) RETURN
  63. ICOND = 0
  64. IF (IRETOU.NE.0) THEN
  65. INFOR = INFOR + 1
  66. GOTO 10
  67. ENDIF
  68. NBFORM = INFOR - 1
  69. SEGADJ LIMOTS
  70. C
  71. C ACTIVATION DU MODELE
  72. C
  73. MMODE1 = IPMOD1
  74. SEGACT MMODE1
  75. NSOUS = MMODE1.KMODEL(/1)
  76. C
  77. IF (NSOUS.EQ.0) THEN
  78. IPMOD2 = IPMOD1
  79. GOTO 1000
  80. ENDIF
  81. C
  82. C BOUCLE SUR LES SOUS-MODELES
  83. C
  84. FIRST = .TRUE.
  85. NBMODI = 15
  86. SEGINI LIMOD1, LIMOD2
  87. INDD = 1
  88. NBCL = NSOUS
  89. 20 ISEG = 0
  90. DO 30 III = 1,NBCL
  91. IF (FIRST) THEN
  92. IMODE1 = MMODE1.KMODEL(III)
  93. ELSE
  94. IMODE1 = LIMOD1(III)
  95. ENDIF
  96. SEGACT IMODE1
  97. IF (IMODE1.FORMOD(1)(1:8).EQ.'MELANGE') THEN
  98. MOTERR(1:8)=IMODE1.FORMOD(1)
  99. CALL ERREUR(39)
  100. GOTO 900
  101. ENDIF
  102. NFOR = IMODE1.FORMOD(/2)
  103. NMAT = IMODE1.MATMOD(/2)
  104. IF (INOM.EQ.1) THEN
  105. DO IV = 1,NFOR
  106. IF (IMODE1.FORMOD(IV)(1:8).EQ.MOTEMP(INDD)(1:8)) THEN
  107. ISEG = ISEG + 1
  108. IF (ISEG.GT.NBMODI) THEN
  109. NBMODI = NBMODI + 15
  110. SEGADJ LIMOD2
  111. ENDIF
  112. LIMOD2(ISEG) = IMODE1
  113. GOTO 30
  114. ENDIF
  115. ENDDO
  116. ELSE IF (INOM.EQ.2) THEN
  117. DO IV = 1,NMAT
  118. IF (IMODE1.MATMOD(IV)(1:8).EQ.MOTEMP(INDD)(1:8)) THEN
  119. ISEG = ISEG + 1
  120. IF (ISEG.GT.NBMODI) THEN
  121. NBMODI = NBMODI + 15
  122. SEGADJ LIMOD2
  123. ENDIF
  124. LIMOD2(ISEG) = IMODE1
  125. GOTO 30
  126. ENDIF
  127. ENDDO
  128. ENDIF
  129. SEGDES IMODE1
  130. 30 CONTINUE
  131. C
  132. IF (LIMOD2(/1).EQ.0.AND.LIMOD1(/1).EQ.0) THEN
  133. IPMOD2 = IPMOD1
  134. GOTO 900
  135. ENDIF
  136. C
  137. NBMODI = ISEG
  138. SEGADJ LIMOD1, LIMOD2
  139. NBCL = NBMODI
  140. DO II = 1, NBCL
  141. LIMOD1(II) = LIMOD2(II)
  142. ENDDO
  143. C
  144. IF ((MOTEMP(/2).GT.1).AND.(INDD.LT.MOTEMP(/2))) THEN
  145. FIRST = .FALSE.
  146. INDD = INDD + 1
  147. NBMODI = 0
  148. SEGADJ LIMOD2
  149. GOTO 20
  150. ENDIF
  151. C
  152. N1 = NSOUS - LIMOD1(/1)
  153. C
  154. C CREATION DU NOUVEAU MMODEL
  155. C
  156. SEGINI MMODEL
  157. IPMOD2 = MMODEL
  158. IA = 0
  159. DO 100 III = 1, NSOUS
  160. IMODE1 = MMODE1.KMODEL(III)
  161. TROUVE = .FALSE.
  162. DO 200 IV = 1, LIMOD1(/1)
  163. IF (IMODE1.EQ.LIMOD1(IV)) THEN
  164. TROUVE = .TRUE.
  165. GOTO 100
  166. ENDIF
  167. 200 CONTINUE
  168. IA = IA + 1
  169. KMODEL(IA) = IMODE1
  170. 100 CONTINUE
  171. SEGDES MMODEL
  172. C
  173. C MENAGE AVANT DE QUITTER
  174. C
  175. 900 SEGDES IMODE1
  176. SEGDES MMODE1
  177. SEGSUP LIMOD1, LIMOD2
  178. SEGSUP LIMOTS
  179. C
  180. 1000 RETURN
  181. END
  182.  
  183.  

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