Esope source files

   1 : C PRCMCT    SOURCE    GOUNAND   11/05/25    21:15:27     6980           
   2 :       SUBROUTINE PRCMCT()
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C***********************************************************************
   6 : C NOM         : PRCMCT
   7 : C DESCRIPTION : Préparation du calcul de CD-1Bt, on effectue les boucles
   8 : C               sur les matrices élémentaires.  
   9 : C     
  10 : C LANGAGE     : ESOPE
  11 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  12 : C               mél : gounand@semt2.smts.cea.fr
  13 : C***********************************************************************
  14 : C APPELES          : PROMAT
  15 : C APPELES (E/S)    : LIROBJ, ECROBJ
  16 : C APPELES (STAT)   : INMSTA, PRMSTA, SUMSTA
  17 : C APPELE PAR       : RYO2V
  18 : C***********************************************************************
  19 : C SYNTAXE GIBIANE    : MATCDB = 'KOPS' 'CMCT' MATC MATB CHPOD
  20 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  21 : C***********************************************************************
  22 : C VERSION    : v1, 28/01/2000, version initiale réécrite
  23 : C HISTORIQUE : v1, 28/01/2000, création
  24 : C HISTORIQUE :
  25 : C HISTORIQUE :
  26 : C***********************************************************************
  27 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  28 : C en cas de modification de ce sous-programme afin de faciliter
  29 : C la maintenance !
  30 : C***********************************************************************
  31 : -INC CCOPTIO
  32 : *     
  33 :       INTEGER IMPR,IRET
  34 :       CHARACTER*8 MONTYP
  35 : *
  36 : * Executable statements
  37 : *     
  38 :       IMPR=IIMPI
  39 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prcmct'
  40 : *     
  41 : * Lecture des arguments
  42 : *     
  42 :       CALL QUETYP(MONTYP,0    ,IRETOU)                                          
  43 :       IF (IRETOU.EQ.0) THEN                                                     
  43 :          CALL ERREUR(533)                                                       
  44 :          RETURN                                                                 
  45 :       ENDIF       
  46 : * Deux matrices : C et B
  47 : *
  48 : * Avec des MATRIK
  49 : *
  50 :       IF (MONTYP.EQ.'MATRIK  ') THEN
  50 :          CALL LIROBJ('MATRIK  ',MATC,1,IRETOU)
  51 :          IF (IERR.NE.0) RETURN
  51 :          CALL LIROBJ('MATRIK  ',MATB,1,IRET)
  52 :          IF (IERR.NE.0) RETURN
  53 : * Le chpoint matrice-masse diagonale D
  53 :          CALL LIROBJ('CHPOINT ',ICHP,0,IRET)
  54 :          IF (IRET.EQ.0) THEN
  55 :             ICHP=0
  56 :          ENDIF
  57 : *
  57 :          CALL PRCMCK(MATC,MATB,ICHP,MATCDB,IMPR,IRET)
  58 :          IF (IRET.NE.0) GOTO 9999
  59 : *     
  59 :          CALL ECROBJ('MATRIK  ',MATCDB)
  60 : *
  61 : * Avec des RIGIDITE
  62 : *
  63 :       ELSEIF (MONTYP.EQ.'RIGIDITE') THEN
  63 :          CALL LIROBJ('RIGIDITE',IRIGC,1,IRET)
  64 :          IF (IERR.NE.0) RETURN
  64 :          CALL LIROBJ('RIGIDITE',IRIGB,1,IRET)
  65 :          IF (IERR.NE.0) RETURN
  66 : * Le chpoint matrice-masse diagonale D
  66 :          CALL LIROBJ('CHPOINT ',ICHP,0,IRET)
  67 :          IF (IRET.EQ.0) THEN
  68 :             ICHP=0
  69 :          ENDIF
  69 :          CALL CMCT3(ICHP,IRIGC,IRIGB,IRIG2)
  70 :          IF (IERR.NE.0) RETURN
  71 : *
  71 :          CALL ECROBJ('RIGIDITE',IRIG2)
  72 :       ELSE
  73 :          MOTERR(1:8)=MONTYP
  73 :          CALL ERREUR(39)
  74 :       ENDIF
  75 : *     
  76 : * Normal termination
  77 : *     
  78 : *      IRET=0
  79 :       RETURN
  80 : *     
  81 : * Format handling
  82 : *     
  83 : *     
  84 : * Error handling
  85 : *     
  86 :  9999 CONTINUE
  87 : *     IRET=1
  88 :       WRITE(IOIMP,*) 'An error was detected in subroutine prcmct'
  88 :       CALL ERREUR(5)
  89 :       RETURN
  90 : *     
  91 : * End of subroutine PRCMCT
  92 : *     
  93 :       END
  94 : 
  95 :  
  96 :  
  97 :  
  98 :