Sources Esope | Cast3M

topadv
C TOPADV    SOURCE    GOUNAND   25/11/24    21:15:17     12406          
      SUBROUTINE TOPADV(TRAVJ,NVDONN,iopt,lchang,mmot)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : TOPADV
C DESCRIPTION : Ajustement (SEGADJ) du nombre d'éléments d'un
C     segment TRAVJ et de ses éventuels sous-objets.
C
C     iopt=0 : on impose NVMAX à la valeur NVDONN donnée
C              on ne modifie pas NVCOU
C     iopt=1 : on calcule un NVMAX automatiquement, éventuellement
C     supérieur à la valeur NVDONN donnée et on modifie NVCOU qui
C     devient égal à NVDONN
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          :
C APPELES (E/S)    :
C APPELES (BLAS)   :
C APPELES (CALCUL) :
C APPELE PAR       :
C***********************************************************************
C SYNTAXE GIBIANE    :
C ENTREES            :
C ENTREES/SORTIES    :
C SORTIES            :
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 11/10/2017, version initiale
C HISTORIQUE : v1, 11/10/2017, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
-INC PPARAM
-INC CCOPTIO
-INC SMLENTI
      POINTEUR JNBL.MLENTI
-INC SMELEME
      POINTEUR JTOPO.MELEME
-INC TMATOP2
-INC TMATOP1
*-INC STOPINV
*-INC STRAVJ
      logical lchang
      character*(*) mmot
      INTEGER IMPR,IRET
*
* Executable statements
*
      if (impr.ge.5) WRITE(IOIMP,*) 'Entrée dans topadv.eso'
*
      lchang=.false.
      NVMAXO=TRAVJ.NVMAX
      NVCOUO=TRAVJ.NVCOU
      if (iopt.eq.0) then
         NVCOUN=NVCOUO
         NVMAXN=NVDONN
         if (nvmaxn.eq.nvmaxo) then
*     write(ioimp,*) 'pas besoin d''appeler topadv ???'
*     goto 9999
            return
         endif
      elseif (iopt.eq.1) then
         NVCOUN=NVDONN
         IF (NVCOUN.LE.NVMAXO) THEN
*     write(ioimp,*) 'pas besoin d''appeler topadv ???'
*     goto 9999
            TRAVJ.NVCOU=NVCOUN
            return
         ELSE
*            NVMAXN=NVDONN+0
*     Stratégie d'augmentation
            NVMAX1=NVDONN
*            XCOF=1.414D0
            XCOF=2.D0
            NVMAX2=TRAVJ.NVINI+INT(((NVMAXO-TRAVJ.NVINI)*XCOF)+0.5D0)
            NVMAXN=MAX(NVMAX1,NVMAX2)
         ENDIF
      endif
 
      IF (NVCOUN.LT.NVCOUO.or.NVMAXN.LT.NVCOUO) THEN
         write(ioimp,*) 'On ne peut pas redimensionner a une ',
     $        'valeur plus petite que nvcou'
         goto 9999
      endif
 
      lchang=.true.
      TRAVJ.NVMAX=NVMAXN
      if (isgadj.gt.0)
     $     write(ioimp,286) mmot,NVMAXO,NVMAXN,NVCOUN
*
      JTOPO=TRAVJ.TOPO
      if (jtopo.ne.0) then
         NBNN=JTOPO.NUM(/1)
         NBELEM=NVMAXN
         NBSOUS=0
         NBREF=0
         segadj jtopo
      endif
*
      TOPINV=TRAVJ.TOPI
      if (topinv.ne.0) then
         IDIMP=IDIM+1
         NBELEM=NVMAXN
         NBPTS=TIC(/1)
         SEGADJ TOPINV
      endif
*
      jnbl=travj.nbl
      if (jnbl.ne.0) then
         jg=nvmaxn
         segadj jnbl
      endif
      TRAVJ.NVCOU=NVCOUN
*
* Normal termination
*
      RETURN
*
* Format handling
*
 286  FORMAT ('In topadv: ',A25,' nbel max ajuste de ',I6,' a ',I6,
     $     ' (nbel. courant=',I6,')')
*
* Error handling
*
 9999 CONTINUE
      MOTERR(1:8)='TOPADV  '
* 349 2
*Problème non prévu dans le s.p. %m1:8 contactez votre assistance
      CALL ERREUR(349)
      RETURN
*
* End of subroutine TOPADV
*
      END