Esope source files

   1 : C KCTRP0    SOURCE    CHAT      07/10/29    21:21:30     5940           
   2 :       SUBROUTINE KCTRP0(MTABLE,IPOINT)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : -INC CCOPTIO
   6 : -INC CCGEOME
   7 : -INC SMTABLE
   8 : -INC SMCOORD
   9 : -INC SMELEME
  10 :       POINTEUR MELEMI.MELEME
  11 :       DIMENSION XA(3,27),XL(3,4),XG(3,4)
  12 :       CHARACTER*8 TYPE,NOME
  13 : 
  14 :       IPOINT=0
  15 :       TYPE=' '
  15 :       CALL ACMO(MTABLE,'MACRO',TYPE,MACRO)
  16 :       TYPE=' '
  16 :       CALL ACMO(MTABLE,'QUADRATI',TYPE,MQ)
  17 :       IF(MACRO.EQ.0.AND.MQ.EQ.0)THEN
  18 : 
  19 :       TYPE=' '
  19 :       CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC)
  20 :       IF(MELEMC.EQ.0)THEN
  21 :       MOTERR(1: 8) = 'DOMAINE.'
  22 :       MOTERR(9:16) = 'CENTRE  '
  22 :       CALL ERREUR(792)
  23 :       IPOINT=0
  24 :       RETURN
  25 :       ENDIF
  26 : 
  27 :       ELSE
  28 :       IF(MACRO.NE.0)MELEMI=MACRO
  29 :       IF(MQ   .NE.0)MELEMI=MQ
  30 : 
  30 :       CALL ECROBJ('MAILLAGE',MELEMI)
  30 :       CALL NBEL
  30 :       CALL LIRENT(NBELEM,1,IRET)
  31 :       IF(IRET.EQ.0)RETURN
  32 :       NBSOUS=0
  33 :       NBREF=0
  34 :       NBNN=1
  35 :       SEGINI MELEME
  36 :       ITYPEL=1
  37 :       NBV0=XCOOR(/1)/(IDIM+1)
  38 :       NBPTS=NBV0+NBELEM
  39 :       SEGADJ MCOORD
  40 :       K0=NBV0
  41 :       KE=0
  42 : 
  43 : 
  44 :       SEGACT MELEMI
  45 :       NBSOUL=MELEMI.LISOUS(/1)
  46 :       IF(NBSOUL.EQ.0)NBSOUL=1
  47 : 
  48 :       DO 1 L=1,NBSOUL
  49 :       IPT1=MELEMI
  50 :       IF(NBSOUL.NE.1)IPT1=MELEMI.LISOUS(L)
  51 :       SEGACT IPT1
  52 :       NP=IPT1.NUM(/1)
  53 :       NEL=IPT1.NUM(/2)
  54 : 
  55 :       NOME=NOMS(IPT1.ITYPEL)//'    '
  55 :       CALL KXL(NOME,'P0',XL)
  56 : 
  57 :       DO 2 K=1,NEL
  58 :       K0=K0+1
  59 :       KE=KE+1
  60 :       DO 3 M=1,IDIM
  61 :       DO 3 I=1,NP
  62 :       NI=IPT1.NUM(I,K)
  63 :       XA(M,I)=XCOOR((NI-1)*(IDIM+1)    +M)
  64 :  3    CONTINUE
  65 : 
  65 :       CALL FFQ(NOME,XA,XL,XG,IDIM,1)
  66 :       DO 4 M=1,IDIM
  67 :       XCOOR((K0-1)*(IDIM+1)    +M)=XG(M,1)
  68 :  4    CONTINUE
  69 :       NUM(1,KE)=K0
  70 :  2    CONTINUE
  71 :  1    CONTINUE
  72 : 
  73 :       IPOINT=MELEME
  73 :       CALL ECMO(MTABLE,'CENTREP0','MAILLAGE',MELEME)
  74 :       ENDIF
  75 : 
  76 :       RETURN
  77 :  1002 FORMAT(10(1X,1PE11.4))
  78 :       END
  79 :  
  80 :  
  81 :  
  82 :  
  83 :  
  84 :  
  85 :