Sources Esope | Cast3M

selmod
C SELMOD    SOURCE    OF166741  24/10/21    21:15:23     12042          
 
C Operateur CONVEC :
C ==================
C Selectionne dans un modele (quelconque) les sous-modeles de 
C formulation 'THERMIQUE' concernes par la CONVECTION forcee/externe
 
      SUBROUTINE SELMOD (ipmodt, ipmodc)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCPRECO
 
-INC SMMODEL
-INC SMELEME
 
C Elem. RACCORD : RAC2 RAC3 LIA3 LIA4 LIA6 LIA8 SEG2
C Cas Particulier : en 1D, SEG2 = element RACCORD (OF)
C ---------------
      PARAMETER ( NBRAC=7 )
      INTEGER IRAC(NBRAC)
      DATA IRAC /  12 , 13 , 18 , 19 , 20 , 21 ,  2  /
 
      CHARACTER*(16) mofort,mofcnv,mofray
 
      IPMODC = 0
 
      mmodel = IPMODT 
c*      segact mmodel &lt;- Actif en E/S
 
      iimpi0 = IIMPI
c*dbg      iimpi0 = 1972
 
C- Recherche si le modele IPMODT n'a pas deja ete traite :
C- Verification si presence dans le preconditionnement CCPRECO
      ith   = oothrd
      ith1  = ith + 1
 
      CALL OOOHO1(mmodel,ihorot)
      ITAILL = NBMOCV(ith1)
      DO is = 1, ITAILL
        IF ( PMOCVE(is,ith1) .EQ. mmodel .AND.
     &       PMOCVH(is,ith1) .EQ. ihorot ) THEN
          mmode1 = PMOCVS(is,ith1)
          if (iimpi0.eq.1972) then
            write(ioimp,*) 'Preconditionnement SELMOD trouve',
     &                     ipmodt,mmode1,is
          endif
C       Mise a jour du preconditionnement dans CCPRECO : Deplacement en position 1
          IF (is .GT. 1) THEN
            DO js = is, 2, -1
              PMOCVE(js,ith1) = PMOCVE(js - 1,ith1)
              PMOCVH(js,ith1) = PMOCVH(js - 1,ith1)
              PMOCVS(js,ith1) = PMOCVS(js - 1,ith1)
            ENDDO
            PMOCVE(1,ith1) = mmodel
            PMOCVH(1,ith1) = ihorot
            PMOCVS(1,ith1) = mmode1
          ENDIF
          GOTO 100
        ENDIF
      ENDDO
 
C- Construction du MODELE recherche
      mofort = 'THERMIQUE       '
C (1) SELECTION dans le MODELE de la partie 'CONVECTION'
      mofcnv = 'CONVECTION      '
C (2) OUBLI des elements RACCORDs (s'ils existent) de la partie CONVECTION
C     Petit traitement pour le cas 1D : on simule l'element raccord 1D via
C     un element fini SEG2 (cela evite de creer un nouvel element fini)
      IF (IDIM.EQ.1) THEN
        KRACC = 7
        NRACC = 1
      ELSE
        KRACC = 1
        NRACC = 6
      ENDIF
C (3) SELECTION dans le MODELE de la partie 'RAYONNEMENT'
      mofray = 'RAYONNEMENT     '
C (4) IPMODC = FUSION des parties 'CONVECTION' sans RACCORD et 'RAYONNEMENT'
 
      SEGINI,mmode1=mmodel
      nsou = mmode1.kmodel(/1)
 
      N1 = 0
      DO is = 1, nsou
        imodel = mmode1.kmodel(is)
c*        segact imodel
        DO js = 1, imodel.formod(/2)
          inok = 1
          IF (imodel.formod(js).EQ.mofort) THEN
            DO k = 1, imodel.matmod(/2)
              IF      (imodel.matmod(k).EQ.mofcnv) THEN
                CALL PLACE2(IRAC(KRACC),NRACC,inok,imodel.NEFMOD)
              ELSE IF (imodel.matmod(k).EQ.mofray) THEN
                inok = 0
              ENDIF
            ENDDO
          ENDIF
          IF (inok.EQ.0) THEN
            N1 = N1 + 1
            mmode1.kmodel(N1) = imodel
          ENDIF
        ENDDO
      ENDDO
 
      IF (N1.NE.nsou) then
        SEGADJ,mmode1
      else
        if (iimpi0.eq.1972) write(ioimp,*) 'SELMOD : IPMODT=IPMODC !'
        segsup,mmode1
        mmode1=mmodel
      endif
 
C  Mise a jour du preconditionnement dans CCPRECO
      ITAILL       = MIN(ITAILL + 1, NPMCNV)
      NBMOCV(ith1) = ITAILL
      DO is = ITAILL, 2, -1
        PMOCVE(is,ith1) = PMOCVE(is - 1,ith1)
        PMOCVH(is,ith1) = PMOCVH(is - 1,ith1)
        PMOCVS(is,ith1) = PMOCVS(is - 1,ith1)
      ENDDO
      PMOCVE(1,ith1) = mmodel
      PMOCVH(1,ith1) = ihorot
      PMOCVS(1,ith1) = mmode1
      if (iimpi0.eq.1972) then
        write(ioimp,*) 'Preconditionnement SELMOD realise',ipmodt,mmode1
      endif
 
 100  CONTINUE
      IPMODC = mmode1
      IF (IPMODC.NE.IPMODT) CALL ACTOBJ('MMODEL  ',IPMODC,1)
 
c      return
      END