Télécharger la plaquette Cast3M


fr en

Télécharger machin.eso

Retour à la liste

Numérotation des lignes : 

machin

  1. C MACHIN    SOURCE    GOUNAND   21/04/14    21:15:01     10964          
  2.       SUBROUTINE MACHIN()
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C NOM         : MACHIN
  7. C DESCRIPTION : Changement de nom d'inconnues primales et duales
  8. C               d'une matrice (type RIGIDITE ou MATRIK)
  9. C
  10. C
  11. C LANGAGE     : ESOPE
  12. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  13. C               mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES          :
  16. C APPELES (E/S)    : LIROBJ
  17. C APPELES (BLAS)   :
  18. C APPELES (CALCUL) :
  19. C APPELE PAR       :
  20. C***********************************************************************
  21. C SYNTAXE GIBIANE    :
  22. C    MATRIK2  = 'KOPS'  'CHANINCO'  MATRIK1
  23. C                        LISTMOT1 LISTMOT2 LISTMOT3 LISTMOT4 ;
  24. C ENTREES            : EMTK
  25. C ENTREES/SORTIES    : -
  26. C SORTIES            : SMTK
  27. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  28. C***********************************************************************
  29. C VERSION    : v1, 04/07/2002, version initiale
  30. C HISTORIQUE : v1, 04/07/2002, création
  31. C HISTORIQUE :
  32. C HISTORIQUE :
  33. C***********************************************************************
  34. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  35. C en cas de modification de ce sous-programme afin de faciliter
  36. C la maintenance !
  37. C***********************************************************************
  38.  
  39. -INC PPARAM
  40. -INC CCOPTIO
  41. -INC SMLMOTS
  42.       POINTEUR IEPRI.MLMOTS
  43.       POINTEUR IEDUA.MLMOTS
  44.       POINTEUR ISPRI.MLMOTS
  45.       POINTEUR ISDUA.MLMOTS
  46. *
  47.       CHARACTER*4 MEPRI,MEDUA,MSPRI,MSDUA
  48.       CHARACTER*8 MONTYP
  49. *
  50. * Executable statements
  51. *
  52. *
  53. * Lecture des arguments
  54. *
  55.       CALL LIROBJ('LISTMOTS',IEPRI,0,ILMOTS)
  56.       IF (ILMOTS.EQ.0) THEN
  57.          CALL LIRCHA(MEPRI,1,iretou)
  58.          IF( ierr.ne.0) RETURN
  59.          CALL LIRCHA(MSPRI,1,iretou)
  60.          IF( ierr.ne.0) RETURN
  61.          CALL LIRCHA(MEDUA,1,iretou)
  62.          IF( ierr.ne.0) RETURN
  63.          CALL LIRCHA(MSDUA,1,iretou)
  64.          IF( ierr.ne.0) RETURN
  65.          JGN=4
  66.          JGM=1
  67.          segini iepri,ispri,iedua,isdua
  68.          iepri.mots(1)=mepri
  69.          ispri.mots(1)=mspri
  70.          iedua.mots(1)=medua
  71.          isdua.mots(1)=msdua
  72.       ELSE
  73.          CALL LIROBJ('LISTMOTS',ISPRI,1,IRETOU)
  74.          IF (IERR.NE.0) RETURN
  75.          CALL LIROBJ('LISTMOTS',IEDUA,1,IRETOU)
  76.          IF (IERR.NE.0) RETURN
  77.          CALL LIROBJ('LISTMOTS',ISDUA,1,IRETOU)
  78.          IF (IERR.NE.0) RETURN
  79.       ENDIF
  80.       CALL QUETYP(MONTYP,0    ,IRETOU)
  81. *      WRITE(IOIMP,*) 'MONTYP=',MONTYP
  82.       IF (IRETOU.EQ.0) THEN
  83.          CALL ERREUR(533)
  84.          RETURN
  85.       ENDIF
  86. *
  87.       IF (MONTYP.EQ.'MATRIK  ') THEN
  88.          CALL LIROBJ('MATRIK  ',IMAT,1,IRETOU)
  89.          IF (IERR.NE.0) RETURN
  90.          CALL MACHIK(IMAT,IEPRI,ISPRI,IEDUA,ISDUA,IMAT2)
  91.          IF (IERR.NE.0) RETURN
  92.          CALL ECROBJ('MATRIK  ',IMAT2)
  93.       ELSEIF (MONTYP.EQ.'RIGIDITE') THEN
  94.          CALL LIROBJ('RIGIDITE',IMAT,1,IRETOU)
  95.          IF (IERR.NE.0) RETURN
  96. * Autorise le changement de nom des multiplicateurs de Lagrange
  97.          CALL ECRCHA('MULT')
  98.          CALL ECROBJ('LISTMOTS',ISDUA)
  99.          CALL ECROBJ('LISTMOTS',IEDUA)
  100.          CALL ECROBJ('LISTMOTS',ISPRI)
  101.          CALL ECROBJ('LISTMOTS',IEPRI)
  102.          CALL ECROBJ('RIGIDITE',IMAT)
  103.          CALL ECRCHA('INCO')
  104.          CALL PRCHAN
  105.       ELSE
  106.          MOTERR(1:8)=MONTYP
  107.          CALL ERREUR(39)
  108.       ENDIF
  109. *
  110. * Normal termination
  111. *
  112.       RETURN
  113. *
  114. * Format handling
  115. *
  116. *
  117. * End of subroutine MACHIN
  118. *
  119.       END
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  

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