Télécharger machi2.eso

Retour à la liste

Numérotation des lignes :

machi2
  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.  
  44. -INC PPARAM
  45. -INC CCOPTIO
  46. -INC CCHAMP
  47. -INC SMLMOTS
  48. POINTEUR PRI.MLMOTS
  49. POINTEUR DUA.MLMOTS
  50. CHARACTER*8 MTYP,TYPE
  51. CHARACTER*8 BLAN,TYCHPO,TYLMOT,TYMATK,TYRIGI
  52. *
  53. * Executable statements
  54. *
  55. BLAN=' '
  56. TYCHPO='CHPOINT '
  57. TYLMOT='LISTMOTS'
  58. TYMATK='MATRIK '
  59. TYRIGI='RIGIDITE'
  60. * On construit les noms primaux et duaux en recopiant NOMDD et NOMDU
  61. * de CCHAMP
  62. *
  63. JGN=4
  64. JGM=LNOMDD
  65. SEGINI PRI
  66. DO IGM=1,JGM
  67. PRI.MOTS(IGM)=NOMDD(IGM)
  68. ENDDO
  69. SEGDES PRI
  70. JGN=4
  71. JGM=LNOMDU
  72. SEGINI DUA
  73. DO IGM=1,JGM
  74. DUA.MOTS(IGM)=NOMDU(IGM)
  75. ENDDO
  76. SEGDES DUA
  77. TYPE=BLAN
  78. CALL QUETYP(TYPE,1,IRET)
  79. IF (TYPE.EQ.TYCHPO) THEN
  80. MTYP=TYLMOT
  81. IF (IKAS.EQ.1) THEN
  82. CALL ECROBJ(MTYP,PRI)
  83. CALL ECROBJ(MTYP,DUA)
  84. ELSEIF (IKAS.EQ.2) THEN
  85. CALL ECROBJ(MTYP,DUA)
  86. CALL ECROBJ(MTYP,PRI)
  87. ELSE
  88. CALL ERREUR(5)
  89. RETURN
  90. ENDIF
  91. CALL NOMC
  92. ELSEIF (TYPE.EQ.TYMATK.OR.TYPE.EQ.TYRIGI) THEN
  93. MTYP=TYLMOT
  94. IF (IKAS.EQ.1) THEN
  95. CALL ECROBJ(MTYP,PRI)
  96. CALL ECROBJ(MTYP,DUA)
  97. CALL ECROBJ(MTYP,PRI)
  98. CALL ECROBJ(MTYP,PRI)
  99. ELSEIF (IKAS.EQ.2) THEN
  100. CALL ECROBJ(MTYP,DUA)
  101. CALL ECROBJ(MTYP,PRI)
  102. CALL ECROBJ(MTYP,PRI)
  103. CALL ECROBJ(MTYP,PRI)
  104. ELSE
  105. CALL ERREUR(5)
  106. RETURN
  107. ENDIF
  108. CALL MACHIN
  109. ELSE
  110. MOTERR(1:8)=TYPE
  111. * 39 2
  112. *On ne veut pas d'objet de type %m1:8
  113. CALL ERREUR(131)
  114. ENDIF
  115. *
  116. * Normal termination
  117. *
  118. RETURN
  119. *
  120. * Format handling
  121. *
  122. *
  123. * Error handling
  124. *
  125. 9999 CONTINUE
  126. WRITE(IOIMP,*) 'An error was detected in subroutine machi2'
  127. CALL ERREUR(5)
  128. RETURN
  129. *
  130. * End of subroutine MACHI2
  131. *
  132. END
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  

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