Télécharger pre41.eso

Retour à la liste

Numérotation des lignes :

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

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