Télécharger kmac.eso

Retour à la liste

Numérotation des lignes :

  1. C KMAC SOURCE PV 20/04/03 21:15:30 10571
  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.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMCOORD
  23. PARAMETER (NTB=3)
  24. CHARACTER*8 LTAB(NTB),MTYP,CHAI,NOM
  25. DIMENSION KTAB(NTB)
  26. DATA LTAB/'EQPR ','KIZX ','OPER_0D '/
  27. C***
  28. CKMAC
  29. C write(6,*)' Debut KMAC '
  30. segact mcoord
  31.  
  32. C Nouvelle directive EQUA de EQEX
  33. MTYP=' '
  34. CALL QUETYP(MTYP,0,IRET)
  35. IF(IRET.EQ.0)THEN
  36. C% On attend un des objets : %m1:8 %m9:16 %m17:24 %m25:32 %m33:40
  37. MOTERR( 1: 8) = 'CHAI '
  38. MOTERR( 9:16) = 'MMODEL '
  39. MOTERR(17:24) = 'TABLE '
  40. CALL ERREUR(472)
  41. RETURN
  42. ENDIF
  43. WRITE(NOM,FMT='(A7,I1)')' K',IKAS
  44. IF(MTYP.EQ.'MMODEL')THEN
  45. CALL YTCLSF(NOM,'KMAC ')
  46. RETURN
  47. ELSEIF(MTYP.EQ.'MOT ')THEN
  48. CALL LIRCHA(CHAI,1,IRET)
  49. CALL YTCLSF(CHAI,'KMAC ')
  50. RETURN
  51. ENDIF
  52. C Fin Nouvelle directive EQUA de EQEX
  53.  
  54. NTO=0
  55. CALL LITABS(LTAB,KTAB,NTB,NTO,IRET)
  56.  
  57. IF(KTAB(1).EQ.0.AND.KTAB(2).NE.0.AND.KTAB(3).EQ.0)THEN
  58. CALL KMIC(IKAS,KTAB(2))
  59. RETURN
  60. C Bifurcation en cas de discrétisation 0D
  61. ELSEIF(KTAB(1).EQ.0.AND.KTAB(2).EQ.0.AND.KTAB(3).NE.0)THEN
  62. CALL TGRAD (KTAB(3))
  63. RETURN
  64. ELSEIF(KTAB(1).NE.0.AND.KTAB(2).EQ.0.AND.KTAB(3).EQ.0)THEN
  65. MTABP=KTAB(1)
  66. CALL LEKTAB(MTABP,'MATC',MATRAK)
  67. IF(MATRAK.EQ.0)THEN
  68. WRITE(6,*)' Opérateur KMAC : '
  69. WRITE(6,*)' On ne trouve pas MATC dans la table pression'
  70. RETURN
  71. ENDIF
  72. CALL ECROBJ('MATRAK',MATRAK)
  73. RETURN
  74. ELSE
  75. WRITE(6,*)' Opérateur KMAC : '
  76. WRITE(6,*)' On attend une table soustype EQPR, KIZX ou OPER_0D'
  77. RETURN
  78. ENDIF
  79. RETURN
  80. 1001 FORMAT(20(1X,I5))
  81. END
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  

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