Télécharger la plaquette Cast3M


fr en

Télécharger pjlibr.eso

Retour à la liste

Numérotation des lignes : 

pjlibr

  1. C PJLIBR    SOURCE    CB215821  20/11/25    13:35:50     10792          
  2.       SUBROUTINE PJLIBR(IP1,IP2,IP4,IRET )
  3.  
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6.  
  7. C***********************************************************************
  8. C  CALCUL DES FORCES GENERALISEES DANS LE CAS D'UNE BASE TOURNANTE     *
  9. C  ET D'UN CHARGEMENT NON LIE A LA BASE ( OPTION LIBR DE PJBA )        *
  10. C  APPELE PAR PJBA                                                     *
  11. C***********************************************************************
  12. C ARGUMENTS                                                            *
  13. C     ENTREES :                                                        *
  14. C   -----------                                                        *
  15. C    IP1 = CHAMPOINT ASSOCIE AU CHARGEMENT(OBJET 'CHPOINT')            *
  16. C    IP2 = BASE MODALE (OBJET 'BASEMODA')                              *
  17. C    IP4 = NUMERO DE LA BASE ELEMENTAIRE AFFECTEE (ENTIER)             *
  18. C     SORTIES :                                                        *
  19. C   -----------                                                        *
  20. C    IRET = LISTE DES CHAMPOINTS DE DECOMPOSITION DES FORCES           *
  21. C           GENERALISEES ( OBJET 'LISTCHPO' )                          *
  22. C                                                                      *
  23. C PROGAMMEUR : CHARVET QUEMIN                                          *
  24. C***********************************************************************
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC SMCHPOI
  29. -INC SMLCHPO
  30. -INC SMLREEL
  31.  
  32.       SEGMENT ICARA
  33.         CHARACTER*(LOCOMP) LCARA(NCARA)
  34.       ENDSEGMENT
  35.  
  36.       SEGMENT ILIST
  37.         INTEGER     LIST(NLIST)
  38.       ENDSEGMENT
  39.  
  40.       CHARACTER*(LOCOMP) MOT1,MOT2,MOT3,MOT4
  41.       CHARACTER*(LOCOMP) LDUATR(3),LDUARO(3)
  42.       DIMENSION IPLACF(3),IPLACM(3)
  43. C
  44.       DATA LDUATR/'FX  ','FY  ','FZ  '/
  45.       DATA LDUARO/'MX  ','MY  ','MZ  '/
  46. C
  47.       IF(IFOMOD.EQ.0) GOTO 5000
  48.       DO 1 I=1,3
  49.       IPLACF(I) = 0
  50.       IPLACM(I) = 0
  51. 1     CONTINUE
  52. C
  53. C DESCRIPTION DES COMPOSANTES DU CHAMPOINT IP1
  54.       NBMO = 0
  55.       MCHPOI = IP1
  56.       SEGACT MCHPOI
  57.       MSOUPO = IPCHP(1)
  58.       SEGACT MSOUPO
  59.       SEGDES MCHPOI
  60.       NDDL = NOCOMP(/2)
  61.       NCARA = NDDL
  62.       SEGINI ICARA
  63.       MOTDDL = ICARA
  64.       DO 2 I = 1,NDDL
  65.       MOT1 = NOCOMP(I)
  66.       LCARA(I) = MOT1
  67.       DO 3 J = 1,IDIM
  68.       IF( MOT1.EQ.LDUARO(J) ) THEN
  69.       IPLACM(J) = I
  70.       NBMO = NBMO + 1
  71.       GOTO 2
  72.       ENDIF
  73.       IF( MOT1.EQ.LDUATR(J) ) THEN
  74.       IPLACF(J) = I
  75.       GOTO 2
  76.       ENDIF
  77. 3     CONTINUE
  78. 2     CONTINUE
  79.       IF( NBMO.NE.0. AND .IDIM.EQ.2 ) GOTO 6000
  80. C
  81. C CREATION D'UN CHAMPOINT NUL
  82.       IPOE = IGEOC
  83.       SEGDES MSOUPO
  84.       JG = 1
  85.       SEGINI MLREEL
  86.       PROG(1) = 0.D0
  87.       IL0 = MLREEL
  88.       NLIST = NDDL
  89.       SEGINI ILIST
  90.       DO 4 I =1,NDDL
  91.       LIST(I) = IL0
  92. 4     CONTINUE
  93.       LIST0 = ILIST
  94.       CALL MANUC1(IPOE,MOTDDL,LIST0,ICH0)
  95.       ILIST = LIST0
  96.       SEGSUP ILIST
  97.       MLREEL= IL0
  98.       SEGSUP MLREEL
  99.       ICARA = MOTDDL
  100.       SEGSUP ICARA
  101. C
  102.       N1 = IDIM * IDIM
  103.       SEGINI MLCHPO
  104. C
  105. C CALCUL DES CHAMPOINTS DE DECOMPOSITION
  106.       DO 5 I = 1,IDIM
  107.       MOT2 = LDUATR(I)
  108.       IF ( NBMO.NE.0. AND .IDIM.EQ.3 ) MOT4 = LDUARO(I)
  109. C
  110.       DO 6 J = 1,IDIM
  111.       K = (J-1) * IDIM + I
  112.       IF(IPLACF(J).EQ.0) THEN
  113.            CALL COPIE2(ICH0,ICH)
  114.       ELSE
  115.            MOT1 = LDUATR(J)
  116.            CALL EXCOPP(IP1,MOT1,NIFOUR,ICH,MOT2,NIFOUR,0 )
  117.       ENDIF
  118.       IF( IPLACM(J).NE.0) THEN
  119.            IF ( NBMO.NE.0. AND .IDIM.EQ.3 ) MOT3 = LDUARO(J)
  120.            CALL EXCOPP(IP1,MOT3,NIFOUR,ICHR,MOT4,NIFOUR,0 )
  121.            CALL ADCHPO(ICHR,ICH,ICH2,1D0,-1D0)
  122.            CALL DTCHPO(ICHR)
  123.            CALL DTCHPO(ICH)
  124.            CALL COPIE2(ICH2,ICH)
  125.            CALL DTCHPO(ICH2)
  126.       ENDIF
  127.       CALL PROJBA( ICH,IP2,IP4,IRET1 )
  128.       IF ( IRET1 .EQ. 0 ) THEN
  129.            DO 7 L = 1,N1
  130.            IRET2 = ICHPOI(L)
  131.            IF(IRET2.NE.0) CALL DTCHPO(IRET2)
  132. 7          CONTINUE
  133.            SEGSUP MLCHPO
  134.            CALL DTCHPO (ICH0)
  135.            RETURN
  136.       ENDIF
  137.       ICHPOI(K) = IRET1
  138.       CALL DTCHPO(ICH)
  139. 6     CONTINUE
  140. 5     CONTINUE
  141.       IRET = MLCHPO
  142.       SEGDES MLCHPO
  143.       CALL DTCHPO(ICH0)
  144.       RETURN
  145. C
  146. 5000  CONTINUE
  147.       WRITE(IOIMP,5001)
  148. 5001  FORMAT(' LE CAS AXISYMETRIQUE N EXISTE PAS ENCORE POUR L OPTION
  149.      *LIBR DE PJBA ')
  150.       RETURN
  151. 6000  CONTINUE
  152.       WRITE(IOIMP,6001)
  153. 6001  FORMAT(' LA FORMULATION COQUE PLANE N EXISTE PAS ENCORE POUR L OPT
  154.      *ION LIBR DE PJBA ')
  155.       RETURN
  156.       END
  157.  
  158.  
  159.  
  160.  
  161.  

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