Télécharger la plaquette Cast3M


fr en

Télécharger sols1.eso

Retour à la liste

Numérotation des lignes : 

sols1

  1. C SOLS1     SOURCE    CB215821  25/04/23    21:15:46     12247          
  2.       SUBROUTINE SOLS1(KSOSTU,KSOLE1,KSOLUT)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C
  6. C=======================================================================
  7. C     SOUS-PROGRAMME APPELE PAR L'OPERATEUR SOLS
  8. C     IL FABRIQUE LES SOLUTIONS STATIQUES POUR LES LIAISONS L
  9. C     DE LA STRUCTURE S
  10. C
  11. C     KSOLUT :  OBJET SOLUTION (SOUS TYPE SOLU-STAT)
  12. C     KSOSTU :  STRUCTURE ELEMENTAIRE, SEGMENT MSOSTU
  13. C     KSOLE1 :  LISTE DES LIAISONS ELEMENTAIRES (MJONCT), SEGMENT MSOLEN
  14. C
  15. C   ECRIT PAR FARVACQUE
  16. C   APPELLE ECCHPO RESOU1 ECSOLU ERREUR(108)
  17. C   INTRODUCTION DES RESOLUTIONS SIMULTANEES : M.PETIT  10/3/88
  18. C=======================================================================
  19. C
  20.  
  21. -INC PPARAM
  22. -INC CCOPTIO
  23. -INC SMSTRUC
  24. -INC SMATTAC
  25. -INC SMSOLUT
  26. -INC CCHAMP
  27. -INC SMCHPOI
  28. -INC SMCOORD
  29. -INC SMELEME
  30.  
  31.       SEGMENT IDEMEN(0)
  32. C
  33.       KSOLUT=0
  34.       MSOSTU=KSOSTU
  35.       MSOLE1=KSOLE1
  36.       SEGACT MSOSTU,MSOLE1
  37.       KRIGI=ISRAID
  38. C
  39.       NJONC=MSOLE1.ISOLEN(/1)
  40.       N=NJONC
  41.       SEGINI MSOLEN
  42.       NBELEM=NJONC
  43.       NBNN=1
  44.       NBSOUS=0
  45.       NBREF=0
  46.       SEGINI MELEME
  47.       ITYPEL=1
  48. C
  49. C  **** BOUCLE SUR LES MJONCT PRIS DANS MSOLE1
  50. C
  51.       DO 72 IB=1,NJONC
  52.       MJONCT=MSOLE1.ISOLEN(IB)
  53.       SEGACT MJONCT
  54.       IPT1=MJOPOI
  55.       SEGACT IPT1
  56.       NUM(1,IB)=IPT1.NUM(1,1)
  57. C     WRITE(6,4444) NUM(1,IB)
  58. C4444 FORMAT('   POINT DU MJONCT ',I5)
  59.       IF(MJOTYP.EQ.'DEPI') THEN
  60.         ISOLEN(IB)=IPCHJO(1)
  61.       ELSE
  62.         NCCC=ISTRJO(/1)
  63.         DO 73 IC=1,NCCC
  64.         IF(ISTRJO(IC).EQ.MSOSTU) GOTO 74
  65.    73   CONTINUE
  66.         GOTO 71
  67.    74   CONTINUE
  68.         MCHPOI=IPCHJO(IC)
  69.         SEGACT MCHPOI*MOD
  70.         NSOUPO=IPCHP(/1)
  71.         NAT=1
  72. C  **** ON VA CALCULER LA REPONSE A MCHPO1 QU ON VA METTRE DANS ISOLEN(I
  73.         SEGINI MCHPO1
  74. C        dans les objets solutions il n'y a que des champs diffus
  75.         JATTRI(1) = 1
  76.         MCHPO1.JATTRI(1) = 2
  77.         MCHPO1.MOCHDE=MOCHDE
  78.         MCHPO1.MTYPOI=MTYPOI
  79.         MCHPO1.IFOPOI=IFOPOI
  80.         DO 80 IS=1,NSOUPO
  81.         MSOUPO=IPCHP(IS)
  82.         SEGACT MSOUPO
  83.         NC=NOCOMP(/2)
  84.         SEGINI MSOUP1
  85.         MSOUP1.IGEOC=IGEOC
  86.         IF(MJODDL.NE.'LX  ') GO TO 87
  87. C
  88. C  **** SI LIAISON LIBRE(MJODDL=LX) REPONSE A -Pt
  89. C
  90.         MPOVAL=IPOVAL
  91.         SEGACT MPOVAL
  92.         N=VPOCHA(/1)
  93.         SEGINI MPOVA1
  94.         DO ICOMP=1,NC
  95.           DO I1=1,N
  96.             MPOVA1.VPOCHA(I1,ICOMP)=-VPOCHA(I1,ICOMP)
  97.           ENDDO
  98.         ENDDO
  99.         MSOUP1.IPOVAL=MPOVA1
  100.         GO TO 88
  101.  87     CONTINUE
  102.         MSOUP1.IPOVAL=IPOVAL
  103.  88     CONTINUE
  104.         DO 81 ICOMP=1,NC
  105.         DO 82 ICOMP1=1,LNOMDD
  106.         IF(NOMDD(ICOMP1).NE.NOCOMP(ICOMP)) GO TO 82
  107.         MSOUP1.NOCOMP(ICOMP)=NOMDU(ICOMP1)
  108.         MSOUP1.NOHARM(ICOMP)=NOHARM(ICOMP)
  109.         GO TO 81
  110.  82     CONTINUE
  111.         MOTERR=NOCOMP(ICOMP)
  112.         CALL ERREUR(108)
  113.         GO TO 5000
  114.  81     CONTINUE
  115.         MCHPO1.IPCHP(IS)=MSOUP1
  116.  80     CONTINUE
  117. C
  118.         ISOLEN(IB)=MCHPO1
  119.         IF(MJODDL.EQ.'LX  ') ISOLEN(IB)=-ISOLEN(IB)
  120.  71     CONTINUE
  121.       ENDIF
  122.  72   CONTINUE
  123. C
  124. C
  125.       N=NJONC
  126.       SEGINI MSOLE2
  127.       NIPO=10
  128.       SEGINI MSOLUT
  129.       ITYSOL='SOLUSTAT'
  130.       DO 56 I=1,NIPO
  131.       MSOLIS(I)=0
  132.       MSOLIT(I)=0
  133.   56  CONTINUE
  134.       MSOLIS(3)=MELEME
  135.       MSOLIS(4)=MSOLE2
  136.       MSOLIS(5)=MSOLEN
  137.       MSOLIT(5)=2
  138.       MSOLIT(10)=14
  139.       MSOLIS(10)=MSOLE1
  140. C
  141.       SEGINI IDEMEN
  142.       KDEMEN=IDEMEN
  143.       DO 50 IB=1,NJONC
  144.       ISEC=ABS(ISOLEN(IB))
  145.       IF(IIMPI.EQ.0) GOTO 52
  146.       IF(ISOLEN(IB).GT.0)WRITE(IOIMP,4441)IB
  147.       IF(ISOLEN(IB).LT.0)WRITE(IOIMP,4442)IB
  148.  4441 FORMAT('  SOLUTION STATIQUE NUMERO :',I4,' BLOQUEE.')
  149.  4442 FORMAT('  SOLUTION STATIQUE NUMERO :',I4,' LIBRE  .')
  150.       WRITE(IOIMP,4446)
  151.  4446 FORMAT(' ***** CHPOINT D''EXCITATION ')
  152.       CALL ECCHPO(ISEC,0)
  153.    52 CONTINUE
  154.       IDEMEN(**)=ISEC
  155.       call ecrobj('CHPOINT ',isec)
  156.   50  CONTINUE
  157.       call ecrcha('NOID')
  158.       call ecrcha('NOUN')
  159.       call ecrobj('RIGIDITE',krigi)
  160. C
  161. C  ON RESOUD SIMULTANEMENT POUR LES NJONC LIAISONS
  162. C
  163.       NOID=0
  164.       NOEN=1
  165.       CALL RESOU
  166.       IF(IERR.NE.0) GO TO 5000
  167. C
  168. C
  169.       IDEMEN=KDEMEN
  170.       SEGACT IDEMEN*mod
  171.       do 541 ib=njonc,1,-1
  172.        call lirobj('CHPOINT ',iprem,1,iretou)
  173.        idemen(ib)=iprem
  174.  541  continue
  175.       DO 54 IB=1,NJONC
  176.       LVALM=5
  177.       NIMOD=3
  178.       SEGINI MMODE
  179.       IMODE=MMODE
  180.       FMMODD(1)=0.D0
  181.       FMMODD(2)=0.D0
  182.       FMMODD(2)=0.D0
  183.       FMMODD(4)=0.D0
  184.       FMMODD(5)=0.D0
  185.       IMMODD(1)=IB
  186.       MCHPOI=IDEMEN(IB)
  187.       SEGACT MCHPOI
  188.       IRT=MCHPOI
  189.       IF(IFOPOI.NE.1) GOTO 57
  190.       CALL NUHARM(IRT,IFO,IHARM)
  191.       IF(IFO.NE.1) THEN
  192.          IMMODD(2)=0
  193.          IMMODD(3)=0
  194.       ELSE
  195.          IMMODD(2)=IHARM
  196.          IF(IHARM.LT.0) IMMODD(3)=1
  197.          IF(IHARM.GE.0) IMMODD(3)=2
  198.       ENDIF
  199.  57   CONTINUE
  200.       MCHPOI=IRT
  201.       IF(IIMPI.EQ.0)GOTO 53
  202.       WRITE(IOIMP,4447)
  203.  4447 FORMAT(' ***** CHPOINT REPONSE SOLUTION STATIQUE ')
  204.       CALL ECCHPO(IRT,0)
  205.    53 CONTINUE
  206.       IF(IRT.EQ.0) GO TO 5000
  207.       MJONCT=MSOLE1.ISOLEN(IB)
  208.       SEGACT MJONCT
  209.       IF(MJOTYP.NE.'DEPI') THEN
  210.         MCHPOI=ABS(ISOLEN(IB))
  211.         SEGACT MCHPOI
  212.         NSOUP=IPCHP(/1)
  213.         DO 51 I=1,NSOUP
  214.         MSOUPO=IPCHP(I)
  215.         IF(ISOLEN(IB).GT.0) GO TO 55
  216.         SEGACT MSOUPO
  217.         MPOVAL=IPOVAL
  218.         SEGSUP MPOVAL
  219.  55     CONTINUE
  220.         SEGSUP MSOUPO
  221.   51    CONTINUE
  222.         SEGSUP MCHPOI
  223.       ENDIF
  224.       ISOLEN(IB)=IRT
  225.       MSOLE2.ISOLEN(IB)=IMODE
  226.   54  CONTINUE
  227.       SEGSUP IDEMEN
  228. C
  229.       IF(IIMPI.NE.0) CALL ECSOLU(MSOLUT,0)
  230.       KSOLUT=MSOLUT
  231.  5000 CONTINUE
  232.       END
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  

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