Télécharger la plaquette Cast3M


fr en

Télécharger blofai.eso

Retour à la liste

Numérotation des lignes : 

blofai

  1. C BLOFAI    SOURCE    MB234859  26/07/23    21:15:05     12603          
  2.       SUBROUTINE BLOFAI(MELEME,MLMOT1,MCHPO1)
  3. C----------------------------------------------------------------------
  4. C     Definir une condition aux limites de maniere faible
  5. C
  6. C Entrees :
  7. C ---------
  8. C  MELEME : pointeur MELEME sur le maillage support du blocage
  9. C  MLMOT1 : pointeur MLMOTS contenant les noms de composantes concernees
  10. C
  11. C Sortie  :
  12. C ---------
  13. C  MCHPO1 : pointeur CHPOINT contenant les coefficients a considerer 
  14. C           pour la relation.
  15. C----------------------------------------------------------------------
  16.       IMPLICIT INTEGER(I-N)
  17.       IMPLICIT REAL*8 (A-H,O-Z)
  18. C
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC CCGEOME
  22. -INC CCHAMP
  23. -INC SMELEME
  24. -INC SMLMOTS
  25. -INC SMCHAML
  26. C
  27.       MCHPO1=0
  28. C
  29.       N1PTEL=1
  30.       N1EL=1
  31.       N2PTEL=0
  32.       N2EL=0
  33.       SEGINI,MELVA1
  34.       MELVA1.VELCHE(1,1)=1
  35. C
  36.       N2=MLMOT1.MOTS(/2)
  37.       SEGINI,MCHAM2
  38.       DO IC=1,N2
  39.         MCHAM2.NOMCHE(IC)=MLMOT1.MOTS(IC)
  40.         MCHAM2.TYPCHE(IC)='REAL*8'
  41.       ENDDO
  42. C
  43.       L1=7
  44.       N1=1
  45.       N3=6
  46.       SEGINI,MCHEL2
  47.       MCHEL2.TITCHE=''
  48.       MCHEL2.CONCHE(1)= ' '
  49.       MCHEL2.ICHAML(1)=MCHAM2
  50.       MCHEL2.INFCHE(1,3)=NIFOUR
  51.       MCHEL2.INFCHE(1,4)=0
  52.       MCHEL2.INFCHE(1,6)=1
  53.       MCHEL2.IFOCHE=IFOUR
  54. C
  55.       NBMAI0=LISOUS(/1)
  56.       NBMAI=NBMAI0
  57.       IF (NBMAI0.EQ.0) NBMAI=1
  58.       IPT1=MELEME
  59. C
  60. C     Verification du type d'element
  61.       DO IMAI=1,NBMAI
  62. C
  63.         IF (NBMAI0.NE.0) IPT1=LISOUS(IMAI)
  64. C
  65.         MCHEL2.IMACHE(1)=IPT1
  66. C
  67.         CALL PLACE(NOMTP,LNOMTP,MELE,NOMS(IPT1.ITYPEL))
  68.         IF (MELE.EQ.0) THEN
  69.           CALL ERREUR(16)
  70.           GOTO 1000
  71.         ENDIF
  72.         NLG=NUMGEO(MELE)
  73.         CALL TSHAPE(NLG,'GAUSS',IPINTE)
  74. C
  75.         IF (NLG.EQ.1) THEN
  76.           CALL INTCN0(MELVA1,MELVA1,IPT1,IPINTE,IPCHEQ)
  77.         ELSE IF (NLG.EQ.2.OR.NLG.EQ.3) THEN
  78.           CALL INTCN1(MELVA1,MELVA1,IPT1,IPINTE,IPCHEQ)
  79.         ELSE IF (NLG.EQ.4.OR.NLG.EQ.6.OR.NLG.EQ.8.OR.NLG.EQ.10) THEN
  80.           CALL INTCN2(MELVA1,MELVA1,IPT1,IPINTE,IPCHEQ)
  81.         ELSE
  82.           MOTERR(1:4)=NOMS(IPT1.ITYPEL)
  83.           MOTERR(5:12)='BLOFAI'
  84.           CALL ERREUR(86)
  85.           GOTO 1000
  86.         ENDIF
  87. C
  88.         DO IC=1,N2
  89.           MCHAM2.IELVAL(IC)=IPCHEQ
  90.         ENDDO
  91. C
  92.         CALL CHAMPO(MCHEL2,0,MCHPO2,idum)
  93.         IF (IERR.NE.0) GOTO 1000
  94. C
  95.         IF (MCHPO1.NE.0) THEN
  96.           CALL ADCHPO(MCHPO1,MCHPO2,IPCRET,1.D0,1.D0)
  97.           CALL DTCHPO(MCHPO1)
  98.           CALL DTCHPO(MCHPO2)
  99.           MCHPO1=IPCRET
  100.         ELSE
  101.           MCHPO1=MCHPO2
  102.         ENDIF
  103. C
  104.       ENDDO
  105. C
  106.  1000 CONTINUE
  107.       SEGSUP,MELVA1,MCHAM2,MCHEL2
  108.       END
  109.  
  110.  

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