Télécharger resmak.eso

Retour à la liste

Numérotation des lignes :

  1. C RESMAK SOURCE PV 16/11/26 21:16:19 9205
  2. SUBROUTINE RESMAK (ICOLAC,ITLACC,IMAX1,IDEB)
  3.  
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. C***********************************************************************
  7. C NOM : RESMAK
  8. C DESCRIPTION : Restauration des pointeurs dans les objets
  9. C de type MATRAK.
  10. C (appelé par restpi.eso)
  11. C
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  14. C mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C SYNTAXE GIBIANE : -
  17. C ENTREES : ICOLAC, chapeau sur les piles ITLACC
  18. C (une pour chaque type d'objets)
  19. C IDEB, IMAX1, indice de début et de fin
  20. C sur la pile d'objets MATRAK
  21. C ENTREES/SORTIES : ITLACC, la pile des objets MATRAK sur
  22. C lesquels on va restaurer des pointeurs
  23. C***********************************************************************
  24. C VERSION : v1, 15/07/98, version initiale
  25. C HISTORIQUE : v1, 15/07/98, création
  26. C HISTORIQUE :
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30. C en cas de modification de ce sous-programme afin de faciliter
  31. C la maintenance !
  32. C***********************************************************************
  33. -INC CCOPTIO
  34. C-INC SMMATRAKANC
  35. C*************************************************************************
  36. C
  37. C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees
  38. C
  39.  
  40. * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
  41. * (points CENTRE ) pour chaque operateur de contrainte
  42. * KGEOC SPG pour la totalite des points CENTRE.
  43. * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
  44. * KLEMC Connectivites de l'ensemble des contraintes
  45. * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones
  46.  
  47. SEGMENT MATRAK
  48. INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
  49. INTEGER LIZAFM(NBSOUS)
  50. INTEGER IKAM0 (NBSOUS)
  51. INTEGER IMEM (NBELC)
  52. INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
  53. ENDSEGMENT
  54.  
  55. SEGMENT IZAFM
  56. REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX)
  57. ENDSEGMENT
  58. C*************************************************************************
  59. -INC TMCOLAC
  60. C
  61. C ************************* MATRAK ********************************
  62. C Pile des MELEME
  63. ITLAC1=KCOLA(1)
  64. C Pile des CHPOINT
  65. ITLAC2=KCOLA(2)
  66. DO 1 IEL=IDEB,IMAX1
  67. MATRAK=ITLAC(IEL)
  68. IF (MATRAK.EQ.0) THEN
  69. WRITE(IOIMP,*) 'Failing to save a nil pointer'
  70. WRITE(IOIMP,*) 'MATRAK type object...'
  71. GOTO 9999
  72. ENDIF
  73. SEGACT MATRAK*MOD
  74. NBOP=LGEOC(/1)
  75. IF (NBOP.NE.0)THEN
  76. DO 605 I=1,NBOP
  77. IVA=ABS(LGEOC(I))
  78. IF (IVA.NE.0) LGEOC(I)=ITLAC1.ITLAC(IVA)
  79. 605 CONTINUE
  80. ENDIF
  81. IVA=ABS(KLEMC)
  82. IF (IVA.NE.0) KLEMC=ITLAC1.ITLAC(IVA)
  83. IVA=ABS(KGEOS)
  84. IF (IVA.NE.0) KGEOS=ITLAC1.ITLAC(IVA)
  85. IVA=ABS(KGEOC)
  86. IF (IVA.NE.0) KGEOC=ITLAC1.ITLAC(IVA)
  87. IVA=ABS(KDIAG)
  88. IF (IVA.NE.0) KDIAG=ITLAC2.ITLAC(IVA)
  89. SEGDES MATRAK
  90. 1 CONTINUE
  91. *
  92. * Normal termination
  93. *
  94. RETURN
  95. *
  96. * Format handling
  97. *
  98. *
  99. * Error handling
  100. *
  101. 9999 CONTINUE
  102. WRITE(IOIMP,*) 'An error was detected in subroutine resmak'
  103. RETURN
  104. *
  105. * End of subroutine RESMAK
  106. *
  107. END
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  

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