Télécharger la plaquette Cast3M


fr en

Télécharger trlver.eso

Retour à la liste

Numérotation des lignes : 

trlver

  1. C TRLVER    SOURCE    GOUNAND   21/04/06    21:15:41     10940          
  2.       SUBROUTINE TRLVER(TRAVL,MMOT)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : TRLVER
  7. C DESCRIPTION : Vérifie la consistance du segment TRAVL    
  8. C      
  9. C
  10. C LANGAGE     : ESOPE
  11. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
  12. C               mél : gounand@semt2.smts.cea.fr
  13. C***********************************************************************
  14. C***********************************************************************
  15. C SYNTAXE GIBIANE    : 
  16. C ENTREES            : MELEME (Activé), NEL
  17. C ENTREES/SORTIES    : TOPINV (Activé *MOD)
  18. C SORTIES            :
  19. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  20. C***********************************************************************
  21. C VERSION    : v1, 30/10/2017, version initiale
  22. C HISTORIQUE : v1, 30/10/2017, création
  23. C HISTORIQUE :
  24. C HISTORIQUE :
  25. C***********************************************************************
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC TMATOP1      
  29. *-INC SMELEMX
  30.       POINTEUR LMCANS.MELEMX
  31. -INC SMLENTI
  32.       POINTEUR LIDXCA.MLENTI
  33.       POINTEUR LOKVOL.MLENTI
  34.       POINTEUR LNQUAL.MLENTI
  35.       POINTEUR LINDI.MLENTI
  36.       POINTEUR LINDJ.MLENTI
  37. -INC SMLREEL
  38.       POINTEUR LQUALS.MLREEL
  39. -INC TMATOP2
  40. *-INC STRAVL
  41.       CHARACTER*(*) MMOT
  42. *
  43. *     
  44. * Executable statements
  45. *
  46.       if (impr.ge.5) WRITE(IOIMP,*) 'Entrée dans trlver.eso'
  47.       IDIMP=IDIM+1
  48.       lmcans=travl.mcans
  49.       lidxca=travl.idxca
  50.       lokvol=travl.okvol
  51.       lquals=travl.quals
  52.       lnqual=travl.nqual
  53.       lindi=travl.indi
  54.       lindj=travl.indj
  55. *
  56. *     Petite vérification de consistance de dimension des objets
  57. *     (NCMAX,NLMAX)
  58. *
  59.       if (lmcans.ne.0) then
  60.          call vemelx(lmcans,'trlver')
  61.          if (ierr.ne.0) then
  62.             write(ioimp,*) mmot
  63.             return
  64.          endif
  65.       endif
  66. *     
  67.       if (lidxca.ne.0) then
  68.          jg=lidxca.lect(/1)
  69.          if (jg.ne.ncmax+1) then
  70.             write(ioimp,185) 'lidxca : jg,ncmax=',jg,ncmax
  71.             goto 9999
  72.          endif
  73.       endif
  74. *     
  75.       if (lokvol.ne.0) then
  76.          jg=lokvol.lect(/1)
  77.          if (jg.ne.ncmax) then
  78.             write(ioimp,185) 'lokvol : jg,ncmax=',jg,ncmax
  79.             goto 9999
  80.          endif
  81.       endif
  82. *     
  83.       if (lquals.ne.0) then
  84.          if (lmcans.eq.0) then
  85.             write(ioimp,*) 'lquals existe mais pas lmcans'
  86.             goto 9999
  87.          endif
  88.          jg=lquals.prog(/1)
  89.          nlmax=lmcans.numx(/2)
  90.          if (jg.ne.nlmax) then
  91.             write(ioimp,185) 'lquals : jg,nlmax=',jg,nlmax
  92.             goto 9999
  93.          endif
  94.       endif
  95. *     
  96.       if (lnqual.ne.0) then
  97.          jg=lnqual.lect(/1)
  98.          if (jg.ne.ncmax) then
  99.             write(ioimp,185) 'lnqual : jg,ncmax=',jg,ncmax
  100.             goto 9999
  101.          endif
  102.       endif
  103. *     
  104.       if (lindi.ne.0) then
  105.          jg=lindi.lect(/1)
  106.          if (jg.ne.ncmax) then
  107.             write(ioimp,185) 'lindi : jg,ncmax=',jg,ncmax
  108.             goto 9999
  109.          endif
  110.       endif
  111. *     
  112.       if (lindj.ne.0) then
  113.          jg=lindj.lect(/1)
  114.          if (jg.ne.ncmax) then
  115.             write(ioimp,185) 'lindj : jg,ncmax=',jg,ncmax
  116.             goto 9999
  117.          endif
  118.       endif
  119. *
  120. * Consistance des index
  121. *
  122.       if (lidxca.ne.0) then
  123.          if (lmcans.eq.0) then
  124.             write(ioimp,*) 'lidxca existe mais pas lmcans'
  125.             goto 9999
  126.          endif
  127. *
  128.          nlc=LMCANS.NLCOU
  129.          ncc=TRAVL.NCCOU
  130.          idxp=lidxca.lect(ncc+1)
  131.          if (idxp.ne.nlc+1) then
  132.             write(ioimp,185) 'pb idx lmcans : idxp,nlcou=',idxp,nlc
  133.             goto 9999
  134.          endif
  135.       endif
  136.  
  137.  
  138.  
  139. *
  140. * Normal termination
  141. *
  142.       RETURN
  143. *
  144. * Format handling
  145. *
  146.  185  FORMAT (5X,A32,6I8)
  147.  187  FORMAT (5X,10I8)
  148.  188  FORMAT ('Apres point IELEM(',I2,',1)=',I6,' ; NBL=')
  149.  189  FORMAT ('Le noeud ',I2,'/',I2,' de IELEM de numero',I6
  150.      $     ,' a le plus petit nb de voisins :',I3)
  151. *     
  152. * Error handling     
  153. *     
  154.  9999 CONTINUE
  155.       write(ioimp,*) MMOT
  156.       MOTERR(1:8)='TRLVER  '
  157. * 349 2
  158. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  159.       CALL ERREUR(349)
  160.       RETURN
  161. *
  162. * End of subroutine TRLVER
  163. *
  164.       END
  165.  
  166.  
  167.  

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