Télécharger pendi2.eso

Retour à la liste

Numérotation des lignes :

pendi2
  1. C PENDI2 SOURCE CB215821 20/11/25 13:35:33 10792
  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.  
  86. -INC PPARAM
  87. -INC CCOPTIO
  88. -INC SMCHPOI
  89. -INC SMLMOTS
  90. C
  91. INTEGER IDOMA, IRET1, ICEN, IFAC, IFACEL, IFACEP, ISOMM, INORM
  92. & ,ICHPO, ICHPL1, ICHPL2, LMOT, LMOTGR
  93. & ,ISGLI1, ISGLI2, ICHGRA, ICOEFF
  94. & ,NSOUPO, IMAIL, JGN, JGM
  95. C
  96. CHARACTER*(8) MOT
  97. LOGICAL LOGCOE
  98. C
  99. MOT=' '
  100. C
  101. C**** Lecture du MELEME SPG des points CENTRE.
  102. C
  103. CALL LEKTAB(IDOMA,'CENTRE',ICEN)
  104. IF(IERR .NE. 0) GOTO 9999
  105. C
  106. C**** Lecture du MELEME SPG des points FACE.
  107. C
  108. CALL LEKTAB(IDOMA,'FACE',IFAC)
  109. IF(IERR .NE. 0) GOTO 9999
  110. C
  111. C**** Lecture du MELEME SPG des points SOMMET
  112. C
  113. CALL LEKTAB(IDOMA,'SOMMET',ISOMM)
  114. IF(IERR .NE. 0) GOTO 9999
  115. C
  116. C**** Lecture du MELEME de connect. FACEL
  117. C
  118. CALL LEKTAB(IDOMA,'FACEL',IFACEL)
  119. IF(IERR .NE. 0) GOTO 9999
  120. C
  121. C**** Lecture du MELEME de connect. FACEP
  122. C
  123. CALL LEKTAB(IDOMA,'FACEP',IFACEP)
  124. IF(IERR .NE. 0) GOTO 9999
  125. C
  126. C**** Lecture du MELEME MAILLAGE
  127. C
  128. CALL LEKTAB(IDOMA,'MAILLAGE',IMAIL)
  129. IF(IERR .NE. 0) GOTO 9999
  130. C
  131. C**** Lecture des normales aux faces
  132. C
  133. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  134. IF(IERR .NE. 0) GOTO 9999
  135. JGN=4
  136. JGM=IDIM
  137. SEGINI MLMOTS
  138. MLMOTS.MOTS(1)='UX'
  139. MLMOTS.MOTS(2)='UY'
  140. IF(IDIM .EQ. 3) MLMOTS.MOTS(3)='UZ'
  141. CALL QUEPO1 (INORM, IFAC, MLMOTS)
  142. IF(IERR .NE. 0)GOTO 9999
  143. SEGSUP MLMOTS
  144. C
  145. C**** Lecture du CHPOINT dont on veut calculer le gradient!
  146. C
  147. CALL LIROBJ('CHPOINT ',ICHPO,1,IRET1)
  148. CALL ACTOBJ('CHPOINT ',ICHPO,1)
  149. IF(IERR .NE. 0) GOTO 9999
  150. C
  151. C**** Lecture du CHPOINT des conditions limites de type Dirichlet
  152. C
  153. CALL LIROBJ('CHPOINT ',ICHPL1,1,IRET1)
  154. CALL ACTOBJ('CHPOINT ',ICHPL1,1)
  155. IF(IERR .NE. 0) GOTO 9999
  156. C
  157. C**** Lecture du CHPOINT des conditions limites de type von Neumann
  158. C
  159. CALL LIROBJ('CHPOINT ',ICHPL2,1,IRET1)
  160. CALL ACTOBJ('CHPOINT ',ICHPL2,1)
  161. IF(IERR .NE. 0) GOTO 9999
  162. C
  163. C**** Lecture des noms des composantes du CHPOINT
  164. C
  165. CALL LIROBJ('LISTMOTS',LMOT,1,IRET1)
  166. CALL ACTOBJ('LISTMOTS',LMOT,1)
  167. IF(IERR .NE. 0) GOTO 9999
  168. C
  169. C**** Lecture des noms des composantes du gradients
  170. C
  171. CALL LIROBJ('LISTMOTS',LMOTGR,1,IRET1)
  172. IF(IERR .NE. 0) GOTO 9999
  173. C
  174. C**** Compatibilité entre les liste de composantes
  175. C
  176. MLMOT1=LMOT
  177. MLMOT2=LMOTGR
  178. SEGACT MLMOT1
  179. SEGACT MLMOT2
  180. IF(MLMOT2.MOTS(/2) .NE. (IDIM*MLMOT1.MOTS(/2)))THEN
  181. write(*,*) 'Composantes = ???'
  182. CALL ERREUR(21)
  183. GOTO 9999
  184. ENDIF
  185. C
  186. C**** Control de ICHPO
  187. C
  188. MLMOTS=LMOT
  189. CALL QUEPO1(ICHPO, ICEN, LMOT)
  190. IF (IERR .NE. 0) GOTO 9999
  191. C
  192. C**** Control de ICHPL1
  193. C
  194. MCHPOI = ICHPL1
  195. SEGACT MCHPOI
  196. NSOUPO = MCHPOI.IPCHP(/1)
  197. IF(NSOUPO .EQ. 0) THEN
  198. ICHPL1=0
  199. ISGLI1=0
  200. ELSE
  201. MSOUPO=MCHPOI.IPCHP(1)
  202. SEGACT MSOUPO
  203. ISGLI1=MSOUPO.IGEOC
  204. SEGDES MSOUPO
  205. CALL QUEPO1(ICHPL1, 0, LMOT)
  206. IF (IERR .NE. 0) GOTO 9999
  207. ENDIF
  208. C
  209. C**** Control de ICHPL2
  210. C
  211. MCHPOI = ICHPL2
  212. SEGACT MCHPOI
  213. NSOUPO = MCHPOI.IPCHP(/1)
  214. IF(NSOUPO .EQ. 0) THEN
  215. ICHPL2=0
  216. ISGLI2=0
  217. ELSE
  218. MSOUPO=MCHPOI.IPCHP(1)
  219. SEGACT MSOUPO
  220. ISGLI2=MSOUPO.IGEOC
  221. SEGDES MSOUPO
  222. CALL QUEPO1(ICHPL2, 0, LMOTGR)
  223. IF (IERR .NE. 0) GOTO 9999
  224. ENDIF
  225. C
  226. C**** Lecture du MCHAMLs qui contiennent les elements de matrice
  227. C pour le calcul du gradient
  228. C
  229. C Si MOT = 'GRADGEO', on a ces MCHAMLs; sinon il faut le calculer
  230. C
  231. CALL LIRCHA(MOT,0,IRET1)
  232. IF(IERR .NE. 0) GOTO 9999
  233. IF(IRET1 .EQ. 0)THEN
  234. LOGCOE = .TRUE.
  235. ELSEIF(MOT .NE. 'GRADGEO')THEN
  236. CALL REFUS()
  237. LOGCOE=.TRUE.
  238. ELSE
  239. LOGCOE=.FALSE.
  240. CALL LIROBJ('MCHAML ',ICOEFF,1,IRET1)
  241. CALL ACTOBJ('MCHAML ',ICOEFF,1)
  242. IF(IERR .NE. 0) GOTO 9999
  243. ENDIF
  244. IF(LOGCOE)THEN
  245. CALL GRADI2(ICEN,ISOMM,IFACEL,IFACEP,ISGLI1,ISGLI2,INORM,
  246. & ICOEFF)
  247. IF (IERR .NE. 0) GOTO 9999
  248. ENDIF
  249. C
  250. C**** Calcul de gradient
  251. C
  252. CALL PENDI3(LMOTGR,IFAC,ICHPO,ICHPL1,ICHPL2,INORM,ICOEFF,ICHGRA)
  253. IF(IERR .NE. 0) GOTO 9999
  254. C
  255. C**** Ecriture de gradient, (hessian), (limiteur),
  256. C (MCHAMLs pour le calcul de gradient et/ou du hessian)
  257. C
  258. IF(MOT .NE. 'GRADGEO') THEN
  259. CALL ACTOBJ('MCHAML ',ICOEFF,1)
  260. CALL ECROBJ('MCHAML ',ICOEFF)
  261. IF(IERR .NE. 0) GOTO 9999
  262. ENDIF
  263. CALL ACTOBJ('CHPOINT ',ICHGRA,1)
  264. CALL ECROBJ('CHPOINT ',ICHGRA)
  265. IF(IERR .NE. 0) GOTO 9999
  266. C
  267. SEGDES MLMOTS
  268. C
  269. C**** Sortie du programme
  270. C
  271. 9999 CONTINUE
  272. END
  273.  
  274.  
  275.  
  276.  

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