Télécharger cp2lr.eso

Retour à la liste

Numérotation des lignes :

  1. C CP2LR SOURCE PV 13/04/12 21:15:18 7756
  2. SUBROUTINE CP2LR(CHPOD,
  3. $ ICPRID,ICOGLO,KRIPRI,NIPRI,
  4. $ KRMPRI,NPPRI,
  5. $ LCHPOD,
  6. $ IMPR,IRET)
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8 (A-H,O-Z)
  9. C***********************************************************************
  10. C NOM : CP2LR
  11. C DESCRIPTION : Champoint + maillage + liste de n noms de composantes
  12. C => n listreels (1 par nom de composante) des valeurs du
  13. C champoint sur les points du maillage.
  14. C
  15. C
  16. C
  17. C LANGAGE : ESOPE
  18. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  19. C mél : gounand@semt2.smts.cea.fr
  20. C***********************************************************************
  21. C APPELES : LICHT2
  22. C APPELES (E/S) : LIROBJ, ECROBJ, ECRCHA
  23. C APPELES (UTIL.) : EXCOMP, DTCHPO
  24. C APPELE PAR : PROMAT
  25. C***********************************************************************
  26. C ENTREES : CHPOD, ICPRID, ICOGLO, KRIPRI, NIPRI,
  27. C KRMPRI, NPPRI
  28. C SORTIES : LCHPOD
  29. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  30. C***********************************************************************
  31. C VERSION : v1, 10/02/2000, version initiale
  32. C HISTORIQUE : v1, 10/02/2000, création
  33. C HISTORIQUE :
  34. C HISTORIQUE :
  35. C***********************************************************************
  36. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  37. C en cas de modification de ce sous-programme afin de faciliter
  38. C la maintenance !
  39. C***********************************************************************
  40. -INC CCOPTIO
  41. -INC SMCHPOI
  42. POINTEUR CHPOD.MCHPOI
  43. POINTEUR XCHPOD.MCHPOI
  44. POINTEUR MPXCPD.MPOVAL
  45. -INC SMELEME
  46. POINTEUR MLXCPD.MELEME
  47. -INC SMLENTI
  48. POINTEUR ICPRID.MLENTI
  49. POINTEUR KRIPRI.MLENTI
  50. POINTEUR KRMPRI.MLENTI
  51. -INC SMLMOTS
  52. POINTEUR ICOGLO.MLMOTS
  53. -INC SMLREEL
  54. SEGMENT LLR
  55. POINTEUR LISLR(NBME).MLREEL
  56. ENDSEGMENT
  57. INTEGER NBME
  58. POINTEUR LCHPOD.LLR
  59. INTEGER JG
  60. POINTEUR SLMPD.MLREEL
  61. *
  62. INTEGER NIPRI,NPPRI
  63. INTEGER IMPR,IRET
  64. *
  65. INTEGER NIPRID,NPOCPD
  66. INTEGER IIPRID,IPOCPD,IIPRI
  67. INTEGER NULOPO
  68. CHARACTER*4 NOMI
  69. *
  70. * Executable statements
  71. *
  72. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cp2lr.eso'
  73. *
  74. * Parcours des noms de composantes
  75. *
  76. IF (CHPOD.EQ.0) THEN
  77. LCHPOD=0
  78. ELSE
  79. SEGACT ICPRID
  80. NIPRID=ICPRID.LECT(/1)
  81. SEGACT ICOGLO
  82. SEGACT KRIPRI
  83. SEGACT KRMPRI
  84. NBME=NIPRI
  85. SEGINI LCHPOD
  86. DO 1 IIPRID=1,NIPRID
  87. IIPRI=KRIPRI.LECT(ICPRID.LECT(IIPRID))
  88. IF (IIPRI.NE.0) THEN
  89. NOMI=ICOGLO.MOTS(ICPRID.LECT(IIPRID))(1:4)
  90. CALL ECROBJ('CHPOINT ',CHPOD)
  91. CALL ECRCHA(NOMI)
  92. CALL EXCOMP
  93. CALL LIROBJ('CHPOINT ',XCHPOD,1,IRET)
  94. IF (IRET.EQ.0) THEN
  95. WRITE(IOIMP,*) 'Erreur extraction comp.',NOMI
  96. WRITE(IOIMP,*) 'de la matrice diagonale.'
  97. GOTO 9999
  98. ENDIF
  99. CALL LICHT2(XCHPOD,
  100. $ MPXCPD,MLXCPD,
  101. $ IMPR,IRET)
  102. IF (IRET.NE.0) GOTO 9999
  103. JG=NPPRI
  104. SEGINI,SLMPD
  105. SEGACT MPXCPD
  106. SEGACT MLXCPD
  107. NPOCPD=MLXCPD.NUM(/2)
  108. DO 12 IPOCPD=1,NPOCPD
  109. NULOPO=KRMPRI.LECT(MLXCPD.NUM(1,IPOCPD))
  110. IF (NULOPO.NE.0) THEN
  111. SLMPD.PROG(NULOPO)=MPXCPD.VPOCHA(IPOCPD,1)
  112. ENDIF
  113. 12 CONTINUE
  114. SEGDES MLXCPD
  115. SEGDES MPXCPD
  116. SEGDES SLMPD
  117. LCHPOD.LISLR(IIPRI)=SLMPD
  118. CALL DTCHPO(XCHPOD)
  119. ENDIF
  120. 1 CONTINUE
  121. SEGDES LCHPOD
  122. SEGDES KRMPRI
  123. SEGDES KRIPRI
  124. SEGDES ICOGLO
  125. SEGDES ICPRID
  126. ENDIF
  127. *
  128. * Normal termination
  129. *
  130. IRET=0
  131. RETURN
  132. *
  133. * Format handling
  134. *
  135. *
  136. * Error handling
  137. *
  138. 9999 CONTINUE
  139. IRET=1
  140. WRITE(IOIMP,*) 'An error was detected in subroutine cp2lr'
  141. RETURN
  142. *
  143. * End of subroutine CP2LR
  144. *
  145. END
  146.  
  147.  
  148.  
  149.  
  150.  

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