Télécharger kmac.eso

Retour à la liste

Numérotation des lignes :

  1. C KMAC SOURCE CHAT 06/08/24 21:47:10 5529
  2. SUBROUTINE KMAC(IKAS)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C************************************************************************
  6. C Operateur KMAC
  7. C
  8. C OBJET : Cree un objet de type MATRAK
  9. C
  10. C SYNTAXE : RESU = KMAC RVP ;
  11. C
  12. C RVP : TABLE de soustype EQPR (cree par EQPR)
  13. C
  14. C REMARQUE : Cet objet n'est pas un objet STANDART CASTEM2000
  15. C Il n'est donc pas listable
  16. C Il est tout juste bon a mettre dans la table RVP pour etre utilise
  17. C par les operateurs de résolution de la matrice de contrainte
  18. C***********************************************************************
  19. -INC CCOPTIO
  20. PARAMETER (NTB=3)
  21. CHARACTER*8 LTAB(NTB),MTYP,CHAI,NOM
  22. DIMENSION KTAB(NTB)
  23. DATA LTAB/'EQPR ','KIZX ','OPER_0D '/
  24. C***
  25. CKMAC
  26. C write(6,*)' Debut KMAC '
  27.  
  28. C Nouvelle directive EQUA de EQEX
  29. MTYP=' '
  30. CALL QUETYP(MTYP,0,IRET)
  31. IF(IRET.EQ.0)THEN
  32. C% On attend un des objets : %m1:8 %m9:16 %m17:24 %m25:32 %m33:40
  33. MOTERR( 1: 8) = 'CHAI '
  34. MOTERR( 9:16) = 'MMODEL '
  35. MOTERR(17:24) = 'TABLE '
  36. CALL ERREUR(472)
  37. RETURN
  38. ENDIF
  39. WRITE(NOM,FMT='(A7,I1)')' K',IKAS
  40. IF(MTYP.EQ.'MMODEL')THEN
  41. CALL YTCLSF(NOM,'KMAC ')
  42. RETURN
  43. ELSEIF(MTYP.EQ.'MOT ')THEN
  44. CALL LIRCHA(CHAI,1,IRET)
  45. CALL YTCLSF(CHAI,'KMAC ')
  46. RETURN
  47. ENDIF
  48. C Fin Nouvelle directive EQUA de EQEX
  49.  
  50. NTO=0
  51. CALL LITABS(LTAB,KTAB,NTB,NTO,IRET)
  52.  
  53. IF(KTAB(1).EQ.0.AND.KTAB(2).NE.0.AND.KTAB(3).EQ.0)THEN
  54. CALL KMIC(IKAS,KTAB(2))
  55. RETURN
  56. C Bifurcation en cas de discrétisation 0D
  57. ELSEIF(KTAB(1).EQ.0.AND.KTAB(2).EQ.0.AND.KTAB(3).NE.0)THEN
  58. CALL TGRAD (KTAB(3))
  59. RETURN
  60. ELSEIF(KTAB(1).NE.0.AND.KTAB(2).EQ.0.AND.KTAB(3).EQ.0)THEN
  61. MTABP=KTAB(1)
  62. CALL LEKTAB(MTABP,'MATC',MATRAK)
  63. IF(MATRAK.EQ.0)THEN
  64. WRITE(6,*)' Opérateur KMAC : '
  65. WRITE(6,*)' On ne trouve pas MATC dans la table pression'
  66. RETURN
  67. ENDIF
  68. CALL ECROBJ('MATRAK',MATRAK)
  69. RETURN
  70. ELSE
  71. WRITE(6,*)' Opérateur KMAC : '
  72. WRITE(6,*)' On attend une table soustype EQPR, KIZX ou OPER_0D'
  73. RETURN
  74. ENDIF
  75. RETURN
  76. 1001 FORMAT(20(1X,I5))
  77. END
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  

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