Télécharger la plaquette Cast3M


fr en

Télécharger descar.eso

Retour à la liste

Numérotation des lignes : 

descar

  1. C DESCAR    SOURCE    GOUNAND   25/06/11    21:15:07     12278          
  2.       SUBROUTINE DESCAR(DES1,IPRI,DES3)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : DESCAR
  7. C DESCRIPTION : A partir d'un descripteur DES1 en entree, on construit
  8. C     un descripteur carre, soit base sur les inconnues
  9. C     primales (ipri=1), soit sur les inconnues duales (ipri=2)
  10. C     Si le descripteur est deja carre, on le renvoie
  11. C
  12. C
  13. C LANGAGE     : ESOPE
  14. C AUTEUR      : Stephane GOUNAND (CEA/DES/ISAS/DM2S/SEMT/LTA)
  15. C               mel : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C ENTREES            : DES1 IPRI
  18. C ENTREES/SORTIES    :
  19. C SORTIES            : DES3
  20. C***********************************************************************
  21. C VERSION    : v1, 26/05/2025, version initiale
  22. C HISTORIQUE : v1, 26/05/2025, creation
  23. C HISTORIQUE :
  24. C HISTORIQUE :
  25. C***********************************************************************
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC CCHAMP
  29. -INC SMRIGID
  30.       logical lcar
  31.       CHARACTER*(LOCHPO) NOMINC,NOMDUA
  32. *
  33. * Executable statements
  34. *
  35.       nligrp=des1.noelep(/1)
  36.       nligrd=des1.noeled(/1)
  37.       if (nligrp.ne.nligrd) goto 13
  38.       do ilig=1,nligrp
  39.          if (des1.noelep(ilig).ne.des1.noeled(ilig)) goto 13
  40.       enddo
  41.       do ilig=1,nligrp
  42.          nominc=des1.lisinc(ilig)
  43.          CALL PLACE(NOMDD,LNOMDD,IPLA,NOMINC)
  44.          IF (IPLA.EQ.0) THEN
  45.             nomdua=nominc
  46.          ELSE
  47.             nomdua=nomdu(ipla)
  48.          ENDIF
  49.          if (des1.lisdua(ilig).ne.nomdua) goto 13
  50.       enddo
  51. * Carré
  52.       des3=des1
  53.       return
  54.  13   CONTINUE
  55. * Pas carré
  56.       if (ipri.eq.1) then
  57.          nligrp=des1.noelep(/1)
  58.          nligrd=nligrp
  59.          segini des3
  60.          do iligrp=1,nligrp
  61.             nno=des1.noelep(iligrp)
  62.             des3.noelep(iligrp)=nno
  63.             des3.noeled(iligrp)=nno
  64.             nominc=des1.lisinc(iligrp)
  65.             des3.lisinc(iligrp)=nominc
  66.             CALL PLACE(NOMDD,LNOMDD,IPLA,NOMINC)
  67.             IF (IPLA.EQ.0) THEN
  68.                des3.lisdua(iligrp)=nominc
  69.             ELSE
  70.                des3.lisdua(iligrp)=nomdu(ipla)
  71.             ENDIF
  72.          enddo
  73.       elseif (ipri.eq.2) then
  74.          nligrd=des1.noeled(/1)
  75.          nligrp=nligrd
  76.          segini des3
  77.          do iligrd=1,nligrd
  78.             nno=des1.noeled(iligrd)
  79.             des3.noeled(iligrd)=nno
  80.             des3.noelep(iligrd)=nno
  81.             nomdua=des1.lisdua(iligrd)
  82.             des3.lisdua(iligrd)=nomdua
  83.             CALL PLACE(NOMDU,LNOMDU,IPLA,NOMDUA)
  84.             IF (IPLA.EQ.0) THEN
  85.                des3.lisinc(iligrd)=nomdua
  86.             ELSE
  87.                des3.lisinc(iligrd)=nomdd(ipla)
  88.             ENDIF
  89.          enddo
  90.  
  91.       else
  92.          write(ioimp,*) 'ipri=',ipri
  93.          call erreur(5)
  94.          return
  95.       endif
  96. *
  97. * Normal termination
  98. *
  99.       RETURN
  100. *
  101. * Format handling
  102. *
  103. *
  104. * Error handling
  105. *
  106. *
  107. * End of subroutine DESCAR
  108. *
  109.       END
  110.  
  111.  

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