Télécharger chalvs.eso

Retour à la liste

Numérotation des lignes :

  1. C CHALVS SOURCE FANDEUR 17/12/20 21:15:13 9649
  2.  
  3. C=======================================================================
  4. C= C H A L V S =
  5. C= ----------- =
  6. C= =
  7. C= Fonction : =
  8. C= ---------- =
  9. C= =
  10. C= Parametres : (E)=Entree (S)=Sortie =
  11. C= ------------ =
  12. C= IPMODE (E) Pointeur sur le segment MMODEL de la structure =
  13. C= IFORMU (E) Formulation associee au MMODEL de la structure =
  14. C= ITYPEF (E) Type(Famille) des EF du MMODEL de la structure =
  15. C= IPCHPO (E) Pointeur sur le CHPOINT de sources (puits) aux =
  16. C= noeuds de la structure (champ variable) =
  17. C= S1 (E) Valeur de la source (FLOTTANT = champ constant) =
  18. C= IPGEOM (E) Pointeur sur le MAILLAGE sur lequel s'applique S1 =
  19. C= IPCHEL (E) Pointeur sur le segment MCHAML de sources donnees =
  20. C= en chaque element de la structure (champ variable) =
  21. C= IPCHSO (S) Pointeur sur le champ de sources volumiques =
  22. C= ISUPSO (S) Support du champ de sources volumiques =
  23. C=======================================================================
  24.  
  25. SUBROUTINE CHALVS (IPMODE,IFORMU,ITYPEF, IPCHPO,S1,IPGEOM,IPCHEL,
  26. & IPCHSO,ISUPSO)
  27.  
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8 (A-H,O-Z)
  30.  
  31. -INC CCOPTIO
  32.  
  33. c* -INC SMMODEL
  34. c* -INC SMCHPOI
  35.  
  36. IPCHSO = 0
  37. ISUPSO = 0
  38.  
  39. C 1 - Sources sous forme d'un MCHAML
  40. C Determination du support :
  41. C =======================================================
  42. IF (IPCHEL.NE.0) THEN
  43. IPCHSO = IPCHEL
  44. CALL QUESUP(IPMODE,IPCHSO,0,0,iok,ISUPSO)
  45. IF (IERR.NE.0 .OR. iok.EQ.9999) THEN
  46. IPCHSO = 0
  47. CALL ERREUR(21)
  48. RETURN
  49. ENDIF
  50. ISUP_Z = ISUPSO
  51. IPCH_Z = IPCHSO
  52. C En massif, on passe aux points d'integration (MASSE ou GAUSS
  53. C selon la formulation) si le champ est aux noeuds ou au gravite
  54. C Si le champ a un autre support que NOEUD ou GRAVITE, on ne change
  55. C pas le support a MASSE pour l'instant.
  56. IF (ITYPEF.EQ.1) THEN
  57. IF (ISUPSO.EQ.1 .OR. ISUPSO.EQ.2) THEN
  58. C* Rappel : diffusion = thermique (en attendant retour a "mecanique")
  59. C* IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2) THEN
  60. IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2 .OR. IFORMU.EQ.3) THEN
  61. ISUPSO = 6
  62. ELSE
  63. c* Avant on mettait au support RIGIDITE : ISUPSO = 3
  64. c* Maintenant on met au support MASSE : ISUPSO = 4
  65. ISUPSO = 4
  66. ENDIF
  67. ENDIF
  68. * Pour l'instant, si pas massif on passe aux noeuds comme avant
  69. ELSE
  70. IF (ISUPSO.NE.1) THEN
  71. ISUPSO = 1
  72. ENDIF
  73. ENDIF
  74. IF (ISUP_Z.NE.ISUPSO) THEN
  75. CALL CHASUP(IPMODE,IPCH_Z,IPCHSO,iok,ISUPSO)
  76. IF (IERR.NE.0 .OR. iok.NE.0) THEN
  77. IPCHSO = 0
  78. CALL ERREUR(21)
  79. RETURN
  80. ENDIF
  81. ENDIF
  82. ELSE
  83.  
  84. C 2 - Sources constantes (FLOTTANT) sur un MAILLAGE
  85. C Sources mises sous forme d'un CHPOINT puis
  86. C Transfert du CHPOINT en MCHAML au support adhoc
  87. C =======================================================
  88. C Les composantes sont fonction de la formulation !
  89. IF (IPGEOM.NE.0) THEN
  90. IF (ITYPEF.EQ.2) THEN
  91. CALL ECRREE(S1)
  92. CALL ECRCHA('SSUP')
  93. CALL ECRREE(S1)
  94. CALL ECRCHA('SMOY')
  95. CALL ECRREE(S1)
  96. CALL ECRCHA('SINF')
  97. CALL ECRENT(3)
  98. C* ELSE IF (ITYPEF.EQ.1 .OR. ITYPEF.EQ.3) THEN
  99. ELSE
  100. CALL ECRREE(S1)
  101. CALL ECRCHA('SCAL')
  102. CALL ECRENT(1)
  103. ENDIF
  104. CALL ECROBJ('MAILLAGE',IPGEOM)
  105. CALL MANUCH
  106. IF (IERR.NE.0) RETURN
  107. CALL LIROBJ('CHPOINT',IPCH_Z,1,iok)
  108. IF (IERR.NE.0) RETURN
  109. IPCHPO = IPCH_Z
  110.  
  111. C 3 - Sources sous forme d'un CHPOINT
  112. C Transfert du CHPOINT en MCHAML au support adhoc
  113. C =======================================================
  114. ELSE
  115. IPCH_Z = 0
  116. ENDIF
  117.  
  118. C Changement en MCHAML au support adapte du modele (commun a 2 et 3) :
  119. C* En fait on devrait directement creer le MCHAML sans passer par le CHPOINT...
  120. IF (ITYPEF.EQ.1) THEN
  121. C* Rappel : diffusion = thermique (en attendant retour a "mecanique")
  122. C* IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2) THEN
  123. IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2 .OR. IFORMU.EQ.3) THEN
  124. ISUPSO = 6
  125. ELSE
  126. c* On met au support MASSE : ISUPSO = 4 (integration plus "precise")
  127. C* Avant on prenait RIGIDITE : ISUPSO = 3
  128. ISUPSO = 4
  129. ENDIF
  130. ELSE
  131. ISUPSO = 1
  132. ENDIF
  133. CALL CHAME1(0,IPMODE,IPCHPO,'VOLUMIQUE',IPCHSO,ISUPSO)
  134. IF (IERR.NE.0) RETURN
  135. if (ipch_z.ne.0) call dtchpo(ipch_z)
  136.  
  137. ENDIF
  138.  
  139. RETURN
  140. END
  141.  
  142.  
  143.  

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