Télécharger pendi2.eso

Retour à la liste

pendi2
C PENDI2    SOURCE    CB215821  20/11/25    13:35:33     10792          
      SUBROUTINE PENDI2(IDOMA)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PENDI2
C
C DESCRIPTION       :  Appelle par PENT
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI
C
C************************************************************************
C
C
C************************************************************************
C
C PHRASE D'APPEL (GIBIANE) :
C
C
C RCHPO1  RCHELEM1 = 'PENT'
C         MCLE1 MCLE2 MCLE3 TABDO LMOT1 LMOT2 CHPO1 CHPO2 CHPO3 ;
C
C ou
C
C RCHPO1  = 'PENT'
C        MCLE1 MCLE2 MCLE3 TABDO LMOT1 LMOT2 CHPO1 CHPO2 CHPO3
C        MCLE5 RCHELEM1 ;
C
C
C Entrées:
C
C  TABDO   :  Donnée de la table domaine;
C
C  MCLE1   :  type du champ par point CHPO1. Pour le moment, seul le
C             type 'FACE' est autorisé;
C
C  MCLE2   :  'DIAMANT'
C
C  MCLE3   :  Calcul ou non du limiteur : 'NOLIMITE'
C
C  LMOT1   :  Nom de composantes du champoint duquel on veut calculer
C             le gradient
C
C  LMOT2   :  Nom de composantes du gradients
C
C  CHPO1   :  CHAMPOINT centre du quel on veut calculer le gradient
C
C  CHPO2   :  Conditions aux limites de type Dirichlet
C
C  CHPO3   :  Conditions aux limites de type von Neumann (dans le repaire
C             global)
C
C  MCLE4   :  Donnée ou non du RCHELEM1:
C             'GRADGEO' si donnée, vide sinon.
C
C
C E/S    :
C
C RCHELEM1: Champ par élément des coefficients géométriques pour le
C           calcul du gradient (et du hessien)
C           (entrée si MCLE4 = 'GRADGEO', sinon sortie).
C
C
C Sorties:
C
C RCHPO1 :  Champ par point contenant le gradient de CHPO1 (toujours
C           calculé) ;
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE : Creé le 2/3/2001
C
C************************************************************************
C
C
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMLMOTS
C
      INTEGER IDOMA, IRET1, ICEN, IFAC, IFACEL, IFACEP, ISOMM, INORM
     &     ,ICHPO, ICHPL1, ICHPL2, LMOT, LMOTGR
     &     ,ISGLI1, ISGLI2, ICHGRA,  ICOEFF
     &     ,NSOUPO, IMAIL, JGN, JGM
C
      CHARACTER*(8)  MOT
      LOGICAL LOGCOE
C
      MOT='        '
C
C**** Lecture du MELEME SPG des points CENTRE.
C
      CALL LEKTAB(IDOMA,'CENTRE',ICEN)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du MELEME SPG des points FACE.
C
      CALL LEKTAB(IDOMA,'FACE',IFAC)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du MELEME SPG des points SOMMET
C
      CALL LEKTAB(IDOMA,'SOMMET',ISOMM)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du MELEME de connect. FACEL
C
      CALL LEKTAB(IDOMA,'FACEL',IFACEL)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du MELEME de connect. FACEP
C
      CALL LEKTAB(IDOMA,'FACEP',IFACEP)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du MELEME MAILLAGE
C
      CALL LEKTAB(IDOMA,'MAILLAGE',IMAIL)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture des normales aux faces
C
      CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
      IF(IERR .NE. 0) GOTO 9999
      JGN=4
      JGM=IDIM
      SEGINI MLMOTS
      MLMOTS.MOTS(1)='UX'
      MLMOTS.MOTS(2)='UY'
      IF(IDIM .EQ. 3) MLMOTS.MOTS(3)='UZ'
      CALL QUEPO1 (INORM, IFAC, MLMOTS)
      IF(IERR .NE. 0)GOTO 9999
      SEGSUP MLMOTS
C
C**** Lecture du CHPOINT dont on veut calculer le gradient!
C
      CALL LIROBJ('CHPOINT ',ICHPO,1,IRET1)
      CALL ACTOBJ('CHPOINT ',ICHPO,1)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du CHPOINT des conditions limites de type Dirichlet
C
      CALL LIROBJ('CHPOINT ',ICHPL1,1,IRET1)
      CALL ACTOBJ('CHPOINT ',ICHPL1,1)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du CHPOINT des conditions limites de type von Neumann
