Esope source files

   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=' '
  29 :       CALL QUETYP(MTYP,0,IRET)
  30 :       IF(IRET.EQ.0)THEN
  31 : C% On attend un des objets : %m1:8 %m9:16 %m17:24 %m25:32 %m33:40
  32 :       MOTERR( 1: 8) = 'CHAI    '
  33 :       MOTERR( 9:16) = 'MMODEL  '
  34 :       MOTERR(17:24) = 'TABLE   '
  34 :       CALL ERREUR(472)
  35 :       RETURN
  36 :       ENDIF
  37 :       WRITE(NOM,FMT='(A7,I1)')'      K',IKAS
  38 :       IF(MTYP.EQ.'MMODEL')THEN
  38 :         CALL YTCLSF(NOM,'KMAC    ')
  39 :         RETURN
  40 :       ELSEIF(MTYP.EQ.'MOT     ')THEN
  40 :         CALL LIRCHA(CHAI,1,IRET)
  40 :         CALL YTCLSF(CHAI,'KMAC    ')
  41 :         RETURN
  42 :       ENDIF
  43 : C Fin Nouvelle directive EQUA de EQEX
  44 : 
  45 :       NTO=0
  45 :       CALL LITABS(LTAB,KTAB,NTB,NTO,IRET)
  46 : 
  47 :       IF(KTAB(1).EQ.0.AND.KTAB(2).NE.0.AND.KTAB(3).EQ.0)THEN
  47 :         CALL KMIC(IKAS,KTAB(2))
  48 :         RETURN
  49 : C Bifurcation en cas de discrétisation 0D
  50 :       ELSEIF(KTAB(1).EQ.0.AND.KTAB(2).EQ.0.AND.KTAB(3).NE.0)THEN
  50 :         CALL TGRAD (KTAB(3))
  51 :         RETURN
  52 :       ELSEIF(KTAB(1).NE.0.AND.KTAB(2).EQ.0.AND.KTAB(3).EQ.0)THEN
  53 :         MTABP=KTAB(1)
  53 :         CALL LEKTAB(MTABP,'MATC',MATRAK)
  54 :         IF(MATRAK.EQ.0)THEN
  55 :           WRITE(6,*)' Opérateur KMAC : '
  56 :           WRITE(6,*)' On ne trouve pas MATC dans la table pression'
  57 :           RETURN
  58 :         ENDIF
  58 :         CALL ECROBJ('MATRAK',MATRAK)
  59 :         RETURN
  60 :       ELSE
  61 :         WRITE(6,*)' Opérateur KMAC : '
  62 :       WRITE(6,*)' On attend une table soustype EQPR, KIZX ou OPER_0D'
  63 :         RETURN
  64 :       ENDIF
  65 :       RETURN
  66 :  1001 FORMAT(20(1X,I5))
  67 :       END
  68 :  
  69 :  
  70 :  
  71 :  
  72 :  
  73 :