Télécharger pre41.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE41 SOURCE CB215821 19/07/31 21:16:25 10277
  2. SUBROUTINE PRE41()
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PRE41
  8. C
  9. C DESCRIPTION : Voir PRE4
  10. C
  11. C Transport de scalaires passifs
  12. C
  13. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  14. C
  15. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
  16. C
  17. C************************************************************************
  18. C
  19. C
  20. C APPELES (Outils) : LIRTAB, ACMO, LEKTAB, QUETYP, ERREUR, LIROBJ,
  21. C QUEPO1, ECROBJ
  22. C
  23. C APPELES (Calcul) : PRE411 (2D)
  24. C
  25. C
  26. C************************************************************************
  27. C
  28. C HISTORIQUE (Anomalies et modifications éventuelles)
  29. C
  30. C HISTORIQUE : Créée le 28.11.01
  31. C
  32. C************************************************************************
  33. C
  34. C
  35. C**** Variables de COOPTIO
  36. C
  37. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  38. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  39. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  40. C & ,IECHO, IIMPI, IOSPI
  41. C & ,IDIM
  42. C & ,MCOORD
  43. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  44. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  45. C & ,NORINC,NORVAL,NORIND,NORVAD
  46. C & ,NUCROU, IPSAUV
  47. C
  48. C**** Les variables
  49. C
  50. IMPLICIT INTEGER(I-N)
  51. INTEGER ICOND, IRETOU, IERR0
  52. & ,IDOMA, ICEN, IFACE, IFACEL, IROC, IROF, INEFMD
  53. CHARACTER*(8) MTYPR, TYPE
  54. CHARACTER*(40) MESERR
  55. LOGICAL LOGAN
  56. C
  57. C**** Les Includes
  58. C
  59. -INC PPARAM
  60. -INC CCOPTIO
  61. -INC SMLMOTS
  62. POINTEUR MLMCOM.MLMOTS
  63. C
  64. C**** Initialisation des parametres d'erreur
  65. C
  66. LOGAN=.FALSE.
  67. MESERR = ' '
  68. MOTERR(1:40) = MESERR(1:40)
  69. C
  70. C**** Lecture de l'objet MODELE
  71. C
  72. ICOND = 1
  73. CALL QUETYP(TYPE,ICOND,IRETOU)
  74.  
  75. IF(IRETOU.EQ.0.AND.TYPE.NE.'MMODEL')THEN
  76. WRITE(6,*)' On attend un objet MMODEL'
  77. RETURN
  78. ENDIF
  79. CALL LIROBJ('MMODEL ',MMODEL,ICOND,IRETOU)
  80. CALL ACTOBJ('MMODEL ',MMODEL,1)
  81. IF(IERR.NE.0)GOTO 9999
  82. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  83. IF(IERR.NE.0)GOTO 9999
  84. C
  85. C**** Lecture du MELEME SPG des points CENTRE.
  86. C
  87. C
  88. C CALL LEKTAB(IDOMA,'CENTRE',IP)
  89. C
  90. C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas,
  91. C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL'
  92. C -> la correspondance global des noeuds saut!
  93. C
  94. C On peut utilizer ACCTAB ou ACMO
  95. C
  96. MTYPR = 'MAILLAGE'
  97. CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN)
  98. IF(IERR.NE.0)GOTO 9999
  99. C
  100. C**** Lecture du MELEME 'FACE'
  101. C
  102. MTYPR = 'MAILLAGE'
  103. CALL ACMO(IDOMA,'FACE',MTYPR,IFACE)
  104. IF(IERR.NE.0)GOTO 9999
  105. C
  106. C**** Lecture du MELEME 'FACEL'
  107. C
  108. MTYPR = 'MAILLAGE'
  109. CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL)
  110. IF(IERR.NE.0)GOTO 9999
  111. C
  112. C**** Lecture du CHPOINT ROC
  113. C
  114. ICOND = 1
  115. MTYPR='CHPOINT '
  116. CALL LIROBJ(MTYPR,IROC,ICOND,IRETOU)
  117. CALL ACTOBJ(MTYPR,IROC,1)
  118. IF (IERR.NE.0) GOTO 9999
  119. C
  120. C**** Control du CHPOINT: QUEPO1
  121. C
  122. MLMCOM=0
  123. CALL QUEPO1(IROC, ICEN, MLMCOM)
  124. IF(IERR .NE. 0)THEN
  125. IERR0 = IERR
  126.  
  127. C
  128. C******* Message d'erreur standard
  129. C -301 0 %m1:40
  130. C
  131. MOTERR(1:40) = 'CHPO1 = ??? '
  132. $
  133. WRITE(IOIMP,*) MOTERR
  134.  
  135. GOTO 9999
  136. ENDIF
  137. C
  138. C**** Centre -> Face
  139. C
  140. CALL PRE411(ICEN,IFACE,IFACEL,MLMCOM,IROC,IROF,
  141. & LOGAN,MESERR)
  142. C
  143. C**** Messages d'erreur
  144. C
  145. IF(LOGAN)THEN
  146. C
  147. C******* Anomalie detectée
  148. C
  149. C
  150. C******* Message d'erreur standard
  151. C -301 0
  152. C %m1:40
  153. C
  154. MOTERR(1:40) = MESERR(1:40)
  155. WRITE(IOIMP,*) MOTERR
  156. C
  157. C******* Message d'erreur standard
  158. C 5 3
  159. C Erreur anormale.contactez votre support
  160. C
  161. CALL ERREUR(5)
  162. GOTO 9999
  163. C
  164. ELSE
  165. C
  166. C******* Ecriture de ROF, VITF, PF, YF, GAMMAF
  167. C
  168. MTYPR = 'MCHAML '
  169. CALL ACTOBJ(MTYPR,IROF,1)
  170. CALL ECROBJ(MTYPR,IROF)
  171. ENDIF
  172. C
  173. SEGSUP MLMCOM
  174. 9999 CONTINUE
  175. END
  176.  
  177.  
  178.  

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