Télécharger kcha.eso

Retour à la liste

Numérotation des lignes :

  1. C KCHA SOURCE CB215821 19/07/30 21:17:04 10273
  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. CALL ACTOBJ('MMODEL ',IPMODE,1)
  71. IF (IERR.NE.0) RETURN
  72. C
  73. C Récupération de la TABLE domaine et des maillages
  74. C
  75. IPTABL = 0
  76. IF(IRET.EQ.0)THEN
  77. CALL LIRTAB('DOMAINE',IPTABL,1,IRET)
  78. IF (IERR.NE.0) RETURN
  79. ELSE
  80. CALL LEKMOD(IPMODE,IPTABL,IRET)
  81. IF (IERR.NE.0) RETURN
  82. ENDIF
  83.  
  84. C Maillage des points centres
  85. CALL LEKTAB(IPTABL,'CENTRE ',IPCENT)
  86. IF (IERR.NE.0) RETURN
  87.  
  88. C- Maillage support voulu
  89. IF (LQUAF) THEN
  90. CALL LEKTAB(IPTABL,'QUAF ',IPGEOM)
  91. IF (IERR.NE.0) RETURN
  92. ELSE
  93. CALL LEKTAB(IPTABL,'MAILLAGE',IPGEOM)
  94. IF (IERR.NE.0) RETURN
  95. ENDIF
  96. C
  97. C- Transformation ...
  98. C
  99. IF (IKCHA.EQ.1) THEN
  100. C
  101. C- d'un CHPO CENTRE en MCHAML constant par élément
  102. C
  103. C Lecture objet à transformer
  104. CALL LIROBJ('CHPOINT ',ICHP1,1,IRET1)
  105. CALL ACTOBJ('CHPOINT ',ICHP1,1)
  106. IF (IERR.NE.0) RETURN
  107. C Construction du segment de travail
  108. NBCOMP = 0
  109. NOMTOT(1) = ' '
  110. CALL KCHA0(ICHP1,IPCENT,NBCOMP,NOMTOT,MTRAV,IREDIR)
  111. C Appel de la procédure de métamorphose :
  112. CALL KCHA1(MTRAV,IPGEOM,IPRESU)
  113. ELSE
  114. C
  115. C- d'un MCHAML constant par élément en CHPO CENTRE
  116. C
  117. C Lecture objet à transformer
  118. CALL LIROBJ('MCHAML ',IPIN,1,IRET1)
  119. CALL ACTOBJ('MCHAML ',IPIN,1)
  120. IF (IERR.NE.0) RETURN
  121. CALL REDUAF(IPIN,IPMODE,IPCHE1,0,IR,KER)
  122. IF(IR .NE. 1) CALL ERREUR(KER)
  123. IF(IERR .NE. 0) RETURN
  124. C Appel de la procédure de métamorphose :
  125. CALL KCHA2(IPCHE1,IPGEOM,IPCENT,IPRESU)
  126. IF(IERR .NE. 0) RETURN
  127. ENDIF
  128. C
  129. C- Ecriture du résultat
  130. C
  131. IF (IPRESU .EQ. 0) then
  132. CALL ERREUR(5)
  133. ELSE
  134. IF (IKCHA .EQ. 1) THEN
  135. CALL ACTOBJ('MCHAML ',IPRESU,1)
  136. CALL ECROBJ('MCHAML ',IPRESU)
  137. ELSE
  138. CALL ACTOBJ('CHPOINT ',IPRESU,1)
  139. CALL ECROBJ('CHPOINT ',IPRESU)
  140. ENDIF
  141. ENDIF
  142.  
  143. END
  144.  
  145.  
  146.  

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