Télécharger kcha.eso

Retour à la liste

Numérotation des lignes :

  1. C KCHA SOURCE CB215821 16/12/05 21:39:53 9237
  2. SUBROUTINE KCHA
  3. C-----------------------------------------------------------------------
  4. C Transforme un CHPO de support CENTRE en un MCHAML constant par élément
  5. C Transforme un MCHAML constant par élément en un CHPO de support CENTRE
  6. C de nature DIFFUSE
  7. C-----------------------------------------------------------------------
  8. C
  9. C---------------------------
  10. C Phrase d'appel (GIBIANE) :
  11. C---------------------------
  12. C
  13. C RES1 = 'KCHA' MODL1 MOT1 DONN1 ('QUAF')
  14. C TABL1
  15. C
  16. C------------------------
  17. C Opérandes et résultat :
  18. C------------------------
  19. C
  20. C RES1 : Contient le CHPO ou le MCHAML résultat selon l'option MOT1
  21. C Le support de RES1 est soit table.centre, soit table.maillage
  22. C MOT1 : Mot de quatre lettre indiquant le type d'objet à créer
  23. C Si MOT1='CHPO' un MCHAML constant devient un CHPO centre
  24. C Si MOT1='CHAM' un CHPO centre devient un MCHAML constant
  25. C MODL1 : Objet MMODEL
  26. C TABL1 : TABLE Domaine
  27. C DONN1 : Objet à transformer (CHPO OU MCHAML)
  28. C 'QUAF' : mot de 4 lettres indiquant le travail avec maillage QUAF
  29. C plutôt que simple
  30. C
  31. C-----------------------------------------------------------------------
  32. C
  33. C Langage : ESOPE + FORTRAN77
  34. C
  35. C Auteurs : F.DABBENE 07/94
  36. C Révision : 01/99 P.Maugis
  37. C Révision : 11/06 PM : utilisation maillages QUAF
  38. C
  39. C-----------------------------------------------------------------------
  40. IMPLICIT INTEGER(I-N)
  41. IMPLICIT REAL*8 (A-H,O-Z)
  42. PARAMETER (NBOPT=2)
  43. C
  44. -INC CCOPTIO
  45. -INC SMCHAML
  46. -INC SMCHPOI
  47. -INC SMELEME
  48. -INC SMTABLE
  49. C
  50. CHARACTER*4 MOTOPT(NBOPT),NOMTOT(1),MOQUAF(1)
  51. DATA MOTOPT / 'CHAM' , 'CHPO' /
  52. DATA MOQUAF / 'QUAF' /
  53. LOGICAL LQUAF
  54. C
  55. C- Lecture de l'option et traitement
  56. C
  57. * on construit un CHAMELEM ou un CHPOINT ?
  58. ICOND = 1
  59. CALL LIRMOT(MOTOPT,NBOPT,IKCHA,ICOND)
  60. IF (IKCHA.EQ.0) RETURN
  61.  
  62. * maillage simple ou QUAF ?
  63. ICOND = 0
  64. CALL LIRMOT(MOQUAF,1,IQUAF,ICOND)
  65. LQUAF = (IQUAF.EQ.1)
  66. C
  67. C Lecture du modèle
  68. C
  69. CALL LIROBJ('MMODEL',IPMODE,0,IRET)
  70. IF (IERR.NE.0) RETURN
  71. C
  72. C Récupération de la TABLE domaine et des maillages
  73. C
  74. IPTABL = 0
  75. IF(IRET.EQ.0)THEN
  76. CALL LIRTAB('DOMAINE',IPTABL,1,IRET)
  77. IF (IERR.NE.0) RETURN
  78. ELSE
  79. CALL LEKMOD(IPMODE,IPTABL,IRET)
  80. IF (IERR.NE.0) RETURN
  81. ENDIF
  82.  
  83. C Maillage des points centres
  84. CALL LEKTAB(IPTABL,'CENTRE ',IPCENT)
  85. IF (IERR.NE.0) RETURN
  86.  
  87. C- Maillage support voulu
  88. IF (LQUAF) THEN
  89. CALL LEKTAB(IPTABL,'QUAF ',IPGEOM)
  90. IF (IERR.NE.0) RETURN
  91. ELSE
  92. CALL LEKTAB(IPTABL,'MAILLAGE',IPGEOM)
  93. IF (IERR.NE.0) RETURN
  94. ENDIF
  95. C
  96. C- Transformation ...
  97. C
  98. IF (IKCHA.EQ.1) THEN
  99. C
  100. C- d'un CHPO CENTRE en MCHAML constant par élément
  101. C
  102. C Lecture objet à transformer
  103. CALL LIROBJ('CHPOINT',ICHP1,1,IRET1)
  104. IF (IERR.NE.0) RETURN
  105. C Construction du segment de travail
  106. NBCOMP = 0
  107. NOMTOT(1) = ' '
  108. CALL KCHA0(ICHP1,IPCENT,NBCOMP,NOMTOT,MTRAV,IREDIR)
  109. C Appel de la procédure de métamorphose :
  110. CALL KCHA1(MTRAV,IPGEOM,IPRESU)
  111. ELSE
  112. C
  113. C- d'un MCHAML constant par élément en CHPO CENTRE
  114. C
  115. C Lecture objet à transformer
  116. CALL LIROBJ('MCHAML',IPIN,1,IRET1)
  117. IF (IERR.NE.0) RETURN
  118. CALL REDUAF(IPIN,IPMODE,IPCHE1,0,IR,KER)
  119. IF(IR .NE. 1) CALL ERREUR(KER)
  120. IF(IERR .NE. 0) RETURN
  121. C Appel de la procédure de métamorphose :
  122. CALL KCHA2(IPCHE1,IPGEOM,IPCENT,IPRESU)
  123. IF(IERR .NE. 0) RETURN
  124. ENDIF
  125. C
  126. C- Ecriture du résultat
  127. C
  128. IF (IPRESU .EQ. 0) then
  129. CALL ERREUR(5)
  130. ELSE
  131. IF (IKCHA .EQ. 1) THEN
  132. CALL ECROBJ('MCHAML',IPRESU)
  133. ELSE
  134. CALL ECROBJ('CHPOINT',IPRESU)
  135. ENDIF
  136. ENDIF
  137. C
  138. RETURN
  139. END
  140.  
  141.  
  142.  

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