Sources Esope | Cast3M

kbor
C KBOR      SOURCE    CB215821  20/11/25    13:30:49     10792          
      SUBROUTINE KBOR(MCHPO1,MCHPO2)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C----------------------------------------------------------------------
C Surcharge du second membre par certaines valeurs en vue de traiter
C les conditions aux limites de type Dirichlet en mecanique des fluides
C----------------------------------------------------------------------
C
C     SYNTAXE : CHP3 = KOPS CHP1 'CLIM' CHP2 ENTI1 ;
C
C 'CLIM'  : Mot désignant l'option ad'hoc pour passer ici
C  CHP1   : Champoint contenant le second membre
C  CHP2   : Champoint de conditions aux limites
C  ENTI1  : Entier indiquant le type de surcharge
C              0 -> 0  1 -> 1.E30  2 -> 1.E30*CHP2  3 -> CHP2
C             -1,-2,-3 -> on teste sur le nom des composantes et non sur
C                         ux,uy,uz (meme specif que |ENTI1|)
C  CHP3   : Contient CHP1 surchargé suivant CHP2 et ENTI1
C
C----------------------------------------------------------------------
C
C--------------
C Entree/Sortie
C--------------
C
C E/S MCHPO1 : Pointeur de CHP1 en Entrée et de CHPO3 en sortie
C E/  MCHPO2 : Pointeur de CHP2
C
C----------------------------------------------------------------------
C Le pointeur de CHP3 écrase subtilement celui de CHP1 (!?)
C----------------------------------------------------------------------
-INC CCREEL
-INC SMELEME
      POINTEUR MELEM1.MELEME,MELEM2.MELEME
-INC SMCHPOI
-INC PPARAM
-INC SMLENTI
      CHARACTER*(LOCOMP) NMC1,NMC2,NMC3
C
      IF (MCHPO1.EQ.0.OR.MCHPO2.EQ.0) THEN
C 5 3    Erreur anormale.contactez votre support
         CALL ERREUR(5)
         RETURN
      ENDIF
      CALL LIRENT(IKAS,1,IRET)
      IF (IRET.EQ.0) RETURN
      IKA1=IKAS
      IKAS=ABS(IKAS)
      IF (IKAS.GE.4) THEN
C 26 2   Tache impossible. Probablement données erronées
         CALL ERREUR(26)
         RETURN
      ENDIF
      CALL ECROBJ('CHPOINT',MCHPO1)
      CALL COPIER
      CALL LIROBJ('CHPOINT',MCHPO1,1,IRET)
      IF(IRET.EQ.0)RETURN
 
C     write(6,*)' MCHPO1,MCHPO2=',MCHPO1,MCHPO2
      SEGACT MCHPO1,MCHPO2
      NSOUP1=MCHPO1.IPCHP(/1)
 
      NSOUP2=MCHPO2.IPCHP(/1)
C     write(6,*)' NSOUP1,NSOUP2=',NSOUP1,NSOUP2
      DO 21 L2=1,NSOUP2
      MSOUP2=MCHPO2.IPCHP(L2)
      SEGACT MSOUP2
      MELEM2=MSOUP2.IGEOC
      SEGACT MELEM2
      NPT2=MELEM2.NUM(/2)
      NC2=MSOUP2.NOHARM(/1)
      MPOVA2=MSOUP2.IPOVAL
      SEGACT MPOVA2
C     write(6,*)' NC2,NPT2=',nc2,npt2
      DO 21 N2=1,NC2
      NMC2=MSOUP2.NOCOMP(N2)
 
      DO 11 L1=1,NSOUP1
C     write(6,*)' L1=',L1
      MSOUP1=MCHPO1.IPCHP(L1)
      SEGACT MSOUP1
      MELEM1=MSOUP1.IGEOC
      SEGACT MELEM1
      NPT1=MELEM1.NUM(/2)
      NC1=MSOUP1.NOHARM(/1)
      MPOVA1=MSOUP1.IPOVAL
      SEGACT MPOVA1*MOD
C     write(6,*)' NC1,NPT1=',nc1,npt1
      DO 11 N1=1,NC1
      NMC1=MSOUP1.NOCOMP(N1)
Correction ttmf3, le 18/08/99 : NMC3 non initialisée
      NMC3=NMC2
C     write(6,*)' NC1,NC2,NSOUP1,NSOUP2=',
C    &NC1,NC2,NSOUP1,NSOUP2
      IF(NMC2(1:1).EQ.'1')NMC3='UX  '
      IF(NMC2(1:1).EQ.'2')NMC3='UY  '
      IF(NMC2(1:1).EQ.'3')NMC3='UZ  '
      IF(IKA1.LE.0)NMC3=NMC2
      IF(NMC1.NE.NMC3)GO TO 11
      CALL KRIPAD(MELEM1,MLENTI)
      DO 2 I2=1,NPT2
      I1=LECT(MELEM2.NUM(1,I2))
      IF(I1.EQ.0)GO TO 2
      IF(IKAS.EQ.0)THEN
C     MPOVA1.VPOCHA(I1,N1)=XPETIT
      MPOVA1.VPOCHA(I1,N1)=1.D-30
      ELSEIF(IKAS.EQ.1)THEN
C     MPOVA1.VPOCHA(I1,N1)=XGRAND
      MPOVA1.VPOCHA(I1,N1)=1.D30
      ELSEIF(IKAS.EQ.2)THEN
C     MPOVA1.VPOCHA(I1,N1)=MPOVA2.VPOCHA(I2,N2)*XGRAND
      MPOVA1.VPOCHA(I1,N1)=MPOVA2.VPOCHA(I2,N2)*1.D30
      ELSEIF(IKAS.EQ.3)THEN
      MPOVA1.VPOCHA(I1,N1)=MPOVA2.VPOCHA(I2,N2)
      ELSE
*      WRITE(6,*)' KOPS : CLIM IKAS=',IKAS,' NON PREVU '
      RETURN
      ENDIF
 
 2    CONTINUE
 
 11   CONTINUE
 21   CONTINUE
 
      CALL ECROBJ('CHPOINT ',MCHPO1)
 
      RETURN
 1001 FORMAT(20(1X,I5))
 1008 FORMAT(10(1X,A8))
 1002 FORMAT(10(1X,1PE11.4))
      END