Télécharger kctrp0.eso

Retour à la liste

Numérotation des lignes :

  1. C KCTRP0 SOURCE BP208322 16/11/18 21:18:03 9177
  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=' '
  16. CALL ACMO(MTABLE,'MACRO',TYPE,MACRO)
  17. TYPE=' '
  18. CALL ACMO(MTABLE,'QUADRATI',TYPE,MQ)
  19. IF(MACRO.EQ.0.AND.MQ.EQ.0)THEN
  20.  
  21. TYPE=' '
  22. CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC)
  23. IF(MELEMC.EQ.0)THEN
  24. MOTERR(1: 8) = 'DOMAINE.'
  25. MOTERR(9:16) = 'CENTRE '
  26. CALL ERREUR(792)
  27. IPOINT=0
  28. RETURN
  29. ENDIF
  30.  
  31. ELSE
  32. IF(MACRO.NE.0)MELEMI=MACRO
  33. IF(MQ .NE.0)MELEMI=MQ
  34.  
  35. CALL ECROBJ('MAILLAGE',MELEMI)
  36. CALL NBEL
  37. CALL LIRENT(NBELEM,1,IRET)
  38. IF(IRET.EQ.0)RETURN
  39. NBSOUS=0
  40. NBREF=0
  41. NBNN=1
  42. SEGINI MELEME
  43. ITYPEL=1
  44. NBV0=XCOOR(/1)/(IDIM+1)
  45. NBPTS=NBV0+NBELEM
  46. SEGADJ MCOORD
  47. K0=NBV0
  48. KE=0
  49.  
  50.  
  51. SEGACT MELEMI
  52. NBSOUL=MELEMI.LISOUS(/1)
  53. IF(NBSOUL.EQ.0)NBSOUL=1
  54.  
  55. DO 1 L=1,NBSOUL
  56. IPT1=MELEMI
  57. IF(NBSOUL.NE.1)IPT1=MELEMI.LISOUS(L)
  58. SEGACT IPT1
  59. NP=IPT1.NUM(/1)
  60. NEL=IPT1.NUM(/2)
  61.  
  62. NOME=NOMS(IPT1.ITYPEL)//' '
  63. CALL KXL(NOME,'P0',XL)
  64.  
  65. DO 2 K=1,NEL
  66. K0=K0+1
  67. KE=KE+1
  68. DO 3 M=1,IDIM
  69. DO 3 I=1,NP
  70. NI=IPT1.NUM(I,K)
  71. XA(M,I)=XCOOR((NI-1)*(IDIM+1) +M)
  72. 3 CONTINUE
  73.  
  74. CALL FFQ(NOME,XA,XL,XG,IDIM,1)
  75. DO 4 M=1,IDIM
  76. XCOOR((K0-1)*(IDIM+1) +M)=XG(M,1)
  77. 4 CONTINUE
  78. NUM(1,KE)=K0
  79. 2 CONTINUE
  80. 1 CONTINUE
  81.  
  82. IPOINT=MELEME
  83. CALL ECMO(MTABLE,'CENTREP0','MAILLAGE',MELEME)
  84. ENDIF
  85.  
  86. RETURN
  87. 1002 FORMAT(10(1X,1PE11.4))
  88. END
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales