Télécharger examel.eso

Retour à la liste

Numérotation des lignes :

  1. C EXAMEL SOURCE PV 16/11/26 21:15:44 9205
  2. SUBROUTINE EXAMEL (ICOLAC,ITLACC,M1,M2,IIICHA)
  3. C----------------------------------------------------------------------
  4. C
  5. C BUT: REMPLIT LES PILES A PARTIR DE L EXAMEN DE LA PILE
  6. C SI IIICHA =1 ON CHANGE LES POINTEURS----
  7. C
  8. C ENTREE ITLACC POINTEUR DE LA PILE EXAMINEE
  9. C ICOLAC POINTEUR SUR LE CHAPEAU DES PILES
  10. C M1 @REMIER INDICE D EXAMEN DANS LA PILE
  11. C M2 DERNIER INDICE
  12. C IIICHA =1 ON CHANGE LES POINTEURS
  13. C----------------------------------------------------------------
  14. C APPELE PAR EXPIL
  15. C APPELLE AJOUN
  16. C
  17. C=======================================================================
  18. C TABLEAU KCOLA :
  19. C 1 MELEME 2 CHPOIN 3 MRIGID 4 MCHAFF 5 MCHELM 6
  20. C 7 8 MSOLUT 9 MSTRUC 10 11 MAFFEC 12 MSOSTU
  21. C 13 IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
  22. C 19 MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 23 MSUPER
  23. C=======================================================================
  24. C
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8(A-H,O-Z)
  27. logical ooovp1
  28. -INC SMELEME
  29. -INC CCOPTIO
  30. -INC TMCOLAC
  31. -INC SMCOORD
  32. -INC CCGEOME
  33. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  34. ICO1=KCOLA(1)
  35. ICO2=KCOLA(32)
  36. ILISSE=ILISSG
  37. SEGACT ILISSE*MOD
  38. ITLAC1=ICO2
  39. SEGINI ICPR
  40. IFAIT = ITLAC1.ITLAC(/1)
  41. DO 710 IHU=1,IFAIT
  42. IAM=ITLAC1.ITLAC(IHU)
  43. ICPR(IAM)=IHU
  44. 710 CONTINUE
  45. * mise a jour de ilgni et nsdpge a ne faire qu'une fois
  46. if (m1.eq.1.and.iiicha.eq.1) then
  47. if (ilgni.ne.0) then
  48. if (icpr(ilgni).eq.0) then
  49. IFAIT = IFAIT + 1
  50. ICPR(ilgni)=IFAIT
  51. ENDIF
  52. ilgni = icpr(ilgni)
  53. endif
  54. if (nsdpge.ne.0) then
  55. if (icpr(nsdpge).eq.0) then
  56. IFAIT = IFAIT + 1
  57. ICPR(nsdpge)=IFAIT
  58. ENDIF
  59. nsdpge = icpr(nsdpge)
  60. endif
  61. endif
  62. DO 601 IEL=M1,M2
  63. MELEME=ITLAC(IEL)
  64. C WRITE (IOIMP,8876) MELEME
  65. IF (MELEME.EQ.0) GO TO 601
  66. if (.NOT.ooovp1(meleme)) goto 610
  67. C8876 FORMAT(' MELEME',I6)
  68. if(IIICHA.EQ.1) then
  69. Cgf activation en mod pour pouvoir renumeroter les maillages
  70. SEGACT MELEME*MOD
  71. else
  72. Cgf On ne fait que lire le maillage, pas besoin de l'ouvrir en
  73. C ecriture
  74. SEGACT MELEME
  75. endif
  76. IF(LISOUS(/1).EQ.0) GO TO 602
  77. IF (LISOUS(/1).LT.0) GOTO 610
  78. DO 603 I=1,LISOUS(/1)
  79. IVA=LISOUS(I)
  80. if (IIICHA.EQ.1.AND..NOT.ooovp1(iva)) goto 610
  81. CALL AJOUN(ICO1,IVA,ILISSE,1)
  82. IF(IIICHA.EQ.1)LISOUS(I)=IVA
  83. 603 CONTINUE
  84. 602 CONTINUE
  85. IF(LISREF(/1).EQ.0) GO TO 645
  86. IF (LISREF(/1).GT.1000) GOTO 610
  87. IF (LISREF(/1).LT.0) GOTO 610
  88. DO 646 I=1,LISREF(/1)
  89. IVA=LISREF(I)
  90. if (IIICHA.EQ.1.AND..NOT.ooovp1(iva)) goto 610
  91. CALL AJOUN(ICO1,IVA,ILISSE,1)
  92. IF(IIICHA.EQ.1)LISREF(I)=IVA
  93. 646 CONTINUE
  94. 645 CONTINUE
  95. IF(NUM(/2).EQ.0) GO TO 660
  96. DO 661 K2=1,NUM(/2)
  97. DO 661 K1=1,NUM(/1)
  98. IVA=NUM(K1,K2)
  99. if (iva.gt.icpr(/1).or.iva.le.0) goto 610
  100. IF(ICPR(IVA).EQ.0) THEN
  101. IFAIT = IFAIT + 1
  102. ICPR(IVA)=IFAIT
  103. * ITLAC1.ITLAC(**)= IVA
  104. * CALL AJOUN(ICO2,IVA,)
  105. ENDIF
  106. IF(IIICHA.EQ.1) NUM(K1,K2)=ICPR(IVA)
  107. 661 CONTINUE
  108. 660 CONTINUE
  109. SEGDES MELEME
  110. GOTO 601
  111. 610 continue
  112. * meleme invalide. On le supprime de la pile
  113. moterr(1:8)='MAILLAGE'
  114. interr(1)=itlac(iel)
  115. call erreur(861)
  116. itlac(iel)=0
  117. 601 CONTINUE
  118. C# MC IF(IICHA.NE.1) CALL ITLACT (ICPR,ITLAC1,IFAIT)
  119. IF(IIICHA.NE.1) CALL ITLACT (ICPR,ITLAC1,IFAIT,ILISSE)
  120. SEGSUP ICPR
  121. * SEGDES ILISSE
  122. RETURN
  123. C ************
  124. END
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  

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