Télécharger topv4.eso

Retour à la liste

topv4
C TOPV4     SOURCE    GOUNAND   25/11/24    21:15:22     12406          
      SUBROUTINE TOPV4(TRAVL,IALGO,XVMIN,XVTOL,NKPVIR,impr)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : TOPV4
C DESCRIPTION :  Amélioration d'une topologie autour d'un élément : sélection des
C      candidats de volume minimum mais non nul
C
C
C
C               IJOB=0
C               Minimise le volume d'une topologie de maillage
C               en le maintenant supérieur à 0
C               IJOB=1
C               Minimise le volume, mais on a le droit d'ajouter des
C               noeuds internes
C               IJOB=2
C               La topologie de maillage est supposée être un maillage
C               On essaie de l'améliorer en conservant son volume
C               mais en augmentant sa qualité grace a l'adjonction
C               de noeuds internes
C
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C VERSION    : v1, 05/02/2013, version initiale
C HISTORIQUE : v1, 05/05/2013, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC TMATOP1
      POINTEUR LMCANS.MELEMX
-INC SMLENTI
      POINTEUR LIDXCA.MLENTI
      POINTEUR LOKVOL.MLENTI
-INC SMLREEL
-INC SMCOORD
      POINTEUR KCOORD.MCOORD
*
      INTEGER JCAND
      LOGICAL LCHANG
      LOGICAL LCHTOP
*
* Executable statements
*
*      WRITE(IOIMP,*) 'entree topv4'
*
      LMCANS=TRAVL.MCANS
      LIDXCA=TRAVL.IDXCA
      LOKVOL=TRAVL.OKVOL
*
      TRAVL.NVOCOU=0
      JCAND=TRAVL.NCCOU
      DO ICAND=1,JCAND
*         IMCAND=ITCAND(ICAND)
*Erreur pour calculer le volume, il ne faut pas utiliser la métrique !
*
         IELDEB=LIDXCA.LECT(ICAND)
         IELFIN=LIDXCA.LECT(ICAND+1)-1
         CALL VOMSI3(LMCANS,IELDEB,IELFIN,NKPVIR,XVCAND,XVCANS,XVCANV)
         IF (IERR.NE.0) RETURN
 
         if (impr.ge.4) then
            WRITE(IOIMP,*) '  ICAND=',ICAND,' XVCAND=',XVCAND,' XVCANS='
     $           ,XVCANS,' XVCANV=',XVCANV
* àfaire            CALL ECMAI1(imcand,0)
         endif
 
         IF (IALGO.EQ.0) THEN
            IF (XVCAND.GT.XVTOL.AND.XVCAND.LE.XVMIN+XVTOL) THEN
               IF (ABS(XVMIN-XVCAND).LE.XVTOL) THEN
*
                  NVOCOU=NVOCOU+1
                  LOKVOL.LECT(NVOCOU)=ICAND
               ELSE
                  XVMIN=XVCAND
*
                  NVOCOU=1
                  LOKVOL.LECT(NVOCOU)=ICAND
               ENDIF
            ENDIF
         ELSEIF (IALGO.EQ.1) THEN
* On ne retient pas les candidats qui ont des elements qui se replient
*            if (XVCAND.NE.XVCANS) THEN
            if (ABS(XVCAND-XVCANS).GE.XVTOL) THEN
               if(impr.ge.4) then
                  WRITE(IOIMP,*) '  ICAND=',ICAND,' XVCAND=',XVCAND,'
     $                 XVCANS=',XVCANS
                  write(ioimp,*) '    Candidat non selectionne : ',
     $                 'il y a repliement.'
               endif
            elseif (ABS(XVCANV).GE.XVTOL) then
               if(impr.ge.4) then
                  WRITE(IOIMP,*) '  ICAND=',ICAND,' XVCANV=',XVCANV,'
     $                 XVTOL=',XVTOL
                  write(ioimp,*) '    Candidat non selectionne : ',
     $                 'un noeud virtuel nest plus coplanaire.'
               endif
            else
               IF (ABS(XVMIN-XVCAND).LE.XVTOL) THEN
                  NVOCOU=NVOCOU+1
                  LOKVOL.LECT(NVOCOU)=ICAND
               ELSE
               if(impr.ge.4) then
                  WRITE(IOIMP,*) '  ICAND=',ICAND,' XVCAND=',XVCAND,'
     $                 XVMIN=',XVMIN
                  write(ioimp,*) '    Candidat non selectionne : ',
     $                 'pas le bon volume.'
               endif
 
               ENDIF
            endif
         ELSE
            WRITE(IOIMP,*) 'IALGO=',IALGO,' unknown'
            GOTO 9999
         ENDIF
      ENDDO
      if (impr.ge.4) then
         write(ioimp,*) 'Apres selection vol ncandidat=',nvocou
         Write(ioimp,*) (lokvol.lect(iii),iii=1,nvocou)
      endif
*      write(ioimp,*) 'Sortie topv4'
      RETURN
 9999 CONTINUE
      MOTERR(1:8)='TOPV4   '
* 349 2
*Problème non prévu dans le s.p. %m1:8 contactez votre assistance
      CALL ERREUR(349)
      RETURN
*
* End of subroutine TOPV4
*
      END
 
 

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