Télécharger kbor.eso

Retour à la liste

Numérotation des lignes :

  1. C KBOR SOURCE CHAT 05/01/13 00:52:05 5004
  2. SUBROUTINE KBOR(MCHPO1,MCHPO2)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C----------------------------------------------------------------------
  6. C Surcharge du second membre par certaines valeurs en vue de traiter
  7. C les conditions aux limites de type Dirichlet en mecanique des fluides
  8. C----------------------------------------------------------------------
  9. C
  10. C SYNTAXE : CHP3 = KOPS CHP1 'CLIM' CHP2 ENTI1 ;
  11. C
  12. C 'CLIM' : Mot désignant l'option ad'hoc pour passer ici
  13. C CHP1 : Champoint contenant le second membre
  14. C CHP2 : Champoint de conditions aux limites
  15. C ENTI1 : Entier indiquant le type de surcharge
  16. C 0 -> 0 1 -> 1.E30 2 -> 1.E30*CHP2 3 -> CHP2
  17. C -1,-2,-3 -> on teste sur le nom des composantes et non sur
  18. C ux,uy,uz (meme specif que |ENTI1|)
  19. C CHP3 : Contient CHP1 surchargé suivant CHP2 et ENTI1
  20. C
  21. C----------------------------------------------------------------------
  22. C
  23. C--------------
  24. C Entree/Sortie
  25. C--------------
  26. C
  27. C E/S MCHPO1 : Pointeur de CHP1 en Entrée et de CHPO3 en sortie
  28. C E/ MCHPO2 : Pointeur de CHP2
  29. C
  30. C----------------------------------------------------------------------
  31. C Le pointeur de CHP3 écrase subtilement celui de CHP1 (!?)
  32. C----------------------------------------------------------------------
  33. -INC CCREEL
  34. -INC SMELEME
  35. POINTEUR MELEM1.MELEME,MELEM2.MELEME
  36. -INC SMCHPOI
  37. -INC SMLENTI
  38. CHARACTER*4 NMC1,NMC2,NMC3
  39. C
  40. IF (MCHPO1.EQ.0.OR.MCHPO2.EQ.0) THEN
  41. C 5 3 Erreur anormale.contactez votre support
  42. CALL ERREUR(5)
  43. RETURN
  44. ENDIF
  45. CALL LIRENT(IKAS,1,IRET)
  46. IF (IRET.EQ.0) RETURN
  47. IKA1=IKAS
  48. IKAS=ABS(IKAS)
  49. IF (IKAS.GE.4) THEN
  50. C 26 2 Tache impossible. Probablement données erronées
  51. CALL ERREUR(26)
  52. RETURN
  53. ENDIF
  54. CALL ECROBJ('CHPOINT',MCHPO1)
  55. CALL COPIER
  56. CALL LIROBJ('CHPOINT',MCHPO1,1,IRET)
  57. IF(IRET.EQ.0)RETURN
  58.  
  59. C write(6,*)' MCHPO1,MCHPO2=',MCHPO1,MCHPO2
  60. SEGACT MCHPO1,MCHPO2
  61. NSOUP1=MCHPO1.IPCHP(/1)
  62.  
  63. NSOUP2=MCHPO2.IPCHP(/1)
  64. C write(6,*)' NSOUP1,NSOUP2=',NSOUP1,NSOUP2
  65. DO 21 L2=1,NSOUP2
  66. MSOUP2=MCHPO2.IPCHP(L2)
  67. SEGACT MSOUP2
  68. MELEM2=MSOUP2.IGEOC
  69. SEGACT MELEM2
  70. NPT2=MELEM2.NUM(/2)
  71. NC2=MSOUP2.NOHARM(/1)
  72. MPOVA2=MSOUP2.IPOVAL
  73. SEGACT MPOVA2
  74. C write(6,*)' NC2,NPT2=',nc2,npt2
  75. DO 21 N2=1,NC2
  76. NMC2=MSOUP2.NOCOMP(N2)
  77.  
  78. DO 11 L1=1,NSOUP1
  79. C write(6,*)' L1=',L1
  80. MSOUP1=MCHPO1.IPCHP(L1)
  81. SEGACT MSOUP1
  82. MELEM1=MSOUP1.IGEOC
  83. SEGACT MELEM1
  84. NPT1=MELEM1.NUM(/2)
  85. NC1=MSOUP1.NOHARM(/1)
  86. MPOVA1=MSOUP1.IPOVAL
  87. SEGACT MPOVA1*MOD
  88. C write(6,*)' NC1,NPT1=',nc1,npt1
  89. DO 11 N1=1,NC1
  90. NMC1=MSOUP1.NOCOMP(N1)
  91. Correction ttmf3, le 18/08/99 : NMC3 non initialisée
  92. NMC3=NMC2
  93. C write(6,*)' NC1,NC2,NSOUP1,NSOUP2=',
  94. C &NC1,NC2,NSOUP1,NSOUP2
  95. IF(NMC2(1:1).EQ.'1')NMC3='UX '
  96. IF(NMC2(1:1).EQ.'2')NMC3='UY '
  97. IF(NMC2(1:1).EQ.'3')NMC3='UZ '
  98. IF(IKA1.LE.0)NMC3=NMC2
  99. IF(NMC1.NE.NMC3)GO TO 11
  100. CALL KRIPAD(MELEM1,MLENTI)
  101. DO 2 I2=1,NPT2
  102. I1=LECT(MELEM2.NUM(1,I2))
  103. IF(I1.EQ.0)GO TO 2
  104. IF(IKAS.EQ.0)THEN
  105. C MPOVA1.VPOCHA(I1,N1)=XPETIT
  106. MPOVA1.VPOCHA(I1,N1)=1.D-30
  107. ELSEIF(IKAS.EQ.1)THEN
  108. C MPOVA1.VPOCHA(I1,N1)=XGRAND
  109. MPOVA1.VPOCHA(I1,N1)=1.D30
  110. ELSEIF(IKAS.EQ.2)THEN
  111. C MPOVA1.VPOCHA(I1,N1)=MPOVA2.VPOCHA(I2,N2)*XGRAND
  112. MPOVA1.VPOCHA(I1,N1)=MPOVA2.VPOCHA(I2,N2)*1.D30
  113. ELSEIF(IKAS.EQ.3)THEN
  114. MPOVA1.VPOCHA(I1,N1)=MPOVA2.VPOCHA(I2,N2)
  115. ELSE
  116. * WRITE(6,*)' KOPS : CLIM IKAS=',IKAS,' NON PREVU '
  117. RETURN
  118. ENDIF
  119.  
  120. 2 CONTINUE
  121.  
  122. 11 CONTINUE
  123. 21 CONTINUE
  124.  
  125. CALL ECROBJ('CHPOINT ',MCHPO1)
  126.  
  127. RETURN
  128. 1001 FORMAT(20(1X,I5))
  129. 1008 FORMAT(10(1X,A8))
  130. 1002 FORMAT(10(1X,1PE11.4))
  131. END
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  

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