Télécharger la plaquette Cast3M


fr en

Télécharger mrem.eso

Retour à la liste

Numérotation des lignes : 

mrem

  1. C MREM      SOURCE    MB234859  25/01/03    21:15:18     12105          
  2.        SUBROUTINE MREM
  3. ************************************************************************
  4. *      remontee de la sotution complete  apres resolution a partir
  5. *  d une matrice condensee par CMCT ( hors de resou )
  6. *
  7. *     Syntaxe :
  8. *         chpo3 = MREM chpo1 (rig1 et rig2) chpo2 ;
  9. *
  10. *               chpo1  solution reduite sur les ddl non elimines
  11. *               rig1  rigidites initiale (hors  dependances )
  12. *               rig2  rigidites de dependances
  13. *
  14. *               chpo3  solution complete en deplacements et LX
  15. *
  16. *************************************************************************
  17.       IMPLICIT INTEGER(I-N)
  18.       IMPLICIT REAL*8(A-H,O-Z)
  19. C
  20. -INC SMRIGID
  21. -INC PPARAM
  22. -INC CCOPTIO
  23. -INC SMCHPOI
  24. -INC SMLCHPO
  25. C
  26.         segment idemem(0)
  27.         segment ideme0(idemem(/1),30)
  28.         segment ideme1(idemem(/1),30)
  29. C
  30.         ipt8=0
  31.         segini idemem
  32.         CALL LIROBJ('CHPOINT',mchpoi,1,IRETOU)
  33.         IF(IERR.NE.0) GO TO 5000
  34.         idemem(**)=mchpoi
  35.         segini ideme0,ideme1
  36.         CALL LIROBJ('LISTCHPO',mlchpo,1,IRETOU)
  37.         IF(IERR.NE.0) GO TO 5000
  38.         CALL LIROBJ('LISTCHPO',mlchp1,1,IRETOU)
  39.         IF(IERR.NE.0) GO TO 5000
  40.         segact mlchpo,mlchp1
  41.         if=mlchpo.ichpoi(/1)
  42.         if (if.ne.mlchp1.ichpoi(/1)) call erreur(5)
  43.         do 1000 i=1,if
  44.           ideme0(1,i)=mlchpo.ichpoi(i)
  45.           ideme1(1,i)=mlchp1.ichpoi(i)
  46.  1000   continue
  47.  
  48.         CALL LIROBJ('RIGIDITE',mrigid,1,IRETOU)
  49.         IF(IERR.NE.0) GO TO 5000
  50. C
  51.         do 2010 ifois=1,30
  52.           segact mrigid
  53.           mrigid=jrsup
  54.           if (mrigid.eq.0) goto 2011
  55.           segact mrigid
  56.           isouci=1
  57.           iverif=0
  58.           call resour(idemem,ideme0,ideme1,mrigid,if,ipt8,isouci,iverif)
  59.           if=if-1
  60.  2010   continue
  61.  2011   continue
  62.         if (if.ne.0) call erreur(5)
  63.         iret=idemem(1)
  64.         call ecrobj('CHPOINT',iret)
  65. C
  66. 5000   continue
  67.        RETURN
  68.        END
  69.  
  70.  

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