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

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