Sources Esope | Cast3M

typchl
C TYPCHL    SOURCE    CB215821  24/04/12    21:17:24     11897          
 
C-----------------------------------------------------------------------
*  Identification du type d'un MCHAML a partir de ses noms de composante
*
*  En entree : 
*     ipche1 = MCHAML a typer
*     ipmod1 = MMODEL associe
*
*  ipche1 et ipmod1 sont tous deux actifs en entree et sortie
*
*  En sortie :
*     TYPE   = chaine de caractere, type du MCHAML
*     LTYP   = longueur de TYPE
*
C-----------------------------------------------------------------------
 
      SUBROUTINE TYPCHL(ipche1,ipmod1,type,ltyp)
 
      IMPLICIT REAL*8(A-H,O-Z)
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
 
-INC SMCHAML
-INC SMMODEL
 
 
      CHARACTER*(50)      type,typ1
      CHARACTER*(LOCOMP)  mocp,mot
      LOGICAL             BZONES
 
      type   = ' '
      ltyp   = 1
 
      mmodel = ipmod1
      mchelm = ipche1
 
* Si le MCHAML est vide, on renvoie le type par defaut
      nsche=mchelm.ichaml(/1)
      IF (nsche.eq.0) GOTO 9000
 
* Si le MCHAML a plus de sous-zones que le modele,
* il doit avoir le meme nombre de sous-zones geometriques 
* mais des points supports differents
* Si le MCHAML a moins de zous-zone que le modele,
* on doit chercher les nom des composantes des sous modele qui ont
* meme zone geometrique qu un sous zone du MCHAML
 
      NSMOD = mmodel.kmodel(/1)
      BZONES= .false.
      if (nsche.NE.NSMOD) then
        BZONES= .true.
      endif
 
* -----------------------------------
*     On parcourt les sous-zones du MCHAML
*     Celles du MMODEL sont appareillees
* -----------------------------------
 
* On met ltyp a -1 pour distinguer du type par defaut
      ltyp = -1
 
* Boucle sur les sous-zones du chamel
      DO is = 1, nsche
        mchaml = mchelm.ichaml(is)
        if (BZONES) then
           ipt1=mchelm.imache(is)
           do izz=1,NSMOD
              imodel = mmodel.kmodel(izz)
              ipt2 = imodel.imamod
              if (ipt2.eq.ipt1) goto 10
           ENDDO
        else
           imodel = mmodel.kmodel(is)
        endif
 10     continue
 
* Boucle sur les composantes du chamel
        ncp =mchaml.NOMCHE(/2)
        DO icp=1,ncp
           mocp=mchaml.NOMCHE(icp)
 
* ITYP indique si un type a deja ete trouve
           ITYP=0
*
* 
C---------------------------
C Cas des modeles de modele (melange) 
C
* Si modele de MELANGE, il faut regarder le NOMID des sous-modeles
* et les noms de phase :
           IF (IMODEL.FORMOD(1)(1:8).EQ.'MELANGE ') THEN
C             NSMD = imodel.IVAMOD(/1)
C             DO ISM=1,NSMD
C
C     write(6,*) 'Dans typchl, IMODEL.TYMODE = ',IMODEL.TYMODE(ISM)
C                IF (IMODEL.TYMODE(ISM).NE.'IMODEL') THEN
C                   write(iimpi,*) ' *** Dans typchl.eso' 
C                   CALL ERREUR(26)
C                   RETURN
C                ENDIF
C
C                IMODE1=IMODEL.IVAMOD(ISM)
C     write(6,*) 'Dans typchl, IMODE1 = ',IMODE1
C                SEGINI,IMODE1
C
C On regarde d'abord les noms de phase :
C                MOT = IMODE1.CONMOD(17:24)
C     write(6,*) 'Dans typchl, IMODE1.CONMOD = ',MOT(1:8)
C                IF (MOT(1:4).EQ.MOCP(1:4)) THEN
C                   IF (LTYP.EQ.-1) THEN
C                      ITYP=1
C                      TYPE='CARACTERISTIQUES'
C                      LTYP=LONG(TYPE)
C                   ELSE
C                      IF (TYPE(1:LTYP).NE.'CARACTERISTIQUES') THEN
C                         LTYP=1
C                         TYPE=' ' 
C                         GOTO 9000
C                      ENDIF
C                   ENDIF
C                ENDIF
C
C On regarde ensuite les nomid : Appel a TYCOMP
C                IPMOD = IMODE1
C                CALL TYCOMP(IPMOD,MOCP,TYP1,LTYP1)
C                IF (IERR.NE.0) RETURN
C
C                IF (LTYP1.NE.0) THEN
C                   ITYP = 1
C                   IF (LTYP.EQ.-1) THEN
C                      LTYP=LTYP1
C                      TYPE=TYP1(1:LTYP1)
C                   ELSE
C                      IF (TYP1(1:LTYP1).NE.TYPE(1:LTYP)) THEN
C                         LTYP=1
C                         TYPE=' ' 
C                         GOTO 9000
C                      ENDIF
C                   ENDIF
C                ENDIF
C                SEGDES,IMODE1
C             ENDDO
C
C Si le type de la 1ere composante pas identifiee dans les sous-modeles
C du modele de melange, on sort : 
C             IF (ITYP.EQ.0) THEN
C                LTYP=1
C                TYPE=' '
C                GOTO 9000
C             ENDIF
C
C Finalement, si modele MELANGE, on ne fait rien !!
C On signale le cas en mettant l'indicateur ltyp a -2
              ITYP =  1
              LTYP = -2
C
C Fin des modeles de modeles (melange)
C---------------------------
C
           ELSE
C
C---------------------------
C Cas de modeles "simples" 
C
C Recherche dans les noms de composantes du modele
C
              IPMOD = IMODEL
              CALL TYCOMP(IPMOD,MOCP,TYP1,LTYP1)
              IF (IERR.NE.0) RETURN
C             write(6,*) ' Dans typchl : TYP1,LTYP1',TYP1,LTYP1
C
              IF (LTYP1.NE.0) THEN
                 ITYP = 1
                 IF (LTYP.EQ.-1) THEN
                    LTYP=LTYP1
                    TYPE=TYP1(1:LTYP1)
                 ELSEIF (LTYP.GT.0) THEN
                    IF (TYP1(1:LTYP1).NE.TYPE(1:LTYP)) THEN
                       LTYP=1
                       TYPE=' ' 
                       GOTO 9000
                    ENDIF
                 ENDIF
              ENDIF
           ENDIF
C
C Fin des modeles "simples"
C---------------------------
C
C Pas de type identifie pour cette composante :
           IF (ITYP.EQ.0) THEN
              LTYP=1
              TYPE=' '
              GOTO 9000
           ENDIF
 
C Fin boucle sur les composantes
        ENDDO
C
C Fin boucle sur les sous-zones
      ENDDO
C
 9000 CONTINUE
 
      IF (LTYP.EQ.-1) LTYP=1
 
      RETURN
      END