Télécharger la plaquette Cast3M


fr en

Télécharger topadp.eso

Retour à la liste

Numérotation des lignes : 

topadp

  1. C TOPADP    SOURCE    GOUNAND   21/04/06    21:15:26     10940          
  2.       SUBROUTINE TOPADP(TRAVJ,NPDONN,iopt,lchang,mmot)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : TOPADP
  7. C DESCRIPTION : Ajustement (SEGADJ) du nombre de noeuds d'un
  8. C     segment TRAVJ et de ses éventuels sous-objets.
  9. C
  10. C     iopt=0 : on impose NPMAX à la valeur NPDONN donnée
  11. C              on ne modifie pas NPCOU      
  12. C     iopt=1 : on calcule un NPMAX automatiquement, éventuellement
  13. C     supérieur à la valeur NPDONN donnée et on modifie NPCOU qui
  14. C     devient égal à NPDONN
  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 SMCOORD      
  40.       POINTEUR JCOORD.MCOORD
  41. -INC SMLENTI
  42.       POINTEUR JNNO.MLENTI
  43. *del-INC SMELEME
  44. *del      POINTEUR JTOPO.MELEME
  45. -INC TMATOP2
  46. -INC TMATOP1
  47. *-INC STOPINV
  48. *-INC SMETRIQ
  49.       POINTEUR JCMETR.METRIQ
  50. *-INC STRAVJ
  51.       logical lchang
  52.       character*(*) mmot
  53. *     
  54. * Executable statements
  55. *
  56.       if (impr.ge.5) WRITE(IOIMP,*) 'Entrée dans topadp.eso'
  57. *
  58.       lchang=.false.
  59.       NPMAXO=TRAVJ.NPMAX
  60.       NPCOUO=TRAVJ.NPCOU
  61.       if (iopt.eq.0) then
  62.          NPCOUN=NPCOUO
  63.          NPMAXN=NPDONN
  64.          if (npmaxn.eq.npmaxo) then
  65. *     write(ioimp,*) 'pas besoin d''appeler topadp ???'
  66. *     goto 9999
  67.             return
  68.          endif
  69.       elseif (iopt.eq.1) then
  70.          NPCOUN=NPDONN
  71.          IF (NPCOUN.LE.NPMAXO) THEN
  72. *     write(ioimp,*) 'pas besoin d''appeler topadp ???'
  73. *     goto 9999
  74.             TRAVJ.NPCOU=NPCOUN
  75.             return
  76.          ELSE
  77. *            NPMAXN=NPDONN+0
  78. *     Stratégie d'augmentation
  79.             NPMAX1=NPDONN
  80. *            XCOF=1.414D0
  81.             XCOF=2.D0
  82.             NPMAX2=TRAVJ.NPINI+INT(((NPMAXO-TRAVJ.NPINI)*XCOF)+0.5D0)
  83.             NPMAXN=MAX(NPMAX1,NPMAX2)
  84.          ENDIF
  85.       endif
  86.  
  87.       IF (NPCOUN.LT.NPCOUO.or.NPMAXN.LT.NPCOUO) THEN
  88.          write(ioimp,*) 'On ne peut pas redimensionner à une ',
  89.      $        'valeur plus petite que npcou' 
  90.          goto 9999
  91.       endif
  92.  
  93.       lchang=.true.
  94.  
  95.       TRAVJ.NPMAX=NPMAXN
  96.       if (isgadj.gt.0)
  97. *     $     write(ioimp,286) TRAVJ,NPMAXO,NPMAXN,NPCOUN
  98.      $     write(ioimp,286) mmot,NPMAXO,NPMAXN,NPCOUN
  99. *     
  100.       JCOORD=TRAVJ.COORD
  101.       if (jcoord.ne.0) then
  102.          NBPTS=NPMAXN
  103.          segadj jcoord
  104.       endif
  105. *     
  106.       JCMETR=TRAVJ.CMETR
  107.       if (jcmetr.ne.0) then
  108.          NNIN=JCMETR.XIN(/1)
  109.          NNNOE=NPMAXN
  110.          segadj jcmetr
  111.       endif
  112. *     
  113.       TOPINV=TRAVJ.TOPI
  114.       if (topinv.ne.0) then
  115.          IDIMP=IDIM+1
  116.          NBELEM=NVMAX
  117.          NBPTS=NPMAXN
  118.          SEGADJ TOPINV
  119.          DO IPTS=NPMAXO+1,NPMAXN
  120.             TIC(IPTS)=-1
  121.          ENDDO
  122.       endif
  123. *     
  124.       jnno=travj.nno
  125.       if (jnno.ne.0) then
  126.          jg=npmaxn-npini
  127.          segadj jnno
  128.       endif
  129.       TRAVJ.NPCOU=NPCOUN
  130. *
  131. * Normal termination
  132. *
  133.       RETURN
  134. *
  135. * Format handling
  136. *
  137. * 286  FORMAT ('Segment TRAV=',I8,' nbno max ajusté de ',I6,' à ',I6,
  138. *     $     ' (nbno courant=',I6,')') 
  139.  286  FORMAT (A25,' nbno max ajusté de ',I6,' à ',I6,
  140.      $     ' (nbno courant=',I6,')') 
  141. * 187  FORMAT (5X,10I8)
  142. * 188  FORMAT ('Apres point IELEM(',I2,',1)=',I6,' ; NBL=')
  143. * 189  FORMAT ('Le noeud ',I2,'/',I2,' de IELEM de numero',I6
  144. *     $     ,' a le plus petit nb de voisins :',I3)
  145. *     
  146. * Error handling     
  147. *     
  148.  9999 CONTINUE
  149.       MOTERR(1:8)='TOPADP  '
  150. * 349 2
  151. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  152.       CALL ERREUR(349)
  153.       RETURN
  154. *
  155. * End of subroutine TOPADP
  156. *
  157.       END
  158.  
  159.  
  160.  

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