Télécharger la plaquette Cast3M


fr en

Télécharger rlence.eso

Retour à la liste

Numérotation des lignes : 

rlence

  1. C RLENCE    SOURCE    KK2000    14/04/10    21:15:37     8032
  2.       SUBROUTINE RLENCE(MELCEN,MELTFA,MELFAC,MFACEL,MELEME)
  3. C
  4. C************************************************************************
  5. C
  6. C PROJET            :  CASTEM 2000
  7. C
  8. C NOM               :  RLENCE
  9. C
  10. C DESCRIPTION       :  Cette subroutine est appellée par la subroutine
  11. C                      GRADGE (calcul des coefficient pour le gradient
  12. C                      d'un CHPOINT 'CENTRE')
  13. C
  14. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  15. C
  16. C AUTEUR            :  A. Beccantini, SFME/LTMF
  17. C
  18. C************************************************************************
  19. C
  20. C
  21. C APPELES (Outils)  :
  22. C
  23. C APPELES (Calcul)  :
  24. C
  25. C
  26. C************************************************************************
  27. C
  28. C INPUT    :     ICEN   : 'CENTRE' points
  29. C
  30. C                IELTFA : Element-faces
  31. C
  32. C                IFAC   : 'FACE' points
  33. C
  34. C                IFACEL : Left center - face center -right center
  35. C
  36. C
  37. C OUTPUT   :     MELEME  : stencil to compute gradient
  38. C
  39. C************************************************************************
  40. C
  41. C HISTORIQUE (Anomalies et modifications éventuelles)
  42. C
  43. C HISTORIQUE : 04.07.2003
  44. C
  45. C************************************************************************
  46. C
  47.       IMPLICIT INTEGER(I-N)
  48.       IMPLICIT REAL*8(A-H,O-Z)
  49.  
  50. C
  51.       INTEGER NBSOUS, NSOU, JG, NBNN, NBELEM, NBREF
  52.      &     ,NGVOI,NLVOI,NCENG,NCEND, NCEN
  53.      &     ,ISOUS, ICEN, IELEM, IVOI
  54. C
  55.  
  56. -INC PPARAM
  57. -INC CCOPTIO
  58. -INC SMLENTI
  59. -INC SMELEME
  60.       POINTEUR MELCEN.MELEME,MELTFA.MELEME,MELFAC.MELEME,MFACEL.MELEME
  61.       POINTEUR MLELTF.MLENTI, MLEFAC.MLENTI
  62.  
  63. C
  64.       SEGACT MELCEN
  65.       SEGACT MELTFA
  66.       SEGACT MFACEL
  67. C
  68.       CALL KRIPAD(MELFAC,MLEFAC)
  69. C     SEGINI MLEFAC
  70.       SEGACT MELFAC
  71. C
  72. C     MELEME has the same structure than 'ELTFA'
  73. C     Each element of MELEME has one point more than each element of
  74. C     'ELTFA'
  75. C
  76.       NBSOUS=MELTFA.LISOUS(/1)
  77.       NSOU=MAX(NBSOUS,1)
  78.       JG=NSOU
  79.       SEGINI MLENTI
  80.       SEGINI MLELTF
  81. C
  82. C**** MLENTI contains the pointers of the elementary meshes
  83. C     of ELTFA
  84. C
  85.       IF (NSOU.EQ.1)THEN
  86.          MLENTI.LECT(1)=MELTFA
  87.       ELSE
  88.          DO ISOUS=1,NSOU,1
  89.             IPT1=MELTFA.LISOUS(ISOUS)
  90.             MLENTI.LECT(ISOUS)=IPT1
  91.          ENDDO
  92.       ENDIF
  93. C
  94.       ICEN=0
  95.       DO ISOUS=1,NSOU,1
  96.          IPT1=MLENTI.LECT(ISOUS)
  97.          SEGACT IPT1
  98.          NBNN=IPT1.NUM(/1)+1
  99.          NBELEM=IPT1.NUM(/2)
  100.          NBREF=0
  101.          NBSOUS=0
  102.          SEGINI IPT2
  103.          MLELTF.LECT(ISOUS)=IPT2
  104. C        POLY elts
  105.          IPT2.ITYPEL=32
  106.          DO IELEM=1,NBELEM,1
  107.             ICEN=ICEN+1
  108.             NCEN=MELCEN.NUM(1,ICEN)
  109.             IPT2.NUM(NBNN,IELEM)=NCEN
  110.             DO IVOI=1,NBNN-1,1
  111.                NGVOI=IPT1.NUM(IVOI,IELEM)
  112.                NLVOI=MLEFAC.LECT(NGVOI)
  113.                NCENG=MFACEL.NUM(1,NLVOI)
  114.                NCEND=MFACEL.NUM(3,NLVOI)
  115.                IF(NCENG .EQ. NCEND)THEN
  116. C
  117. C**************** We are on the BC
  118. C
  119.                   IF(NCEND .NE. NCEN)THEN
  120.                      WRITE(IOIMP,*) 'subroutine rlence.eso. 1'
  121.                      CALL ERREUR(5)
  122.                      GOTO 9999
  123.                   ENDIF
  124.                   IPT2.NUM(IVOI,IELEM)=NGVOI
  125.                ELSEIF(NCENG .EQ. NCEN)THEN
  126.                   IPT2.NUM(IVOI,IELEM)=NCEND
  127.                ELSEIF(NCEND .EQ. NCEN)THEN
  128.                   IPT2.NUM(IVOI,IELEM)=NCENG
  129.                ELSE
  130.                   WRITE(IOIMP,*) 'subroutine rlence.eso. 2'
  131.                   CALL ERREUR(5)
  132.                   GOTO 9999
  133.                ENDIF
  134.             ENDDO
  135.          ENDDO
  136.          SEGDES IPT1
  137.          SEGDES IPT2
  138.       ENDDO
  139. C
  140.       SEGDES MELCEN
  141.       SEGDES MELTFA
  142.       SEGDES MELFAC
  143.       SEGDES MFACEL
  144.       SEGSUP MLENTI
  145.       SEGSUP MLEFAC
  146. C
  147.       IF(NSOU .EQ. 1)THEN
  148.          MELEME=MLELTF.LECT(1)
  149.       ELSE
  150.          NBNN=0
  151.          NBELEM=0
  152.          NBSOUS=NSOU
  153.          NBREF=0
  154.          SEGINI MELEME
  155.          DO ISOUS=1,NSOU,1
  156.             MELEME.LISOUS(ISOUS)=MLELTF.LECT(ISOUS)
  157.          ENDDO
  158.          SEGDES MELEME
  159.       ENDIF
  160. C
  161.       SEGSUP MLELTF
  162. C
  163.  9999 RETURN
  164.       END
  165.  
  166.  
  167.  
  168.  

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