Sources Esope | Cast3M

topv4
C TOPV4     SOURCE    GOUNAND   26/06/09    21:15:20     12566          
      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 10 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.5) then
            WRITE(IOIMP,'(2(A,1X,I5),3(3X,A,1X,E10.3))')
     $           'topv4 : candidat',ICAND,'nelem=',ielfin-ieldeb+1
     $           ,'xvcand=',XVCAND,'xvcans=',XVCANS,'xvcanv=',XVCANV
* àfaire            CALL ECMAI1(imcand,0)
         endif
 128     format (A,1X,I3,1X,2A,3(1X,A,1X,E10.3))
         IF (IALGO.EQ.0) THEN
            IF (NKPVIR.GT.0) THEN
               IF (ABS(XVCANV).GE.XVTOL) THEN
                  if(impr.ge.5) then
                     write(ioimp,128)
     $                    'topv4 : candidat',icand,'non selectionne, '
     $                    ,'un noeud virtuel n''est plus coplanaire :'
     $                    ,'xvcanv=',XVCANV
                  endif
                  goto 10
               ENDIF
            ENDIF
*
            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(XVMIN-XVCAND).GE.XVTOL) THEN
               if(impr.ge.5) then
                  write(ioimp,128)
     $                 'topv4 : candidat',icand,'non selectionne, '
     $                 ,'pas le bon volume :'
     $                 ,'xvcand=',XVCAND
               endif
            elseif (ABS(XVCANV).GE.XVTOL) then
               if(impr.ge.5) then
                  write(ioimp,128)
     $                 'topv4 : candidat',icand,'non selectionne, '
     $                 ,'un noeud virtuel n''est plus coplanaire :'
     $                 ,'xvcanv=',XVCANV
               endif
            elseif (ABS(XVCAND-XVCANS).GE.XVTOL) THEN
               if(impr.ge.5) then
                  write(ioimp,128)
     $                 'topv4 : candidat',icand,'non selectionne, '
     $                 ,'il y a repliement :'
     $                 ,'xvcand=',XVCAND,'.ne.xvcans=',XVCANS
               endif
            else
               NVOCOU=NVOCOU+1
               LOKVOL.LECT(NVOCOU)=ICAND
            endif
         ELSE
            WRITE(IOIMP,*) 'IALGO=',IALGO,' unknown'
            GOTO 9999
         ENDIF
 10   CONTINUE
      if (impr.ge.4) then
         write(ioimp,'(A,1X,I5,1X,A,1000(I5,1X))')
     $        'topv4 : apres selection volume',nvocou,'candidats='
     $        ,(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