Télécharger manuc3.eso

Retour à la liste

Numérotation des lignes :

  1. C MANUC3 SOURCE CHAT 11/03/16 21:27:10 6902
  2. SUBROUTINE MANUC3(MLENT1,MLMOTS,IPOI,MONMOT,MLMOT3,MLMOT2,
  3. . LETYP,JER1,MLMOT4,ICHA)
  4. *------------------------------------------------------------------
  5. *
  6. * CREATION D'UN MCHAML
  7. *
  8. *------------------------------------------------------------------
  9. IMPLICIT INTEGER(I-N)
  10. -INC SMCHAML
  11. -INC SMLMOTS
  12. -INC SMLREEL
  13. -INC SMLENTI
  14. -INC SMMODEL
  15. -INC CCOPTIO
  16. *
  17. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  18. * -----------
  19. *
  20. * MLENT1 (E) POINTEURS SUR ZONES ELEMENTAIRES DE MAILLAGE
  21. * MLMOTS (E) POINTEUR SUR UN LISTMOTS CONTENANT LES NOMS
  22. * MLMOT3 (E) POINTEUR SUR UN LISTMOTS CONTENANT LES TYPES
  23. * MLMOT2 (E) POINTEUR SUR UN LISTMOTS CONTENANT LES TYPES
  24. * MLMOT4 (E) POINTEUR SUR UN LISTMOTS CONTENANT LES NOMS
  25. * DES CONSTITUANTS
  26. * IPOI (E) POINTEUR SUR UN LISTENTI OU UN LISTREEL
  27. * MONMOT (E) MOT DE 8 CARACTERES
  28. * LETYP (E) TYPE DU MCHAML A CREER
  29. * JER1 (E) LONGUEUR DE LA CHAINE DE CARACTERES
  30. * ICHA (S) POINTEUR SUR LE MCHAML RESULTAT
  31. *
  32. * LANGAGE:
  33. * --------
  34. *
  35. * ESOPE + FORTRAN77
  36. *
  37. ************************************************************************
  38. *
  39. SEGMENT MPTVAL
  40. INTEGER IPOS(NS) ,NSOF(NS)
  41. INTEGER IVAL(NCOSOU)
  42. CHARACTER*16 TYVAL(NCOSOU)
  43. ENDSEGMENT
  44. *
  45. SEGMENT NOTYPE
  46. CHARACTER*16 TYPE(NBTYPE)
  47. ENDSEGMENT
  48. *
  49. *
  50. PARAMETER ( N3=6 )
  51. PARAMETER (NINF=3)
  52. CHARACTER*8 MONMOT
  53. CHARACTER*(NCONCH) CONM
  54. CHARACTER*4 CAR,CAR2
  55. CHARACTER*(*) LETYP
  56. DIMENSION INFOS(NINF)
  57. NCOUCH=0
  58. *
  59. * RECHERCHE DES ZONES DE MAILLAGE ELEMENTAIRES
  60. *
  61. SEGACT,MLENT1
  62. N1=MLENT1.LECT(/1)
  63. INFOS(1) = 0
  64. INFOS(2) = 0
  65. INFOS(3) = NIFOUR
  66. *
  67. * INITIALISATION DU SEGMENT MCHELM
  68. *
  69. L1=JER1
  70. SEGINI,MCHELM
  71. ICHA=MCHELM
  72. TITCHE=LETYP
  73. IFOCHE=IFOUR
  74. *
  75. SEGACT,MLMOTS
  76. SEGACT,MLMOT3
  77. SEGACT,MLMOT2
  78. SEGACT,MLMOT4
  79. N2=MOTS(/2)
  80. IF(MONMOT.EQ.'REAL*8 ') THEN
  81. MLREEL=IPOI
  82. SEGACT,MLREEL
  83. ELSE
  84. MLENTI=IPOI
  85. SEGACT,MLENTI
  86. ENDIF
  87. *
  88. * BOUCLE SUR LES ZONES ELEMENTAIRES DU MAILLAGE
  89. *
  90. DO 20 I=1,N1
  91. IPMAIL = MLENT1.LECT(I)
  92. CONCHE(I)= MLMOT4.MOTS(I)
  93. IMACHE(I)= IPMAIL
  94. INFCHE(I,1) = 0
  95. INFCHE(I,2) = NCOUCH
  96. INFCHE(I,3) = NIFOUR
  97. INFCHE(I,4) = 0
  98. INFCHE(I,5) = 0
  99. INFCHE(I,6) = 1
  100. SEGINI,MCHAML
  101. ICHAML(I)=MCHAML
  102. *
  103. DO 10 IN=1,N2
  104. NOMCHE(IN)=MOTS(IN)
  105. IF (MONMOT.EQ.'REAL*8 ') THEN
  106. TYPCHE(IN)=MONMOT(1:6)
  107. N1PTEL=1
  108. N1EL=1
  109. N2PTEL=0
  110. N2EL=0
  111. ELSE
  112. CAR =MLMOT3.MOTS(IN)
  113. CAR2=MLMOT2.MOTS(IN)
  114. *
  115. * TRAITEMENT PARTICULIER POUR LE TYPE 'MCHAML'
  116. *
  117. IF (CAR.EQ.'MCHA') THEN
  118. IPT = LECT(IN)
  119. CALL QUESUP(0,IPT,0,0,ISUP,IRET)
  120. IF(IERR.NE.0)THEN
  121. SEGSUP MCHAML
  122. GOTO 99
  123. ENDIF
  124. IF (ISUP.NE.1)THEN
  125. MCHEL1=IPT
  126. SEGACT MCHEL1
  127. MOTERR(1:8)=MCHEL1.TITCHE
  128. SEGDES MCHEL1
  129. CALL ERREUR(124)
  130. SEGSUP MCHAML
  131. GOTO 99
  132. ENDIF
  133. NBROBL=1
  134. NBRFAC=0
  135. SEGINI NOMID
  136. MOTAUX=NOMID
  137. LESOBL(1)=NOMCHE(IN)
  138. NBTYPE=1
  139. SEGINI NOTYPE
  140. MOTYPE=NOTYPE
  141. TYPE(1)=' '
  142. CONM=CONCHE(I)
  143. CALL KOMCHA(IPT,IPMAIL,CONM,MOTAUX,MOTYPE,1,INFOS,3,IVAAUX)
  144. SEGSUP NOTYPE
  145. IF (IERR.NE.0)THEN
  146. SEGSUP MCHAML
  147. GOTO 99
  148. ENDIF
  149. MPTVAL=IVAAUX
  150. TYPCHE(IN)=TYVAL(1)
  151. MELVA1 = IVAL(1)
  152. SEGINI,MELVAL=MELVA1
  153. IELVAL(IN) = MELVAL
  154. SEGDES,MELVAL
  155. GO TO 10
  156. ENDIF
  157. *
  158. TYPCHE(IN)='POINTEUR'//CAR(1:4)//CAR2(1:4)
  159. N1PTEL=0
  160. N1EL=0
  161. N2PTEL=1
  162. N2EL=1
  163. ENDIF
  164. *
  165. * INITIALISATION DU SEGMENT MELVAL
  166. *
  167. SEGINI,MELVAL
  168. IELVAL(IN)=MELVAL
  169. IF (MONMOT.EQ.'REAL*8 ') THEN
  170. VELCHE(N1PTEL,N1EL)=PROG(IN)
  171. ELSE
  172. IELCHE(N2PTEL,N2EL)=LECT(IN)
  173. ENDIF
  174. SEGDES,MELVAL
  175. 10 CONTINUE
  176. * END DO
  177. SEGDES,MCHAML
  178. 20 CONTINUE
  179. * END DO
  180. *
  181. 99 CONTINUE
  182. IF (MONMOT.EQ.'REAL*8 ') THEN
  183. SEGDES,MLREEL
  184. ELSE
  185. SEGDES,MLENTI
  186. ENDIF
  187. SEGDES,MLMOTS
  188. SEGDES,MLMOT4
  189. SEGDES,MLMOT3
  190. SEGDES,MLMOT2
  191. *
  192. IF(IERR.NE.0)THEN
  193. SEGSUP,MCHELM
  194. ELSE
  195. SEGDES,MCHELM
  196. ENDIF
  197. SEGDES,MLENT1
  198. *
  199. END
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  

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