Télécharger la plaquette Cast3M


fr en

Télécharger pre41.eso

Retour à la liste

Numérotation des lignes : 

pre41

  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