Télécharger la plaquette Cast3M


fr en

Télécharger trlini.eso

Retour à la liste

Numérotation des lignes : 

trlini

  1. C TRLINI    SOURCE    GOUNAND   26/01/09    21:16:09     12442          
  2.       SUBROUTINE TRLINI(NELMOY,NNM,ityp,TRAVL)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : TRLINI
  7. C DESCRIPTION : Initialisation d'un segment TRAVL et de ses sous-objets.
  8. C
  9. C LANGAGE     : ESOPE
  10. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
  11. C               mél : gounand@semt2.smts.cea.fr
  12. C***********************************************************************
  13. C APPELES          :
  14. C APPELES (E/S)    :
  15. C APPELES (BLAS)   :
  16. C APPELES (CALCUL) :
  17. C APPELE PAR       :
  18. C***********************************************************************
  19. C SYNTAXE GIBIANE    :
  20. C ENTREES            :
  21. C ENTREES/SORTIES    :
  22. C SORTIES            :
  23. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24. C***********************************************************************
  25. C VERSION    : v1, 07/11/2017, version initiale
  26. C HISTORIQUE : v1, 07/11/2017, création
  27. C HISTORIQUE :
  28. C HISTORIQUE :
  29. C***********************************************************************
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC TMATOP2
  33. -INC TMATOP1
  34. *-INC SMELEMX
  35.       POINTEUR LMCANS.MELEMX
  36.       POINTEUR IPBTL.MELEMX
  37. -INC SMLENTI
  38.       POINTEUR LIDXCA.MLENTI
  39.       POINTEUR LOKVOL.MLENTI
  40.       POINTEUR LNQUAL.MLENTI
  41.       POINTEUR LINDI.MLENTI
  42.       POINTEUR LINDJ.MLENTI
  43. -INC SMLREEL
  44.       POINTEUR LQUALS.MLREEL
  45. *      POINTEUR LMAXQL.MLREEL
  46. *-INC STRAVL
  47.       logical lchang
  48.       INTEGER IMPR,IRET
  49. *
  50. * Executable statements
  51. *
  52.       if (impr.ge.5) WRITE(IOIMP,*) 'Entrée dans trlini.eso'
  53. *
  54.       SEGINI TRAVL
  55. *!!! A changer !
  56.       TRAVL.NCMAX=NELMOY
  57. *      NNMAX=KEXTO.NUM(/1)
  58.       NNMAX=NNM
  59. *!!! A changer !
  60.       NLMAX=TRAVL.NCMAX*NELMOY
  61. *      NLMAX=0
  62.       SEGINI LMCANS
  63. *      LMCANS.ITYPEX=KEXTO.ITYPEL
  64.       LMCANS.ITYPEX=ityp
  65.       LMCANS.NNCOU=NNMAX
  66.       TRAVL.MCANS=LMCANS
  67.       JG=TRAVL.NCMAX+1
  68.       SEGINI LIDXCA
  69.       LIDXCA.LECT(1)=1
  70.       TRAVL.IDXCA=LIDXCA
  71.       JG=TRAVL.NCMAX
  72.       SEGINI LOKVOL
  73.       TRAVL.OKVOL=LOKVOL
  74. * Recuperation valeur ISTRID
  75.       CALL QUALI6(0,1,0,IMET,IMOMET,XDENS,0,0,XVTOL,0,NQDC,ISTRID)
  76.       JG=LMCANS.NUMX(/2)*ISTRID
  77.       SEGINI LQUALS
  78.       TRAVL.QUALS=LQUALS
  79.       JG=TRAVL.NCMAX
  80.       SEGINI LNQUAL
  81.       TRAVL.NQUAL=LNQUAL
  82.       JG=TRAVL.NCMAX
  83.       SEGINI LINDI
  84.       TRAVL.INDI=LINDI
  85.       JG=TRAVL.NCMAX
  86.       SEGINI LINDJ
  87.       TRAVL.INDJ=LINDJ
  88. *      JG=TRAVL.NCMAX
  89. *      SEGINI LMAXQL
  90. *      TRAVL.MAXQL=LMAXQL
  91. *
  92. *!!! A changer !
  93. *      NNC=2
  94. *      NNL=NNC*IDIMP
  95. *      CALL TRLADJ(TRAVL,NNC,NNL,lchang,'trlini : TRAVL')
  96. *      if (ierr.ne.0) return
  97.  
  98. *
  99. *     Segment de travail pour stocker les points du contour
  100. *
  101.       NNMAX=1
  102.       NLMAX=NELMOY
  103.       SEGINI IPBTL
  104.       IPBTL.NNINI=NNMAX
  105.       IPBTL.NNCOU=NNMAX
  106.       IPBTL.NLINI=NLMAX
  107.       IPBTL.NLCOU=0
  108.       IPBTL.ITYPEX=1
  109.       TRAVL.PBTL=IPBTL
  110.  
  111. *
  112. * Normal termination
  113. *
  114.       RETURN
  115. *
  116. * Format handling
  117. *
  118.  286  FORMAT ('Segment TRAV=',I8,' nbel max ajusté de ',I6,' à ',I6,
  119.      $     ' (nbel. courant=',I6,')')
  120. * 187  FORMAT (5X,10I8)
  121. * 188  FORMAT ('Apres point IELEM(',I2,',1)=',I6,' ; NBL=')
  122. * 189  FORMAT ('Le noeud ',I2,'/',I2,' de IELEM de numero',I6
  123. *     $     ,' a le plus petit nb de voisins :',I3)
  124. *
  125. * Error handling
  126. *
  127.  9999 CONTINUE
  128.       MOTERR(1:8)='TRLINI  '
  129. * 349 2
  130. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  131.       CALL ERREUR(349)
  132.       RETURN
  133. *
  134. * End of subroutine TRLINI
  135. *
  136.       END
  137.  
  138.  

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