Sources Esope | Cast3M

kctrp0
C KCTRP0    SOURCE    PV        20/03/24    21:18:28     10554          
      SUBROUTINE KCTRP0(MTABLE,IPOINT)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC SMTABLE
-INC SMCOORD
-INC SMELEME
      POINTEUR MELEMI.MELEME
      DIMENSION XA(3,27),XL(3,4),XG(3,4)
      CHARACTER*8 TYPE,NOME
 
      IPOINT=0
      TYPE=' '
      CALL ACMO(MTABLE,'MACRO',TYPE,MACRO)
      TYPE=' '
      CALL ACMO(MTABLE,'QUADRATI',TYPE,MQ)
      IF(MACRO.EQ.0.AND.MQ.EQ.0)THEN
 
      TYPE=' '
      CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC)
      IF(MELEMC.EQ.0)THEN
      MOTERR(1: 8) = 'DOMAINE.'
      MOTERR(9:16) = 'CENTRE  '
      CALL ERREUR(792)
      IPOINT=0
      RETURN
      ENDIF
 
      ELSE
      IF(MACRO.NE.0)MELEMI=MACRO
      IF(MQ   .NE.0)MELEMI=MQ
 
      CALL ECROBJ('MAILLAGE',MELEMI)
      CALL NBEL
      CALL LIRENT(NBELEM,1,IRET)
      IF(IRET.EQ.0)RETURN
      NBSOUS=0
      NBREF=0
      NBNN=1
      SEGINI MELEME
      ITYPEL=1
      segact mcoord*mod
      NBV0=nbpts
      NBPTS=NBV0+NBELEM
      SEGADJ MCOORD
      K0=NBV0
      KE=0
 
 
      SEGACT MELEMI
      NBSOUL=MELEMI.LISOUS(/1)
      IF(NBSOUL.EQ.0)NBSOUL=1
 
      DO 1 L=1,NBSOUL
      IPT1=MELEMI
      IF(NBSOUL.NE.1)IPT1=MELEMI.LISOUS(L)
      SEGACT IPT1
      NP=IPT1.NUM(/1)
      NEL=IPT1.NUM(/2)
 
      NOME=NOMS(IPT1.ITYPEL)//'    '
      CALL KXL(NOME,'P0',XL)
 
      DO 2 K=1,NEL
      K0=K0+1
      KE=KE+1
      DO 3 M=1,IDIM
      DO 3 I=1,NP
      NI=IPT1.NUM(I,K)
      XA(M,I)=XCOOR((NI-1)*(IDIM+1)    +M)
 3    CONTINUE
 
      CALL FFQ(NOME,XA,XL,XG,IDIM,1)
      DO 4 M=1,IDIM
      XCOOR((K0-1)*(IDIM+1)    +M)=XG(M,1)
 4    CONTINUE
      NUM(1,KE)=K0
 2    CONTINUE
 1    CONTINUE
 
      IPOINT=MELEME
      CALL ECMO(MTABLE,'CENTREP0','MAILLAGE',MELEME)
      ENDIF
 
      RETURN
 1002 FORMAT(10(1X,1PE11.4))
      END