Télécharger pent15.eso

Retour à la liste

Numérotation des lignes :

  1. C PENT15 SOURCE CHAT 05/01/13 02:12:12 5004
  2. SUBROUTINE PENT15(IDOMA,IOP2,IOP3)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PENT15
  8. C
  9. C DESCRIPTION : Appellé par PENT
  10. C
  11. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  12. C
  13. C AUTEUR : A. BECCANTINI, R. MOREL, DRN/DMT/SEMT/LTMF
  14. C
  15. C************************************************************************
  16. C
  17. C
  18. C PHRASE D'APPEL (GIBIANE) :
  19. C
  20. C
  21. C RCHPO1 RCHPO2 RCHELEM1 = 'PENT'
  22. C MCLE1 MCLE2 MCLE3 TABDO LMOT CHPO1 (MCLE4 CHPO2) ;
  23. C
  24. C ou
  25. C
  26. C RCHPO1 RCHPO2 = 'PENT'
  27. C MCLE1 MCLE2 MCLE3 TABDO LMOT CHPO1 (MCL4 CHPO2) 'GRADGEO' RCHELEM1 ;
  28. C
  29. C
  30. C Entrées:
  31. C
  32. C TABDO : Donnée de la table domaine;
  33. C
  34. C MCLE1 : type du champ par point CHPO1. Pour le moment, seul le type
  35. C 'CENTRE' est autorisé;
  36. C
  37. C MCLE2 : Traitement des éléments de bord et ordre de précision du
  38. C calcul de gradient . Options sont possibles : 'BORDNULL',
  39. C 'EULESCAL', 'EULEVECT', 'LINEXACT', 'QUADRATI'
  40. C
  41. C MCLE3 : Calcul ou non du limiteur : 'LIMITEUR' ou 'NOLIMITE';
  42. C
  43. C LMOT : noms de composantes du chpoint
  44. C
  45. C CHPO1 : Donnée du Champ par point de type MCLE1;
  46. C
  47. C MCLE4 : Donnée ou non du CHPO2
  48. C 'CLIM' si donnée, vide sinon.
  49. C
  50. C CHPO2 : Donnée du Champ par point des conditions aux limites
  51. C
  52. C
  53. C
  54. C E/S :
  55. C
  56. C RCHELEM1: Champ par élément des coefficients géométriques pour le
  57. C calcul du gradient
  58. C (entrée si MCLE4 = 'GRADGEO', sinon sortie).
  59. C
  60. C
  61. C Sorties:
  62. C
  63. C RCHPO1 : Champ par point contenant le gradient de CHPO1 (toujours
  64. C calculé) ;
  65. C
  66. C RCHPO2 : Champ par point contenant le limiteur du gradient
  67. C (toujours calculé) ;
  68. C
  69. C
  70. C************************************************************************
  71. C
  72. C HISTORIQUE (Anomalies et modifications éventuelles)
  73. C
  74. C HISTORIQUE : Recreé le 22/3/2000
  75. C
  76. C************************************************************************
  77. C
  78. C
  79. IMPLICIT INTEGER(I-N)
  80. -INC CCOPTIO
  81. -INC SMCHPOI
  82. -INC SMLMOTS
  83. C
  84. C
  85. C**** Variables de COOPTIO
  86. C
  87. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  88. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  89. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  90. C & ,IECHO, IIMPI, IOSPI
  91. C & ,IDIM
  92. C & ,MCOORD
  93. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  94. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  95. C & ,NORINC,NORVAL,NORIND,NORVAD
  96. C & ,NUCROU, IPSAUV, IFICLE, IPREFI
  97. C & ,IREFOR, ISAFOR
  98. C
  99. INTEGER IDOMA, IRET1, ICEN, IFACEL, IELTFA
  100. & ,IOP2, IOP3
  101. & ,ICHPO, ICHGRA, IMCALP
  102. & ,NBCOMP
  103. & ,ICHCL, IFAC, INORM
  104. & ,NSOUPO, ICELL, LMOT, JGM, JGN, ICHAM
  105.  
  106. C
  107. CHARACTER*(8) MOT
  108. C
  109. MOT=' '
  110. C
  111. C*************************************************
  112. C**** TABLE DOMAINE ****************************
  113. C*************************************************
  114. C
  115. C**** Lecture du MELEME SPG des points CENTRE.
  116. C
  117. CALL LEKTAB(IDOMA,'CENTRE',ICEN)
  118. IF(IERR .NE. 0) GO TO 9999
  119. C
  120. C**** Lecture du MELEME de connect. FACEL
  121. C
  122. CALL LEKTAB(IDOMA,'FACEL',IFACEL)
  123. IF(IERR .NE. 0) GO TO 9999
  124. C
  125. C**** Lecture du MELEME de connect. ELTFA
  126. C
  127. CALL LEKTAB(IDOMA,'ELTFA',IELTFA)
  128. IF(IERR .NE. 0) GO TO 9999
  129. C
  130. C**** Lecture du MELEME de connect. FACEL
  131. C
  132. CALL LEKTAB(IDOMA,'FACE',IFAC)
  133. IF(IERR .NE. 0) GO TO 9999
  134. C
  135. C**** Lecture du MELEME de connect. FACEL
  136. C
  137. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  138. IF(IERR .NE. 0) GO TO 9999
  139. JGN=4
  140. JGM=IDIM
  141. SEGINI MLMOT1
  142. MLMOT1.MOTS(1)='UX '
  143. MLMOT1.MOTS(2)='UY '
  144. IF(IDIM.EQ.3) MLMOT1.MOTS(3)='UZ '
  145. CALL QUEPO1(INORM, IFAC, MLMOT1)
  146. IF (IERR .NE. 0) GOTO 9999
  147. SEGSUP MLMOT1
  148. C
  149. C****************************************************
  150. C
  151. C
  152. C**** Lecture des noms des composantes du CHPOINT
  153. C
  154. CALL LIROBJ('LISTMOTS',LMOT,1,IRET1)
  155. IF(IERR .NE. 0) GOTO 9999
  156. C
  157. C**** Lecture du CHPOINT dont on veut calculer le gradient!
  158. C
  159. CALL LIROBJ('CHPOINT ',ICHPO,1,IRET1)
  160. IF(IERR .NE. 0) GOTO 9999
  161. C
  162. C**** Control du CHPOINT
  163. C
  164. CALL QUEPO1(ICHPO, ICEN, LMOT)
  165. IF (IERR .NE. 0) GOTO 9999
  166. C
  167. MLMOTS=LMOT
  168. SEGACT MLMOTS
  169. NBCOMP = MLMOTS.MOTS(/2)
  170. SEGDES MLMOTS
  171. IF(NBCOMP .GT. 9)THEN
  172. C
  173. C******* Message d'erreur standard
  174. C -301 0 %m1:40
  175. C
  176. MOTERR(1:40) = 'NBCOMP > 9 '
  177. WRITE(IOIMP,*) MOTERR(1:40)
  178. CALL ERREUR(22)
  179. GOTO 9999
  180. ENDIF
  181. C
  182. C**** Lecture du CHPOINT du conditions aux limites (optionel)
  183. C
  184. IRET1=0
  185. CALL LIRCHA(MOT,0,IRET1)
  186. IF(IERR .NE. 0) GOTO 9999
  187. IF(IRET1.NE.0)THEN
  188. IF(MOT .EQ. 'CLIM') THEN
  189. CALL LIROBJ('CHPOINT ',ICHCL,1,ICELL)
  190. IF(IERR .NE. 0) GOTO 9999
  191. MCHPOI = ICHCL
  192. SEGACT MCHPOI
  193. NSOUPO = MCHPOI.IPCHP(/1)
  194. IF(NSOUPO .EQ. 0) ICHCL=0
  195. SEGDES MCHPOI
  196. ELSE
  197. C
  198. C******* Je la remets dans la pile
  199. C
  200. CALL ECRCHA(MOT)
  201. IF(IERR .NE. 0) GOTO 9999
  202. ICHCL=0
  203. ENDIF
  204. ELSE
  205. ICHCL=0
  206. ENDIF
  207. C
  208. C**** Control du CHPOIT
  209. C N.B.: MLMOTS contient les composantes de ICHPO
  210. C
  211. IF(ICHCL .GT. 0)THEN
  212. ICELL = 0
  213. CALL QUEPO1(ICHCL, ICELL, MLMOTS)
  214. IF (IERR .NE. 0) GOTO 9999
  215. ENDIF
  216. C
  217. C**** Lecture du MCHAMLs qui contiennent les elements de matrice
  218. C pour le calcul du gradient
  219. C
  220. C Si MOT = 'GRADGEO', on a ces MCHAMLs; sinon il faut le calculer
  221. C
  222. CALL LIRCHA(MOT,0,IRET1)
  223. IF(IERR .NE. 0) GOTO 9999
  224. C
  225. C******* IOP2 1 2
  226. C 'EULESCAL','EULEVECT'
  227. C
  228. IF(MOT .NE. 'GRADGEO') THEN
  229. IF (IOP2.LE.3) THEN
  230. C CALL GRADGE(IDOMA,IOP2,ICHCL,MCHEL7)
  231. CALL GRADGE(ICEN,IELTFA,IFAC,IFACEL,INORM,ICHCL,ICHAM)
  232. IF (IERR .NE. 0) GOTO 9999
  233. ELSE
  234. CALL ERREUR(5)
  235. GOTO 9999
  236. ENDIF
  237. ELSE
  238. CALL LIROBJ('MCHAML ',ICHAM,1,IRET1)
  239. IF (IERR .NE. 0) GOTO 9999
  240. ENDIF
  241. C
  242. C**** Calcul de gradient
  243. C
  244. CALL PENTE1(ICEN,IFAC,IFACEL,INORM,IOP2,IOP3,ICHAM,ICHPO,
  245. & ICHCL,ICHGRA,IMCALP)
  246. C
  247. C**** Anomalie in PENTE1
  248. C
  249. IF(IERR .NE. 0) GOTO 9999
  250. C
  251. C**** Ecriture de gradient, limiteur,
  252. C (MCHAMLs pour le calcul de gradient)
  253. C
  254. IF(MOT .NE. 'GRADGEO') THEN
  255. CALL ECROBJ('MCHAML',ICHAM)
  256. IF(IERR .NE. 0) GOTO 9999
  257. ENDIF
  258. IF(IERR .NE. 0) GOTO 9999
  259. CALL ECROBJ ('CHPOINT',IMCALP)
  260. IF(IERR .NE. 0) GOTO 9999
  261. C
  262. CALL ECROBJ('CHPOINT',ICHGRA)
  263. IF(IERR .NE. 0) GOTO 9999
  264. C
  265. C**** Sortie du programme
  266. C
  267. 9999 CONTINUE
  268. C
  269. RETURN
  270. END
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  

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