Esope source files

   1 : C KBOR      SOURCE    CHAT      05/01/13    00:52:05     5004           
   2 :       SUBROUTINE KBOR(MCHPO1,MCHPO2)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C----------------------------------------------------------------------
   6 : C Surcharge du second membre par certaines valeurs en vue de traiter
   7 : C les conditions aux limites de type Dirichlet en mecanique des fluides
   8 : C----------------------------------------------------------------------
   9 : C
  10 : C     SYNTAXE : CHP3 = KOPS CHP1 'CLIM' CHP2 ENTI1 ;
  11 : C
  12 : C 'CLIM'  : Mot désignant l'option ad'hoc pour passer ici
  13 : C  CHP1   : Champoint contenant le second membre
  14 : C  CHP2   : Champoint de conditions aux limites
  15 : C  ENTI1  : Entier indiquant le type de surcharge
  16 : C              0 -> 0  1 -> 1.E30  2 -> 1.E30*CHP2  3 -> CHP2
  17 : C             -1,-2,-3 -> on teste sur le nom des composantes et non sur
  18 : C                         ux,uy,uz (meme specif que |ENTI1|)
  19 : C  CHP3   : Contient CHP1 surchargé suivant CHP2 et ENTI1
  20 : C
  21 : C----------------------------------------------------------------------
  22 : C
  23 : C--------------
  24 : C Entree/Sortie
  25 : C--------------
  26 : C
  27 : C E/S MCHPO1 : Pointeur de CHP1 en Entrée et de CHPO3 en sortie
  28 : C E/  MCHPO2 : Pointeur de CHP2
  29 : C
  30 : C----------------------------------------------------------------------
  31 : C Le pointeur de CHP3 écrase subtilement celui de CHP1 (!?)
  32 : C----------------------------------------------------------------------
  33 : -INC CCREEL
  34 : -INC SMELEME
  35 :       POINTEUR MELEM1.MELEME,MELEM2.MELEME
  36 : -INC SMCHPOI
  37 : -INC SMLENTI
  38 :       CHARACTER*4 NMC1,NMC2,NMC3
  39 : C
  40 :       IF (MCHPO1.EQ.0.OR.MCHPO2.EQ.0) THEN
  41 : C 5 3    Erreur anormale.contactez votre support
  41 :          CALL ERREUR(5)
  42 :          RETURN
  43 :       ENDIF
  43 :       CALL LIRENT(IKAS,1,IRET)
  44 :       IF (IRET.EQ.0) RETURN
  45 :       IKA1=IKAS
  46 :       IKAS=ABS(IKAS)
  47 :       IF (IKAS.GE.4) THEN
  48 : C 26 2   Tache impossible. Probablement données erronées
  48 :          CALL ERREUR(26)
  49 :          RETURN
  50 :       ENDIF
  50 :       CALL ECROBJ('CHPOINT',MCHPO1)
  50 :       CALL COPIER
  50 :       CALL LIROBJ('CHPOINT',MCHPO1,1,IRET)
  51 :       IF(IRET.EQ.0)RETURN
  52 : 
  53 : C     write(6,*)' MCHPO1,MCHPO2=',MCHPO1,MCHPO2
  54 :       SEGACT MCHPO1,MCHPO2
  55 :       NSOUP1=MCHPO1.IPCHP(/1)
  56 : 
  57 :       NSOUP2=MCHPO2.IPCHP(/1)
  58 : C     write(6,*)' NSOUP1,NSOUP2=',NSOUP1,NSOUP2
  59 :       DO 21 L2=1,NSOUP2
  60 :       MSOUP2=MCHPO2.IPCHP(L2)
  61 :       SEGACT MSOUP2
  62 :       MELEM2=MSOUP2.IGEOC
  63 :       SEGACT MELEM2
  64 :       NPT2=MELEM2.NUM(/2)
  65 :       NC2=MSOUP2.NOHARM(/1)
  66 :       MPOVA2=MSOUP2.IPOVAL
  67 :       SEGACT MPOVA2
  68 : C     write(6,*)' NC2,NPT2=',nc2,npt2
  69 :       DO 21 N2=1,NC2
  70 :       NMC2=MSOUP2.NOCOMP(N2)
  71 : 
  72 :       DO 11 L1=1,NSOUP1
  73 : C     write(6,*)' L1=',L1
  74 :       MSOUP1=MCHPO1.IPCHP(L1)
  75 :       SEGACT MSOUP1
  76 :       MELEM1=MSOUP1.IGEOC
  77 :       SEGACT MELEM1
  78 :       NPT1=MELEM1.NUM(/2)
  79 :       NC1=MSOUP1.NOHARM(/1)
  80 :       MPOVA1=MSOUP1.IPOVAL
  81 :       SEGACT MPOVA1*MOD
  82 : C     write(6,*)' NC1,NPT1=',nc1,npt1
  83 :       DO 11 N1=1,NC1
  84 :       NMC1=MSOUP1.NOCOMP(N1)
  85 : Correction ttmf3, le 18/08/99 : NMC3 non initialisée
  86 :       NMC3=NMC2
  87 : C     write(6,*)' NC1,NC2,NSOUP1,NSOUP2=',
  88 : C    &NC1,NC2,NSOUP1,NSOUP2
  89 :       IF(NMC2(1:1).EQ.'1')NMC3='UX  '
  90 :       IF(NMC2(1:1).EQ.'2')NMC3='UY  '
  91 :       IF(NMC2(1:1).EQ.'3')NMC3='UZ  '
  92 :       IF(IKA1.LE.0)NMC3=NMC2
  93 :       IF(NMC1.NE.NMC3)GO TO 11
  93 :       CALL KRIPAD(MELEM1,MLENTI)
  94 :       DO 2 I2=1,NPT2
  95 :       I1=LECT(MELEM2.NUM(1,I2))
  96 :       IF(I1.EQ.0)GO TO 2
  97 :       IF(IKAS.EQ.0)THEN
  98 : C     MPOVA1.VPOCHA(I1,N1)=XPETIT
  99 :       MPOVA1.VPOCHA(I1,N1)=1.D-30
 100 :       ELSEIF(IKAS.EQ.1)THEN
 101 : C     MPOVA1.VPOCHA(I1,N1)=XGRAND
 102 :       MPOVA1.VPOCHA(I1,N1)=1.D30
 103 :       ELSEIF(IKAS.EQ.2)THEN
 104 : C     MPOVA1.VPOCHA(I1,N1)=MPOVA2.VPOCHA(I2,N2)*XGRAND
 105 :       MPOVA1.VPOCHA(I1,N1)=MPOVA2.VPOCHA(I2,N2)*1.D30
 106 :       ELSEIF(IKAS.EQ.3)THEN
 107 :       MPOVA1.VPOCHA(I1,N1)=MPOVA2.VPOCHA(I2,N2)
 108 :       ELSE
 109 : *      WRITE(6,*)' KOPS : CLIM IKAS=',IKAS,' NON PREVU '
 110 :       RETURN
 111 :       ENDIF
 112 : 
 113 :  2    CONTINUE
 114 : 
 115 :  11   CONTINUE
 116 :  21   CONTINUE
 117 : 
 117 :       CALL ECROBJ('CHPOINT ',MCHPO1)
 118 : 
 119 :       RETURN
 120 :  1001 FORMAT(20(1X,I5))
 121 :  1008 FORMAT(10(1X,A8))
 122 :  1002 FORMAT(10(1X,1PE11.4))
 123 :       END
 124 : 
 125 : 
 126 : 
 127 : 
 128 : 
 129 :  
 130 :  
 131 :  
 132 :  
 133 :