Télécharger la plaquette Cast3M


fr en

Télécharger trladj.eso

Retour à la liste

Numérotation des lignes : 

trladj

  1. C TRLADJ    SOURCE    GOUNAND   25/11/24    21:15:24     12406          
  2.       SUBROUTINE TRLADJ(TRAVL,NCDONN,NLDONN,lchang,mmot)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : TRLADJ
  7. C DESCRIPTION : Ajustement (SEGADJ) du nombre de candidats d'un
  8. C     segment TRAVL et de ses éventuels sous-objets.
  9. C
  10. C     iopt=1 : on calcule un NCMAX automatiquement, éventuellement
  11. C     supérieur à la valeur NCDONN donnée et on modifie NCCOU qui
  12. C     devient égal à NCDONN
  13. C
  14. C Repris de topadv.eso
  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, 31/10/2017, version initiale
  33. C HISTORIQUE : v1, 31/10/2017, création
  34. C HISTORIQUE :
  35. C HISTORIQUE :
  36. C***********************************************************************
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC TMATOP1
  40. *-INC SMELEMX
  41.       POINTEUR LMCANS.MELEMX
  42. -INC SMLENTI
  43.       POINTEUR LIDXCA.MLENTI
  44.       POINTEUR LOKVOL.MLENTI
  45.       POINTEUR LNQUAL.MLENTI
  46.       POINTEUR LINDI.MLENTI
  47.       POINTEUR LINDJ.MLENTI
  48. -INC SMLREEL
  49.       POINTEUR LQUALS.MLREEL
  50. -INC TMATOP2
  51. *-INC STRAVL
  52.       character*(*) mmot
  53.       logical lchang,lchan2
  54.       INTEGER IMPR,IRET
  55. *
  56. * Executable statements
  57. *
  58.       if (impr.ge.5) WRITE(IOIMP,*) 'Entrée dans trladj.eso'
  59. *
  60.       lchang=.false.
  61.       NCMAXO=TRAVL.NCMAX
  62.       NCCOUO=TRAVL.NCCOU
  63. *
  64.       NCCOUN=NCDONN
  65.       IF (NCCOUN.LE.NCMAXO) THEN
  66. *     write(ioimp,*) 'pas besoin d''appeler trladj ???'
  67. *     goto 9999
  68. *         TRAVL.NCCOU=NCCOUN
  69. *         return
  70.       ELSE
  71. *     NCMAXN=NCDONN+0
  72. *     Stratégie d'augmentation
  73.          NCMAX1=NCDONN
  74. *     XCOF=1.414D0
  75.          XCOF=2.D0
  76.          NCMAX2=TRAVL.NCINI+INT(((NCMAXO-TRAVL.NCINI)*XCOF)+0.5D0)
  77.          NCMAXN=MAX(NCMAX1,NCMAX2)
  78.  
  79.          IF (NCCOUN.LT.NCCOUO.or.NCMAXN.LT.NCCOUO) THEN
  80.             write(ioimp,*) 'On ne peut pas redimensionner à une ',
  81.      $           'valeur plus petite que nccou'
  82.             goto 9999
  83.          endif
  84.  
  85.          lchang=.true.
  86.          TRAVL.NCMAX=NCMAXN
  87.          if (isgadj.gt.0)
  88.      $        write(ioimp,486) mmot,NCMAXO,NCMAXN,NCCOUN
  89. *
  90.          lidxca=travl.idxca
  91.          if (lidxca.ne.0) then
  92.             jg=ncmaxn+1
  93.             segadj lidxca
  94.          endif
  95. *
  96.          lokvol=travl.okvol
  97.          if (lokvol.ne.0) then
  98.             jg=ncmaxn
  99.             segadj lokvol
  100.          endif
  101. *
  102.          lnqual=travl.nqual
  103.          if (lnqual.ne.0) then
  104.             jg=ncmaxn
  105.             segadj lnqual
  106.          endif
  107. *
  108.          lindi=travl.indi
  109.          if (lindi.ne.0) then
  110.             jg=ncmaxn
  111.             segadj lindi
  112.          endif
  113. *
  114.          lindj=travl.indj
  115.          if (lindj.ne.0) then
  116.             jg=ncmaxn
  117.             segadj lindj
  118.          endif
  119.       ENDIF
  120. *
  121.       lmcans=travl.mcans
  122.       if (lmcans.ne.0) then
  123.          call mlxadl(lmcans,nldonn,lchan2,mmot)
  124.          if (ierr.ne.0) return
  125.       endif
  126. *
  127.       lquals=travl.quals
  128.       if (lquals.ne.0) then
  129.          if (lmcans.eq.0) then
  130.             write(ioimp,*) 'lquals existe mais pas lmcans'
  131.             goto 9999
  132.          endif
  133.          jg=lmcans.numx(/2)
  134.          segadj lquals
  135.       endif
  136. *
  137.       TRAVL.NCCOU=NCCOUN
  138. *
  139. * Normal termination
  140. *
  141.       RETURN
  142. *
  143. * Format handling
  144. *
  145.  486  FORMAT ('In trladj: ',A25,' nbcand max ajuste de ',I6,' a ',I6,
  146.      $     ' (nbcand. courant=',I6,')')
  147. *
  148. * Error handling
  149. *
  150.  9999 CONTINUE
  151.       MOTERR(1:8)='TRLADJ  '
  152. * 349 2
  153. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  154.       CALL ERREUR(349)
  155.       RETURN
  156. *
  157. * End of subroutine TRLADJ
  158. *
  159.       END
  160.  
  161.  

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