Télécharger evnumo.eso

Retour à la liste

Numérotation des lignes :

  1. C EVNUMO SOURCE CHAT 05/01/12 23:46:57 5004
  2. SUBROUTINE EVNUMO(ITYPE,IRET,NOMCO,IBOO)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C=======================================================================
  6. C CHERCHE DANS L'OBJET IRET DE TYPE ITYPE LA LISTE DES POINTS ET
  7. C REMPLIT LE TABLEAU NUMOO
  8. C APPELE PAR EVSOLU
  9. C APPELLE CHANGE,LIRE,REFUS,ERREUR(66)
  10. C ECRIT PAR FARVACQUE LE 24/10/85
  11. C=======================================================================
  12. -INC CCOPTIO
  13. -INC SMSOLUT
  14. -INC SMATTAC
  15. -INC SMELEME
  16. -INC SMCHPOI
  17. SEGMENT ITRAV1(0)
  18. SEGMENT STRAV2
  19. CHARACTER*4 ITRAV2(0)
  20. ENDSEGMENT
  21. SEGMENT NUMOO
  22. INTEGER NUMO(N),KLIST(N)
  23. CHARACTER*4 NUDDL(N)
  24. ENDSEGMENT
  25. LOGICAL L0,L1
  26. CHARACTER*8 ITYPE,TYPRET,CHARRE
  27. CHARACTER*4 NOMCO
  28. *
  29. IF (ITYPE.EQ.'POINT ') THEN
  30. N=1
  31. SEGINI NUMOO
  32. NUMO(1)=IRET
  33. NUDDL(1)=NOMCO
  34. *
  35. ELSE IF (ITYPE.EQ.'MAILLAGE') THEN
  36. MELEME= IRET
  37. SEGACT MELEME
  38. IF(ITYPEL.NE.1) CALL CHANGE (IRET,1)
  39. MELEME=IRET
  40. SEGACT MELEME
  41. N=NUM(/2)
  42. SEGINI NUMOO
  43. DO 10 I=1,N
  44. NUMO(I)=NUM(1,I)
  45. NUDDL(I)=NOMCO
  46. 10 CONTINUE
  47. SEGDES MELEME
  48. *
  49. ELSE IF (ITYPE.EQ.'CHPOINT ') THEN
  50. MCHPOI=IRET
  51. SEGACT MCHPOI
  52. NSOUPO=IPCHP(/1)
  53. SEGINI ITRAV1
  54. SEGINI STRAV2
  55. DO 20 I=1,NSOUPO
  56. MSOUPO=IPCHP(I)
  57. SEGACT MSOUPO
  58. MELEME=IGEOC
  59. SEGACT MELEME
  60. NP=NUM(/2)
  61. NC=NOCOMP(/2)
  62. MPOVAL=IPOVAL
  63. SEGACT MPOVAL
  64. DO 22 J1=1,NP
  65. DO 22 J2=1,NC
  66. * IF(VPOCHA(J1,J2).EQ.0.) GOTO 22
  67. ITRAV1(**)=NUM(1,J1)
  68. ITRAV2(**)=NOCOMP(J2)
  69. 22 CONTINUE
  70. SEGDES MELEME,MPOVAL,MSOUPO
  71. 20 CONTINUE
  72. SEGDES MCHPOI
  73. N=ITRAV1(/1)
  74. SEGINI NUMOO
  75. DO 24 I=1,N
  76. NUMO(I)=ITRAV1(I)
  77. NUDDL(I)=ITRAV2(I)
  78. 24 CONTINUE
  79. SEGSUP ITRAV1,STRAV2
  80. *
  81. ELSE IF (ITYPE.EQ.'ATTACHE ') THEN
  82. MATTAC=IRET
  83. SEGACT MATTAC
  84. NSOU=LISATT(/1)
  85. N=0
  86. NI=0
  87. SEGINI NUMOO
  88. DO 30 I=1,NSOU
  89. MSOUMA=LISATT(I)
  90. SEGACT MSOUMA
  91. MJONCT=IATREL(1)
  92. SEGDES MSOUMA
  93. SEGACT MJONCT
  94. MCHPOI=MJOPOI
  95. SEGDES MJONCT
  96. SEGACT MCHPOI
  97. MSOUPO=IPCHP(1)
  98. SEGDES MCHPOI
  99. SEGACT MSOUPO
  100. MELEME=IGEOC
  101. SEGDES MSOUPO
  102. SEGACT MELEME
  103. NM=NUM(/2)
  104. N=N+NM
  105. SEGADJ NUMOO
  106. DO 32 J=1,NM
  107. NUMO(NI+J)=NUM(1,J)
  108. NUDDL(NI+J)=NOMCO
  109. 32 CONTINUE
  110. NI=N
  111. SEGDES MELEME
  112. 30 CONTINUE
  113. SEGDES MATTAC
  114. *
  115. ELSE IF (ITYPE.EQ.'SOLUTION') THEN
  116. MSOLUT=IRET
  117. SEGACT MSOLUT
  118. IF (MSOLIS(3).EQ.0) THEN
  119. MOTERR(1:8)='SOLUTION'
  120. MOTERR(9:16)='MODE'
  121. CALL ERREUR(66)
  122. * ON ATTEND UN MODE
  123. SEGDES MSOLUT
  124. GOTO 5000
  125. ELSE
  126. MELEME=MSOLIS(3)
  127. SEGDES MSOLUT
  128. SEGACT MELEME
  129. N=NUM(/2)
  130. SEGINI NUMOO
  131. DO 40 I=1,N
  132. NUMO(I)=NUM(1,I)
  133. NUDDL(I)=NOMCO
  134. 40 CONTINUE
  135. SEGDES MELEME
  136. ENDIF
  137. *
  138. ELSE IF (ITYPE.EQ.'TABLE ') THEN
  139. CALL ACCTAB(IRET,'MOT',I0,X0,'MODES',L0,IP0,
  140. & 'TABLE',I1,X1,' ',L1,IBAS)
  141. IB = 0
  142. NBMODE = 0
  143. 50 CONTINUE
  144. IB = IB + 1
  145. TYPRET = ' '
  146. CALL ACCTAB(IBAS,'ENTIER',IB,X0,' ',L0,IP0,
  147. & TYPRET,I1,X1,CHARRE,L1,IBBB)
  148. IF (IBBB.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  149. NBMODE = NBMODE + 1
  150. GOTO 50
  151. ENDIF
  152. N = NBMODE
  153. SEGINI NUMOO
  154. DO 52 IB = 1,NBMODE
  155. CALL ACCTAB(IBAS,'ENTIER',IB,X0,' ',L0,IP0,
  156. & TYPRET,I1,X1,TYPRET,L1,IBBB)
  157. CALL ACCTAB(IBBB,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  158. & 'POINT',I1,X1,' ',L1,IPTR)
  159. NUMO(IB)=IPTR
  160. NUDDL(IB)=NOMCO
  161. 52 CONTINUE
  162. ENDIF
  163. IBOO=NUMOO
  164. IF(IIMPI.NE.0)WRITE(6,1700)(NUMO(I),NUDDL(I),I=1,NUMO(/1))
  165. 1700 FORMAT(' COUPLES NUMO-NUDDL ',10(I5,A4,1X))
  166. 5000 CONTINUE
  167. RETURN
  168. END
  169.  
  170.  
  171.  

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