C KMAC SOURCE CHAT 06/08/24 21:47:10 5529 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 CCOPTIO 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 ' 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