Télécharger la plaquette Cast3M


fr en

Télécharger kcha.eso

Retour à la liste

Numérotation des lignes : 

kcha

  1. C KCHA      SOURCE    PV        22/01/10    21:15:03     11259          
  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.  
  45. -INC PPARAM
  46. -INC CCOPTIO
  47. -INC SMCHAML
  48. -INC SMCHPOI
  49. -INC SMELEME
  50. -INC SMTABLE
  51. C
  52.       CHARACTER*4 MOTOPT(NBOPT),MOQUAF(1)
  53.       CHARACTER*(LOCOMP) NOMTOT(1)
  54.       DATA        MOTOPT / 'CHAM' , 'CHPO' /
  55.       DATA        MOQUAF / 'QUAF' /
  56.       LOGICAL     LQUAF
  57. C
  58. C-    Lecture de l'option et traitement
  59. C
  60. *     on construit un CHAMELEM ou un CHPOINT ?
  61.       ICOND = 1
  62.       CALL LIRMOT(MOTOPT,NBOPT,IKCHA,ICOND)
  63.       IF (IKCHA.EQ.0) RETURN
  64.  
  65. *     maillage simple ou QUAF ?
  66.       ICOND = 0
  67.       CALL LIRMOT(MOQUAF,1,IQUAF,ICOND)
  68.       LQUAF = (IQUAF.EQ.1)
  69. C
  70. C     Lecture du modèle
  71. C
  72.       CALL LIROBJ('MMODEL  ',IPMODE,0,IRET)
  73.       if(iret.ne.0) CALL ACTOBJ('MMODEL  ',IPMODE,1)
  74.       IF (IERR.NE.0) RETURN
  75. C
  76. C     Récupération de la TABLE domaine et des maillages
  77. C
  78.       IPTABL = 0
  79.       IF(IRET.EQ.0)THEN
  80.         CALL LIRTAB('DOMAINE',IPTABL,1,IRET)
  81.         IF (IERR.NE.0) RETURN
  82.       ELSE
  83.         CALL LEKMOD(IPMODE,IPTABL,IRET)
  84.         IF (IERR.NE.0) RETURN
  85.       ENDIF
  86.  
  87. C     Maillage des points centres
  88.       CALL LEKTAB(IPTABL,'CENTRE  ',IPCENT)
  89.       IF (IERR.NE.0) RETURN
  90.  
  91. C-    Maillage support voulu
  92.       IF (LQUAF) THEN
  93.          CALL LEKTAB(IPTABL,'QUAF    ',IPGEOM)
  94.          IF (IERR.NE.0) RETURN
  95.       ELSE
  96.          CALL LEKTAB(IPTABL,'MAILLAGE',IPGEOM)
  97.          IF (IERR.NE.0) RETURN
  98.       ENDIF
  99. C
  100. C-    Transformation ...
  101. C
  102.       IF (IKCHA.EQ.1) THEN
  103. C
  104. C-       d'un CHPO CENTRE en MCHAML constant par élément
  105. C
  106. C        Lecture objet à transformer
  107.          CALL LIROBJ('CHPOINT ',ICHP1,1,IRET1)
  108.          CALL ACTOBJ('CHPOINT ',ICHP1,1)
  109.          IF (IERR.NE.0) RETURN
  110. C        Construction du segment de travail
  111.          NBCOMP    = 0
  112.          NOMTOT(1) = '    '
  113.          CALL KCHA0(ICHP1,IPCENT,NBCOMP,NOMTOT,MTRAV,IREDIR)
  114. C        Appel de la procédure de métamorphose :
  115.          CALL KCHA1(MTRAV,IPGEOM,IPRESU)
  116.       ELSE
  117. C
  118. C-       d'un MCHAML constant par élément en CHPO CENTRE
  119. C
  120. C        Lecture objet à transformer
  121.          CALL LIROBJ('MCHAML  ',IPIN,1,IRET1)
  122.          CALL ACTOBJ('MCHAML  ',IPIN,1)
  123.          IF (IERR.NE.0) RETURN
  124.          CALL REDUAF(IPIN,IPMODE,IPCHE1,0,IR,KER)
  125.          IF(IR   .NE. 1) CALL ERREUR(KER)
  126.          IF(IERR .NE. 0) RETURN
  127. C        Appel de la procédure de métamorphose :
  128.          CALL KCHA2(IPCHE1,IPGEOM,IPCENT,IPRESU)
  129.          IF(IERR .NE. 0) RETURN
  130.       ENDIF
  131. C
  132. C-    Ecriture du résultat
  133. C
  134.       IF (IPRESU .EQ. 0) then
  135.         CALL ERREUR(5)
  136.       ELSE
  137.         IF (IKCHA .EQ. 1) THEN
  138.           CALL ACTOBJ('MCHAML  ',IPRESU,1)
  139.           CALL ECROBJ('MCHAML  ',IPRESU)
  140.         ELSE
  141.           CALL ACTOBJ('CHPOINT ',IPRESU,1)
  142.           CALL ECROBJ('CHPOINT ',IPRESU)
  143.         ENDIF
  144.       ENDIF
  145.  
  146.       END
  147.  
  148.  
  149.  
  150.  
  151.  

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