Télécharger la plaquette Cast3M


fr en

Télécharger kres.eso

Retour à la liste

Numérotation des lignes : 

kres

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales