1 : C PJLIBR SOURCE PV 11/03/07 21:17:48 6885 2 : SUBROUTINE PJLIBR(IP1,IP2,IP4,IRET ) 3 : IMPLICIT INTEGER(I-N) 4 : CHARACTER*4 MOT1,MOT2,MOT3,MOT4 5 : CHARACTER*4 LDUATR(3),LDUARO(3) 6 : DIMENSION IPLACF(3),IPLACM(3) 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 : -INC CCOPTIO 26 : -INC SMCHPOI 27 : -INC SMLCHPO 28 : -INC SMLREEL 29 : SEGMENT ICARA 30 : CHARACTER*4 LCARA(NCARA) 31 : ENDSEGMENT 32 : SEGMENT ILIST 33 : INTEGER LIST(NLIST) 34 : ENDSEGMENT 35 : C 36 : DATA LDUATR/'FX ','FY ','FZ '/ 37 : DATA LDUARO/'MX ','MY ','MZ '/ 38 : C 39 : IF(IFOMOD.EQ.0) GOTO 5000 40 : DO 1 I=1,3 41 : IPLACF(I) = 0 42 : IPLACM(I) = 0 43 : 1 CONTINUE 44 : C 45 : C DESCRIPTION DES COMPOSANTES DU CHAMPOINT IP1 46 : NBMO = 0 47 : MCHPOI = IP1 48 : SEGACT MCHPOI 49 : MSOUPO = IPCHP(1) 50 : SEGACT MSOUPO 51 : SEGDES MCHPOI 52 : NDDL = NOCOMP(/2) 53 : NCARA = NDDL 54 : SEGINI ICARA 55 : MOTDDL = ICARA 56 : DO 2 I = 1,NDDL 57 : MOT1 = NOCOMP(I) 58 : LCARA(I) = MOT1 59 : DO 3 J = 1,IDIM 60 : IF( MOT1.EQ.LDUARO(J) ) THEN 61 : IPLACM(J) = I 62 : NBMO = NBMO + 1 63 : GOTO 2 64 : ENDIF 65 : IF( MOT1.EQ.LDUATR(J) ) THEN 66 : IPLACF(J) = I 67 : GOTO 2 68 : ENDIF 69 : 3 CONTINUE 70 : 2 CONTINUE 71 : IF( NBMO.NE.0. AND .IDIM.EQ.2 ) GOTO 6000 72 : C 73 : C CREATION D'UN CHAMPOINT NUL 74 : IPOE = IGEOC 75 : SEGDES MSOUPO 76 : JG = 1 77 : SEGINI MLREEL 78 : PROG(1) = 0.D0 79 : IL0 = MLREEL 80 : NLIST = NDDL 81 : SEGINI ILIST 82 : DO 4 I =1,NDDL 83 : LIST(I) = IL0 84 : 4 CONTINUE 85 : LIST0 = ILIST 85 : CALL MANUC1(IPOE,MOTDDL,LIST0,ICH0) 86 : ILIST = LIST0 87 : SEGSUP ILIST 88 : MLREEL= IL0 89 : SEGSUP MLREEL 90 : ICARA = MOTDDL 91 : SEGSUP ICARA 92 : C 93 : N1 = IDIM * IDIM 94 : SEGINI MLCHPO 95 : C 96 : C CALCUL DES CHAMPOINTS DE DECOMPOSITION 97 : DO 5 I = 1,IDIM 98 : MOT2 = LDUATR(I) 99 : IF ( NBMO.NE.0. AND .IDIM.EQ.3 ) MOT4 = LDUARO(I) 100 : C 101 : DO 6 J = 1,IDIM 102 : K = (J-1) * IDIM + I 103 : IF(IPLACF(J).EQ.0) THEN 103 : CALL COPIE2(ICH0,ICH) 104 : ELSE 105 : MOT1 = LDUATR(J) 105 : CALL EXCOPP (IP1,MOT1,ICH,MOT2,0 ) 106 : ENDIF 107 : IF( IPLACM(J).NE.0) THEN 108 : IF ( NBMO.NE.0. AND .IDIM.EQ.3 ) MOT3 = LDUARO(J) 108 : CALL EXCOPP (IP1,MOT3,ICHR,MOT4,0 ) 108 : CALL ADCHPO (ICHR,ICH,ICH2,1D0,-1D0) 108 : CALL DTCHPO (ICHR) 108 : CALL DTCHPO (ICH) 108 : CALL COPIE2(ICH2,ICH) 108 : CALL DTCHPO(ICH2) 109 : ENDIF 109 : CALL PROJBA( ICH,IP2,IP4,IRET1 ) 110 : IF ( IRET1 .EQ. 0 ) THEN 111 : DO 7 L = 1,N1 112 : IRET2 = ICHPOI(L) 112 : IF(IRET2.NE.0) CALL DTCHPO(IRET2) 113 : 7 CONTINUE 114 : SEGSUP MLCHPO 114 : CALL DTCHPO (ICH0) 115 : RETURN 116 : ENDIF 117 : ICHPOI(K) = IRET1 117 : CALL DTCHPO(ICH) 118 : 6 CONTINUE 119 : 5 CONTINUE 120 : IRET = MLCHPO 121 : SEGDES MLCHPO 121 : CALL DTCHPO(ICH0) 122 : RETURN 123 : C 124 : 5000 CONTINUE 125 : WRITE(IOIMP,5001) 126 : 5001 FORMAT(' LE CAS AXISYMETRIQUE N EXISTE PAS ENCORE POUR L OPTION 127 : *LIBR DE PJBA ') 128 : RETURN 129 : 6000 CONTINUE 130 : WRITE(IOIMP,6001) 131 : 6001 FORMAT(' LA FORMULATION COQUE PLANE N EXISTE PAS ENCORE POUR L OPT 132 : *ION LIBR DE PJBA ') 133 : RETURN 134 : END 135 : 136 :
© Cast3M 2003 - All rights reserved.
Disclaimer