Télécharger pent.eso

Retour à la liste

Numérotation des lignes :

pent
  1. C PENT SOURCE CB215821 23/01/25 21:15:29 11573
  2. SUBROUTINE PENT
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PENT (OPERATEUR GIBIANE)
  8. C
  9. C DESCRIPTION : Calcul du gradient d'un CHPOINT 2D/3D de type CENTRE
  10. C avec possible limitation LED ("Local extremum
  11. C diminishing");
  12. C
  13. C Calcul du gradient d'un CHPOINT 2D/3D de type FACE
  14. C avec la methode du diamant linaire exacte
  15. C
  16. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  17. C
  18. C AUTEURS : A. BECCANTINI, R. MOREL, C. LEPOTIER, DEN/DM2S
  19. C
  20. C************************************************************************
  21. C
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8(A-H,O-Z)
  24.  
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC SMCOORD
  29. C
  30. INTEGER IDOMA, ICOND, IRET1, NBOPT1,NBOPT2,NBOPT3,IOP1,IOP2,IOP3
  31. & ,INEFMD,MMODEL
  32. C
  33. PARAMETER(NBOPT1 = 3,NBOPT2 = 6,NBOPT3=2)
  34. CHARACTER*(8) LISMC1(NBOPT1),LISMC2(NBOPT2),LISMC3(NBOPT3),MOT
  35. & ,TYPE
  36. DATA LISMC1 /'CENTRE ','SOMMET ','FACE '/
  37. DATA LISMC2 /'EULESCAL','EULEVECT','DIAMANT','MPFA','DIAMAN2',
  38. & 'VFSYM'/
  39. DATA LISMC3 /'NOLIMITE','LIMITEUR'/
  40. SEGACT,MCOORD
  41. C
  42. C**** Lecture de l'objet MODELE
  43. C
  44. ICOND = 1
  45. CALL QUETYP(TYPE,ICOND,IRET1)
  46.  
  47. IF(IRET1.EQ.0.AND.TYPE.NE.'MMODEL')THEN
  48. WRITE(6,*)' On attend un objet MMODEL'
  49. RETURN
  50. ENDIF
  51. CALL LIROBJ('MMODEL ',MMODEL,ICOND,IRET1)
  52. CALL ACTOBJ('MMODEL ',MMODEL,1)
  53. IF(IERR.NE.0)GOTO 9999
  54. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  55. IF(IERR.NE.0)GOTO 9999
  56. C
  57. C**** Les options
  58. C
  59. C CENTRE, SOMMET ou FACE
  60. C
  61. CALL LIRCHA(MOT,1,IRET1)
  62. IF(IERR .NE. 0) GOTO 9999
  63. CALL OPTLI(IOP1,LISMC1,MOT,NBOPT1)
  64. IF(IERR .NE. 0) GOTO 9999
  65. IF(IOP1 .EQ. 0) THEN
  66. C
  67. C******* Message d'erreur standard
  68. C 251 2
  69. C Tentative d'utilisation d'une option non implémentée
  70.  
  71. CALL ERREUR(251)
  72. GOTO 9999
  73. ENDIF
  74. C
  75. C**** Les differentes methodes (voir LISMC2)
  76. C
  77. CALL LIRCHA(MOT,1,IRET1)
  78. IF(IERR .NE. 0) GOTO 9999
  79. CALL OPTLI(IOP2,LISMC2,MOT,NBOPT2)
  80. IF(IOP2 .EQ. 0) THEN
  81. C
  82. C******* Message d'erreur standard
  83. C 251 2
  84. C Tentative d'utilisation d'une option non implémentée
  85.  
  86. CALL ERREUR(251)
  87. GOTO 9999
  88. ENDIF
  89. C
  90. C
  91. C**** Les cas 1-2 ('EULESCAL','EULEVECT') sont traités ensembles
  92. C
  93. IF(IOP2.LE.2)THEN
  94. C
  95. C**** Limiteur ou non
  96. C
  97. CALL LIRCHA(MOT,1,IRET1)
  98. IF(IERR .NE. 0) GOTO 9999
  99. CALL OPTLI(IOP3,LISMC3,MOT,NBOPT3)
  100. IF(IOP3 .EQ. 0) THEN
  101. C
  102. C******* Message d'erreur standard
  103. C 251 2
  104. C Tentative d'utilisation d'une option non implémentée
  105.  
  106. CALL ERREUR(251)
  107. GOTO 9999
  108. ENDIF
  109. C
  110. C******* Pour l'instant les cas 1-5 sont donnent des gradients
  111. C aux centres
  112. C
  113. IF(IOP1 .NE. 1)THEN
  114. C
  115. C********** Message d'erreur standard
  116. C 251 2
  117. C Tentative d'utilisation d'une option non implémentée
  118. C
  119. CALL ERREUR(251)
  120. GOTO 9999
  121. ENDIF
  122. CALL PENT15(IDOMA,IOP2,IOP3)
  123. IF(IERR.NE.0) GOTO 9999
  124. ELSEIF(IOP2.EQ.3)THEN
  125. C
  126. C******* Pour l'instant les cas 3 ('DIAMANT') donne un gradient aux
  127. C interfaces
  128. C
  129. IF(IOP1 .NE. 3)THEN
  130. C
  131. C********** Message d'erreur standard
  132. C 251 2
  133. C Tentative d'utilisation d'une option non implémentée
  134. C
  135. CALL ERREUR(251)
  136. GOTO 9999
  137. ENDIF
  138. CALL PENDIA(IDOMA)
  139. IF(IERR.NE.0) GOTO 9999
  140. ELSEIF(IOP2.EQ.4)THEN
  141. C
  142. C******* Le cas 4 ('NORVEGE') donne un gradient aux
  143. C interfaces
  144. C
  145. IF(IOP1 .NE. 3)THEN
  146. C
  147. C********** Message d'erreur standard
  148. C 251 2
  149. C Tentative d'utilisation d'une option non implémentée
  150. C
  151. CALL ERREUR(251)
  152. GOTO 9999
  153. ENDIF
  154. CALL NORV(IDOMA)
  155. IF(IERR.NE.0) GOTO 9999
  156. ELSEIF(IOP2.EQ.5)THEN
  157. C
  158. C******* Le cas 5 ('DIAMAN2') donne un gradient aux
  159. C interfaces
  160. C
  161. IF(IOP1 .NE. 3)THEN
  162. C
  163. C********** Message d'erreur standard
  164. C 251 2
  165. C Tentative d'utilisation d'une option non implémentée
  166. C
  167. CALL ERREUR(251)
  168. GOTO 9999
  169. ENDIF
  170. CALL PENDI2(IDOMA)
  171. IF(IERR.NE.0) GOTO 9999
  172. ELSEIF(IOP2.EQ.6)THEN
  173. C
  174. C******* Le cas 6 ('VFSYM') donne un gradient aux
  175. C SCHEMA PROPOSE PAR Christophe Le Potier
  176. C Références : {C. Le Potier}
  177. c \emph{Schema volumes finis pour des operateurs de diffusion
  178. c fortement anisotropes sur des maillages non structures},
  179. C C. R. Acad. Sci. Ser. I \textbf{340}, 2005, pp. 921--926.
  180. C interfaces
  181. C
  182. IF(IOP1 .NE. 3)THEN
  183. C
  184. C********** Message d'erreur standard
  185. C 251 2
  186. C Tentative d'utilisation d'une option non implémentée
  187. C
  188. CALL ERREUR(251)
  189. GOTO 9999
  190. ENDIF
  191. CALL VFSYM(IDOMA)
  192. IF(IERR.NE.0) GOTO 9999
  193. ENDIF
  194. C
  195. 9999 RETURN
  196.  
  197. SEGDES,MCOORD
  198. END
  199.  
  200.  

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