Esope source files

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