Télécharger machi2.eso

Retour à la liste

Numérotation des lignes :

  1. C MACHI2 SOURCE BP208322 15/06/22 21:20:27 8543
  2. SUBROUTINE MACHI2(IKAS)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C NOM : MACHI2
  7. C DESCRIPTION : Changement de noms d'inconnues duales
  8. C d'une matrice (type MATRIK) pour qu'ils soient
  9. C identiques aux noms d'inconnues primales
  10. C IKAS=1
  11. C ou pour qu'ils correspondent aux noms d'inconnues
  12. C primales (noms standard CASTEM)
  13. C IKAS=2
  14. C
  15. C
  16. C
  17. C LANGAGE : ESOPE
  18. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  19. C mél : gounand@semt2.smts.cea.fr
  20. C***********************************************************************
  21. C APPELES :
  22. C APPELES (E/S) :
  23. C APPELES (BLAS) :
  24. C APPELES (CALCUL) :
  25. C APPELE PAR :
  26. C***********************************************************************
  27. C SYNTAXE GIBIANE :
  28. C MATRIK2 = 'KOPS' 'NINCDUPR' MATRIK1 ;
  29. C ENTREES : -
  30. C ENTREES/SORTIES : -
  31. C SORTIES : -
  32. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  33. C***********************************************************************
  34. C VERSION : v1, 22/02/2006, version initiale
  35. C HISTORIQUE : v1, 22/02/2006, création
  36. C HISTORIQUE :
  37. C HISTORIQUE :
  38. C***********************************************************************
  39. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  40. C en cas de modification de ce sous-programme afin de faciliter
  41. C la maintenance !
  42. C***********************************************************************
  43. -INC CCOPTIO
  44. -INC CCHAMP
  45. -INC SMLMOTS
  46. POINTEUR PRI.MLMOTS
  47. POINTEUR DUA.MLMOTS
  48. CHARACTER*8 MTYP,TYPE
  49. CHARACTER*8 BLAN,TYCHPO,TYLMOT,TYMATK,TYRIGI
  50. *
  51. * Executable statements
  52. *
  53. BLAN=' '
  54. TYCHPO='CHPOINT '
  55. TYLMOT='LISTMOTS'
  56. TYMATK='MATRIK '
  57. TYRIGI='RIGIDITE'
  58. * On construit les noms primaux et duaux en recopiant NOMDD et NOMDU
  59. * de CCHAMP
  60. *
  61. JGN=4
  62. JGM=LNOMDD
  63. SEGINI PRI
  64. DO IGM=1,JGM
  65. PRI.MOTS(IGM)=NOMDD(IGM)
  66. ENDDO
  67. SEGDES PRI
  68. JGN=4
  69. JGM=LNOMDU
  70. SEGINI DUA
  71. DO IGM=1,JGM
  72. DUA.MOTS(IGM)=NOMDU(IGM)
  73. ENDDO
  74. SEGDES DUA
  75. TYPE=BLAN
  76. CALL QUETYP(TYPE,1,IRET)
  77. IF (TYPE.EQ.TYCHPO) THEN
  78. MTYP=TYLMOT
  79. IF (IKAS.EQ.1) THEN
  80. CALL ECROBJ(MTYP,PRI)
  81. CALL ECROBJ(MTYP,DUA)
  82. ELSEIF (IKAS.EQ.2) THEN
  83. CALL ECROBJ(MTYP,DUA)
  84. CALL ECROBJ(MTYP,PRI)
  85. ELSE
  86. CALL ERREUR(5)
  87. RETURN
  88. ENDIF
  89. CALL NOMC
  90. ELSEIF (TYPE.EQ.TYMATK.OR.TYPE.EQ.TYRIGI) THEN
  91. MTYP=TYLMOT
  92. IF (IKAS.EQ.1) THEN
  93. CALL ECROBJ(MTYP,PRI)
  94. CALL ECROBJ(MTYP,DUA)
  95. CALL ECROBJ(MTYP,PRI)
  96. CALL ECROBJ(MTYP,PRI)
  97. ELSEIF (IKAS.EQ.2) THEN
  98. CALL ECROBJ(MTYP,DUA)
  99. CALL ECROBJ(MTYP,PRI)
  100. CALL ECROBJ(MTYP,PRI)
  101. CALL ECROBJ(MTYP,PRI)
  102. ELSE
  103. CALL ERREUR(5)
  104. RETURN
  105. ENDIF
  106. CALL MACHIN
  107. ELSE
  108. MOTERR(1:8)=TYPE
  109. * 39 2
  110. *On ne veut pas d'objet de type %m1:8
  111. CALL ERREUR(131)
  112. ENDIF
  113. *
  114. * Normal termination
  115. *
  116. RETURN
  117. *
  118. * Format handling
  119. *
  120. *
  121. * Error handling
  122. *
  123. 9999 CONTINUE
  124. WRITE(IOIMP,*) 'An error was detected in subroutine machi2'
  125. CALL ERREUR(5)
  126. RETURN
  127. *
  128. * End of subroutine MACHI2
  129. *
  130. END
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  

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