Télécharger cp2lr.eso

Retour à la liste

Numérotation des lignes :

cp2lr
  1. C CP2LR SOURCE CB215821 20/11/25 13:22:44 10792
  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 PPARAM
  41. -INC CCOPTIO
  42. -INC SMCHPOI
  43. POINTEUR CHPOD.MCHPOI
  44. POINTEUR XCHPOD.MCHPOI
  45. POINTEUR MPXCPD.MPOVAL
  46. -INC SMELEME
  47. POINTEUR MLXCPD.MELEME
  48. -INC SMLENTI
  49. POINTEUR ICPRID.MLENTI
  50. POINTEUR KRIPRI.MLENTI
  51. POINTEUR KRMPRI.MLENTI
  52. -INC SMLMOTS
  53. POINTEUR ICOGLO.MLMOTS
  54. -INC SMLREEL
  55. SEGMENT LLR
  56. POINTEUR LISLR(NBME).MLREEL
  57. ENDSEGMENT
  58. INTEGER NBME
  59. POINTEUR LCHPOD.LLR
  60. INTEGER JG
  61. POINTEUR SLMPD.MLREEL
  62. *
  63. INTEGER NIPRI,NPPRI
  64. INTEGER IMPR,IRET
  65. *
  66. INTEGER NIPRID,NPOCPD
  67. INTEGER IIPRID,IPOCPD,IIPRI
  68. INTEGER NULOPO
  69. CHARACTER*4 NOMI
  70. *
  71. * Executable statements
  72. *
  73. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cp2lr.eso'
  74. *
  75. * Parcours des noms de composantes
  76. *
  77. IF (CHPOD.EQ.0) THEN
  78. LCHPOD=0
  79. ELSE
  80. SEGACT ICPRID
  81. NIPRID=ICPRID.LECT(/1)
  82. SEGACT ICOGLO
  83. SEGACT KRIPRI
  84. SEGACT KRMPRI
  85. NBME=NIPRI
  86. SEGINI LCHPOD
  87. DO 1 IIPRID=1,NIPRID
  88. IIPRI=KRIPRI.LECT(ICPRID.LECT(IIPRID))
  89. IF (IIPRI.NE.0) THEN
  90. NOMI=ICOGLO.MOTS(ICPRID.LECT(IIPRID))(1:4)
  91. CALL ECROBJ('CHPOINT ',CHPOD)
  92. CALL ECRCHA(NOMI)
  93. CALL EXCOMP
  94. CALL LIROBJ('CHPOINT ',XCHPOD,1,IRET)
  95. IF (IRET.EQ.0) THEN
  96. WRITE(IOIMP,*) 'Erreur extraction comp.',NOMI
  97. WRITE(IOIMP,*) 'de la matrice diagonale.'
  98. GOTO 9999
  99. ENDIF
  100. CALL LICHT2(XCHPOD,
  101. $ MPXCPD,MLXCPD,
  102. $ IMPR,IRET)
  103. IF (IRET.NE.0) GOTO 9999
  104. JG=NPPRI
  105. SEGINI,SLMPD
  106. SEGACT MPXCPD
  107. SEGACT MLXCPD
  108. NPOCPD=MLXCPD.NUM(/2)
  109. DO 12 IPOCPD=1,NPOCPD
  110. NULOPO=KRMPRI.LECT(MLXCPD.NUM(1,IPOCPD))
  111. IF (NULOPO.NE.0) THEN
  112. SLMPD.PROG(NULOPO)=MPXCPD.VPOCHA(IPOCPD,1)
  113. ENDIF
  114. 12 CONTINUE
  115. SEGDES MLXCPD
  116. SEGDES MPXCPD
  117. SEGDES SLMPD
  118. LCHPOD.LISLR(IIPRI)=SLMPD
  119. CALL DTCHPO(XCHPOD)
  120. ENDIF
  121. 1 CONTINUE
  122. SEGDES LCHPOD
  123. SEGDES KRMPRI
  124. SEGDES KRIPRI
  125. SEGDES ICOGLO
  126. SEGDES ICPRID
  127. ENDIF
  128. *
  129. * Normal termination
  130. *
  131. IRET=0
  132. RETURN
  133. *
  134. * Format handling
  135. *
  136. *
  137. * Error handling
  138. *
  139. 9999 CONTINUE
  140. IRET=1
  141. WRITE(IOIMP,*) 'An error was detected in subroutine cp2lr'
  142. RETURN
  143. *
  144. * End of subroutine CP2LR
  145. *
  146. END
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  

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