Sources Esope | Cast3M

fptuya
C FPTUYA    SOURCE    OF166741  24/10/03    21:15:18     12022          
      SUBROUTINE FPTUYA(IPMODL,IPCHE1,IPTFP,IRET)
C____________________________________________________________________
C
C   CALCULE LES FORCES DE PRESSIONS APPLIQUEES SUR DES TUYAUX
C    ( EFFET DE FOND ) APPELE PAR PRESSI
C
C
C   ENTREES :
C   ---------
C
C       IPCHE1   POINTEUR SUR UN MCHAML DE CARACTERISTIQUES
C       IPMODL   POINTEUR SUR UN MMODEL
C
C  SORTIES
C
C
C       IPTFP    CHPOINT DES FORCES NODALES EQUIVALENTES
C       IRET     1 OU 0 SI SUCCES OU NON
C
C     M. PETIT NOVEMBRE 89
C     PASSAGE AUX NOUVEAU CHAMELEM PAR JM CAMPENON LE 04 09 90
C
C_____________________________________________________________________
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
 
-INC SMCOORD
-INC SMELEME
-INC SMMODEL
-INC SMCHAML
-INC SMINTE
 
      SEGMENT NOTYPE
        CHARACTER*16 TYPE(NBTYPE)
      ENDSEGMENT
 
      SEGMENT MPTVAL
        INTEGER IPOS(NS)    ,NSOF(NS)
        INTEGER      IVAL(NCOSOU)
        CHARACTER*16 TYVAL(NCOSOU)
      ENDSEGMENT
 
      CHARACTER*(NCONCH) CONM
      PARAMETER ( NINF=3 )
      INTEGER INFOS(NINF)
 
      IRET = 0
      IPTFP = 0
 
      NHRM = NIFOUR
C
C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
C
      CALL QUESUP(IPMODL,IPCHE1,3,0,ISUP,IRETCA)
      IF (ISUP.GT.1) RETURN
C
C     ACTIVATION DU MODELE
C
      MMODEL = IPMODL
      SEGACT,MMODEL
      NSOUS = mmodel.KMODEL(/1)
C
C     CREATION D UN MCHELM INTERMEDIAIRE
C
      N1=NSOUS
      L1=5
      N3=6
      SEGINI,MCHELM
      mchelm.TITCHE='FORCE'
      mchelm.IFOCHE=IFOUR
C
C  SEGMENTS DE TRAVAIL :
C  CARACTERISTIQUES POUR LES TUYAUX
      NBROBL = 3
      NBRFAC = 4
      SEGINI NOMID
      LESOBL(1)='EPAI'
      LESOBL(2)='RAYO'
      LESOBL(3)='PRES'
      LESFAC(1)='RACO'
      LESFAC(2)='VX'
      LESFAC(3)='VY'
      LESFAC(4)='VZ'
      MOCARA=NOMID
 
      NCARA = NBROBL
      NCARF = NBRFAC
      NCARR = NCARA+NCARF
 
      NBTYPE=1
      SEGINI NOTYPE
      TYPE(1)='REAL*8'
      MOTYR8 = NOTYPE
 
C   DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
      ISCH = 0
 
      DO 10 ISOUS = 1, NSOUS
 
        ISOK = 0
        IVACAR = 0
        IVAFOR = 0
C
C     TRAITEMENT DU MODELE
C
        IMODEL = mmodel.KMODEL(ISOUS)
        SEGACT,IMODEL
C
C     ON RECUPERE L INFORMATION GENERALE
C
        IPMAIL = imodel.IMAMOD
        CONM   = imodel.CONMOD
        MELE   = imodel.NEFMOD
C
C     ACTIVATION DU MELEME
C
        MELEME = IPMAIL
        SEGACT,MELEME
        NBNN   = meleme.NUM(/1)
        NBELEM = meleme.NUM(/2)
