Télécharger pendia.eso

Retour à la liste

Numérotation des lignes :

  1. C PENDIA SOURCE CHAT 05/01/13 02:12:09 5004
  2. SUBROUTINE PENDIA(IDOMA)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PENDIA
  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 CHPO1 (MCLE4 CHPO2) ;
  25. C
  26. C ou
  27. C
  28. C RCHPO1 = 'PENT'
  29. C MCLE1 MCLE2 MCLE3 TABDO CHPO1 (MCL4 CHPO2) MCLE5 RCHELEM1 ;
  30. C
  31. C
  32. C Entrées:
  33. C
  34. C TABDO : Donnée de la table domaine;
  35. C
  36. C MCLE1 : type du champ par point CHPO1. Pour le moment, seul le type
  37. C 'FACE' est autorisé;
  38. C
  39. C MCLE2 : Traitement des éléments de bord et ordre de précision du
  40. C calcul de gradient . Options sont possibles : 'DIAMANT'
  41. C
  42. C MCLE3 : Calcul ou non du limiteur : 'LIMITEUR' ou 'NOLIMITE';
  43. C
  44. C CHPO1 : Donnée du Champ par point de type MCLE1;
  45. C
  46. C MCLE4 : Donnée ou non du CHPO2
  47. C 'CLIM' si donnée, vide sinon.
  48. C
  49. C CHPO2 : Donnée du Champ par point des conditions aux limites
  50. C
  51. C MCLE4 : Donnée ou non du RCHELEM1:
  52. C 'GRADGEO' si donnée, vide sinon.
  53. C
  54. C
  55. C E/S :
  56. C
  57. C RCHELEM1: Champ par élément des coefficients géométriques pour le
  58. C calcul du gradient (et du hessien)
  59. C (entrée si MCLE4 = 'GRADGEO', sinon sortie).
  60. C
  61. C
  62. C Sorties:
  63. C
  64. C RCHPO1 : Champ par point contenant le gradient de CHPO1 (toujours
  65. C calculé) ;
  66. C
  67. C************************************************************************
  68. C
  69. C HISTORIQUE (Anomalies et modifications éventuelles)
  70. C
  71. C HISTORIQUE : Creé le 2/3/2001
  72. C
  73. C************************************************************************
  74. C
  75. C
  76. C
  77. IMPLICIT INTEGER(I-N)
  78. -INC CCOPTIO
  79. -INC SMCHPOI
  80. -INC SMLMOTS
  81. C
  82. C**** Variables de COOPTIO
  83. C
  84. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  85. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  86. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  87. C & ,IECHO, IIMPI, IOSPI
  88. C & ,IDIM
  89. C & ,MCOORD
  90. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  91. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  92. C & ,NORINC,NORVAL,NORIND,NORVAD
  93. C & ,NUCROU, IPSAUV
  94. C
  95. INTEGER IDOMA, IRET1, ICEN, IFACEL, IFACEP, ICELL, ISOMM
  96. & ,ICHPO, ICHGRA, ICOEFF
  97. & ,NBCOMP
  98. & ,ICHCL, ISGLIM, NSOUPO, IMAIL, IMOT
  99.  
  100. C
  101. CHARACTER*(8) MOT,MTYPR
  102. LOGICAL LOGCOE
  103. C+PPb On initialise parceque c'est utile...
  104. MOT=' '
  105. C+PPb
  106. C
  107. C**** Lecture du MELEME SPG des points CENTRE.
  108. C
  109. CALL LEKTAB(IDOMA,'CENTRE',ICEN)
  110. IF(IERR .NE. 0) GOTO 9999
  111. C
  112. C**** Lecture du MELEME SPG des points FACE.
  113. C
  114. CALL LEKTAB(IDOMA,'FACE',IFAC)
  115. IF(IERR .NE. 0) GOTO 9999
  116. C
  117. C**** Lecture du MELEME SPG des points SOMMET
  118. C
  119. CALL LEKTAB(IDOMA,'SOMMET',ISOMM)
  120. IF(IERR .NE. 0) GOTO 9999
  121. C
  122. C**** Lecture du MELEME de connect. FACEL
  123. C
  124. CALL LEKTAB(IDOMA,'FACEL',IFACEL)
  125. IF(IERR .NE. 0) GOTO 9999
  126. C
  127. C**** Lecture du MELEME de connect. FACEP
  128. C
  129. CALL LEKTAB(IDOMA,'FACEP',IFACEP)
  130. IF(IERR .NE. 0) GOTO 9999
  131. C
  132. C**** Lecture du MELEME MAILLAGE
  133. C
  134. CALL LEKTAB(IDOMA,'MAILLAGE',IMAIL)
  135. IF(IERR .NE. 0) GOTO 9999
  136. C
  137. C**** Lecture du CHPOINT dont on veut calculer le gradient!
  138. C
  139. CALL LIROBJ('CHPOINT ',ICHPO,1,IRET1)
  140. IF(IERR .NE. 0) GOTO 9999
  141. C
  142. C**** Control du CHPOIT
  143. C
  144. MLMOTS=0
  145. CALL QUEPO1(ICHPO, ICEN, MLMOTS)
  146. IMOT=MLMOTS
  147. IF (IERR .NE. 0) GOTO 9999
  148. C En sortie, MLMOTS contient le nom de composantes de ICHPO
  149. SEGACT MLMOTS
  150. NBCOMP = MLMOTS.MOTS(/2)
  151. SEGDES MLMOTS
  152. IF(NBCOMP .GT. 9)THEN
  153. C
  154. C******* Message d'erreur standard
  155. C -301 0 %m1:40
  156. C
  157. MOTERR(1:40) = 'NBCOMP > 9 '
  158. WRITE(IOIMP,*) MOTERR(1:40)
  159. CALL ERREUR(22)
  160. GOTO 9999
  161. ENDIF
  162. C
  163. C**** Lecture du CHPOINT du conditions aux limites (optionel)
  164. C
  165. IRET1=0
  166. CALL LIRCHA(MOT,0,IRET1)
  167. IF(IERR .NE. 0) GOTO 9999
  168. IF(IRET1.NE.0)THEN
  169. IF(MOT .EQ. 'CLIM') THEN
  170. CALL LIROBJ('CHPOINT ',ICHCL,1,ICELL)
  171. IF(IERR .NE. 0) GOTO 9999
  172. MCHPOI = ICHCL
  173. SEGACT MCHPOI
  174. NSOUPO = MCHPOI.IPCHP(/1)
  175. IF(NSOUPO .EQ. 0) THEN
  176. ICHCL=0
  177. ISGLIM=0
  178. ELSE
  179. MSOUPO=MCHPOI.IPCHP(1)
  180. SEGACT MSOUPO
  181. ISGLIM=MSOUPO.IGEOC
  182. SEGDES MSOUPO
  183. ENDIF
  184. SEGDES MCHPOI
  185. ELSE
  186. C
  187. C******* Je la remets dans la pile
  188. C
  189. CALL ECRCHA(MOT)
  190. IF(IERR .NE. 0) GOTO 9999
  191. ICHCL=0
  192. ISGLIM=0
  193. ENDIF
  194. ELSE
  195. ISGLIM=0
  196. ICHCL=0
  197. ENDIF
  198. C
  199. C**** Control du CHPOIT
  200. C N.B.: MLMOTS contient les composantes de ICHPO
  201. C
  202. IF(ICHCL .GT. 0)THEN
  203. ICELL = 0
  204. CALL QUEPO1(ICHCL, ICELL, MLMOTS)
  205. IF (IERR .NE. 0) GOTO 9999
  206. ENDIF
  207. C
  208. C**** Lecture du MCHAMLs qui contiennent les elements de matrice
  209. C pour le calcul du gradient et (eventuelment) de l'hessian
  210. C
  211. C Si MOT = 'GRADGEO', on a ces MCHAMLs; sinon il faut le calculer
  212. C
  213. CALL LIRCHA(MOT,0,IRET1)
  214. IF(IERR .NE. 0) GOTO 9999
  215. IF(IRET1 .EQ. 0)THEN
  216. LOGCOE = .TRUE.
  217. ELSEIF(MOT .NE. 'GRADGEO')THEN
  218. CALL ECRCHA(MOT)
  219. IF(IERR .NE. 0) GOTO 9999
  220. LOGCOE=.TRUE.
  221. ELSE
  222. LOGCOE=.FALSE.
  223. CALL LIROBJ('MCHAML ',ICOEFF,1,IRET1)
  224. IF(IERR .NE. 0) GOTO 9999
  225. ENDIF
  226. IF(LOGCOE)THEN
  227. CALL GRADIA(ICEN,ISOMM,IFACEL,IFACEP,IMAIL,ISGLIM,
  228. & ICOEFF)
  229. IF (IERR .NE. 0) GOTO 9999
  230. ENDIF
  231. C
  232. C**** Calcul de gradient
  233. C
  234. CALL PENDI1(IMOT,IFAC,ICHPO,ICHCL,ICOEFF,ICHGRA)
  235. IF(IERR .NE. 0) GOTO 9999
  236. C
  237. C**** Ecriture de gradient, (hessian), (limiteur),
  238. C (MCHAMLs pour le calcul de gradient et/ou du hessian)
  239. C
  240. IF(MOT .NE. 'GRADGEO') THEN
  241. CALL ECROBJ('MCHAML',ICOEFF)
  242. IF(IERR .NE. 0) GOTO 9999
  243. ENDIF
  244. CALL ECROBJ('CHPOINT',ICHGRA)
  245. IF(IERR .NE. 0) GOTO 9999
  246. C
  247. SEGSUP MLMOTS
  248. C
  249. C**** Sortie du programme
  250. C
  251. 9999 CONTINUE
  252. C
  253. RETURN
  254. END
  255.  
  256.  
  257.  
  258.  
  259.  

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