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 CCOPTIO
  60. -INC SMLMOTS
  61. POINTEUR MLMCOM.MLMOTS
  62. C
  63. C**** Initialisation des parametres d'erreur
  64. C
  65. LOGAN=.FALSE.
  66. MESERR = ' '
  67. MOTERR(1:40) = MESERR(1:40)
  68. C
  69. C**** Lecture de l'objet MODELE
  70. C
  71. ICOND = 1
  72. CALL QUETYP(TYPE,ICOND,IRETOU)
  73.  
  74. IF(IRETOU.EQ.0.AND.TYPE.NE.'MMODEL')THEN
  75. WRITE(6,*)' On attend un objet MMODEL'
  76. RETURN
  77. ENDIF
  78. CALL LIROBJ('MMODEL ',MMODEL,ICOND,IRETOU)
  79. CALL ACTOBJ('MMODEL ',MMODEL,1)
  80. IF(IERR.NE.0)GOTO 9999
  81. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  82. IF(IERR.NE.0)GOTO 9999
  83. C
  84. C**** Lecture du MELEME SPG des points CENTRE.
  85. C
  86. C
  87. C CALL LEKTAB(IDOMA,'CENTRE',IP)
  88. C
  89. C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas,
  90. C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL'
  91. C -> la correspondance global des noeuds saut!
  92. C
  93. C On peut utilizer ACCTAB ou ACMO
  94. C
  95. MTYPR = 'MAILLAGE'
  96. CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN)
  97. IF(IERR.NE.0)GOTO 9999
  98. C
  99. C**** Lecture du MELEME 'FACE'
  100. C
  101. MTYPR = 'MAILLAGE'
  102. CALL ACMO(IDOMA,'FACE',MTYPR,IFACE)
  103. IF(IERR.NE.0)GOTO 9999
  104. C
  105. C**** Lecture du MELEME 'FACEL'
  106. C
  107. MTYPR = 'MAILLAGE'
  108. CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL)
  109. IF(IERR.NE.0)GOTO 9999
  110. C
  111. C**** Lecture du CHPOINT ROC
  112. C
  113. ICOND = 1
  114. MTYPR='CHPOINT '
  115. CALL LIROBJ(MTYPR,IROC,ICOND,IRETOU)
  116. CALL ACTOBJ(MTYPR,IROC,1)
  117. IF (IERR.NE.0) GOTO 9999
  118. C
  119. C**** Control du CHPOINT: QUEPO1
  120. C
  121. MLMCOM=0
  122. CALL QUEPO1(IROC, ICEN, MLMCOM)
  123. IF(IERR .NE. 0)THEN
  124. IERR0 = IERR
  125.  
  126. C
  127. C******* Message d'erreur standard
  128. C -301 0 %m1:40
  129. C
  130. MOTERR(1:40) = 'CHPO1 = ??? '
  131. $
  132. WRITE(IOIMP,*) MOTERR
  133.  
  134. GOTO 9999
  135. ENDIF
  136. C
  137. C**** Centre -> Face
  138. C
  139. CALL PRE411(ICEN,IFACE,IFACEL,MLMCOM,IROC,IROF,
  140. & LOGAN,MESERR)
  141. C
  142. C**** Messages d'erreur
  143. C
  144. IF(LOGAN)THEN
  145. C
  146. C******* Anomalie detectée
  147. C
  148. C
  149. C******* Message d'erreur standard
  150. C -301 0
  151. C %m1:40
  152. C
  153. MOTERR(1:40) = MESERR(1:40)
  154. WRITE(IOIMP,*) MOTERR
  155. C
  156. C******* Message d'erreur standard
  157. C 5 3
  158. C Erreur anormale.contactez votre support
  159. C
  160. CALL ERREUR(5)
  161. GOTO 9999
  162. C
  163. ELSE
  164. C
  165. C******* Ecriture de ROF, VITF, PF, YF, GAMMAF
  166. C
  167. MTYPR = 'MCHAML '
  168. CALL ACTOBJ(MTYPR,IROF,1)
  169. CALL ECROBJ(MTYPR,IROF)
  170. ENDIF
  171. C
  172. SEGSUP MLMCOM
  173. 9999 CONTINUE
  174. END
  175.  
  176.  
  177.  

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