Télécharger la plaquette Cast3M


fr en

Télécharger cp2tr2.eso

Retour à la liste

Numérotation des lignes : 

cp2tr2

  1. C CP2TR2    SOURCE    CB215821  20/11/25    13:22:46     10792          
  2.       SUBROUTINE CP2TR2(LISCOM,MELTOT,MYCHPO,
  3.      $     MYMTRA,IRET)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5.       IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM         : CP2TR2
  8. C DESCRIPTION : Transformation d'un chpoint MYCHPO
  9. C               en un objet MTRAV MYMTRA plus commode
  10. C               LISCOM et MELEME sont les composantes et points
  11. C               qui nous intéressent.
  12. C
  13. C
  14. C LANGAGE     : ESOPE
  15. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  16. C               mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C VERSION    : v1, 11/04/2008, version initiale
  19. C HISTORIQUE : v1, 11/04/2008, création
  20. C HISTORIQUE :
  21. C HISTORIQUE :
  22. C***********************************************************************
  23. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  24. C en cas de modification de ce sous-programme afin de faciliter
  25. C la maintenance !
  26. C***********************************************************************
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC SMCOORD
  31. *
  32. -INC SMCHPOI
  33.       POINTEUR MYCHPO.MCHPOI
  34.       POINTEUR MYMSOU.MSOUPO
  35.       POINTEUR MYMPOV.MPOVAL
  36.       INTEGER N,NC
  37. -INC TMTRAV
  38.       POINTEUR MYMTRA.MTRAV
  39.       INTEGER NNIN,NNNOE
  40. -INC SMLMOTS
  41.       POINTEUR LISCOM.MLMOTS
  42.       INTEGER JGN,JGM
  43. -INC SMELEME
  44.       POINTEUR MYMEL.MELEME
  45.       POINTEUR MELTOT.MELEME
  46. -INC SMLENTI
  47.       POINTEUR KRINCO.MLENTI
  48.       POINTEUR KRIGEO.MLENTI
  49.       INTEGER JG
  50. *
  51. * Includes persos
  52. *
  53. * Liste de MELEME
  54.       INTEGER NBMEL
  55.       SEGMENT MELS
  56.       POINTEUR LISMEL(NBMEL).MELEME
  57.       ENDSEGMENT
  58.       POINTEUR GPMELS.MELS
  59. *
  60.       LOGICAL LVIDE
  61.       INTEGER IMPR,IRET
  62. *
  63.       INTEGER I,IC,IGM,JGM2,ININ,INNOE,IGLOB
  64.       INTEGER NTOTPO,NTOGPO
  65. *
  66. * Executable statements
  67. *
  68.       IMPR=0
  69.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans cp2tr2.eso'
  70. *
  71.       SEGACT LISCOM
  72.       JGN=LISCOM.MOTS(/1)
  73.       JGM=LISCOM.MOTS(/2)
  74. *
  75. * Initialisation de l'objet MTRAV
  76. *
  77.       SEGACT MELTOT
  78.       NTOTPO=MELTOT.NUM(/2)
  79.       NNIN=JGM
  80.       NNNOE=NTOTPO
  81.       SEGINI MYMTRA
  82.       DO ININ=1,NNIN
  83.          MYMTRA.INCO(ININ)=LISCOM.MOTS(ININ)
  84.       ENDDO
  85.       DO INNOE=1,NNNOE
  86.          MYMTRA.IGEO(INNOE)=MELTOT.NUM(1,INNOE)
  87.       ENDDO
  88. *
  89. * Remplissage de l'objet MTRAV
  90. *
  91. *  Création du segment de répérage dans IGEO
  92.       NTOGPO=nbpts
  93.       JG=NTOGPO
  94.       SEGINI,KRIGEO
  95.       CALL RSETEE(MYMTRA.IGEO,NNNOE,
  96.      $     KRIGEO.LECT,NTOGPO,
  97.      $     IMPR,IRET)
  98.       IF (IRET.NE.0) GOTO 9999
  99. *  Parcours de l'objet champoint
  100.       SEGACT MYCHPO
  101.       NSOUPO=MYCHPO.IPCHP(/1)
  102.       DO ISOUPO=1,NSOUPO
  103.          MYMSOU=MYCHPO.IPCHP(ISOUPO)
  104.          SEGACT MYMSOU
  105.          NC=MYMSOU.NOCOMP(/2)
  106. *   Création du segment de repérage dans les noms d'inconnues
  107.          JG=NC
  108.          SEGINI KRINCO
  109.          CALL CREPE2(JGN,NC,NNIN,
  110.      $        MYMSOU.NOCOMP,MYMTRA.INCO,
  111.      $        KRINCO.LECT,
  112.      $        IMPR,IRET)
  113.          IF (IRET.NE.0) GOTO 9999
  114.          MYMEL=MYMSOU.IGEOC
  115.          MYMPOV=MYMSOU.IPOVAL
  116.          SEGACT MYMEL
  117.          SEGACT MYMPOV
  118.          N=MYMPOV.VPOCHA(/1)
  119.          DO IC=1,NC
  120.             ININ=KRINCO.LECT(IC)
  121.             IF (ININ.NE.0) THEN
  122.                DO I=1,N
  123.                   IGLOB=MYMEL.NUM(1,I)
  124.                   INNOE=KRIGEO.LECT(IGLOB)
  125.                   IF (INNOE.NE.0) THEN
  126.                      MYMTRA.IBIN(ININ,INNOE)=1
  127.                      MYMTRA.BB(ININ,INNOE)=MYMPOV.VPOCHA(I,IC)
  128.                   ENDIF
  129.                ENDDO
  130.             ENDIF
  131.          ENDDO
  132.          SEGDES MYMPOV
  133.          SEGDES MYMEL
  134.          SEGSUP KRINCO
  135.          SEGDES MYMSOU
  136.       ENDDO
  137.       SEGSUP KRIGEO
  138.       SEGDES MYCHPO
  139.       SEGDES MYMTRA
  140. *
  141. * Normal termination
  142. *
  143.       IRET=0
  144.       RETURN
  145. *
  146. * Format handling
  147. *
  148. *
  149. * Error handling
  150. *
  151.  9999 CONTINUE
  152.       IRET=1
  153.       WRITE(IOIMP,*) 'An error was detected in subroutine cp2tr2'
  154.       RETURN
  155. *
  156. * End of subroutine CP2TR2
  157. *
  158.       END
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  

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