Télécharger examtk.eso

Retour à la liste

Numérotation des lignes :

  1. C EXAMTK SOURCE PV 16/11/26 21:15:45 9205
  2. SUBROUTINE EXAMTK (ICOLAC,ITLACC,M1,M2,IIICHA)
  3. C----------------------------------------------------------------------
  4. C
  5. C BUT: REMPLIT LES PILES A PARTIR DE L EXAMEN DES MATRAK
  6. C SI IIICHA =1 ON CHANGE LES POINTEURS----
  7. C completement pompe sur exachp
  8. C
  9. C ENTREE ITLACC POINTEUR DE LA PILE EXAMINEE
  10. C ICOLAC POINTEUR SUR LE CHAPEAU DES PILES
  11. C M1 @REMIER INDICE D EXAMEN DANS LA PILE
  12. C M2 DERNIER INDICE
  13. C IIICHA =1 ON CHANGE LES POINTEURS
  14. C----------------------------------------------------------------
  15. C APPELE PAR EXPIL
  16. C APPELLE AJOUN
  17. C
  18. C=======================================================================
  19. C TABLEAU KCOLA :
  20. C 1 MELEME 2 CHPOIN 3 MRIGID 4 MCHAFF 5 MCHELM 6
  21. C 7 8 MSOLUT 9 MSTRUC 10 11 MAFFEC 12 MSOSTU
  22. C 13 IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
  23. C 19 MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 23 MSUPER
  24. C=======================================================================
  25. C
  26. IMPLICIT INTEGER(I-N)
  27. IMPLICIT REAL*8(A-H,O-Z)
  28. C-INC SMMATRAKANC
  29. C*************************************************************************
  30. C
  31. C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees
  32. C
  33.  
  34. * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
  35. * (points CENTRE ) pour chaque operateur de contrainte
  36. * KGEOC SPG pour la totalite des points CENTRE.
  37. * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
  38. * KLEMC Connectivites de l'ensemble des contraintes
  39. * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones
  40.  
  41. SEGMENT MATRAK
  42. INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
  43. INTEGER LIZAFM(NBSOUS)
  44. INTEGER IKAM0 (NBSOUS)
  45. INTEGER IMEM (NBELC)
  46. INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
  47. ENDSEGMENT
  48.  
  49. SEGMENT IZAFM
  50. REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX)
  51. ENDSEGMENT
  52.  
  53. POINTEUR IPMJ.IZAFM,IPMK.IZAFM
  54.  
  55. C*******************************************************************
  56. POINTEUR IVA.MELEME
  57. -INC CCOPTIO
  58. -INC TMCOLAC
  59. ICO1=KCOLA(1)
  60. ICO2=KCOLA(2)
  61. ILISSE=ILISSG
  62. SEGACT ILISSE*MOD
  63. DO 604 IEL=M1,M2
  64. MATRAK=ITLAC(IEL)
  65. IF (MATRAK.EQ.0) GO TO 604
  66. SEGACT MATRAK*MOD
  67. NBOP=LGEOC(/1)
  68. IF (NBOP.NE.0)THEN
  69. DO 605 I=1,NBOP
  70. IVA=LGEOC(I)
  71. IF (IVA.GT.0) THEN
  72. SEGDES IVA
  73. CALL AJOUN(ICO1,IVA,ILISSE,1)
  74. IF(IIICHA.EQ.1) LGEOC(I) =-IVA
  75. ENDIF
  76. 605 CONTINUE
  77. ENDIF
  78. IVA=KLEMC
  79. IF (IVA.GT.0) THEN
  80. SEGDES IVA
  81. CALL AJOUN(ICO1,IVA,ILISSE,1)
  82. IF(IIICHA.EQ.1) KLEMC =-IVA
  83. ENDIF
  84. IVA=KGEOS
  85. IF (IVA.GT.0) THEN
  86. SEGDES IVA
  87. CALL AJOUN(ICO1,IVA,ILISSE,1)
  88. IF(IIICHA.EQ.1) KGEOS =-IVA
  89. ENDIF
  90. IVA=KGEOC
  91. IF (IVA.GT.0) THEN
  92. SEGDES IVA
  93. CALL AJOUN(ICO1,IVA,ILISSE,1)
  94. IF(IIICHA.EQ.1) KGEOC =-IVA
  95. ENDIF
  96. IVA=KDIAG
  97. IF (IVA.GT.0) THEN
  98. SEGDES IVA
  99. CALL AJOUN(ICO2,IVA,ILISSE,1)
  100. IF(IIICHA.EQ.1) KDIAG =-IVA
  101. ENDIF
  102. SEGDES MATRAK
  103. 604 CONTINUE
  104. * SEGDES ILISSE
  105. RETURN
  106. C ************
  107. END
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  

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