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

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