Télécharger chalvs.eso

Retour à la liste

Numérotation des lignes :

  1. C CHALVS SOURCE PASCAL 19/11/19 21:15:14 10384
  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.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34.  
  35. c* -INC SMMODEL
  36. c* -INC SMCHPOI
  37.  
  38. IPCHSO = 0
  39. ISUPSO = 0
  40.  
  41. C 1 - Sources sous forme d'un MCHAML
  42. C Determination du support :
  43. C =======================================================
  44. IF (IPCHEL.NE.0) THEN
  45. IPCHSO = IPCHEL
  46. CALL QUESUP(IPMODE,IPCHSO,0,0,iok,ISUPSO)
  47. IF (IERR.NE.0 .OR. iok.EQ.9999) THEN
  48. IPCHSO = 0
  49. CALL ERREUR(21)
  50. RETURN
  51. ENDIF
  52. ISUP_Z = ISUPSO
  53. IPCH_Z = IPCHSO
  54. C En massif, on passe aux points d'integration (MASSE ou GAUSS
  55. C selon la formulation) si le champ est aux noeuds ou au gravite
  56. C Si le champ a un autre support que NOEUD ou GRAVITE, on ne change
  57. C pas le support a MASSE pour l'instant.
  58. IF (ITYPEF.EQ.1) THEN
  59. IF (ISUPSO.EQ.1 .OR. ISUPSO.EQ.2) THEN
  60. C* Rappel : diffusion = thermique (en attendant retour a "mecanique")
  61. C* IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2) THEN
  62. IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2 .OR. IFORMU.EQ.3) THEN
  63. ISUPSO = 6
  64. ELSE
  65. c* Avant on mettait au support RIGIDITE : ISUPSO = 3
  66. c* Maintenant on met au support MASSE : ISUPSO = 4
  67. ISUPSO = 4
  68. ENDIF
  69. ENDIF
  70. * Pour l'instant, si pas massif on passe aux noeuds comme avant
  71. ELSE
  72. IF (ISUPSO.NE.1) THEN
  73. ISUPSO = 1
  74. ENDIF
  75. ENDIF
  76. IF (ISUP_Z.NE.ISUPSO) THEN
  77. CALL CHASUP(IPMODE,IPCH_Z,IPCHSO,iok,ISUPSO)
  78. IF (IERR.NE.0 .OR. iok.NE.0) THEN
  79. IPCHSO = 0
  80. CALL ERREUR(21)
  81. RETURN
  82. ENDIF
  83. ENDIF
  84. ELSE
  85.  
  86. C 2 - Sources constantes (FLOTTANT) sur un MAILLAGE
  87. C Sources mises sous forme d'un CHPOINT puis
  88. C Transfert du CHPOINT en MCHAML au support adhoc
  89. C =======================================================
  90. C Les composantes sont fonction de la formulation !
  91. IF (IPGEOM.NE.0) THEN
  92. IF (ITYPEF.EQ.2) THEN
  93. CALL ECRREE(S1)
  94. CALL ECRCHA('QSUP')
  95. CALL ECRREE(S1)
  96. CALL ECRCHA('QVOL')
  97. CALL ECRREE(S1)
  98. CALL ECRCHA('QINF')
  99. CALL ECRENT(3)
  100. C* ELSE IF (ITYPEF.EQ.1 .OR. ITYPEF.EQ.3) THEN
  101. ELSE
  102. CALL ECRREE(S1)
  103. CALL ECRCHA('QVOL')
  104. CALL ECRENT(1)
  105. ENDIF
  106. CALL ECROBJ('MAILLAGE',IPGEOM)
  107. CALL MANUCH
  108. IF (IERR.NE.0) RETURN
  109. CALL LIROBJ('CHPOINT',IPCH_Z,1,iok)
  110. IF (IERR.NE.0) RETURN
  111. IPCHPO = IPCH_Z
  112.  
  113. C 3 - Sources sous forme d'un CHPOINT
  114. C Transfert du CHPOINT en MCHAML au support adhoc
  115. C =======================================================
  116. ELSE
  117. IPCH_Z = 0
  118. ENDIF
  119.  
  120. C Changement en MCHAML au support adapte du modele (commun a 2 et 3) :
  121. C* En fait on devrait directement creer le MCHAML sans passer par le CHPOINT...
  122. IF (ITYPEF.EQ.1) THEN
  123. C* Rappel : diffusion = thermique (en attendant retour a "mecanique")
  124. C* IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2) THEN
  125. IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2 .OR. IFORMU.EQ.3) THEN
  126. ISUPSO = 6
  127. ELSE
  128. c* On met au support MASSE : ISUPSO = 4 (integration plus "precise")
  129. C* Avant on prenait RIGIDITE : ISUPSO = 3
  130. ISUPSO = 4
  131. ENDIF
  132. ELSE
  133. ISUPSO = 1
  134. ENDIF
  135. CALL CHAME1(0,IPMODE,IPCHPO,'VOLUMIQUE',IPCHSO,ISUPSO)
  136. IF (IERR.NE.0) RETURN
  137. if (ipch_z.ne.0) call dtchpo(ipch_z)
  138.  
  139. ENDIF
  140.  
  141. RETURN
  142. END
  143.  
  144.  
  145.  
  146.  

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