Esope source files

   1 : C KRES      SOURCE    GOUNAND   06/03/06    21:17:51     5319           
   2 :       SUBROUTINE KRES
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C*************************************************************************
   6 : C     Operateur KRES
   7 : C     
   8 : C     OBJET   : Resoud l'equation de contrainte
   9 : C     SYNTAXE : PRES = KRES RVP 
  10 : C     
  11 : C*************************************************************************
  12 : -INC SMCHPOI
  13 : -INC CCOPTIO
  14 : C     
  15 :       CHARACTER*8 TYPE,MTYP
  16 : 
  17 :       PARAMETER (NBM=3)
  18 :       CHARACTER*4 LMOT(NBM)
  19 : 
  20 :       PARAMETER (NTB=1)
  21 :       CHARACTER*8 LTAB(NTB)
  22 :       DIMENSION KTAB(NTB)
  23 :       DATA LTAB/'EQPR    '/
  24 :       DATA LMOT/'IMPR','BETA','PIMP'/
  25 : C***  
  25 :       CALL QUETYP(MTYP,1,IRET)
  26 :       IF (IRET.EQ.0) RETURN
  27 :       IF(MTYP.EQ.'MATRIK'.OR.MTYP.EQ.'RIGIDITE')THEN
  27 :          CALL KRES2
  28 :          RETURN
  29 :       ELSEIF(MTYP.EQ.'MOT     ')THEN
  29 :          CALL LIRCHA(TYPE,1,LCHA)
  30 :          IF(LCHA.EQ.0)THEN
  31 : * Opération illicite dans ce contexte
  31 :             CALL ERREUR(153)
  32 :             RETURN
  33 :          ENDIF
  34 :          IF(TYPE(1:2).EQ.'LL')THEN
  34 :             CALL KRESLL
  35 :             RETURN
  36 :          ELSE
  37 : * Opération illicite dans ce contexte
  37 :             CALL ERREUR(153)
  38 :             RETURN
  39 :          ENDIF
  40 :       ENDIF
  41 :       NTO=1
  41 :       CALL LITABS(LTAB,KTAB,NTB,NTO,IRET)
  42 :       IF (IERR.NE.0) THEN
  43 :          RETURN
  44 :       ENDIF
  45 :       MTABP=KTAB(1)
  46 : 
  47 :       TYPE='CHPOINT '
  47 :       CALL LIROBJ(TYPE,MCHB,1,IRET)
  48 :       IF(IRET.EQ.0)THEN
  49 :          WRITE(6,*)' On attend un CHPOINT-CENTRE'
  50 :          RETURN
  51 :       ENDIF
  52 : 
  53 :       KDPDQ=0
  54 :       BETA=0.D0
  55 :       KPIMP=0
  56 :       PIMP=0.D0
  57 : 
  58 :       IMPR=0
  59 :  1    CONTINUE
  59 :       CALL LIRMOT(LMOT,NBM,IP,0)
  60 :       IF(IP.EQ.0)GO TO 2
  61 :       IF(IP.EQ.1)THEN
  62 :          IMPR=1
  63 :       ENDIF
  64 :       IF(IP.EQ.2)THEN
  64 :          CALL LIRENT(KDPDQ,1,IRETOU)
  65 :          IF(IRETOU.EQ.0)THEN
  66 :             RETURN
  67 :          ENDIF
  67 :          CALL LIRREE(BETA,1,IRETOU)
  68 :          IF(IRETOU.EQ.0)THEN
  69 :             RETURN
  70 :          ENDIF
  71 :       ENDIF
  72 :       IF(IP.EQ.3)THEN
  72 :          CALL LIRENT(KPIMP,1,IRETOU)
  73 :          IF(IRETOU.EQ.0)THEN
  74 :             RETURN
  75 :          ENDIF
  75 :          CALL LIRREE(PIMP,1,IRETOU)
  76 :          IF(IRETOU.EQ.0) THEN
  77 :             RETURN
  78 :          ENDIF
  78 : C       CALL LIRENT(NIMP,1,IRETOU)
  79 : C       IF(IRETOU.EQ.0)RETURN
  80 :          IF(KPIMP.NE.0.AND.KPIMP.NE.1)THEN
  81 : C Tentative d'utilisation d'une option non implémentée
  81 :             CALL ERREUR (251)
  82 :             RETURN
  83 :          ENDIF
  84 :       ENDIF
  85 :       GO TO 1
  86 :  2    CONTINUE
  87 : 
  88 : C ***********************************************************************
  89 : C     
  90 : C     ON PREPARE LE CALCUL DE LA PRESSION SUIVANT LE TYPE
  91 : C     
  92 : C     D'INVERSION   (KTYPI)
  93 : C     
  94 : C ***********************************************************************
  95 : 
  96 : 
  96 :       CALL LEKTAB(MTABP,'MATC',MATRIK)
  97 :       IF(MATRIK.EQ.0)GO TO 90
  98 : 
  98 :       CALL ACME(MTABP,'KTYPI',KTYPI)
  99 : C     write(6,*)' Kres : KTYPI=',KTYPI
 100 : C     
 101 : C------------------------------------------------------------------------
 102 : C     
 103 :       IF(KTYPI.EQ.1.OR.KTYPI.EQ.5)THEN
 104 : C     
 105 : C  METHODE DIRECTE
 106 : C     
 106 :          CALL KMDMT(MTABP,MCHB,MCHB,IMPR,BETA,KDPDQ,KPIMP,PIMP,NIMP)
 107 : C     
 108 : C------------------------------------------------------------------------
 109 : C     
 110 : 
 111 :       ELSEIF(KTYPI.GT.1.AND.KTYPI.LT.5)THEN
 112 : 
 112 :          CALL KRESS(MTABP,MCHB,MCHB,IMPR,BETA,KDPDQ,KPIMP,PIMP,NIMP)
 113 : 
 114 : C     
 115 : C------------------------------------------------------------------------
 116 : C     
 117 :       ELSEIF(KTYPI.EQ.6)THEN
 118 : C     
 119 : C NEDELEC 28 1 91  METHODE ITERATIVE CHEBYSHEV
 120 : C     
 120 :          CALL PROGC(MTABP)
 120 :          CALL CAPR(MTABP)
 121 : C     
 122 : C----------------------------------------------------------------------
 123 : C     
 124 :       ELSEIF(KTYPI.EQ.7)THEN
 125 : C     
 126 : C NEDELEC 11 4 91 GRADIENT CONJUGUE PRECON PAR DIAG
 127 : C     
 127 :          CALL KRESF(MTABP,MCHB,MCHB,IMPR)
 128 : C     
 129 : C---------------------------------------------------------------------
 130 : C     
 131 :       ELSE
 132 :          WRITE(6,*)' KRES   : OPTION NON PREVUE  KTYPI=',KTYPI
 133 : C Tentative d'utilisation d'une option non implémentée
 133 :          CALL ERREUR (251)
 134 :          RETURN
 135 :       ENDIF
 136 :       RETURN
 137 :  1001 FORMAT(20(1X,I5))
 138 :  1002 FORMAT(10(1X,1PE11.4))
 139 :  90   CONTINUE
 140 : C Les options de calcul sont erronées.
 140 :       CALL ERREUR(717)
 141 :       RETURN
 142 :       END
 143 :  
 144 :  
 145 :  
 146 :  
 147 :  
 148 :  
 149 :  
 150 :