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

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