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    GOUNAND   24/09/06    21:15:03     12004          
  2.       SUBROUTINE CP2TR2(ILMOTS,IMEL,MCHPOI,MTRAV)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : CP2TR2
  7. C DESCRIPTION : Transformation d'un chpoint MYCHPO
  8. C               en un objet MTRAV MYMTRA plus commode
  9. C               LISCOM et MELEME sont les composantes et points
  10. C               qui nous intéressent.
  11. C               On ne veut pas plusieurs numéros d'harmonique
  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. -INC TMTRAV
  34. -INC SMLMOTS
  35. -INC SMELEME
  36. -INC SMLENTI
  37.       POINTEUR KRIGEO.MLENTI
  38. *
  39. * Executable statements
  40. *
  41.       IF (ILMOTS.EQ.0.AND.IMEL.EQ.0) THEN
  42.          CALL TRACHP(MCHPOI,MTRAV)
  43.          RETURN
  44.       ENDIF
  45.       IF (ILMOTS.EQ.0) THEN
  46.          CALL EXTR11(MCHPOI,MLMOTS)
  47.          IF (IERR.NE.0) RETURN
  48.       ELSE
  49.          MLMOTS=ILMOTS
  50.       ENDIF
  51.       IF (IMEL.EQ.0) THEN
  52.          IMUL=0
  53.          CALL EXTR21(MCHPOI,IMUL,MELEME)
  54.          IF (IERR.NE.0) RETURN
  55.       ELSE
  56.          MELEME=IMEL
  57.       ENDIF
  58. *
  59. * Initialisation de l'objet MTRAV
  60. *
  61.       SEGACT MELEME
  62.       NNNOE=NUM(/2)
  63.       SEGACT MLMOTS
  64.       JGM=MOTS(/2)
  65.       NNIN=JGM
  66.       SEGINI MTRAV
  67.       DO ININ=1,NNIN
  68.          INCO(ININ)=MOTS(ININ)
  69.       ENDDO
  70.       DO INNOE=1,NNNOE
  71.          IGEO(INNOE)=NUM(1,INNOE)
  72.       ENDDO
  73. *
  74. * Remplissage de l'objet MTRAV
  75. *
  76. *  Création du segment de répérage dans IGEO
  77.       NTOGPO=nbpts
  78.       JG=NTOGPO
  79.       SEGINI,KRIGEO
  80.       DO INNOE=1,NNNOE
  81.          KRIGEO.LECT(IGEO(INNOE))=INNOE
  82.       ENDDO
  83. *  Parcours de l'objet champoint
  84.       SEGACT MCHPOI
  85.       NSOUPO=IPCHP(/1)
  86.       NHARMO=-10
  87.       DO ISOUPO=1,NSOUPO
  88.          MSOUPO=IPCHP(ISOUPO)
  89.          SEGACT MSOUPO
  90.          NC=NOCOMP(/2)
  91. *   Création du segment de repérage dans les noms d'inconnues
  92.          DO IC=1,NC
  93.             ININ=0
  94.             DO JNIN=1,NNIN
  95.                IF (INCO(JNIN).EQ.NOCOMP(IC)) THEN
  96.                   ININ=JNIN
  97.                   GOTO 2
  98.                ENDIF
  99.             ENDDO
  100.  2          CONTINUE
  101.             IF (JNIN.NE.0) THEN
  102.                IF(NHARMO.EQ.-10) THEN
  103.                   NHARMO=NOHARM(IC)
  104.                ELSE
  105.                   IF (NOHARM(IC).NE.NHARMO) THEN
  106.                      CALL ERREUR(435)
  107.                      RETURN
  108.                   ENDIF
  109.                ENDIF
  110.                IPT1= IGEOC
  111.                SEGACT IPT1
  112.                MPOVAL=IPOVAL
  113.                SEGACT MPOVAL
  114.                N=VPOCHA(/1)
  115.                DO I=1,N
  116.                   IGLOB=IPT1.NUM(1,I)
  117.                   INNOE=KRIGEO.LECT(IGLOB)
  118.                   IF (INNOE.NE.0) THEN
  119.                      IBIN(ININ,INNOE)=1
  120.                      BB(ININ,INNOE)=VPOCHA(I,IC)
  121.                   ENDIF
  122.                ENDDO
  123.             ENDIF
  124.          ENDDO
  125.       ENDDO
  126.       IF(NHARMO.NE.-10) THEN
  127.          DO ININ=1,NNIN
  128.             NHAR(ININ)=NHARMO
  129.          ENDDO
  130.       ENDIF
  131.       SEGSUP KRIGEO
  132. *
  133. * Normal termination
  134. *
  135.       RETURN
  136. *
  137. * End of subroutine CP2TR2
  138. *
  139.       END
  140.  
  141.  

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