Télécharger la plaquette Cast3M


fr en

Télécharger mtxadj.eso

Retour à la liste

Numérotation des lignes : 

mtxadj

  1. C MTXADJ    SOURCE    GOUNAND   21/04/06    21:15:15     10940          
  2.       SUBROUTINE MTXADJ(MLENTX,JGDONN,lchang,mmot)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : MTXADJ
  7. C DESCRIPTION : Ajustement (SEGADJ) du nombre d'éléments d'un
  8. C     segment MLENTX
  9. C
  10. C     On calcule un JGMAX automatiquement, éventuellement
  11. C     supérieur à la valeur JGDONN donnée et on modifie JGCOU qui
  12. C     devient égal à JGDONN
  13. C
  14. C     Inspiré de mlxadl
  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, 20/12/2017, version initiale
  33. C HISTORIQUE : v1, 20/12/2017, création
  34. C HISTORIQUE :
  35. C HISTORIQUE :
  36. C***********************************************************************
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. *(pour impr)       
  40. -INC TMATOP2
  41. -INC TMATOP1
  42. *-INC SMLENTX
  43.       logical lchang
  44.       character*(*) mmot
  45. *     
  46. * Executable statements
  47. *
  48.       if (impr.ge.5) WRITE(IOIMP,*) 'Entrée dans mtxadj.eso'
  49. *
  50.       lchang=.false.
  51.       JGMAXO=MLENTX.LECTX(/1)
  52.       JGCOUO=MLENTX.JGCOU
  53.       JGCOUN=JGDONN
  54.       IF (JGCOUN.LE.JGMAXO) THEN
  55. *     write(ioimp,*) 'pas besoin d''appeler mtxadj ???'
  56. *     goto 9999
  57. *         MELEMX.NLCOU=NLCOUN
  58. *         return
  59.       ELSE
  60. *            NVMAXN=NVDONN+0
  61. *     Stratégie d'augmentation
  62.          JGMAX1=JGDONN
  63. *     XCOF=1.414D0
  64.          XCOF=2.D0
  65.          JGMAX2=MLENTX.JGINI+INT(((JGMAXO-MLENTX.JGINI)*XCOF)+0.5D0)
  66.          JGMAXN=MAX(JGMAX1,JGMAX2)
  67. *      endif
  68.  
  69.          IF (JGCOUN.LT.JGCOUO.or.JGMAXN.LT.JGCOUO) THEN
  70.             write(ioimp,*) 'On ne peut pas redimensionner à une ',
  71.      $           'valeur plus petite que jgcou' 
  72.             goto 9999
  73.          endif
  74.  
  75.          lchang=.true.
  76.          JGMAX=JGMAXN
  77.          if (isgadj.gt.0)
  78.      $        write(ioimp,386) mmot,JGMAXO,JGMAXN,JGCOUN
  79. *     
  80.          SEGADJ MLENTX
  81.       ENDIF
  82.       MLENTX.JGCOU=JGCOUN
  83. *
  84. * Normal termination
  85. *
  86.       RETURN
  87. *
  88. * Format handling
  89. *
  90. * 386  FORMAT ('Segment MELEMX=',I8,' nbel max ajusté de ',I6,' à ',I6,
  91. *     $     ' (nbel. courant=',I6,')') 
  92.  386  FORMAT (A25,' nbel max ajusté de ',I6,' à ',I6,
  93.      $     ' (nbel. courant=',I6,')') 
  94. * 187  FORMAT (5X,10I8)
  95. * 188  FORMAT ('Apres point IELEM(',I2,',1)=',I6,' ; NBL=')
  96. * 189  FORMAT ('Le noeud ',I2,'/',I2,' de IELEM de numero',I6
  97. *     $     ,' a le plus petit nb de voisins :',I3)
  98. *     
  99. * Error handling     
  100. *     
  101.  9999 CONTINUE
  102.       MOTERR(1:8)='MTXADJ  '
  103. * 349 2
  104. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  105.       CALL ERREUR(349)
  106.       RETURN
  107. *
  108. * End of subroutine MTXADJ
  109. *
  110.       END
  111.  
  112.  
  113.  

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