Télécharger la plaquette Cast3M


fr en

Télécharger topadv.eso

Retour à la liste

Numérotation des lignes : 

topadv

  1. C TOPADV    SOURCE    GOUNAND   21/04/06    21:15:27     10940          
  2.       SUBROUTINE TOPADV(TRAVJ,NVDONN,iopt,lchang,mmot)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : TOPADV
  7. C DESCRIPTION : Ajustement (SEGADJ) du nombre d'éléments d'un
  8. C     segment TRAVJ et de ses éventuels sous-objets.
  9. C
  10. C     iopt=0 : on impose NVMAX à la valeur NVDONN donnée
  11. C              on ne modifie pas NVCOU      
  12. C     iopt=1 : on calcule un NVMAX automatiquement, éventuellement
  13. C     supérieur à la valeur NVDONN donnée et on modifie NVCOU qui
  14. C     devient égal à NVDONN
  15. C
  16. C LANGAGE     : ESOPE
  17. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
  18. C               mél : gounand@semt2.smts.cea.fr
  19. C***********************************************************************
  20. C APPELES          : 
  21. C APPELES (E/S)    : 
  22. C APPELES (BLAS)   :
  23. C APPELES (CALCUL) :
  24. C APPELE PAR       :
  25. C***********************************************************************
  26. C SYNTAXE GIBIANE    :
  27. C ENTREES            :
  28. C ENTREES/SORTIES    :
  29. C SORTIES            :
  30. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  31. C***********************************************************************
  32. C VERSION    : v1, 11/10/2017, version initiale
  33. C HISTORIQUE : v1, 11/10/2017, création
  34. C HISTORIQUE :
  35. C HISTORIQUE :
  36. C***********************************************************************
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC SMLENTI
  40.       POINTEUR JNBL.MLENTI
  41. -INC SMELEME
  42.       POINTEUR JTOPO.MELEME
  43. -INC TMATOP2
  44. -INC TMATOP1
  45. *-INC STOPINV
  46. *-INC STRAVJ
  47.       logical lchang
  48.       character*(*) mmot
  49.       INTEGER IMPR,IRET
  50. *     
  51. * Executable statements
  52. *
  53.       if (impr.ge.5) WRITE(IOIMP,*) 'Entrée dans topadv.eso'
  54. *
  55.       lchang=.false.
  56.       NVMAXO=TRAVJ.NVMAX
  57.       NVCOUO=TRAVJ.NVCOU
  58.       if (iopt.eq.0) then
  59.          NVCOUN=NVCOUO
  60.          NVMAXN=NVDONN
  61.          if (nvmaxn.eq.nvmaxo) then
  62. *     write(ioimp,*) 'pas besoin d''appeler topadv ???'
  63. *     goto 9999
  64.             return
  65.          endif
  66.       elseif (iopt.eq.1) then
  67.          NVCOUN=NVDONN
  68.          IF (NVCOUN.LE.NVMAXO) THEN
  69. *     write(ioimp,*) 'pas besoin d''appeler topadv ???'
  70. *     goto 9999
  71.             TRAVJ.NVCOU=NVCOUN
  72.             return
  73.          ELSE
  74. *            NVMAXN=NVDONN+0
  75. *     Stratégie d'augmentation
  76.             NVMAX1=NVDONN
  77. *            XCOF=1.414D0
  78.             XCOF=2.D0
  79.             NVMAX2=TRAVJ.NVINI+INT(((NVMAXO-TRAVJ.NVINI)*XCOF)+0.5D0)
  80.             NVMAXN=MAX(NVMAX1,NVMAX2)
  81.          ENDIF
  82.       endif
  83.  
  84.       IF (NVCOUN.LT.NVCOUO.or.NVMAXN.LT.NVCOUO) THEN
  85.          write(ioimp,*) 'On ne peut pas redimensionner à une ',
  86.      $        'valeur plus petite que nvcou' 
  87.          goto 9999
  88.       endif
  89.  
  90.       lchang=.true.
  91.       TRAVJ.NVMAX=NVMAXN
  92.       if (isgadj.gt.0)
  93. *     $     write(ioimp,286) TRAVJ,NVMAXO,NVMAXN,NVCOUN
  94.      $     write(ioimp,286) mmot,NVMAXO,NVMAXN,NVCOUN
  95. *     
  96.       JTOPO=TRAVJ.TOPO
  97.       if (jtopo.ne.0) then
  98.          NBNN=JTOPO.NUM(/1)
  99.          NBELEM=NVMAXN
  100.          NBSOUS=0
  101.          NBREF=0
  102.          segadj jtopo
  103.       endif
  104. *     
  105.       TOPINV=TRAVJ.TOPI
  106.       if (topinv.ne.0) then
  107.          IDIMP=IDIM+1
  108.          NBELEM=NVMAXN
  109.          NBPTS=TIC(/1)
  110.          SEGADJ TOPINV
  111.       endif
  112. *     
  113.       jnbl=travj.nbl
  114.       if (jnbl.ne.0) then
  115.          jg=nvmaxn
  116.          segadj jnbl
  117.       endif
  118.       TRAVJ.NVCOU=NVCOUN
  119. *
  120. * Normal termination
  121. *
  122.       RETURN
  123. *
  124. * Format handling
  125. *
  126. * 286  FORMAT ('Segment TRAV=',I8,' nbel max ajusté de ',I6,' à ',I6,
  127. *     $     ' (nbel. courant=',I6,')') 
  128.  286  FORMAT (A25,' nbel max ajusté de ',I6,' à ',I6,
  129.      $     ' (nbel. courant=',I6,')') 
  130. * 187  FORMAT (5X,10I8)
  131. * 188  FORMAT ('Apres point IELEM(',I2,',1)=',I6,' ; NBL=')
  132. * 189  FORMAT ('Le noeud ',I2,'/',I2,' de IELEM de numero',I6
  133. *     $     ,' a le plus petit nb de voisins :',I3)
  134. *     
  135. * Error handling     
  136. *     
  137.  9999 CONTINUE
  138.       MOTERR(1:8)='TOPADV  '
  139. * 349 2
  140. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  141.       CALL ERREUR(349)
  142.       RETURN
  143. *
  144. * End of subroutine TOPADV
  145. *
  146.       END
  147.  
  148.  
  149.  

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