Esope source files

   1 : C KQCEST    SOURCE    CHAT      07/10/29    21:22:34     5940           
   2 :       SUBROUTINE KQCEST(MAIL,IKR)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)   
   5 : C*************************************************************************
   6 : C     Ce SP regarde la famille d'éléments
   7 : C
   8 : C     IKT = 0 Ce n'était pas des QCF
   9 : C     IKT = 1 C'était des QCF
  10 : C     IKL = 0 Ce n'était pas des Lineaires
  11 : C     IKL = 1 C'était des Lineaires
  12 : C     IKR = 0 Famille non reconnue
  13 : C     IKR = 1 C'était des QCF
  14 : C     IKR = 2 C'était des Lineaires
  15 : C     IKR = 3 C'était des Macro
  16 : C     IKR = 4 C'était des quadratiques castem 2000 (mecanique)
  17 : C     IKR =34 C'était des Macro ou des Quad
  18 : C     IKR =134 C'était des Macro ou des Quad ou des quaf
  19 : C     IKR =1341 C'était des Macro ou des Quad ou des quaf  SEG3
  20 : C     IKR =13  C'était des Macro ou des Quaf
  21 : C
  22 : C*************************************************************************
  23 : -INC CCOPTIO
  24 : -INC SMCOORD
  25 : -INC CCGEOME
  26 : -INC SMELEME
  27 :       PARAMETER (NBTE=28)
  28 :       CHARACTER*8 NOM8,LTYPL(NBTE)
  29 : 
  30 :       DATA LTYPL/
  31 :      &  'SEG3    ','TRI7    ','QUA9    ',
  32 :      &  'CU27    ','PR21    ','TE15    ','PY19    ',
  33 :      &  'SEG2    ','TRI3    ','QUA4    ',
  34 :      &  'CUB8    ','PRI6    ','TET4    ','PYR5    ',
  35 :      &  'SEG3    ','TRI6    ','QUA9    ',
  36 :      &  'CU27    ','PR18    ','TE10    ','PY14    ',
  37 :      &  'SEG3    ','TRI6    ','QUA8    ',
  38 :      &  'CU20    ','PR15    ','TE10    ','PY13    '/
  39 : 
  40 : 
  41 : 
  42 : C****
  43 :       MELEME=MAIL
  44 :       IKR=0
  45 :       SEGACT MELEME
  46 :       NBSOUS=LISOUS(/1)
  47 : C On regarde à qui on a à faire
  48 : C     SONT ce des QCF IKT=1  ?
  49 :       IKKT=1
  50 :       IKKL=1
  51 :       IKKM=1
  52 :       IKKQ=1
  53 :       NBSOU1=NBSOUS
  54 :       IF(NBSOU1.EQ.0)NBSOU1=1
  55 :       DO 1670 L=1,NBSOU1
  56 :       IPT1=MELEME
  57 :       IF(NBSOU1.NE.1)IPT1=LISOUS(L)
  58 :       SEGACT IPT1
  59 :       NOM8=NOMS(IPT1.ITYPEL)//'    '
  59 :       CALL OPTLI(IP,LTYPL,NOM8,NBTE)
  60 :       IF(IP.EQ.0)THEN
  61 :       IKR=0
  62 :       RETURN
  63 :       ENDIF
  64 :       IF(NOM8.EQ.'SEG3'.AND.NBSOU1.EQ.1)THEN
  65 :       IKR =1341
  66 :       RETURN
  67 :       ENDIF
  68 :       IF(IP.GT.7)IKKT=0
  68 :       CALL OPTLI(IP,LTYPL(8),NOM8,7)
  69 :       IF(IP.EQ.0)IKKL=0
  69 :       CALL OPTLI(IP,LTYPL(15),NOM8,7)
  70 :       IF(IP.EQ.0)IKKM=0
  70 :       CALL OPTLI(IP,LTYPL(22),NOM8,7)
  71 :       IF(IP.EQ.0)IKKQ=0
  72 :       SEGDES IPT1
  73 :  1670 CONTINUE
  74 : 
  75 : C     write(6,*)'IKKT,IKKL,IKKM,IKKQ=',IKKT,IKKL,IKKM,IKKQ
  76 :       IF(IKKT.NE.0)IKR=1
  77 :       IF(IKKL.NE.0)IKR=2
  78 :       IF(IKKM.NE.0)IKR=3
  79 :       IF(IKKQ.NE.0)IKR=4
  80 :       IF(IKKM.EQ.1.AND.IKKQ.EQ.1)IKR=34
  81 :       IF(IKKT.EQ.1.AND.IKKM.EQ.1.AND.IKKQ.EQ.1)IKR=134
  82 :       IF(IKKT.EQ.1.AND.IKKM.EQ.1)IKR=13
  83 : 
  84 :       RETURN
  85 :  1001 FORMAT(20(1X,I5))
  86 :       END
  87 :  
  88 :  
  89 :  
  90 :  
  91 :  
  92 :