Télécharger chalvs.eso

Retour à la liste

Numérotation des lignes :

  1. C CHALVS SOURCE FANDEUR 16/11/30 21:15:08 9222
  2. C CHALVS SOURCE FANDEUR
  3.  
  4. C=======================================================================
  5. C= C H A L V S =
  6. C= ----------- =
  7. C= =
  8. C= Fonction : =
  9. C= ---------- =
  10. C= =
  11. C= Parametres : (E)=Entree (S)=Sortie =
  12. C= ------------ =
  13. C= IPMODE (E) Pointeur sur le segment MMODEL de la structure =
  14. C= IFORMU (E) Formulation associee au MMODEL de la structure =
  15. C= ITYPEF (E) Type(Famille) des EF du MMODEL de la structure =
  16. C= IPCHPO (E) Pointeur sur le CHPOINT de sources (puits) aux =
  17. C= noeuds de la structure (champ variable) =
  18. C= S1 (E) Valeur de la source (FLOTTANT = champ constant) =
  19. C= IPGEOM (E) Pointeur sur le MAILLAGE sur lequel s'applique S1 =
  20. C= IPCHEL (E) Pointeur sur le segment MCHAML de sources donnees =
  21. C= en chaque element de la structure (champ variable) =
  22. C= IPCHSO (S) Pointeur sur le champ de sources volumiques =
  23. C= ISUPSO (S) Support du champ de sources volumiques =
  24. C=======================================================================
  25.  
  26. SUBROUTINE CHALVS (IPMODE,IFORMU,ITYPEF, IPCHPO,S1,IPGEOM,IPCHEL,
  27. & IPCHSO,ISUPSO)
  28.  
  29. IMPLICIT INTEGER(I-N)
  30. IMPLICIT REAL*8 (A-H,O-Z)
  31.  
  32. -INC CCOPTIO
  33.  
  34. c* -INC SMMODEL
  35. c* -INC SMCHPOI
  36.  
  37. IPCHSO = 0
  38. ISUPSO = 0
  39.  
  40. C 1 - Sources sous forme d'un MCHAML
  41. C Determination du support :
  42. C =======================================================
  43. IF (IPCHEL.NE.0) THEN
  44. IPCHSO = IPCHEL
  45. CALL QUESUP(IPMODE,IPCHSO,0,0,iok,ISUPSO)
  46. IF (IERR.NE.0 .OR. iok.EQ.9999) THEN
  47. IPCHSO = 0
  48. CALL ERREUR(21)
  49. RETURN
  50. ENDIF
  51. * Pour l'instant, si pas massif on passe aux noeuds comme avant
  52. IF (ITYPEF.NE.1) THEN
  53. IF (ISUPSO.NE.1) THEN
  54. IPCH_Z = IPCHSO
  55. CALL CHASUP(IPMODE,IPCH_Z,IPCHSO,iok,1)
  56. IF (IERR.NE.0 .OR. iok.NE.0) THEN
  57. IPCHSO = 0
  58. CALL ERREUR(21)
  59. RETURN
  60. ENDIF
  61. ISUPSO = 1
  62. ENDIF
  63. ENDIF
  64. ELSE
  65.  
  66. C 2 - Sources constantes (FLOTTANT) sur un MAILLAGE
  67. C Sources mises sous forme d'un CHPOINT puis
  68. C transfert du CHPOINT en MCHAML aux noeuds du modele
  69. C =======================================================
  70. C Les composantes sont fonction de la formulation !
  71. IF (IPGEOM.NE.0) THEN
  72. IF (ITYPEF.EQ.2) THEN
  73. CALL ECRREE(S1)
  74. CALL ECRCHA('SSUP')
  75. CALL ECRREE(S1)
  76. CALL ECRCHA('SMOY')
  77. CALL ECRREE(S1)
  78. CALL ECRCHA('SINF')
  79. CALL ECRENT(3)
  80. C* ELSE IF (ITYPEF.EQ.1 .OR. ITYPEF.EQ.3) THEN
  81. ELSE
  82. CALL ECRREE(S1)
  83. CALL ECRCHA('SCAL')
  84. CALL ECRENT(1)
  85. ENDIF
  86. CALL ECROBJ('MAILLAGE',IPGEOM)
  87. CALL MANUCH
  88. IF (IERR.NE.0) RETURN
  89. CALL LIROBJ('CHPOINT',IPCH_Z,1,iok)
  90. IF (IERR.NE.0) RETURN
  91. C Changement en MCHAML aux noeuds du modele :
  92. CALL CHAME1(0,IPMODE,IPCH_Z,'VOLUMIQUE',IPCHSO,1)
  93. IF (IERR.NE.0) RETURN
  94. ISUPSO = 1
  95. C* call dtchpo(ipch_z)
  96.  
  97. C 3 - Sources sous forme d'un CHPOINT
  98. C Transfert du CHPOINT en MCHAML aux noeuds du modele
  99. C =======================================================
  100. ELSE
  101. CALL CHAME1(0,IPMODE,IPCHPO,'VOLUMIQUE',IPCHSO,1)
  102. IF (IERR.NE.0) RETURN
  103. ISUPSO = 1
  104.  
  105. ENDIF
  106. ENDIF
  107.  
  108. RETURN
  109. END
  110.  
  111.  
  112.  

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