Télécharger la plaquette Cast3M


fr en

Télécharger rdscrm.eso

Retour à la liste

Numérotation des lignes : 

rdscrm

  1. C RDSCRM    SOURCE    GOUNAND   24/11/12    21:15:09     12076          
  2.       SUBROUTINE RDSCRM(MRIGID)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : RDSCRM
  7. C DESCRIPTION : Quelquefois, les points de IRIGEL(1,I) ne sont pas
  8. C     tous references par le segment DESCR (cas des QUAFs notamment).
  9. C     Dans ce cas, on fait une reduction du MELEME et on le stocke dans
  10. C     IRIGEL(2,I)
  11. C
  12. C
  13. C
  14. C LANGAGE     : ESOPE
  15. C AUTEUR      : Stephane GOUNAND (CEA/DES/ISAS/DM2S/SEMT/LTA)
  16. C               mel : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C VERSION    : v1, 08/11/2024, version initiale
  19. C HISTORIQUE : v1, 08/11/2024, creation
  20. C HISTORIQUE :
  21. C HISTORIQUE :
  22. C***********************************************************************
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMRIGID
  26. -INC SMELEME
  27.       SEGMENT ICNN(NBNN)
  28.       SEGMENT IBNN(NCNN)
  29. *
  30. * Executable statements
  31. *
  32.       SEGACT MRIGID*MOD
  33.       NNVA=IRIGEL(/2)
  34.       irmel=0
  35.       DO I=1,NNVA
  36.          ipt1=irigel(1,i)
  37.          segact ipt1
  38.          nbnn=ipt1.num(/1)
  39.          segini icnn
  40.          ncnn=0
  41.          descr=irigel(3,i)
  42.          segact descr
  43.          nligrp=noelep(/1)
  44.          do iligrp=1,nligrp
  45.             if (icnn(noelep(iligrp)).eq.0) then
  46.                icnn(noelep(iligrp))=1
  47.                ncnn=ncnn+1
  48.             endif
  49.          enddo
  50.          if (irigel(7,i).ge.2) then
  51.             nligrd=noeled(/1)
  52.             do iligrd=1,nligrd
  53.                if (icnn(noeled(iligrd)).eq.0) then
  54.                   icnn(noeled(iligrd))=1
  55.                   ncnn=ncnn+1
  56.                endif
  57.             enddo
  58.          endif
  59.          if (ncnn.NE.nbnn) then
  60.             segini ibnn
  61.             ic=0
  62.             do ib=1,nbnn
  63.                if (icnn(ib).ne.0) then
  64.                   ic=ic+1
  65.                   ibnn(ic)=ib
  66.                endif
  67.             enddo
  68.             nbnn=ncnn
  69.             nbelem=ipt1.num(/2)
  70.             nbref=0
  71.             nbsous=0
  72.             segini ipt2
  73.             do ibelem=1,nbelem
  74.                do ic=1,ncnn
  75.                   ipt2.num(ic,ibelem)=ipt1.num(ibnn(ic),ibelem)
  76.                enddo
  77.             enddo
  78.             segsup ibnn
  79.             irmel=irmel+1
  80.          else
  81.             ipt2=0
  82.          endif
  83.          segsup icnn
  84.          IF (irigel(2,i).ne.0) then
  85.             moterr(1:8)='rdscrm'
  86.             call erreur(349)
  87.             return
  88.          ELSE
  89.             irigel(2,i)=ipt2
  90.          ENDIF
  91.       ENDDO
  92.       segact mrigid*nomod
  93. *
  94. * Normal termination
  95. *
  96.       RETURN
  97. *
  98. * Format handling
  99. *
  100. *
  101. * Error handling
  102. *
  103. *
  104. * End of subroutine RDSCRM
  105. *
  106.       END
  107.  
  108.  

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