Esope source files

   1 : C RYO2V     SOURCE    GOUNAND   11/10/07    21:16:14     7149           
   2 :       SUBROUTINE RYO2V(IRT)
   3 : C*************************************************************************
   4 : C
   5 : C
   6 : C
   7 : C
   8 : C
   9 : C*************************************************************************
  10 : 
  11 :       IMPLICIT INTEGER(I-N)
  12 :       IMPLICIT REAL*8 (A-H,O-Z)
  13 : 
  14 : -INC CCOPTIO
  15 : -INC SMTABLE
  16 : -INC SMLMOTS
  17 : -INC SMELEME                                                                    
  18 :       POINTEUR MELEMC.MELEME
  19 : -INC SMCOORD
  20 : 
  21 : -INC SMMATRIK
  22 :       POINTEUR MAT1.MATRIK,MAT2.MATRIK,MAT3.MATRIK
  23 : -INC SMCHPOI
  24 : C      POINTEUR IZV1.MCHPOI,IZVV1.MPOVAL
  25 : C      POINTEUR IZV2.MCHPOI,IZVV2.MPOVAL
  26 : 
  27 :       DIMENSION XVEC(3)
  28 :       CHARACTER*8 TYPE,TYPC,TYPE1,TYPE2
  29 :       PARAMETER (NBOP=12)
  30 :       CHARACTER*4 MOT4
  31 :       CHARACTER*8 LOPER(NBOP),MTYP,NOMI
  32 :       DATA LOPER/'CMCT    ','RIMA    ','NINCDUPR','NINCPRDU',
  33 :      $     'EXTRNINC',
  34 :      $     'EXTRINCO','POINTEUR','EXTRDIAG','SPAIDIAG','RELA    ',
  35 :      $     'CONDENSE','EVAPORE '/
  36 : C***
  37 : C     ********************************************
  38 : C     * La premiere partie de cette routine      *
  39 : C     * consiste a recuperer les arguments de    *
  40 : C     * l operateur KOPS afin de pouvoir leurs   *
  41 : C     * attribuer le traitement correspondant    *
  42 : C     ********************************************
  43 : 
  44 : C     On saisit le premier objet de la pile
  45 : C     *************************************
  46 : 
  46 :       CALL QUETYP(MTYP,0,IRET)
  47 :       IF(IRET.EQ.0)THEN
  48 :       IRT=1
  49 :       RETURN
  50 :       ENDIF
  51 : C     write(6,*)' KOPS nag=',nag,' MTYP=',MTYP
  52 : 
  53 : C     ============================================
  54 : C     Cas : Objet = MOT
  55 : C     ============================================
  56 :       IRT=0
  57 :       IF(MTYP.NE.'MOT')THEN
  58 :       IRT=1
  59 :       RETURN
  60 :       ELSE
  60 :          CALL LIRMOT(LOPER,NBOP,KOP,1)
  61 : C     write(6,*)' KOPS ', LOPER(KOP)
  62 : C         write(6,*) 'Avant KOPS ', LOPER(KOP)
  63 :          IF(KOP.EQ.0)THEN
  64 :          IRT=1
  65 :          RETURN
  66 :          ENDIF
  67 :       ENDIF
  68 : 
  69 : C Cas tres tres particulier(s)
  70 : 
  71 : C CAS KOP=1
  72 :       IF(KOP.EQ.1 )THEN
  72 :          CALL PRCMCT
  73 : C         write(6,*) 'Apres KOPS ', LOPER(KOP)
  74 :          RETURN
  75 :       ENDIF
  76 : C CAS KOP=2
  77 :       IF(KOP.EQ.2 )THEN
  77 :          CALL RIMA
  78 : C         write(6,*) 'Apres KOPS ', LOPER(KOP)
  79 :          RETURN
  80 :       ENDIF
  81 :       IF(KOP.EQ.3)THEN
  81 :          CALL MACHI2(1)
  82 : C         write(6,*) 'Apres KOPS ', LOPER(KOP)
  83 :          RETURN
  84 :       ENDIF
  85 :       IF(KOP.EQ.4)THEN
  85 :          CALL MACHI2(2)
  86 : C         write(6,*) 'Apres KOPS ', LOPER(KOP)
  87 :          RETURN
  88 :       ENDIF
  89 : * Mot clé non disponible, voir l'opérateur EXTR 'COMP'
  90 :       IF(KOP.EQ.5)THEN
  90 :          CALL EXTIPD
  91 : C         write(6,*) 'Apres KOPS ', LOPER(KOP)
  92 :          RETURN
  93 :       ENDIF
  94 :       IF(KOP.EQ.6)THEN
  94 :          CALL EXINCO
  95 : C         write(6,*) 'Apres KOPS ', LOPER(KOP)
  96 :          RETURN
  97 :       ENDIF
  98 :       IF(KOP.EQ.7)THEN
  99 :          MTYP='        '
  99 :          CALL LIROBJ(MTYP,IRET,1,IRETOU)
 100 :          IF (IERR.NE.0) RETURN
 100 :          CALL ECRENT(IRET)
 101 : C         write(6,*) 'Apres KOPS ', LOPER(KOP)
 102 :          RETURN
 103 :       ENDIF
 104 :       IF(KOP.EQ.8)THEN
 104 :          CALL EXDIAG(1)
 105 : C         write(6,*) 'Apres KOPS ', LOPER(KOP)
 106 :          RETURN
 107 :       ENDIF
 108 :       IF(KOP.EQ.9)THEN
 108 :          CALL EXDIAG(2)
 109 : C         write(6,*) 'Apres KOPS ', LOPER(KOP)
 110 :          RETURN
 111 :       ENDIF
 112 :       IF(KOP.EQ.10)THEN
 112 :          CALL RELRIG
 113 : C         write(6,*) 'Apres KOPS ', LOPER(KOP)
 114 :          RETURN
 115 :       ENDIF
 116 : *
 117 : * Condense les relations
 118 : *
 119 :       IF(KOP.EQ.11)THEN
 119 :          CALL LIROBJ('RIGIDITE',MRIGID,1,IRET)
 120 :          IF (IERR.NE.0) RETURN
 120 :          CALL LIROBJ('CHPOINT ',KSMBR,1,IRET)
 121 :          IF (IERR.NE.0) RETURN
 121 :          CALL KRES6(MRIGID,KSMBR,.FALSE.,
 122 :      $        MRIGIC,KSMBRC,KSMBR1)
 122 :          CALL ECROBJ('CHPOINT',KSMBR1)
 122 :          CALL ECROBJ('CHPOINT',KSMBRC)
 122 :          CALL ECROBJ('RIGIDITE',MRIGIC)
 123 :          RETURN
 124 :       ENDIF
 125 : *
 126 : * Evapore : opération inverse de la condensation
 127 : *
 128 :       IF(KOP.EQ.12)THEN
 128 :          CALL LIROBJ('CHPOINT ',MSOLC,1,IRET)
 129 :          IF (IERR.NE.0) RETURN
 129 :          CALL LIROBJ('RIGIDITE',MRIGID,1,IRET)
 130 :          IF (IERR.NE.0) RETURN
 130 :          CALL LIROBJ('CHPOINT ',KSMBR,1,IRET)
 131 :          IF (IERR.NE.0) RETURN
 131 :          CALL LIROBJ('CHPOINT ',KSMBR1,1,IRET)
 132 :          IF (IERR.NE.0) RETURN
 132 :          CALL KRES7(MSOLC,MRIGID,KSMBR,KSMBR1,0,
 133 :      $        MCHSOL)
 134 :          IF (IERR.NE.0) RETURN
 134 :          CALL ECROBJ('CHPOINT ',MCHSOL)
 135 :          RETURN
 136 :       ENDIF
 137 :       RETURN
 138 :       END
 139 :  
 140 :  
 141 :  
 142 :  
 143 :  
 144 :  
 145 :  
 146 :  
 147 :  
 148 :  
 149 :  
 150 :  
 151 :  
 152 :