Télécharger examtk.eso

Retour à la liste

Numérotation des lignes :

examtk
  1. C EXAMTK SOURCE PV 21/01/21 21:15:18 10862
  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.  
  58. -INC PPARAM
  59. -INC CCOPTIO
  60. -INC TMCOLAC
  61. iun=1
  62. ICO1=KCOLA(1)
  63. ICO2=KCOLA(2)
  64. ILISSE=ILISSG
  65. SEGACT ILISSE*MOD
  66. DO 604 IEL=M1,M2
  67. MATRAK=ITLAC(IEL)
  68. IF (MATRAK.EQ.0) GO TO 604
  69. SEGACT MATRAK*MOD
  70. NBOP=LGEOC(/1)
  71. IF (NBOP.NE.0)THEN
  72. DO 605 I=1,NBOP
  73. IVA=LGEOC(I)
  74. IF (IVA.GT.0) THEN
  75. SEGDES IVA
  76. CALL AJOUN(ICO1,IVA,ILISSE,iun)
  77. IF(IIICHA.EQ.1) LGEOC(I) =-IVA
  78. ENDIF
  79. 605 CONTINUE
  80. ENDIF
  81. IVA=KLEMC
  82. IF (IVA.GT.0) THEN
  83. SEGDES IVA
  84. CALL AJOUN(ICO1,IVA,ILISSE,iun)
  85. IF(IIICHA.EQ.1) KLEMC =-IVA
  86. ENDIF
  87. IVA=KGEOS
  88. IF (IVA.GT.0) THEN
  89. SEGDES IVA
  90. CALL AJOUN(ICO1,IVA,ILISSE,iun)
  91. IF(IIICHA.EQ.1) KGEOS =-IVA
  92. ENDIF
  93. IVA=KGEOC
  94. IF (IVA.GT.0) THEN
  95. SEGDES IVA
  96. CALL AJOUN(ICO1,IVA,ILISSE,iun)
  97. IF(IIICHA.EQ.1) KGEOC =-IVA
  98. ENDIF
  99. IVA=KDIAG
  100. IF (IVA.GT.0) THEN
  101. SEGDES IVA
  102. CALL AJOUN(ICO2,IVA,ILISSE,iun)
  103. IF(IIICHA.EQ.1) KDIAG =-IVA
  104. ENDIF
  105. SEGDES MATRAK
  106. 604 CONTINUE
  107. * SEGDES ILISSE
  108. RETURN
  109. C ************
  110. END
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  

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