Sources Esope | Cast3M

prchl1
C PRCHL1    SOURCE    CB215821  24/04/12    21:16:53     11897          
C
C-----------------------------------------------------------------------
C Sous-programme de l'operateur PRESSION :
C
C    IPCHE2 = PRES IPMOD1 IPCHE1 ;
C
C   En entree :
C   -----------
C     IPMOD1 : MMODEL de formulation CHARGEMENT PRESSION
C     IPCHE1 : MCHAML passe par l'utilisateur, reduit sur IPMOD1
C
C   En sortie :
C   -----------
C     IPCHE2 : contient le MCHAML de pression resultat / 0 si echec
C              desactive en sortie
C    
C-----------------------------------------------------------------------
      SUBROUTINE PRCHL1(IPMOD10,IPCHE10,IPCHE2)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
      CHARACTER*11 TITCHE
      CHARACTER*4  MOCONT
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMMODEL
C
      IPMOD1 = IPMOD10
      IPCHE1 = IPCHE10
      IPCHE2 = 0 
C
C Verif du support / Changement si besoin
      ICOND = 0
      CALL QUESUP(IPMOD1,IPCHE1,0,ICOND,ISUP,IRET2)
      IF (IERR.NE.0) RETURN
C
C Changement de support si besoin
      IF (IRET2.EQ.9999) THEN
         CALL ERREUR(560)
         RETURN
      ELSEIF (ISUP.NE.5) THEN
         CALL CHASUP(IPMOD1,IPCHE1,IPCHEL,IRET,5)
         IF (IERR.NE.0) RETURN
         IPCHE1=IPCHEL
      ENDIF
c     write (6,*) ' Apres QUESUP, ISUP, IRET2=',ISUP,IRET2
C
C On active le MMODEL
      MMODEL=IPMOD1
      SEGACT, MMODEL
      NSZ = MMODEL.KMODEL(/1)
C
C Initialisation de IPCHE2 (MCHEL2)
      MCHEL1=IPCHE1
      SEGACT,MCHEL1
      SEGINI,MCHEL2=MCHEL1
      N1 = MCHEL1.ICHAML(/1)
      N3 = MCHEL1.INFCHE(/2)
      L1 = 11
      SEGADJ,MCHEL2
      MCHEL2.TITCHE='CONTRAINTES'
      MCHEL2.IFOCHE=IFOUR
C
C Verif nb sous-zones MCHAML &lt; MMODEL
      IF (N1.GT.NSZ) THEN
         CALL ERREUR(553)
         GOTO 999
      ENDIF
C
C Boucles sur les sous-zones :
      DO I=1,N1
         MCHAM1=MCHEL1.ICHAML(I)
         SEGACT,MCHAM1
C On verifie le type de la composante
         IF (MCHAM1.TYPCHE(1).NE.'REAL*8') THEN
            CALL ERREUR(671)
            GOTO 999
         ENDIF
C Tests sur composantes
         NCPCH=MCHAM1.NOMCHE(/2)
         IMODEL=MMODEL.KMODEL(I)
         SEGACT,IMODEL
C Noms des composantes de contrainte
         NOMID=IMODEL.LNOMID(4)
         SEGACT,NOMID
         NCPMO=NOMID.LESOBL(/2)
C Le MCHAML doit avoir le meme nbr de composante que le MMODEL
         IF (NCPCH.NE.NCPMO) THEN
            MOTERR(1:8)='MCHAML  '
            CALL ERREUR(980)
            GOTO 999
         ENDIF
C S'il y a plusieurs composantes de contrainte, le MCHAML fourni
C doit avoir les memes noms de composante que le MMODEL
         IF (NCPMO.NE.1) THEN
            DO J=1,NCPMO
               IF (MCHAM1.NOMCHE(J).NE.NOMID.LESOBL(J)) THEN
                  MOTERR(1:4)=NOMID.LESOBL(J)
                  MOTERR(5:30)=' par element en argument  '
                  CALL ERREUR(77)
                  GOTO 999
               ENDIF
            ENDDO
         ELSE
C Initialisation de MCHAM2 pour changer le nom des composantes
            SEGINI,MCHAM2=MCHAM1
            MCHEL2.ICHAML(I)=MCHAM2
            MCHAM2.NOMCHE(1)=NOMID.LESOBL(1)
            SEGDES,MCHAM2
         ENDIF
         SEGDES,NOMID
C Mise a jour du tableabu INFCHE
         MCHEL2.INFCHE(I,1)=0
         MCHEL2.INFCHE(I,2)=0
         MCHEL2.INFCHE(I,3)=NIFOUR
         MCHEL2.INFCHE(I,4)=IMODEL.INFMOD(7)
         MCHEL2.INFCHE(I,5)=0
         MCHEL2.INFCHE(I,6)=5
      ENDDO
C
      IPCHE2=MCHEL2
C
 999  SEGDES,MCHEL2
C
      RETURN
      END