Télécharger pendi2.eso

Retour à la liste

Numérotation des lignes :

  1. C PENDI2 SOURCE KK2000 14/04/10 21:15:25 8032
  2. SUBROUTINE PENDI2(IDOMA)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PENDI2
  8. C
  9. C DESCRIPTION : Appelle par PENT
  10. C
  11. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  12. C
  13. C AUTEUR : A. BECCANTINI
  14. C
  15. C************************************************************************
  16. C
  17. C
  18. C************************************************************************
  19. C
  20. C PHRASE D'APPEL (GIBIANE) :
  21. C
  22. C
  23. C RCHPO1 RCHELEM1 = 'PENT'
  24. C MCLE1 MCLE2 MCLE3 TABDO LMOT1 LMOT2 CHPO1 CHPO2 CHPO3 ;
  25. C
  26. C ou
  27. C
  28. C RCHPO1 = 'PENT'
  29. C MCLE1 MCLE2 MCLE3 TABDO LMOT1 LMOT2 CHPO1 CHPO2 CHPO3
  30. C MCLE5 RCHELEM1 ;
  31. C
  32. C
  33. C Entrées:
  34. C
  35. C TABDO : Donnée de la table domaine;
  36. C
  37. C MCLE1 : type du champ par point CHPO1. Pour le moment, seul le
  38. C type 'FACE' est autorisé;
  39. C
  40. C MCLE2 : 'DIAMANT'
  41. C
  42. C MCLE3 : Calcul ou non du limiteur : 'NOLIMITE'
  43. C
  44. C LMOT1 : Nom de composantes du champoint duquel on veut calculer
  45. C le gradient
  46. C
  47. C LMOT2 : Nom de composantes du gradients
  48. C
  49. C CHPO1 : CHAMPOINT centre du quel on veut calculer le gradient
  50. C
  51. C CHPO2 : Conditions aux limites de type Dirichlet
  52. C
  53. C CHPO3 : Conditions aux limites de type von Neumann (dans le repaire
  54. C global)
  55. C
  56. C MCLE4 : Donnée ou non du RCHELEM1:
  57. C 'GRADGEO' si donnée, vide sinon.
  58. C
  59. C
  60. C E/S :
  61. C
  62. C RCHELEM1: Champ par élément des coefficients géométriques pour le
  63. C calcul du gradient (et du hessien)
  64. C (entrée si MCLE4 = 'GRADGEO', sinon sortie).
  65. C
  66. C
  67. C Sorties:
  68. C
  69. C RCHPO1 : Champ par point contenant le gradient de CHPO1 (toujours
  70. C calculé) ;
  71. C
  72. C************************************************************************
  73. C
  74. C HISTORIQUE (Anomalies et modifications éventuelles)
  75. C
  76. C HISTORIQUE : Creé le 2/3/2001
  77. C
  78. C************************************************************************
  79. C
  80. C
  81. C
  82. IMPLICIT INTEGER(I-N)
  83. IMPLICIT REAL*8(A-H,O-Z)
  84.  
  85. -INC CCOPTIO
  86. -INC SMCHPOI
  87. -INC SMLMOTS
  88. C
  89. INTEGER IDOMA, IRET1, ICEN, IFAC, IFACEL, IFACEP, ISOMM, INORM
  90. & ,ICHPO, ICHPL1, ICHPL2, LMOT, LMOTGR
  91. & ,ISGLI1, ISGLI2, ICHGRA, ICOEFF
  92. & ,NSOUPO, IMAIL, JGN, JGM
  93. C
  94. CHARACTER*(8) MOT
  95. LOGICAL LOGCOE
  96. C
  97. MOT=' '
  98. C
  99. C**** Lecture du MELEME SPG des points CENTRE.
  100. C
  101. CALL LEKTAB(IDOMA,'CENTRE',ICEN)
  102. IF(IERR .NE. 0) GOTO 9999
  103. C
  104. C**** Lecture du MELEME SPG des points FACE.
  105. C
  106. CALL LEKTAB(IDOMA,'FACE',IFAC)
  107. IF(IERR .NE. 0) GOTO 9999
  108. C
  109. C**** Lecture du MELEME SPG des points SOMMET
  110. C
  111. CALL LEKTAB(IDOMA,'SOMMET',ISOMM)
  112. IF(IERR .NE. 0) GOTO 9999
  113. C
  114. C**** Lecture du MELEME de connect. FACEL
  115. C
  116. CALL LEKTAB(IDOMA,'FACEL',IFACEL)
  117. IF(IERR .NE. 0) GOTO 9999
  118. C
  119. C**** Lecture du MELEME de connect. FACEP
  120. C
  121. CALL LEKTAB(IDOMA,'FACEP',IFACEP)
  122. IF(IERR .NE. 0) GOTO 9999
  123. C
  124. C**** Lecture du MELEME MAILLAGE
  125. C
  126. CALL LEKTAB(IDOMA,'MAILLAGE',IMAIL)
  127. IF(IERR .NE. 0) GOTO 9999
  128. C
  129. C**** Lecture des normales aux faces
  130. C
  131. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  132. IF(IERR .NE. 0) GOTO 9999
  133. JGN=4
  134. JGM=IDIM
  135. SEGINI MLMOTS
  136. MLMOTS.MOTS(1)='UX'
  137. MLMOTS.MOTS(2)='UY'
  138. IF(IDIM .EQ. 3) MLMOTS.MOTS(3)='UZ'
  139. CALL QUEPO1 (INORM, IFAC, MLMOTS)
  140. IF(IERR .NE. 0)GOTO 9999
  141. SEGSUP MLMOTS
  142. C
  143. C**** Lecture du CHPOINT dont on veut calculer le gradient!
  144. C
  145. CALL LIROBJ('CHPOINT ',ICHPO,1,IRET1)
  146. IF(IERR .NE. 0) GOTO 9999
  147. C
  148. C**** Lecture du CHPOINT des conditions limites de type Dirichlet
  149. C
  150. CALL LIROBJ('CHPOINT ',ICHPL1,1,IRET1)
  151. IF(IERR .NE. 0) GOTO 9999
  152. C
  153. C**** Lecture du CHPOINT des conditions limites de type von Neumann
  154. C
  155. CALL LIROBJ('CHPOINT ',ICHPL2,1,IRET1)
  156. IF(IERR .NE. 0) GOTO 9999
  157. C
  158. C**** Lecture des noms des composantes du CHPOINT
  159. C
  160. CALL LIROBJ('LISTMOTS',LMOT,1,IRET1)
  161. IF(IERR .NE. 0) GOTO 9999
  162. C
  163. C**** Lecture des noms des composantes du gradients
  164. C
  165. CALL LIROBJ('LISTMOTS',LMOTGR,1,IRET1)
  166. IF(IERR .NE. 0) GOTO 9999
  167. C
  168. C**** Compatibilité entre les liste de composantes
  169. C
  170. MLMOT1=LMOT
  171. MLMOT2=LMOTGR
  172. SEGACT MLMOT1
  173. SEGACT MLMOT2
  174. IF(MLMOT2.MOTS(/2) .NE. (IDIM*MLMOT1.MOTS(/2)))THEN
  175. write(*,*) 'Composantes = ???'
  176. CALL ERREUR(21)
  177. GOTO 9999
  178. ENDIF
  179. C
  180. C**** Control de ICHPO
  181. C
  182. MLMOTS=LMOT
  183. CALL QUEPO1(ICHPO, ICEN, LMOT)
  184. IF (IERR .NE. 0) GOTO 9999
  185. C
  186. C**** Control de ICHPL1
  187. C
  188. MCHPOI = ICHPL1
  189. SEGACT MCHPOI
  190. NSOUPO = MCHPOI.IPCHP(/1)
  191. IF(NSOUPO .EQ. 0) THEN
  192. ICHPL1=0
  193. ISGLI1=0
  194. ELSE
  195. MSOUPO=MCHPOI.IPCHP(1)
  196. SEGACT MSOUPO
  197. ISGLI1=MSOUPO.IGEOC
  198. SEGDES MSOUPO
  199. CALL QUEPO1(ICHPL1, 0, LMOT)
  200. IF (IERR .NE. 0) GOTO 9999
  201. ENDIF
  202. C
  203. C**** Control de ICHPL2
  204. C
  205. MCHPOI = ICHPL2
  206. SEGACT MCHPOI
  207. NSOUPO = MCHPOI.IPCHP(/1)
  208. IF(NSOUPO .EQ. 0) THEN
  209. ICHPL2=0
  210. ISGLI2=0
  211. ELSE
  212. MSOUPO=MCHPOI.IPCHP(1)
  213. SEGACT MSOUPO
  214. ISGLI2=MSOUPO.IGEOC
  215. SEGDES MSOUPO
  216. CALL QUEPO1(ICHPL2, 0, LMOTGR)
  217. IF (IERR .NE. 0) GOTO 9999
  218. ENDIF
  219. C
  220. C**** Lecture du MCHAMLs qui contiennent les elements de matrice
  221. C pour le calcul du gradient
  222. C
  223. C Si MOT = 'GRADGEO', on a ces MCHAMLs; sinon il faut le calculer
  224. C
  225. CALL LIRCHA(MOT,0,IRET1)
  226. IF(IERR .NE. 0) GOTO 9999
  227. IF(IRET1 .EQ. 0)THEN
  228. LOGCOE = .TRUE.
  229. ELSEIF(MOT .NE. 'GRADGEO')THEN
  230. CALL REFUS()
  231. LOGCOE=.TRUE.
  232. ELSE
  233. LOGCOE=.FALSE.
  234. CALL LIROBJ('MCHAML ',ICOEFF,1,IRET1)
  235. IF(IERR .NE. 0) GOTO 9999
  236. ENDIF
  237. IF(LOGCOE)THEN
  238. CALL GRADI2(ICEN,ISOMM,IFACEL,IFACEP,ISGLI1,ISGLI2,INORM,
  239. & ICOEFF)
  240. IF (IERR .NE. 0) GOTO 9999
  241. ENDIF
  242. C
  243. C**** Calcul de gradient
  244. C
  245. CALL PENDI3(LMOTGR,IFAC,ICHPO,ICHPL1,ICHPL2,INORM,ICOEFF,ICHGRA)
  246. IF(IERR .NE. 0) GOTO 9999
  247. C
  248. C**** Ecriture de gradient, (hessian), (limiteur),
  249. C (MCHAMLs pour le calcul de gradient et/ou du hessian)
  250. C
  251. IF(MOT .NE. 'GRADGEO') THEN
  252. CALL ECROBJ('MCHAML',ICOEFF)
  253. IF(IERR .NE. 0) GOTO 9999
  254. ENDIF
  255. CALL ECROBJ('CHPOINT',ICHGRA)
  256. IF(IERR .NE. 0) GOTO 9999
  257. C
  258. SEGDES MLMOTS
  259. C
  260. C**** Sortie du programme
  261. C
  262. 9999 CONTINUE
  263. C
  264. RETURN
  265. END
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  
  272.  
  273.  

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