Sources Esope | Cast3M

chalvs
C CHALVS    SOURCE    CB215821  26/03/10    21:15:07     12487          
 
C=======================================================================
C=                            C H A L V S                              =
C=                            -----------                              =
C=                                                                     =
C=  Fonction :                                                         =
C=  ----------                                                         =
C=                                                                     =
C=  Parametres :  (E)=Entree  (S)=Sortie                               =
C=  ------------                                                       =
C=   IPMODE   (E)   Pointeur sur le segment MMODEL de la structure     =
C=   IFORMU   (E)   Formulation associee au MMODEL de la structure     =
C=   ITYPEF   (E)   Type(Famille) des EF du MMODEL de la structure     =
C=   IPCHPO   (E)   Pointeur sur le CHPOINT de sources (puits) aux     =
C=                  noeuds de la structure (champ variable)            =
C=   S1       (E)   Valeur de la source (FLOTTANT = champ constant)    =
C=   IPGEOM   (E)   Pointeur sur le MAILLAGE sur lequel s'applique S1  =
C=   IPCHEL   (E)   Pointeur sur le segment MCHAML de sources donnees  =
C=                  en chaque element de la structure (champ variable) =
C=   IPCHSO   (S)   Pointeur sur le champ de sources volumiques        =
C=   ISUPSO   (S)   Support du champ de sources volumiques             =
C=======================================================================
 
      SUBROUTINE CHALVS (IPMODE,IFORMU,ITYPEF, IPCHPO,S1,IPGEOM,IPCHEL,
     &                   IPCHSO,ISUPSO)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
 
c* -INC SMMODEL
c* -INC SMCHPOI
 
      IPCHSO = 0
      ISUPSO = 0
 
C 1 - Sources sous forme d'un MCHAML
C     Determination du support :
C =======================================================
      IF (IPCHEL.NE.0) THEN
        IPCHSO = IPCHEL
        CALL QUESUP(IPMODE,IPCHSO,0,0,iok,ISUPSO)
        IF (IERR.NE.0 .OR. iok.EQ.9999) THEN
          IPCHSO = 0
          CALL ERREUR(21)
          RETURN
        ENDIF
        ISUP_Z = ISUPSO
        IPCH_Z = IPCHSO
 
C       En massif, on passe aux points d'integration (MASSE ou GAUSS 
C       selon la formulation) si le champ est aux noeuds ou au gravite
C       Si le champ a un autre support que NOEUD ou GRAVITE, on ne change
C       pas le support a MASSE pour l'instant.
        IF (ITYPEF.EQ.1) THEN
          IF (ISUPSO.EQ.1 .OR. ISUPSO.EQ.2) THEN
C*          Rappel : diffusion = thermique (en attendant retour a "mecanique")
            IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2 .OR. IFORMU.EQ.3) THEN
              ISUPSO = 6
            ELSE
c*            Avant on mettait au support RIGIDITE : ISUPSO = 3
c*            Maintenant on met au support MASSE   : ISUPSO = 4
              ISUPSO = 4
            ENDIF
          ENDIF
 
        ELSE
          ISUPSO = 6
        ENDIF
 
        IF (ISUP_Z.NE.ISUPSO) THEN
          CALL CHASUP(IPMODE,IPCH_Z,IPCHSO,iok,ISUPSO)
          IF (IERR.NE.0 .OR. iok.NE.0) THEN
            IPCHSO = 0
            CALL ERREUR(21)
            RETURN
          ENDIF
        ENDIF
      ELSE
 
C 2 - Sources constantes (FLOTTANT) sur un MAILLAGE
C     Sources mises sous forme d'un CHPOINT puis
C     Transfert du CHPOINT en MCHAML au support adhoc
C =======================================================
C Les composantes sont fonction de la formulation !
        IF (IPGEOM.NE.0) THEN
          IF (ITYPEF.EQ.2) THEN
            CALL ECRREE(S1)
            CALL ECRCHA('QSUP')
            CALL ECRREE(S1)
            CALL ECRCHA('QVOL')
            CALL ECRREE(S1)
            CALL ECRCHA('QINF')
            CALL ECRENT(3)
C*        ELSE IF (ITYPEF.EQ.1 .OR. ITYPEF.EQ.3) THEN
          ELSE
            CALL ECRREE(S1)
            CALL ECRCHA('QVOL')
            CALL ECRENT(1)
          ENDIF
          CALL ECROBJ('MAILLAGE',IPGEOM)
          CALL MANUCH
          IF (IERR.NE.0) RETURN
          CALL LIROBJ('CHPOINT',IPCH_Z,1,iok)
          IF (IERR.NE.0) RETURN
          IPCHPO = IPCH_Z
 
C 3 - Sources sous forme d'un CHPOINT
C     Transfert du CHPOINT en MCHAML au support adhoc
C =======================================================
        ELSE
          IPCH_Z = 0
        ENDIF
 
C       Changement en MCHAML au support adapte du modele (commun a 2 et 3) :
C*      En fait on devrait directement creer le MCHAML sans passer par le CHPOINT...
        IF (ITYPEF.EQ.1) THEN
C*        Rappel : diffusion = thermique (en attendant retour a "mecanique")
          IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2 .OR. IFORMU.EQ.3) THEN
            ISUPSO = 6
          ELSE
c*          On met au support MASSE : ISUPSO = 4 (integration plus "precise")
C*          Avant on prenait RIGIDITE : ISUPSO = 3
            ISUPSO = 4
          ENDIF
        ELSE
          ISUPSO = 6
        ENDIF
        CALL CHAME1(0,IPMODE,IPCHPO,'VOLUMIQUE',IPCHSO,ISUPSO)
        IF (IERR.NE.0) RETURN
        if (ipch_z.ne.0) call dtchpo(ipch_z)
 
      ENDIF
 
      RETURN
      END