Télécharger pent.eso

Retour à la liste

Numérotation des lignes :

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

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