Télécharger la plaquette Cast3M


fr en

Télécharger mlxadl.eso

Retour à la liste

Numérotation des lignes : 

mlxadl

  1. C MLXADL    SOURCE    GOUNAND   25/11/24    21:15:09     12406          
  2.       SUBROUTINE MLXADL(MELEMX,NLDONN,lchang,mmot)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : MLXADL
  7. C DESCRIPTION : Ajustement (SEGADJ) du nombre d'éléments d'un
  8. C     segment MELEMX
  9. C
  10. C     On calcule un NLMAX automatiquement, éventuellement
  11. C     supérieur à la valeur NLDONN donnée et on modifie NLCOU qui
  12. C     devient égal à NLDONN
  13. C
  14. C     Inspiré de topadv en supprimmant iopt
  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, 30/10/2017, version initiale
  33. C HISTORIQUE : v1, 30/10/2017, création
  34. C HISTORIQUE :
  35. C HISTORIQUE :
  36. C***********************************************************************
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC TMATOP1
  40. -INC TMATOP2
  41.       logical lchang
  42.       character*(*) mmot
  43. *
  44. * Executable statements
  45. *
  46.       if (impr.ge.5) WRITE(IOIMP,*) 'Entree dans mlxadl.eso'
  47. *
  48.       lchang=.false.
  49.       NLMAXO=MELEMX.NUMX(/2)
  50.       NNMAX =MELEMX.NUMX(/1)
  51.       NLCOUO=MELEMX.NLCOU
  52.       NLCOUN=NLDONN
  53.       IF (NLCOUN.LE.NLMAXO) THEN
  54. *     write(ioimp,*) 'pas besoin d''appeler mlxadl ???'
  55. *     goto 9999
  56. *         MELEMX.NLCOU=NLCOUN
  57. *         return
  58.       ELSE
  59. *     Stratégie d'augmentation
  60.          NLMAX1=NLDONN
  61. *     XCOF=1.414D0
  62.          XCOF=2.D0
  63.          NLMAX2=MELEMX.NLINI+INT(((NLMAXO-MELEMX.NLINI)*XCOF)+0.5D0)
  64.          NLMAXN=MAX(NLMAX1,NLMAX2)
  65. *      endif
  66.  
  67.          IF (NLCOUN.LT.NLCOUO.or.NLMAXN.LT.NLCOUO) THEN
  68.             write(ioimp,*) 'On ne peut pas redimensionner a une ',
  69.      $           'valeur plus petite que nlcou'
  70.             goto 9999
  71.          endif
  72.  
  73.          lchang=.true.
  74.          NLMAX=NLMAXN
  75.          if (isgadj.gt.0)
  76.      $        write(ioimp,386) mmot,NLMAXO,NLMAXN,NLCOUN
  77. *
  78.          SEGADJ MELEMX
  79.       ENDIF
  80.       MELEMX.NLCOU=NLCOUN
  81. *
  82. * Normal termination
  83. *
  84.       RETURN
  85. *
  86. * Format handling
  87. *
  88.  386  FORMAT ('In mlxadl: ',A25,' nbel max ajuste de ',I6,' a ',I6,
  89.      $     ' (nbel. courant=',I6,')')
  90. *
  91. * Error handling
  92. *
  93.  9999 CONTINUE
  94.       MOTERR(1:8)='MLXADL  '
  95. * 349 2
  96. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  97.       CALL ERREUR(349)
  98.       RETURN
  99. *
  100. * End of subroutine MLXADL
  101. *
  102.       END
  103.  
  104.  

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