Télécharger crsol1.eso

Retour à la liste

Numérotation des lignes :

  1. C CRSOL1 SOURCE BP208322 09/03/20 21:15:07 6331
  2. ************************************************************************
  3. *
  4. * CRSOL1
  5. * -----------
  6. *
  7. * FONCTION:
  8. * ---------
  9. *
  10. * -- CONSTRUCTION D'UN OBJET SOLUTION, A PARTIR DE LA LISTE
  11. * DES FREQUENCES PROPRES ET DE CELLE DES MODES PROPRES.
  12. * LES LISTES SONT SUPPOSES TRIEES, LES FREQUENCES SHIFTEES,
  13. * ET LES MODES ORTHONORMALISES. --
  14. *
  15. * MODE D'APPEL:
  16. * -------------
  17. *
  18. * CALL CRSOL1 (FREQ,IPLVAR,IPLVAI,IPLVER, IPLVEI, NBMOD, IPKW2M, IPMASS,
  19. * & MTAB3, ICOMP, I)
  20. *
  21. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  22. * -----------
  23. *
  24. * IPLVAR ENTIER (E) POINTEUR DE L'OBJET 'LISTREEL' CONTENANT
  25. * LA SUITE DES FREQUENCES PROPRES REELLES.
  26. * IPLVAI ENTIER (E) POINTEUR DE L'OBJET 'LISTREEL' CONTENANT
  27. * LA SUITE DES FREQUENCES IMAGINAIRES
  28. * IPLVER ENTIER (E) POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  29. * LA SUITE DES MODES PROPRES REELS.
  30. * IPLVEI ENTIER (E) POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  31. * LA SUITE DES MODES PROPRES IMAGINAIRES.
  32. * NBMOD ENTIER (E) NOMBRE DE MODES A INSERER DANS LA SOLUTION
  33. * ON A: NBMOD .LE. DIMENSION( IPLVAL )
  34. *
  35. * IPKW2M, IPMASS (E) MATRICES DE RIGIDITE (DECALEE) ET DE MASSE
  36. *
  37. * FREQ REEL (E) FREQUENCE UTILISEE POUR LE DECALLAGE
  38. *
  39. * MTAB3 ENTIER (S) POINTEUR SUR LA SOLUTION CREEE.
  40. *
  41. *
  42. * AUTEUR, DATE DE CREATION:
  43. * -------------------------
  44. *
  45. * C. LE BIDEAU 09 / 2001 ( FORTRAN + ESOPE )
  46. * MODIF Benoit Prabel Mars 2009
  47. *
  48. ***************************************************
  49. * SUBROUTINE CRSOL1 (FREQ,IPLVAR,IPLVAI,IPLVER, IPLVEI,
  50. * & NBMOD,IPKW2M,IPMASS,MTAB3,ICOMP, I)
  51. SUBROUTINE CRSOL1 (W2,IPLVAR,IPLVAI,IPLVER,NBMOD,NBMOD2,
  52. & IPKW2M,IPMASS,MTAB3,I,INF0)
  53.  
  54. IMPLICIT INTEGER(I-N)
  55. IMPLICIT REAL*8 (A-H,O-Z)
  56.  
  57. -INC CCOPTIO
  58. -INC SMLCHPO
  59. -INC SMLREEL
  60. -INC SMLMOTS
  61. -INC SMTABLE
  62. -INC CCREEL
  63.  
  64. ******
  65. * -- CONSTANTES --
  66. ***
  67. PARAMETER (LPROPR = 10)
  68. PARAMETER (DEUXPI = (2.D0*XPI))
  69.  
  70. ******
  71. * -- ARGUMENTS --
  72. ***
  73. POINTEUR IPLVER.MLCHPO,IPLVAR.MLREEL,IPLVAI.MLREEL
  74. INTEGER NBMOD, IPKW2M, IPMASS
  75.  
  76. ******
  77. * -- VARIABLES LOCALES --
  78. ***
  79. POINTEUR IPLMOX.MLMOTS, IPLMOY.MLMOTS
  80. INTEGER IPMODE, IPSOL1
  81. REAL*8 W2, PROPRE(LPROPR),PROPR2(LPROPR),XRVP, XIVP
  82.  
  83.  
  84. ***** ACTIVATIONS ****************************************************
  85. SEGACT ,IPLVER, IPLVAR, IPLVAI
  86.  
  87. *-----initialisation
  88. NBNEG = 1
  89. NBPOS = 0
  90.  
  91.  
  92. ***** BOUCLE SUR LES MODES A ECRIRE **********************************
  93. JVEC = 0
  94. * DO 100 IB100 = 1, NBMOD
  95. DO 100 IB100 = 1, NBMOD2
  96.  
  97. JVEC = JVEC + 1
  98.  
  99. *------ frequence propre
  100. XRVP = IPLVAR.PROG(JVEC)
  101. XIVP = IPLVAI.PROG(JVEC)
  102. PROPRE(1) = XRVP
  103. PROPRE(6) = XIVP
  104.  
  105. *------ numero du mode (indicé selon lambda)
  106. * NUMOD2 = JVEC - NNBMOD
  107. XLAMBR = (DEUXPI**2) * ((XRVP**2) - (XIVP**2))
  108. * WRITE(6,*) 'CRSOL1: mode',JVEC
  109. * WRITE(6,*) ' w=',XRVP,'+i',XIVP,'L=',XLAMBR,'W2=',W2
  110. if(XLAMBR .lt. W2) then
  111. NBNEG = NBNEG - 1
  112. NUMOD2 = NBNEG
  113. else
  114. NBPOS = NBPOS + 1
  115. NUMOD2 = NBPOS
  116. endif
  117. * write(6,*) 'NBNEG,NBPOS,NUMOD2=',NBNEG,NBPOS,NUMOD2
  118.  
  119. *------ partie reelle du vecteur propre
  120. IPRX = IPLVER.ICHPOI(JVEC)
  121.  
  122. *------ debut masse généralisée + eventuelle recup des mots utiles
  123. CALL MUCPRI ( IPRX, IPMASS, IPBXR )
  124. IF (IB100 .EQ. 1) THEN
  125. CALL CORRSP(IPMASS, IPRX, IPBXR, IPLMOX, IPLMOY)
  126. END IF
  127. CALL XTY1(IPRX, IPBXR, IPLMOX, IPLMOY, XRBXR)
  128. IF (IERR .NE. 0 ) RETURN
  129.  
  130.  
  131. *------ Cas d'un mode Réel
  132. IF((XRVP .eq. 0.) .or. (XIVP .eq. 0.)) then
  133. * valeur propre w réelle pure ou imaginaire pure (car lambda réel pur)
  134. * vecteur propre reel = IPRX
  135. IPIX = 0
  136. * masse complexe généralisée
  137. PROPRE(2) = XRBXR
  138. PROPRE(7) = 0.D0
  139. C INTRODUCTION DES COEF. PI OU 2PI EVENTUELS + calcul DEPGEN
  140. * CALL MASGEN(XRVP,PROPRE)
  141. CALL DEPGEN(IPMASS, IPRX, PROPRE, IPBXR, IPLMOX,IPLMOY)
  142.  
  143. * Ecriture dans MTAB3 du I^eme mode
  144. CALL CREBAS (PROPRE, IPRX, IPIX, IPKW2M, INF0,
  145. & NUMOD2, MTAB3, I)
  146. I = I+1
  147.  
  148.  
  149. *------ Cas d'un mode Complexe
  150. ELSE
  151. IPIX = IPLVER.ICHPOI(JVEC + 1)
  152. * valeur et vecteur propre complexe',IPIX
  153. * fin du calcul de la masse complexe généralisée
  154. CALL XTY1(IPIX, IPBXR, IPLMOX, IPLMOY, XIBXR)
  155. CALL MUCPRI(IPIX, IPMASS, IPBXI)
  156. CALL XTY1(IPRX, IPBXI, IPLMOX, IPLMOY, XRBXI)
  157. CALL XTY1(IPIX, IPBXI, IPLMOX, IPLMOY, XIBXI)
  158. PROPRE(2) = XRBXR - XIBXI
  159. PROPRE(7) = XIBXR + XRBXI
  160. * write(*,*)'masse gene complexe=',(PROPRE(2)),(PROPRE(7))
  161. C INTRODUCTION DES COEF. PI OU 2PI EVENTUELS + calcul DEPGEN
  162. CALL DEPGEN(IPMASS, IPRX, PROPRE, IPBXR, IPLMOX,IPLMOY)
  163. CALL DEPGE2(IPMASS, IPRX,IPIX, PROPRE, IPBXR, IPLMOX,IPLMOY)
  164. * write(*,*)'* on decale JVEC...'
  165. JVEC = JVEC + 1
  166. if(XLAMBR .lt. W2) then
  167. NBNEG = NBNEG - 1
  168. else
  169. NBPOS = NBPOS + 1
  170. endif
  171.  
  172. * Ecriture dans MTAB3 du I^eme mode
  173. CALL CREBAS (PROPRE, IPRX, IPIX, IPKW2M, INF0,
  174. & NUMOD2, MTAB3, I)
  175. I = I+1
  176.  
  177. * Ecriture dans MTAB3 du I+1^eme mode (=conjugué du 1er)
  178. PROPR2(1) = IPLVAR.PROG(JVEC)
  179. PROPR2(6) = IPLVAI.PROG(JVEC)
  180. PROPR2(2) = -1.*PROPRE(2)
  181. PROPR2(7) = -1.*PROPRE(7)
  182. call MUCHPO(IPIX,-1.,IPIXCONJ,1)
  183. CALL CREBAS (PROPR2, IPRX, IPIXCONJ, IPKW2M, INF0,
  184. & NUMOD2, MTAB3, I)
  185. I = I+1
  186.  
  187.  
  188. ENDIF
  189. *-------fin de la distinction Mode reel/complexe
  190.  
  191.  
  192. CALL DTCHPO ( IPBXR )
  193. if((XRVP .ne. 0.) .and. (XIVP .ne. 0.))
  194. & CALL DTCHPO ( IPBXI )
  195.  
  196.  
  197. IF ( IERR .NE. 0 ) RETURN
  198.  
  199. if(JVEC .ge. NBMOD2) goto 900
  200.  
  201. 100 CONTINUE
  202.  
  203. 900 CONTINUE
  204.  
  205. SEGDES ,IPLVER, IPLVAR, IPLVAI
  206.  
  207. RETURN
  208. END
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  

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