Télécharger la plaquette Cast3M


fr en

Télécharger psevo1.eso

Retour à la liste

Numérotation des lignes : 

psevo1

  1. C PSEVO1    SOURCE    BP208322  22/09/09    21:15:05     11448          
  2.  
  3.       SUBROUTINE PSEVO1(IMODE,IPSMO,IBOO,IPX,ILEX,ICHAR,ICONT)
  4.  
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8. ************************************************************************
  9. *
  10. *                             P S E V O 1
  11. *                             -----------
  12. *
  13. * FONCTION:
  14. * ---------
  15. *
  16. *     AJOUTE LA CONTRIBUTION DES MODES NEGLIGES
  17. *                    POUR LES DEPLACEMENTS SI ICONT=0
  18. *                    POUR LES CONTRAINTES  SI ICONT=1
  19. *
  20. * MODULES UTILISES:
  21. * -----------------
  22. *
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMATTAC
  26. -INC SMCHARG
  27. -INC SMCHPOI
  28. -INC SMELEME
  29. -INC SMLREEL
  30. -INC SMSOLUT
  31. *
  32. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
  33. * -----------
  34. *
  35. *     IMODE   (E)  OBJET SOLUTION DE SOUS-TYPE MODE.
  36. *     IPSMO   (E)  OBJET SOLUTION DE SOUS-TYPE PSEUMODE.
  37. *     IBOO    (E)  POINTEUR SUR LE SEGMENT NUMOO.
  38. *             (S)  POINTEUR SUR LE SEGMENT NUMOO.
  39. *     IPX     (E)  POINTEUR SUR LE LISTREEL.
  40. *     ILEX    (E)  CONTIENT LES FORCES DE LIAISON AUX TEMPS DEMANDES.
  41. *     ICHAR   (E)  POINTEUR SUR LE CHARGEMENT.
  42. *
  43.       SEGMENT NUMOO
  44.         INTEGER NUMO(N),KLIST(N)
  45.         CHARACTER*(LOCHPO) NUDDL(N)
  46.       ENDSEGMENT
  47. *
  48. * VARIABLES:
  49. * ----------
  50. *
  51.       CHARACTER*4 COMP,COMP2,MONTYP,DIRECT
  52.       PARAMETER (TOLER = 1.D-6)
  53. *
  54. *
  55. * AUTEUR, DATE DE CREATION:
  56. * -------------------------
  57. *
  58. *     LIONEL VIVAN       SEPTEMBRE 1988
  59. *
  60. * LANGAGE:
  61. * --------
  62. *
  63. *     ESOPE + FORTRAN77
  64. *
  65. ************************************************************************
  66. *
  67.       IF (ICHAR.EQ.0 .AND. ILEX.EQ.0) THEN
  68.          CALL ERREUR(430)
  69.          RETURN
  70.       ENDIF
  71. *
  72.       NUMOO = IBOO
  73.       SEGACT NUMOO
  74.       NP = NUMO(/1)
  75.       DO 2 I = 1,NP
  76.          MLREE3 = KLIST(I)
  77.          SEGACT MLREE3
  78.  2    CONTINUE
  79. *
  80.       MLREEL= IPX
  81.       SEGACT MLREEL
  82.       LDIM = PROG(/1)
  83. *
  84.       IF (ICHAR.NE.0) THEN
  85.          MCHARG = ICHAR
  86.          SEGACT MCHARG
  87.          NCH = KCHARG(/1)
  88.       ENDIF
  89. *
  90.       MSOLUT = IPSMO
  91.       SEGACT MSOLUT
  92. *
  93.       MSOLEN = MSOLIS(10)
  94.       SEGACT MSOLEN
  95.       NPS = ISOLEN(/1)
  96. *
  97.       IF (ICONT.EQ.0) MSOLE1 = MSOLIS(5)
  98.       IF (ICONT.EQ.1) MSOLE1 = MSOLIS(6)
  99.       SEGACT MSOLE1
  100. *
  101.       IF (ILEX.NE.0) THEN
  102.          MSOLE2 = ILEX
  103.          SEGACT MSOLE2
  104.        ENDIF
  105. *
  106.       DO 10 IP = 1,NPS
  107.          MJONCT = ISOLEN(IP)
  108.          SEGACT MJONCT
  109.          MONTYP = MJOTYP
  110. *
  111. *        PSEUDO-MODE D'UNE STRUCTURE MULTISUPPORTEE
  112. *
  113.          IF (MONTYP.EQ.'DEPL') THEN
  114.             IF (ICHAR.EQ.0) THEN
  115.                SEGDES  MJONCT
  116.                GOTO 10
  117.             ENDIF
  118.             ICHM = IPCHJO(1)
  119. *           RECHERCHE DU CHARGEMENT
  120.             DO 12 IC = 1,NCH
  121.                ICHARG = KCHARG(IC)
  122.                SEGACT ICHARG
  123.                IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(IC).NE.'STAT'
  124.      & .OR.CHALIE(IC).NE.'LIE ') THEN
  125.                   SEGDES ICHARG
  126.                   GOTO 12
  127.                ENDIF
  128.                ICHC = ICHPO1
  129.                IF (ICHC.EQ.ICHM) THEN
  130. *                 ON A TROUVE LE CHARGEMENT
  131.                   GOTO 100
  132.                ENDIF
  133.                SEGDES ICHARG
  134. 12          CONTINUE
  135. *
  136. *           MANQUE LE CHARGEMENT POUR LE PSEUDO-MODE
  137. *
  138.             INTERR(1) = IP
  139.             CALL ERREUR(428)
  140.             SEGDES MJONCT
  141.             GOTO 10
  142. *
  143. *        PSEUDO-MODE D'UNE FORCE CONCENTREE
  144. *
  145.          ELSE IF (MONTYP.EQ.'FORC') THEN
  146.             IF (ICHAR.EQ.0) THEN
  147.                SEGDES  MJONCT
  148.                GOTO 10
  149.             ENDIF
  150.             ICHM = IPCHJO(1)
  151. *           RECHERCHE DU CHARGEMENT
  152.             DO 22 IC = 1,NCH
  153.                ICHARG = KCHARG(IC)
  154.                SEGACT ICHARG
  155.                IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(IC).NE.'STAT'
  156.      & .OR.CHALIE(IC).NE.'LIE ') THEN
  157.                   SEGDES ICHARG
  158.                   GOTO 22
  159.                ENDIF
  160.                ICHC = ICHPO1
  161.                IF (ICHC.EQ.ICHM) THEN
  162. *                 ON A TROUVE LE CHARGEMENT
  163.                   GOTO 100
  164.                ENDIF
  165.                SEGDES ICHARG
  166. 22          CONTINUE
  167. *
  168. *           IL N'Y A PAS DE CHARGEMENT POUR CE TYPE DE PSEUDO-MODE
  169. *
  170.             INTERR(1) = IP
  171.             CALL ERREUR(428)
  172.             SEGDES MJONCT
  173.             GOTO 10
  174. *
  175. *        PSEUDO-MODE D'UNE EXCITATION SISMIQUE D'ENSEMBLE
  176. *
  177.          ELSE IF (MONTYP.EQ.'SEIS') THEN
  178.             IF (ICHAR.EQ.0) THEN
  179.                SEGDES  MJONCT
  180.                GOTO 10
  181.             ENDIF
  182.             DIRECT = MJODDL
  183.             IF (DIRECT.EQ.'UX  ') THEN
  184.                IPLAC = 3
  185.             ELSE IF (DIRECT.EQ.'UY  ') THEN
  186.                IPLAC = 4
  187.             ELSE
  188.                IPLAC = 5
  189.             ENDIF
  190.             MSO1 = IMODE
  191.             SEGACT MSO1
  192.             MSOLE2 = MSO1.MSOLIS(4)
  193.             SEGDES MSO1
  194.             SEGACT MSOLE2
  195.             MMODE = MSOLE2.ISOLEN(1)
  196.             SEGDES MSOLE2
  197.             SEGACT MMODE
  198.             QPS = -1.D0 * FMMODD(IPLAC)
  199.             SEGDES MMODE
  200. *           RECHERCHE DU CHARGEMENT
  201.             DO 32 IC = 1,NCH
  202.                ICHARG = KCHARG(IC)
  203.                SEGACT ICHARG
  204.                IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(IC).NE.'STAT'
  205.      & .OR.CHALIE(IC).NE.'LIE ') THEN
  206.                   SEGDES ICHARG
  207.                   GOTO 32
  208.                ENDIF
  209.                MCHPOI = ICHPO1
  210.                SEGACT MCHPOI
  211.                MSOUPO = IPCHP(1)
  212.                SEGDES MCHPOI
  213.                SEGACT MSOUPO
  214.                MPOVAL = IPOVAL
  215.                SEGDES MSOUPO
  216.                SEGACT MPOVAL
  217.                QXYZ = VPOCHA(1,1)
  218.                SEGDES MPOVAL
  219.                EPS = ABS(QPS - QXYZ)
  220.                IF (EPS.LT.TOLER) THEN
  221. *                 ON A TROUVE LE CHARGEMENT
  222.                   GOTO 100
  223.                ENDIF
  224.                SEGDES ICHARG
  225. 32          CONTINUE
  226. *
  227. *           IL N'Y A PAS DE CHARGEMENT CORRESPONDANT AU PSEUDO-MODE
  228. *
  229.             INTERR(1) = IP
  230.             CALL ERREUR(428)
  231.             SEGDES MJONCT
  232.             GOTO 10
  233. *
  234. *        PSEUDO-MODE D'UNE FORCE DE CHOC
  235. *
  236.          ELSE IF (MONTYP.EQ.'CHOC') THEN
  237.             IF (ILEX.EQ.0) THEN
  238.                SEGDES  MJONCT
  239.                GOTO 10
  240.             ENDIF
  241.             GOTO 100
  242.          ENDIF
  243. *
  244. 100      CONTINUE
  245.          IF (ICONT.EQ.0) THEN
  246.             ICHP = MSOLE1.ISOLEN(IP)
  247.          ELSE
  248.             ICCC = MSOLE1.ISOLEN(IP)
  249.             CALL PELPO(ICCC,ICHP,IRETOU)
  250.             IF (IRETOU.EQ.0) THEN
  251.                INTERR(1) = IP
  252.                CALL ERREUR(428)
  253.                SEGDES MJONCT
  254.                GOTO 10
  255.             ENDIF
  256.          ENDIF
  257. *
  258.          IF (ICHAR.NE.0) THEN
  259.             MLREE1 = ICHPO2
  260.             SEGACT MLREE1
  261.             NF = MLREE1.PROG(/1)
  262.             MLREE2 = ICHPO3
  263.             SEGACT MLREE2
  264.          ENDIF
  265. *
  266.          N1 = 1
  267.          N2 = 2
  268.          DO 110 IT = 1,LDIM
  269.             TEM1 = PROG(IT)
  270.             IF (MONTYP.EQ.'CHOC') THEN
  271.                FTEM1 = 0.D0
  272.                IPOINP = MJOPOI
  273.                COMP = MJODDL
  274. *              RECHERCHE DANS LE CHPOINT DES FORCES DE LIAISON
  275.                ICHLIA = MSOLE2.ISOLEN(IT)
  276.                CALL EXTRA9(ICHLIA,IPOINP,COMP,0,.FALSE.,FTEM1,IRET)
  277.                IF (IRET.NE.1) THEN
  278.                  INTERR(1) = IP
  279.                  CALL ERREUR(428)
  280.                  SEGDES MJONCT
  281.                  GOTO 10
  282.                ENDIF
  283.             ELSE
  284.                CALL INTLIN(TEM1,ICHPO2,ICHPO3,NF,N1,N2,FTEM1,IRETOU)
  285.                IF (IRETOU.EQ.0) THEN
  286.                  INTERR(1) = IP
  287.                  CALL ERREUR(428)
  288.                  SEGDES MLREE1
  289.                  SEGDES MLREE2
  290.                  SEGDES ICHARG
  291.                  SEGDES MJONCT
  292.                  GOTO 10
  293.                ENDIF
  294.             ENDIF
  295. *
  296.             DO 120 I3 = 1,NP
  297.                IPOIN = NUMO(I3)
  298.                COMP = NUDDL(I3)
  299.                CALL EXTRA9(ICHP,IPOIN,COMP,0,.FALSE.,XFLOT1,IRET)
  300.                IF (IRET.NE.1) THEN
  301.                  IF (ICHAR.NE.0) THEN
  302.                     SEGDES MLREE1
  303.                     SEGDES MLREE2
  304.                     SEGDES ICHARG
  305.                  ENDIF
  306.                  INTERR(1) = IP
  307.                  CALL ERREUR(428)
  308.                  SEGDES MJONCT
  309.                  GOTO 10
  310.                ENDIF
  311.                XVAL = XFLOT1 * FTEM1
  312. *
  313.       IF (IIMPI.EQ.1804) THEN
  314.       PRINT*,'-- PRISE EN COMPTE DES PSEUDO-MODES -- XVAL :',XVAL
  315.       ENDIF
  316. *
  317.                MLREE3 = KLIST(I3)
  318.                MLREE3.PROG(IT) = MLREE3.PROG(IT) + XVAL
  319. 120         CONTINUE
  320. *
  321. 110      CONTINUE
  322.          IF (ICONT.EQ.1) THEN
  323.             MCHPO1=ICHP
  324.             SEGSUP MCHPO1
  325.          ENDIF
  326.          IF (ICHAR.NE.0) THEN
  327.             SEGDES MLREE1
  328.             SEGDES MLREE2
  329.             SEGDES ICHARG
  330.          ENDIF
  331.          SEGDES MJONCT
  332. *
  333. 10    CONTINUE
  334. *
  335.       SEGDES MLREEL
  336.       SEGDES MSOLE1
  337.       SEGDES MSOLEN
  338.       SEGDES MSOLUT
  339.       IF (ILEX.NE.0) THEN
  340.          SEGDES MSOLE2
  341.       ENDIF
  342.       IF (ICHAR.NE.0) THEN
  343.          SEGDES MCHARG
  344.       ENDIF
  345.       DO 4 I = 1,NP
  346.          MLREE3 = KLIST(I)
  347.          SEGDES MLREE3
  348.  4    CONTINUE
  349. *
  350. *     SEGDES NUMOO
  351.       IBOO = NUMOO
  352. *
  353.       RETURN
  354.       END
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  

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