C
C     INFORMATION SUR L'ELEMENT FINI
C
        MFR = imodel.INFELE(13)
        IF (MFR.NE.13) GOTO 10
C
C     ON A BIEN DES ELEMENTS TUYA
C
        IPMINT = imodel.INFMOD(2+3)
 
        IPPORE=0
        IF (MFR.EQ.33) IPPORE=NBNN
C
C     CREATION DU TABLEAU INFOS
C
        CALL IDENT(IPMAIL,CONM,IPCHE1,0,INFOS,IRTD)
        IF (IRTD.EQ.0) GOTO 101
C
C     TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
C
        CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYR8,1,INFOS,3,IVACAR)
        IF (IERR.NE.0) GOTO 101
C
        IF (ISUP.EQ.1) THEN
          MINTE = IPMINT
          SEGACT,MINTE
          CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
          IF (IERR.NE.0) THEN
            ISUP = 0
            GOTO 101
          ENDIF
        ENDIF
C
C     RECHERCHE DES NOMS DE COMPOSANTES
C
        nomid = imodel.LNOMID(2)
        if (nomid.eq.0) then
          write(ioimp,*) 'FPTUYA : MOFORC = 0 = lnomid(2) !'
          call erreur(5)
        endif
        MOFORC = nomid
        nfor = lesobl(/2)
        nfac = 0
C
C     CREATION DU MCHAML DE LA SOUS ZONE
C
        N2 = NFOR
        SEGINI,MCHAML
C
C     TAILLE DES MELVAL A ALLOUER
C
        N1PTEL = 2
        N1EL   = NBELEM
        N2PTEL = 0
        N2EL   = 0
 
        NS = 1
        NCOSOU = NFOR
        SEGINI,MPTVAL
        IVAFOR = MPTVAL
        NOMID = MOFORC
        DO ICOMP = 1, NFOR
          mchaml.NOMCHE(ICOMP) = LESOBL(ICOMP)
          mchaml.TYPCHE(ICOMP) = 'REAL*8  '
          SEGINI MELVAL
          mchaml.IELVAL(ICOMP) = MELVAL
          mptval.IVAL(ICOMP)   = MELVAL
        ENDDO
C
C     CALCUL DES FORCES DE PRESSION
C
        CALL FPELTU(0,IVACAR,IPMAIL,ISOUS,IVAFOR)
        IF (IERR.NE.0) GOTO 100
 
        ISOK = 1
 
        ISCH = ISCH + 1 
 
        IMACHE(ISCH) = IPMAIL
        CONCHE(ISCH) = CONM
 
        INFCHE(ISCH,1) = 0
        INFCHE(ISCH,2) = 0
        INFCHE(ISCH,3) = NHRM
        INFCHE(ISCH,4) = MINTE
        INFCHE(ISCH,5) = 0
        INFCHE(ISCH,6) = 3
 
        ICHAML(ISCH) = MCHAML
 
 100    continue
        CALL DTMVAL(IVAFOR,1)
        IF (ISUP.EQ.1) THEN
          CALL DTMVAL(IVACAR,3)
        ELSE
          CALL DTMVAL(IVACAR,1)
        ENDIF
 101    continue
C Sortie de la boucle en cas d'erreur
        IF (ISOK.EQ.0) THEN
          SEGSUP,MCHELM
          GOTO 900
        ENDIF
 
 10   CONTINUE
 
      IF (ISCH.NE.NSOUS) THEN
        N1 = ISCH
c*        L1=5
c*        N3=6
        SEGADJ,MCHELM
      ENDIF
 
      IRET = 1
      ICHAM = MCHELM
      CALL CHAMPO(ICHAM,0,IPTFP,IRET)
      CALL DTCHAM(ICHAM)
 
C FIN DU TRAITEMENT
 900  CONTINUE
      NOMID = MOCARA
      SEGSUP,NOMID
      notype = MOTYR8
      SEGSUP,notype
 
      RETURN
      END