Esope source files

   1 : C PENDI2    SOURCE    BECC      05/01/20    21:15:14     5008           
   2 :       SUBROUTINE PENDI2(IDOMA)
   3 : C************************************************************************
   4 : C     
   5 : C PROJET            :  CASTEM 2000
   6 : C     
   7 : C NOM               :  PENDI2 
   8 : C     
   9 : C DESCRIPTION       :  Appelle par PENT
  10 : C     
  11 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  12 : C     
  13 : C AUTEUR            :  A. BECCANTINI
  14 : C     
  15 : C************************************************************************
  16 : C     
  17 : C     
  18 : C************************************************************************
  19 : C     
  20 : C PHRASE D'APPEL (GIBIANE) :
  21 : C     
  22 : C 
  23 : C RCHPO1  RCHELEM1 = 'PENT'
  24 : C         MCLE1 MCLE2 MCLE3 TABDO LMOT1 LMOT2 CHPO1 CHPO2 CHPO3 ;
  25 : C
  26 : C ou
  27 : C
  28 : C RCHPO1  = 'PENT'
  29 : C        MCLE1 MCLE2 MCLE3 TABDO LMOT1 LMOT2 CHPO1 CHPO2 CHPO3 
  30 : C        MCLE5 RCHELEM1 ;
  31 : C
  32 : C
  33 : C Entrées:
  34 : C
  35 : C  TABDO   :  Donnée de la table domaine;
  36 : C
  37 : C  MCLE1   :  type du champ par point CHPO1. Pour le moment, seul le 
  38 : C             type 'FACE' est autorisé;
  39 : C
  40 : C  MCLE2   :  'DIAMANT'
  41 : C
  42 : C  MCLE3   :  Calcul ou non du limiteur : 'NOLIMITE'
  43 : C
  44 : C  LMOT1   :  Nom de composantes du champoint duquel on veut calculer 
  45 : C             le gradient
  46 : C
  47 : C  LMOT2   :  Nom de composantes du gradients 
  48 : C
  49 : C  CHPO1   :  CHAMPOINT centre du quel on veut calculer le gradient
  50 : C
  51 : C  CHPO2   :  Conditions aux limites de type Dirichlet
  52 : C
  53 : C  CHPO3   :  Conditions aux limites de type von Neumann (dans le repaire 
  54 : C             global)
  55 : C
  56 : C  MCLE4   :  Donnée ou non du RCHELEM1:
  57 : C             'GRADGEO' si donnée, vide sinon.
  58 : C
  59 : C
  60 : C E/S    :
  61 : C
  62 : C RCHELEM1: Champ par élément des coefficients géométriques pour le
  63 : C           calcul du gradient (et du hessien)
  64 : C           (entrée si MCLE4 = 'GRADGEO', sinon sortie).
  65 : C
  66 : C
  67 : C Sorties:
  68 : C
  69 : C RCHPO1 :  Champ par point contenant le gradient de CHPO1 (toujours
  70 : C           calculé) ;
  71 : C
  72 : C************************************************************************
  73 : C     
  74 : C HISTORIQUE (Anomalies et modifications éventuelles)
  75 : C     
  76 : C HISTORIQUE : Creé le 2/3/2001
  77 : C     
  78 : C************************************************************************
  79 : C     
  80 : C     
  81 : C     
  82 :       IMPLICIT INTEGER(I-N)
  83 : -INC CCOPTIO
  84 : -INC SMCHPOI
  85 : -INC SMLMOTS
  86 : C     
  87 : C**** Variables de COOPTIO
  88 : C     
  89 :       INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  90 :      &     ,IOTER,   IOLEC,  IOIMP,   IOCAR,  IOACQ
  91 :      &     ,IOPER,   IOSGB,  IOGRA,   IOSAU,  IORES
  92 :      &     ,IECHO,   IIMPI,  IOSPI
  93 :      &     ,IDIM
  94 :      &     ,MCOORD      
  95 :      &     ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  96 :      &     ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  97 :      &     ,NORINC,NORVAL,NORIND,NORVAD
  98 :      &     ,NUCROU, IPSAUV, IFICLE, IPREFI, IREFOR, ISAFOR
  99 : C     
 100 :       INTEGER IDOMA, IRET1, ICEN, IFAC, IFACEL, IFACEP, ISOMM, INORM
 101 :      &     ,ICHPO, ICHPL1, ICHPL2, LMOT, LMOTGR
 102 :      &     ,ISGLI1, ISGLI2, ICHGRA,  ICOEFF
 103 :      &     ,NSOUPO, IMAIL, JGN, JGM
 104 : C
 105 :       CHARACTER*(8)  MOT
 106 :       LOGICAL LOGCOE
 107 : C
 108 :       MOT='        '
 109 : C
 110 : C**** Lecture du MELEME SPG des points CENTRE.
 111 : C     
 111 :       CALL LEKTAB(IDOMA,'CENTRE',ICEN)
 112 :       IF(IERR .NE. 0) GOTO 9999
 113 : C
 114 : C**** Lecture du MELEME SPG des points FACE.
 115 : C     
 115 :       CALL LEKTAB(IDOMA,'FACE',IFAC)
 116 :       IF(IERR .NE. 0) GOTO 9999
 117 : C
 118 : C**** Lecture du MELEME SPG des points SOMMET
 119 : C     
 119 :       CALL LEKTAB(IDOMA,'SOMMET',ISOMM)
 120 :       IF(IERR .NE. 0) GOTO 9999
 121 : C     
 122 : C**** Lecture du MELEME de connect. FACEL
 123 : C     
 123 :       CALL LEKTAB(IDOMA,'FACEL',IFACEL)
 124 :       IF(IERR .NE. 0) GOTO 9999
 125 : C     
 126 : C**** Lecture du MELEME de connect. FACEP
 127 : C     
 127 :       CALL LEKTAB(IDOMA,'FACEP',IFACEP)
 128 :       IF(IERR .NE. 0) GOTO 9999
 129 : C     
 130 : C**** Lecture du MELEME MAILLAGE
 131 : C     
 131 :       CALL LEKTAB(IDOMA,'MAILLAGE',IMAIL)
 132 :       IF(IERR .NE. 0) GOTO 9999
 133 : C     
 134 : C**** Lecture des normales aux faces
 135 : C     
 135 :       CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
 136 :       IF(IERR .NE. 0) GOTO 9999
 137 :       JGN=4
 138 :       JGM=IDIM
 139 :       SEGINI MLMOTS
 140 :       MLMOTS.MOTS(1)='UX'
 141 :       MLMOTS.MOTS(2)='UY'
 142 :       IF(IDIM .EQ. 3) MLMOTS.MOTS(3)='UZ'
 142 :       CALL QUEPO1 (INORM, IFAC, MLMOTS)
 143 :       IF(IERR .NE. 0)GOTO 9999
 144 :       SEGSUP MLMOTS
 145 : C
 146 : C**** Lecture du CHPOINT dont on veut calculer le gradient!
 147 : C
 147 :       CALL LIROBJ('CHPOINT ',ICHPO,1,IRET1)
 148 :       IF(IERR .NE. 0) GOTO 9999
 149 : C
 150 : C**** Lecture du CHPOINT des conditions limites de type Dirichlet
 151 : C
 151 :       CALL LIROBJ('CHPOINT ',ICHPL1,1,IRET1)
 152 :       IF(IERR .NE. 0) GOTO 9999
 153 : C
 154 : C**** Lecture du CHPOINT des conditions limites de type von Neumann
 155 : C
 155 :       CALL LIROBJ('CHPOINT ',ICHPL2,1,IRET1)
 156 :       IF(IERR .NE. 0) GOTO 9999
 157 : C
 158 : C**** Lecture des noms des composantes du CHPOINT
 159 : C
 159 :       CALL LIROBJ('LISTMOTS',LMOT,1,IRET1)
 160 :       IF(IERR .NE. 0) GOTO 9999
 161 : C
 162 : C**** Lecture des noms des composantes du gradients
 163 : C
 163 :       CALL LIROBJ('LISTMOTS',LMOTGR,1,IRET1)
 164 :       IF(IERR .NE. 0) GOTO 9999
 165 : C
 166 : C**** Compatibilité entre les liste de composantes
 167 : C
 168 :       MLMOT1=LMOT
 169 :       MLMOT2=LMOTGR
 170 :       SEGACT MLMOT1
 171 :       SEGACT MLMOT2
 172 :       IF(MLMOT2.MOTS(/2) .NE. (IDIM*MLMOT1.MOTS(/2)))THEN
 173 :          write(*,*) 'Composantes = ???'
 173 :          CALL ERREUR(21)
 174 :          GOTO 9999
 175 :       ENDIF
 176 : C     
 177 : C**** Control de ICHPO
 178 : C     
 179 :       MLMOTS=LMOT
 179 :       CALL QUEPO1(ICHPO, ICEN, LMOT)
 180 :       IF (IERR .NE. 0) GOTO 9999
 181 : C     
 182 : C**** Control de ICHPL1
 183 : C     
 184 :       MCHPOI = ICHPL1
 185 :       SEGACT MCHPOI
 186 :       NSOUPO = MCHPOI.IPCHP(/1)
 187 :       IF(NSOUPO .EQ. 0) THEN
 188 :          ICHPL1=0
 189 :          ISGLI1=0
 190 :       ELSE
 191 :          MSOUPO=MCHPOI.IPCHP(1)
 192 :          SEGACT MSOUPO
 193 :          ISGLI1=MSOUPO.IGEOC
 194 :          SEGDES MSOUPO
 194 :          CALL QUEPO1(ICHPL1, 0, LMOT)
 195 :          IF (IERR .NE. 0) GOTO 9999
 196 :       ENDIF
 197 : C     
 198 : C**** Control de ICHPL2
 199 : C     
 200 :       MCHPOI = ICHPL2
 201 :       SEGACT MCHPOI
 202 :       NSOUPO = MCHPOI.IPCHP(/1)
 203 :       IF(NSOUPO .EQ. 0) THEN
 204 :          ICHPL2=0
 205 :          ISGLI2=0
 206 :       ELSE
 207 :          MSOUPO=MCHPOI.IPCHP(1)
 208 :          SEGACT MSOUPO
 209 :          ISGLI2=MSOUPO.IGEOC
 210 :          SEGDES MSOUPO
 210 :          CALL QUEPO1(ICHPL2, 0, LMOTGR)
 211 :          IF (IERR .NE. 0) GOTO 9999
 212 :       ENDIF
 213 : C     
 214 : C**** Lecture du MCHAMLs qui contiennent les elements de matrice
 215 : C     pour le calcul du gradient
 216 : C     
 217 : C     Si MOT = 'GRADGEO', on a ces MCHAMLs; sinon il faut le calculer
 218 : C     
 218 :       CALL LIRCHA(MOT,0,IRET1)
 219 :       IF(IERR .NE. 0) GOTO 9999
 220 :       IF(IRET1 .EQ. 0)THEN
 221 :          LOGCOE = .TRUE.
 222 :       ELSEIF(MOT .NE. 'GRADGEO')THEN
 222 :          CALL REFUS()
 223 :          LOGCOE=.TRUE.
 224 :       ELSE
 225 :          LOGCOE=.FALSE.
 225 :          CALL LIROBJ('MCHAML  ',ICOEFF,1,IRET1)
 226 :          IF(IERR .NE. 0) GOTO 9999
 227 :       ENDIF
 228 :       IF(LOGCOE)THEN
 228 :          CALL GRADI2(ICEN,ISOMM,IFACEL,IFACEP,ISGLI1,ISGLI2,INORM,
 229 :      &        ICOEFF)
 230 :          IF (IERR .NE. 0) GOTO 9999
 231 :       ENDIF
 232 : C
 233 : C**** Calcul de gradient
 234 : C     
 234 :       CALL PENDI3(LMOTGR,IFAC,ICHPO,ICHPL1,ICHPL2,INORM,ICOEFF,ICHGRA)
 235 :       IF(IERR .NE. 0) GOTO 9999
 236 : C     
 237 : C**** Ecriture de gradient, (hessian), (limiteur),
 238 : C     (MCHAMLs pour le calcul de gradient et/ou du hessian)
 239 : C     
 240 :       IF(MOT .NE. 'GRADGEO') THEN
 240 :          CALL ECROBJ('MCHAML',ICOEFF)
 241 :          IF(IERR .NE. 0) GOTO 9999
 242 :       ENDIF
 242 :       CALL ECROBJ('CHPOINT',ICHGRA)
 243 :       IF(IERR .NE. 0) GOTO 9999
 244 : C
 245 :       SEGDES MLMOTS
 246 : C     
 247 : C**** Sortie du programme
 248 : C     
 249 :  9999 CONTINUE
 250 : C     
 251 :       RETURN
 252 :       END
 253 :  
 254 :  
 255 :  
 256 :  
 257 :  
 258 :