Sources Esope | Cast3M

kmac
C KMAC      SOURCE    PV        20/04/03    21:15:30     10571          
      SUBROUTINE KMAC(IKAS)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C************************************************************************
C    Operateur KMAC
C
C    OBJET   : Cree un objet de type MATRAK
C
C    SYNTAXE : RESU = KMAC RVP  ;
C
C    RVP  : TABLE de soustype EQPR  (cree par EQPR)
C
C    REMARQUE : Cet objet n'est pas un objet STANDART CASTEM2000
C               Il n'est donc pas listable
C    Il est tout juste bon a mettre dans la table RVP pour etre utilise
C    par les operateurs de résolution de la matrice de contrainte
C***********************************************************************
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
      PARAMETER (NTB=3)
      CHARACTER*8 LTAB(NTB),MTYP,CHAI,NOM
      DIMENSION KTAB(NTB)
      DATA LTAB/'EQPR    ','KIZX    ','OPER_0D '/
C***
CKMAC
C     write(6,*)' Debut KMAC '
      segact mcoord
 
C Nouvelle directive EQUA de EQEX
      MTYP=' '
      CALL QUETYP(MTYP,0,IRET)
      IF(IRET.EQ.0)THEN
C% On attend un des objets : %m1:8 %m9:16 %m17:24 %m25:32 %m33:40
      MOTERR( 1: 8) = 'CHAI    '
      MOTERR( 9:16) = 'MMODEL  '
      MOTERR(17:24) = 'TABLE   '
      CALL ERREUR(472)
      RETURN
      ENDIF
      WRITE(NOM,FMT='(A7,I1)')'      K',IKAS
      IF(MTYP.EQ.'MMODEL')THEN
        CALL YTCLSF(NOM,'KMAC    ')
        RETURN
      ELSEIF(MTYP.EQ.'MOT     ')THEN
        CALL LIRCHA(CHAI,1,IRET)
        CALL YTCLSF(CHAI,'KMAC    ')
        RETURN
      ENDIF
C Fin Nouvelle directive EQUA de EQEX
 
      NTO=0
      CALL LITABS(LTAB,KTAB,NTB,NTO,IRET)
 
      IF(KTAB(1).EQ.0.AND.KTAB(2).NE.0.AND.KTAB(3).EQ.0)THEN
        CALL KMIC(IKAS,KTAB(2))
        RETURN
C Bifurcation en cas de discrétisation 0D
      ELSEIF(KTAB(1).EQ.0.AND.KTAB(2).EQ.0.AND.KTAB(3).NE.0)THEN
        CALL TGRAD (KTAB(3))
        RETURN
      ELSEIF(KTAB(1).NE.0.AND.KTAB(2).EQ.0.AND.KTAB(3).EQ.0)THEN
        MTABP=KTAB(1)
        CALL LEKTAB(MTABP,'MATC',MATRAK)
        IF(MATRAK.EQ.0)THEN
          WRITE(6,*)' Opérateur KMAC : '
          WRITE(6,*)' On ne trouve pas MATC dans la table pression'
          RETURN
        ENDIF
        CALL ECROBJ('MATRAK',MATRAK)
        RETURN
      ELSE
        WRITE(6,*)' Opérateur KMAC : '
      WRITE(6,*)' On attend une table soustype EQPR, KIZX ou OPER_0D'
        RETURN
      ENDIF
      RETURN
 1001 FORMAT(20(1X,I5))
      END