Télécharger mkmpos.eso

Retour à la liste

Numérotation des lignes :

  1. C MKMPOS SOURCE CHAT 05/01/13 01:46:19 5004
  2. SUBROUTINE MKMPOS(NBINC,NPOMEL,NTOGPO,NTOTPO,NTOTIN,
  3. $ KRINC,MELEME,KRSPGT,
  4. $ MPOS,
  5. $ IMPR,IRET)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. C***********************************************************************
  9. C NOM : MKMPOS
  10. C PROJET : Noyau linéaire NLIN
  11. C DESCRIPTION : On complète un tableau de correspondance (point support,
  12. C nom d'inconnue scalaire) <-> (numéro de ddl)
  13. C
  14. C On complète le tableau de repérage des inconnues KMINCT
  15. C (segment de type MPOS dans le programme appelant) avec
  16. C les informations données en entrée :
  17. C KRINC : indices des composantes ds le tableau des
  18. C composantes.
  19. C MELEME : liste des numéros globaux de points sur
  20. C lesquels il y a des inconnues.
  21. C KRSPGT : repérage des points ds le tableau des points.
  22. C
  23. C
  24. C LANGAGE : FORTRAN 77 (sauf E/S)
  25. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  26. C mél : gounand@semt2.smts.cea.fr
  27. C***********************************************************************
  28. C APPELE PAR : PRASEM
  29. C***********************************************************************
  30. C ENTREES : NBINC, NPOMEL, NTOGPO,NTOTPO,NTOTIN
  31. C KRINC, MELEME, KRSPGT
  32. C ENTREES/SORTIES : MPOS
  33. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  34. C***********************************************************************
  35. C VERSION : v1, 05/10/99, version initiale
  36. C HISTORIQUE : v1, 05/10/99, création
  37. C HISTORIQUE :
  38. C HISTORIQUE :
  39. C***********************************************************************
  40. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  41. C en cas de modification de ce sous-programme afin de faciliter
  42. C la maintenance !
  43. C***********************************************************************
  44. -INC CCOPTIO
  45. INTEGER NBINC,NPOMEL,NTOGPO,NTOTPO,NTOTIN
  46. INTEGER KRINC(NBINC)
  47. INTEGER MELEME(NPOMEL)
  48. INTEGER KRSPGT(NTOGPO)
  49. INTEGER MPOS(NTOTPO,NTOTIN+1)
  50. *
  51. INTEGER IMPR,IRET
  52. *
  53. LOGICAL LEXIST
  54. INTEGER IPOMEL,IINC
  55. INTEGER IPOMCT,IINCCT
  56. INTEGER NPOINC
  57. *
  58. * Executable statements
  59. *
  60. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkmpos'
  61. DO 1 IPOMEL=1,NPOMEL
  62. IPOMCT=KRSPGT(MELEME(IPOMEL))
  63. IF (IPOMCT.EQ.0) THEN
  64. WRITE(IOIMP,*)
  65. $ 'Un point de KSPGP ou KSPGD n''existe pas '
  66. $ ,'dans KSPGT...'
  67. ENDIF
  68. * On cherche si l'inconnue n'existe pas déjà dans MPOS
  69. DO 12 IINC=1,NBINC
  70. IINCCT=KRINC(IINC)
  71. LEXIST=(MPOS(IPOMCT,IINCCT).NE.0)
  72. * Sinon, on la rajoute...
  73. IF (.NOT.LEXIST) THEN
  74. NPOINC=MPOS(IPOMCT,NTOTIN+1)+1
  75. MPOS(IPOMCT,NTOTIN+1)=NPOINC
  76. MPOS(IPOMCT,IINCCT) =NPOINC
  77. ENDIF
  78. 12 CONTINUE
  79. 1 CONTINUE
  80. *
  81. * Normal termination
  82. *
  83. IRET=0
  84. RETURN
  85. *
  86. * Format handling
  87. *
  88. *
  89. * Error handling
  90. *
  91. 9999 CONTINUE
  92. IRET=1
  93. WRITE(IOIMP,*) 'An error was detected in subroutine mkmpos'
  94. RETURN
  95. *
  96. * End of subroutine MKMPOS
  97. *
  98. END
  99.  
  100.  
  101.  
  102.  

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