C KRES SOURCE CB215821 20/11/25 13:32:57 10792 SUBROUTINE KRES IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C************************************************************************* C Operateur KRES C C OBJET : Resoud l'equation de contrainte C SYNTAXE : PRES = KRES RVP C C************************************************************************* -INC SMCHPOI -INC PPARAM -INC CCOPTIO C CHARACTER*8 TYPE,MTYP PARAMETER (NBM=3) CHARACTER*4 LMOT(NBM) PARAMETER (NTB=1) CHARACTER*8 LTAB(NTB) DIMENSION KTAB(NTB) DATA LTAB/'EQPR '/ DATA LMOT/'IMPR','BETA','PIMP'/ C*** CALL QUETYP(MTYP,1,IRET) IF (IRET.EQ.0) RETURN IF(MTYP.EQ.'MATRIK'.OR.MTYP.EQ.'RIGIDITE')THEN CALL KRES2 RETURN ELSEIF(MTYP.EQ.'MOT ')THEN CALL LIRCHA(TYPE,1,LCHA) IF(LCHA.EQ.0)THEN * Opération illicite dans ce contexte CALL ERREUR(153) RETURN ENDIF IF(TYPE(1:2).EQ.'LL')THEN CALL KRESLL RETURN ELSE * Opération illicite dans ce contexte CALL ERREUR(153) RETURN ENDIF ENDIF NTO=1 CALL LITABS(LTAB,KTAB,NTB,NTO,IRET) IF (IERR.NE.0) THEN RETURN ENDIF MTABP=KTAB(1) TYPE='CHPOINT ' CALL LIROBJ(TYPE,MCHB,1,IRET) IF(IRET.EQ.0)THEN WRITE(6,*)' On attend un CHPOINT-CENTRE' RETURN ENDIF KDPDQ=0 BETA=0.D0 KPIMP=0 PIMP=0.D0 IMPR=0 1 CONTINUE CALL LIRMOT(LMOT,NBM,IP,0) IF(IP.EQ.0)GO TO 2 IF(IP.EQ.1)THEN IMPR=1 ENDIF IF(IP.EQ.2)THEN CALL LIRENT(KDPDQ,1,IRETOU) IF(IRETOU.EQ.0)THEN RETURN ENDIF CALL LIRREE(BETA,1,IRETOU) IF(IRETOU.EQ.0)THEN RETURN ENDIF ENDIF IF(IP.EQ.3)THEN CALL LIRENT(KPIMP,1,IRETOU) IF(IRETOU.EQ.0)THEN RETURN ENDIF CALL LIRREE(PIMP,1,IRETOU) IF(IRETOU.EQ.0) THEN RETURN ENDIF C CALL LIRENT(NIMP,1,IRETOU) C IF(IRETOU.EQ.0)RETURN IF(KPIMP.NE.0.AND.KPIMP.NE.1)THEN C Tentative d'utilisation d'une option non implémentée CALL ERREUR (251) RETURN ENDIF ENDIF GO TO 1 2 CONTINUE C *********************************************************************** C C ON PREPARE LE CALCUL DE LA PRESSION SUIVANT LE TYPE C C D'INVERSION (KTYPI) C C *********************************************************************** CALL LEKTAB(MTABP,'MATC',MATRIK) IF(MATRIK.EQ.0)GO TO 90 CALL ACME(MTABP,'KTYPI',KTYPI) C write(6,*)' Kres : KTYPI=',KTYPI C C------------------------------------------------------------------------ C IF(KTYPI.EQ.1.OR.KTYPI.EQ.5)THEN C C METHODE DIRECTE C CALL KMDMT(MTABP,MCHB,MCHB,IMPR,BETA,KDPDQ,KPIMP,PIMP,NIMP) C C------------------------------------------------------------------------ C ELSEIF(KTYPI.GT.1.AND.KTYPI.LT.5)THEN CALL KRESS(MTABP,MCHB,MCHB,IMPR,BETA,KDPDQ,KPIMP,PIMP,NIMP) C C------------------------------------------------------------------------ C ELSEIF(KTYPI.EQ.6)THEN C C NEDELEC 28 1 91 METHODE ITERATIVE CHEBYSHEV C CALL PROGC(MTABP) CALL CAPR(MTABP) C C---------------------------------------------------------------------- C ELSEIF(KTYPI.EQ.7)THEN C C NEDELEC 11 4 91 GRADIENT CONJUGUE PRECON PAR DIAG C CALL KRESF(MTABP,MCHB,MCHB,IMPR) C C--------------------------------------------------------------------- C ELSE WRITE(6,*)' KRES : OPTION NON PREVUE KTYPI=',KTYPI C Tentative d'utilisation d'une option non implémentée CALL ERREUR (251) RETURN ENDIF RETURN 1001 FORMAT(20(1X,I5)) 1002 FORMAT(10(1X,1PE11.4)) 90 CONTINUE C Les options de calcul sont erronées. CALL ERREUR(717) RETURN END