Télécharger la plaquette Cast3M


fr en

Télécharger vec2ch.eso

Retour à la liste

Numérotation des lignes : 

vec2ch

  1. C VEC2CH    SOURCE    CB215821  22/07/20    15:39:46     11411          
  2.       SUBROUTINE VEC2CH(KVEC,MINC,KISPG,IDMAT,MCHTOT,IMPR,IRET)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C NOM         : VEC2CH
  7. C DESCRIPTION :
  8. C
  9. C
  10. C     Ce sp transforme un vecteur (KVEC pointeur de type IZA)
  11. C     en chpoint (MCHTOT). L'ordonnancement des inconnues est
  12. C     donné par MINC, les points concernés par KISPG et IDMAT
  13. C     donne le passage num. nouvelle -> num. ancienne (NUNA)
  14. C
  15. C     Son alter ego est ch2vec.
  16. C
  17. C LANGAGE     : ESOPE
  18. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  19. C               mél : gounand@semt2.smts.cea.fr
  20. C***********************************************************************
  21. C APPELES  : -
  22. C***********************************************************************
  23. C ENTREES            : KVEC, MINC, KISPG, IDMAT, IMPR
  24. C ENTREES/SORTIES    : -
  25. C SORTIES            : MCHTOT, IRET
  26. C CODE RETOUR (IRET) : 0 si ok
  27. C                     -1 si problème sur les inconnues
  28. C     KVEC   : pointeur sur segment IZA de l'include SMMATRIK
  29. C              contient le vecteur des inconnues à transformer.
  30. C     MINC   : pointeur sur segment MINC de l'include SMMATRIK
  31. C              décrit l'ordonnancement des inconnues dans une
  32. C              certaine numérotation (dite "nouvelle").
  33. C     KISPG  : pointeur sur segment MELEME de l'include SMELEME
  34. C              support géométrique des inconnues.
  35. C     IDMAT  : pointeur sur segment IDMAT de l'include SMMATRIK
  36. C              contient le tableau NUNA permettant de faire
  37. C              le passage numérotation "nouvelle" -> num. ancienne.
  38. C     IMPR   : niveau d'impression
  39. C     MCHTOT : pointeur sur segment MCHPOI de l'include SMCHPOI
  40. C              chpoint correspondant au vecteur KVEC.
  41. C
  42. C***********************************************************************
  43. C VERSION    : v3, 20/10/06
  44. C HISTORIQUE : v1, 01/04/98, création
  45. C HISTORIQUE :     16/05/98, MCHTOT est construit avec ET (CALL prfuse)
  46. C                            et plus avec un NSOUPO par inconnue.
  47. C HISTORIQUE : v2; 01/12/99, nouvelle signification de NUAN
  48. C (renumérotation des ddl et non pas des points) et mise au propre
  49. C (appel de adchpo à la place de prfuse et suppression des objets
  50. C  temporaires)
  51. C HISTORIQUE : v3, 20/10/06, utilisation de TMTRAV et CRECHP (plus
  52. C                  rapide et moins buggé)
  53. C
  54. C
  55. C HISTORIQUE :
  56. C***********************************************************************
  57. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  58. C en cas de modification de ce sous-programme afin de faciliter
  59. C la maintenance !
  60. C***********************************************************************
  61. -INC PPARAM
  62. -INC CCOPTIO
  64.       POINTEUR KVEC.IZA
  65. -INC TMTRAV
  66.       POINTEUR ITRAV.MTRAV
  67. -INC SMCHPOI
  68.       POINTEUR MCHTOT.MCHPOI
  69. -INC SMELEME
  70.       POINTEUR KISPG.MELEME
  71.       CHARACTER*8 NOMINC
  72. C
  73. *
  74. * Executable statements
  75. *
  76.       IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans vec2ch.eso'
  77. C
  78.       IF (IMPR.GT.6) THEN
  79.          WRITE(IOIMP,*) ' vec2ch : entrées '
  80.          WRITE(IOIMP,*) ' KVEC   = ',KVEC
  81.          WRITE(IOIMP,*) ' MINC   = ',MINC
  82.          WRITE(IOIMP,*) ' KISPG  = ',KISPG
  83.          WRITE(IOIMP,*) ' IDMAT  = ',IDMAT
  84.       ENDIF
  85. C
  86.       SEGACT KVEC
  87.       SEGACT MINC
  88.       NNIN=LISINC(/2)
  89.       NNNOE=NPOS(/1)-1
  90.       SEGACT KISPG
  91.       SEGACT IDMAT
  92. *
  93.       SEGINI ITRAV
  94.       DO ININ=1,NNIN
  95.          ITRAV.INCO(ININ)=LISINC(ININ)(1:4)
  96.          DO INNOE=1,NNNOE
  97.             ITRAV.IGEO(INNOE)=KISPG.NUM(1,INNOE)
  98.             IF (MPOS(INNOE,ININ).NE.0) THEN
  99.                ITRAV.IBIN(ININ,INNOE)=1
  100.                ITRAV.BB(ININ,INNOE)=
  101.      $              KVEC.A(NUAN(NPOS(INNOE)+
  102.      $              MPOS(INNOE,ININ)-1))
  103.             ENDIF
  104.          ENDDO
  105.       ENDDO
  106. *
  107.       CALL CRECHP(ITRAV,MCHTOT)
  108. *
  109.       SEGSUP ITRAV
  110.       MCHTOT.JATTRI(1)=2
  111.       MCHTOT.MTYPOI='SOLUTION'
  112.       MCHTOT.MOCHDE=TITREE
  113.       IF (IMPR.GT.6) THEN
  114.          WRITE(IOIMP,*) 'On a créé le chpo. MCHTOT=',MCHTOT
  115.       ENDIF
  116.       CALL ACTOBJ('CHPOINT ',MCHTOT,1)
  117.       SEGDES IDMAT
  118.       SEGDES KISPG
  119.       SEGDES MINC
  120.       SEGDES KVEC
  121. *
  122. *     Terminaison normale
  123. *
  124.       IRET=0
  125.       RETURN
  126. *
  127. *     Gestion des erreurs
  128. *
  129.  9999 CONTINUE
  130.       WRITE(IOIMP,*) 'An error was detected in vec2ch.eso'
  131.       RETURN
  132. *
  133. *     Fin de VEC2CH
  134. *
  135.       END
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  

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