1 : C DEPGE2 SOURCE CHAT 05/01/12 22:42:22 5004 2 : C 3 : SUBROUTINE DEPGE2(IPB,IPRX,IPIX,PROPRE,IBBX2,IPLMOX,IPLMOY) 4 : C 5 : C******************************************************************** 6 : C 7 : C SBR APPELE PAR ITINVC 8 : C 9 : C CALCUL DES DEPLACEMENTS GENERALISES COMPLEXES 10 : C """"""""""""""""""""""""""""""""""""""""""""" 11 : C ECRIT PAR C. LE BIDEAU JUILLET 2001 12 : C 13 : C 14 : C IPB POINTEUR MASSE 15 : C IPRX POINTEUR MODES PROPRES REELS 16 : C IPIX POINTEUR MODES PROPRES IMAGINAIRES 17 : C PROPRE VECTEUR DES CARACTERISTIQUES MODALES VOIR ITINVC 18 : C IBBX2 POINTEUR SUR CHAMPONT M*X 19 : C IPLIMO POINTEUR SUR LISTMOTS CONTENANT LES COUPLES UX FX ETC 20 : C POUR APPEL DE XTY1 21 : C 22 : C CAS PLAN QX,QY (QZ=0) 23 : C CAS AXISYMETRIQUE QX=QY=0 QZ NON NUL) QZ=QZ 24 : C FOURIER: 25 : C N=0 QZ NON NUL QX=QY=0 QZ+QZ 26 : C N=1 (HARM.SYM.) QY=QZ=0 QX NON NUL QX=(QR-QT) 27 : C N=-1 (HARM.ANTIS.) QX=QZ=0 QY NON NUL QY=(QR+QT) 28 : C 29 : C 30 : C 31 : C 07/2001 32 : C _______ 33 : C 34 : C LES CAS N DIFFERENT DE 0 N ONT PU ETRE TESTES CAR LES NUMEROS 35 : C D HARMONIQUE NE SONT PAS STOCKES DANS LES CHAMPS-POINT 36 : C 37 : C SOUS PROGRAMME APPELANT : ITINVC 38 : C 39 : C SOUS PROGRAMME APPELE: 40 : C DEPGE1 : CALCUL DTMU EN TESTANT SI ON EST EN SERIE DE 41 : C FOURIER OU NON 42 : C 43 : C******************************************************************** 44 : C 45 : C 46 : IMPLICIT INTEGER(I-N) 47 : IMPLICIT REAL*8(A-H,O-Z) 48 : REAL*8 PROPRE(*) 49 : -INC SMCHPOI 50 : -INC SMELEME 51 : -INC CCOPTIO 52 : C 53 : CHARACTER*4 MOT(3) 54 : * 55 : * ON PREND LE NUMERO D'OPTION DANS LE MCHPOI ,VARIABLE IFOPOI 56 : * 57 : MCHPOI=IPRX 58 : SEGACT MCHPOI 59 : IFOU1=IFOPOI 60 : SEGDES MCHPOI 61 : JFOUR=IFOU1+4 62 : * 63 : * LEX DEPLACEMENTS GENERALISES SE CALCULENT 64 : * AVEC LE CONJUGUE DU VECTEUR PROPRE 65 : * 65 : CALL MUCHPO(IPIX, -1.D0, IPIXB, 1) 66 : * 67 : * IMPRESSIONS 68 : * 69 : IF(IIMPI.EQ.322) WRITE(IOIMP,1000) JFOUR 70 : 1000 FORMAT(/10X,'SBR DEPGEN JFOUR',I5) 71 : GOTO(200,200,200,210,220,230),JFOUR 72 : 200 CONTINUE 73 : C 74 : C CAS PLAN QX QY (QZ= 0) 75 : C 76 : PROPRE(5)=0.D0 77 : PROPRE(10)=0.D0 78 : MOT(1)='UX' 79 : MOT(2)='UY' 80 : LMOT=2 81 : 520 DO 500 IMOT=1,LMOT 81 : CALL DEPGE1(IPB,IPRX,PROPRE(IMOT+2),MOT(IMOT),IBBX2,IPLMOX, 82 : & IPLMOY) 82 : CALL DEPGE1(IPB,IPIXB,PROPRE(IMOT+7),MOT(IMOT),IBBX2,IPLMOX, 83 : & IPLMOY) 84 : 500 CONTINUE 85 : GOTO 999 86 : 210 CONTINUE 87 : C 88 : C CAS AXISYMETRIQUE QX=QY=0 QZ 89 : C 90 : PROPRE(3)=0.D0 91 : PROPRE(4)=0.D0 92 : MOT(1)='UZ' 92 : CALL DEPGE1(IPB,IPRX,PROPRE(5),MOT(1),IBBX2,IPLMOX,IPLMOY) 93 : PROPRE(5)=PROPRE(5) 94 : PROPRE(8)=0.D0 95 : PROPRE(9)=0.D0 95 : CALL DEPGE1(IPB,IPIXB,PROPRE(10),MOT(1),IBBX2,IPLMOX, 96 : & IPLMOY) 97 : PROPRE(10) = PROPRE(10) 98 : GOTO 999 99 : 220 CONTINUE 100 : C 101 : C SERIE DE FOURIER 102 : C N DIFF. 1 ET 0 QX=QY=QZ=0 103 : C N =1 QY=QZ=0 QX=QR-QT HARM. SYM. 104 : C QX=QZ=0 QY=QR+QT HARM.ANTYS. 105 : C N=0 QX=QY=0 QZ NON NUL 106 : C 107 : MOT(1)='UX' 108 : MOT(2)='UY' 109 : MOT(3)='UZ' 110 : LMOT=3 111 : DO 510 IMOT=1,LMOT 111 : CALL DEPGE1(IPB,IPRX,PROPRE(2+IMOT),MOT(IMOT),IBBX2,IPLMOX, 112 : & IPLMOY) 112 : CALL DEPGE1(IPB,IPIXB,PROPRE(7+IMOT),MOT(IMOT),IBBX2,IPLMOX, 113 : & IPLMOY) 114 : 510 CONTINUE 115 : PROPRE(3)=PROPRE(3) 116 : PROPRE(4)=PROPRE(4) 117 : PROPRE(5)=PROPRE(5) 118 : PROPRE(8)= PROPRE(8) 119 : PROPRE(9)= PROPRE(9) 120 : PROPRE(10)= PROPRE(10) 121 : 122 : GOTO 999 123 : 230 CONTINUE 124 : C 125 : C CAS TRIDIM 126 : C 127 : MOT(1)='UX' 128 : MOT(2)='UY' 129 : MOT(3)='UZ' 130 : LMOT=3 131 : GOTO 520 132 : 999 CONTINUE 133 : RETURN 134 : END 135 : 136 : 137 : 138 : 139 :
© Cast3M 2003 - All rights reserved.
Disclaimer