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   25/11/24    21:15:09     12406          
  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,*) 'Entree 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 a 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 ('In mtxadj: ',A25,' nbel max ajuste de ',I6,' a ',I6,
  91.      $     ' (nbel. courant=',I6,')')
  92. *
  93. * Error handling
  94. *
  95.  9999 CONTINUE
  96.       MOTERR(1:8)='MTXADJ  '
  97. * 349 2
  98. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  99.       CALL ERREUR(349)
  100.       RETURN
  101. *
  102. * End of subroutine MTXADJ
  103. *
  104.       END
  105.  
  106.  

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