C
      CALL LIROBJ('CHPOINT ',ICHPL2,1,IRET1)
      CALL ACTOBJ('CHPOINT ',ICHPL2,1)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture des noms des composantes du CHPOINT
C
      CALL LIROBJ('LISTMOTS',LMOT,1,IRET1)
      CALL ACTOBJ('LISTMOTS',LMOT,1)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture des noms des composantes du gradients
C
      CALL LIROBJ('LISTMOTS',LMOTGR,1,IRET1)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Compatibilité entre les liste de composantes
C
      MLMOT1=LMOT
      MLMOT2=LMOTGR
      SEGACT MLMOT1
      SEGACT MLMOT2
      IF(MLMOT2.MOTS(/2) .NE. (IDIM*MLMOT1.MOTS(/2)))THEN
         write(*,*) 'Composantes = ???'
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
C
C**** Control de ICHPO
C
      MLMOTS=LMOT
      CALL QUEPO1(ICHPO, ICEN, LMOT)
      IF (IERR .NE. 0) GOTO 9999
C
C**** Control de ICHPL1
C
      MCHPOI = ICHPL1
      SEGACT MCHPOI
      NSOUPO = MCHPOI.IPCHP(/1)
      IF(NSOUPO .EQ. 0) THEN
         ICHPL1=0
         ISGLI1=0
      ELSE
         MSOUPO=MCHPOI.IPCHP(1)
         SEGACT MSOUPO
         ISGLI1=MSOUPO.IGEOC
         SEGDES MSOUPO
         CALL QUEPO1(ICHPL1, 0, LMOT)
         IF (IERR .NE. 0) GOTO 9999
      ENDIF
C
C**** Control de ICHPL2
C
      MCHPOI = ICHPL2
      SEGACT MCHPOI
      NSOUPO = MCHPOI.IPCHP(/1)
      IF(NSOUPO .EQ. 0) THEN
         ICHPL2=0
         ISGLI2=0
      ELSE
         MSOUPO=MCHPOI.IPCHP(1)
         SEGACT MSOUPO
         ISGLI2=MSOUPO.IGEOC
         SEGDES MSOUPO
         CALL QUEPO1(ICHPL2, 0, LMOTGR)
         IF (IERR .NE. 0) GOTO 9999
      ENDIF
C
C**** Lecture du MCHAMLs qui contiennent les elements de matrice
C     pour le calcul du gradient
C
C     Si MOT = 'GRADGEO', on a ces MCHAMLs; sinon il faut le calculer
C
      CALL LIRCHA(MOT,0,IRET1)
      IF(IERR .NE. 0) GOTO 9999
      IF(IRET1 .EQ. 0)THEN
         LOGCOE = .TRUE.
      ELSEIF(MOT .NE. 'GRADGEO')THEN
         CALL REFUS()
         LOGCOE=.TRUE.
      ELSE
         LOGCOE=.FALSE.
         CALL LIROBJ('MCHAML  ',ICOEFF,1,IRET1)
         CALL ACTOBJ('MCHAML  ',ICOEFF,1)
         IF(IERR .NE. 0) GOTO 9999
      ENDIF
      IF(LOGCOE)THEN
         CALL GRADI2(ICEN,ISOMM,IFACEL,IFACEP,ISGLI1,ISGLI2,INORM,
     &        ICOEFF)
         IF (IERR .NE. 0) GOTO 9999
      ENDIF
C
C**** Calcul de gradient
C
      CALL PENDI3(LMOTGR,IFAC,ICHPO,ICHPL1,ICHPL2,INORM,ICOEFF,ICHGRA)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Ecriture de gradient, (hessian), (limiteur),
C     (MCHAMLs pour le calcul de gradient et/ou du hessian)
C
      IF(MOT .NE. 'GRADGEO') THEN
         CALL ACTOBJ('MCHAML  ',ICOEFF,1)
         CALL ECROBJ('MCHAML  ',ICOEFF)
         IF(IERR .NE. 0) GOTO 9999
      ENDIF
      CALL ACTOBJ('CHPOINT ',ICHGRA,1)
      CALL ECROBJ('CHPOINT ',ICHGRA)
      IF(IERR .NE. 0) GOTO 9999
C
      SEGDES MLMOTS
C
C**** Sortie du programme
C
 9999 CONTINUE
      END
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales