Télécharger la plaquette Cast3M


fr en

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