Télécharger la plaquette Cast3M


fr en

Télécharger simul1.eso

Retour à la liste

Numérotation des lignes : 

simul1

  1. C SIMUL1    SOURCE    PB245956  20/12/21    21:15:16     10747          
  2.       SUBROUTINE SIMUL1 (FREQ,NBMODE,IPRIGI,IPMASS,  IPSOLU, LIMAGE)
  3.  
  4. ************************************************************************
  5. *
  6. *                             S I M U L 1
  7. *                             -----------
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. *     APPELE PAR LE SOUS-PROGRAMME "SIMULT".
  13. *     DETERMINE UNE SERIE DE MODES PROPRES DONT LES FREQUENCES SONT
  14. *     VOISINES D'UNE VALEUR DONNEE.
  15. *
  16. * MODE D'APPEL:
  17. * -------------
  18. *
  19. *     CALL SIMUL1 (FREQ,NBMODE,IPRIGI,IPMASS,  IPSOLU)
  20. *
  21. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  22. * -----------
  23. *
  24. *     FREQ    REEL DP   (E)  FREQUENCE AUTOUR DE LAQUELLE ON CHERCHE
  25. *                            DES FREQUENCES PROPRES.
  26. *     NBMODE  ENTIER    (E)  NOMBRE DE MODES PROPRES DEMANDES.
  27. *     IPRIGI  ENTIER    (E)  POINTEUR SUR L'OBJET 'RIGIDITE' DE
  28. *                            SOUS-TYPE "RIGIDITE".
  29. *     IPMASS  ENTIER    (E)  POINTEUR SUR L'OBJET 'RIGIDITE' DE
  30. *                            SOUS-TYPE "MASSE".
  31. *     IPSOLU  ENTIER    (S)  POINTEUR SUR L'OBJET 'SOLUTION' CONTENANT
  32. *                            LES MODES PROPRES CALCULES.
  33. *     LIMAGE  (E)  LOGICAL =vrai si on souhaite garder les eventuelles
  34. *                           valeurs propres negatives
  35. *                           (matrice K non definie positive par ex.)
  36. *
  37. * MODE DE FONCTIONNEMENT:
  38. * -----------------------
  39. *
  40. *   . SELON LA MEMOIRE, ON SE DONNE UN NOMBRE MAX DE VECTEURS X
  41. *   . PAR CYCLE, ON REALISE LES OPERATIONS SUIVANTES :
  42. *     1. (DECALE) DECALAGE DE LA MATRICE DE RIGIDITE K'= K -(2*pi*freq)^2*M
  43. *     2. (LANCZO) CALCUL DES VECTEURS K'-ORTHOGONAUX DE LANCZOS = X
  44. *                 (eventuellement M-orthogonaux a qq Z deja convergés)
  45. *     3. (SIMU21) CALCUL DES VALEURS et VECTEURS PROPRES DU PROBLEME REDUIT
  46. *     4. (SIMUL3) DEDUCTION DES FREQUENCES PROPRES DU PROBLEME PHYSIQUE,
  47. *                 RECOMBINAISON DES VECTEURS PROPRES Z=X*PHI,
  48. *                 CALCUL DU RESIDU,
  49. *                 ORTHOGONALISATION % MODES DEJA CONVERGES
  50. *     5. (SIMUL6) CREATION DE L'OBJET "SOLUTION" DE CE CYCLE
  51. *     6. (SIMUL7) CALCUL DES MASSE ET DEP GENERALISES ET NUMERO DE MODES
  52. *     7. (STRATE) ADJONCTION DES MODES A CEUX DES CYCLES PRECEDENTS,
  53. *                 CALCUL D'UN SHIFT A APPLIQUER AU PROCHAIN CYCLE,
  54. *                 VERIFICATION DE LA COMPLETUDE DU SPECTRE
  55. *
  56. * DESCRIPTION DES VARIABLES : cf. commentaires au cours du programme
  57. * --------------------------
  58. *
  59. * CREATION, MODIFICATIONS :
  60. * ------------------------
  61. *
  62. * CREATION : PASCAL MANIGOT        22 AVRIL 1985
  63. * REFONTE  : THIERRY CHARRAS, BENOIT PRABEL 2010
  64. *
  65. * LANGAGE : ESOPE (FORTRAN77)
  66. *
  67. ************************************************************************
  68. *
  69.       IMPLICIT INTEGER(I-N)
  70.       IMPLICIT REAL*8 (A-H,O-Z)
  71. -INC CCREEL
  72.  
  73. -INC PPARAM
  74. -INC CCOPTIO
  75. -INC SMLMOTS
  76. -INC SMRIGID
  77. -INC SMTABLE
  78. -INC SMVECTD
  79. -INC SMCHPOI
  80. -INC SMLENTI
  81. c -INC SMLCHPO
  82. c -INC SMSOLUT
  83. -INC SMMATRI
  84. *
  85. *     REGOUPEMENT DE RENSEIGNEMENTS POUR "LANCZO" et "SIMUL.":
  86.       COMMON/CLANCZ/ IPV1,IPMV1,IPLMOX,IPLMOY
  87.       COMMON/CSIMUL/ W2SHIF,XPREC21,mvecri,IPVECX,IPVECZ,IPMZ,IPFREZ
  88. *
  89.       REAL*8  W2SHIF,FREQ,DEUXPI,XPREC21
  90.       LOGICAL LIMAGE,LIMAG2
  91.       LOGICAL lshift
  92.       INTEGER OOOVAL
  93. *
  94.       PARAMETER (DEUXPI = (2.D0*XPI))
  95. *
  96. *
  97. *     -- INITIALISATIONS --
  98. *
  99. *     du temps cpu passé dans SIMUL1 et les subroutines appelés
  100.       call gibtem(xkt)
  101.       xkt1 = 0.D0
  102.  
  103. *     de la precision demandée a simu21 a simul3
  104.       XPREC21 = EPSLON(1.0D0)
  105.       XPREC21 = XPREC21**0.5
  106.       XPREC21 = max(XPREC21,1.D-8)
  107.  
  108. *     liste des lambdas, des vect p, des permutations du cycle en cours
  109.       IPVALP = 0
  110.       IPHI = 0
  111.       IPERM = 0
  112. *     nombre de vect p converges pour le cycle / le shift en cours
  113.       nbonve = 0
  114.       nbonZ = 0
  115. *     solution du cycle en cours / cumul
  116.       IPSOLU = 0
  117.       idist  = 0
  118. *     cumul des vect p converges Z, et produit M*Z / |Z^T*M*Z|
  119.       IPVECZ = 0
  120.       IPMZ = 0
  121. *     nombre total de vect p ayant deja converges
  122.       nvecZ = 0
  123.       ifini  = 0
  124.  
  125. *     decalage spectral initial =shifti  et courant=FREQ(->W2SHIF)
  126.       lshift = .false.
  127.       W2SHIF = (DEUXPI * FREQ) ** 2
  128.       IF (LIMAGE) THEN
  129.          W2SHIF = SIGN(W2SHIF,FREQ)
  130.       ENDIF
  131.       shifti = freq
  132.       frshif = shifti
  133.       CALL DECALE (IPRIGI,IPMASS,W2SHIF, IPKW2M)
  134.       IPKWM0= IPKW2M
  135.  
  136. *     vecteur aleatoire V et M*V
  137.       call aleat1(IPKW2M,IPV1)
  138.       CALL MUCPRI(IPV1,IPMASS,IPMV1)
  139.       CALL CORRSP(IPKW2M,IPV1,IPMV1,IPLMOX,IPLMOY)
  140.       CALL INITFL(IPKW2M,IPMASS,IPMV1,IPV1,IFLU)
  141.  
  142. *ajout bp 06/01/2012:
  143. *     M est symetriques, mais est elle définie positive?
  144.       CALL DIAGN1(IPMASS,nvp0M)
  145. *     correction pour elements fluides (inconnue PI mise à 0 via INITFL)
  146. c       nvp0M = nvp0M - IFLU
  147. *     bp 10/01/2012: nvp0M et NEMSM ne semblent pas bien calculés ...
  148. *     (resultats dependant machine -> cf. dyna7.dgibi)
  149. *     on propose la solution qui suppose que nvp0M si M est LIQUIDE
  150.       if(IFLU.gt.0) nvp0M=0
  151. *     M est elle singuliere ?
  152.       MRIGID=IPMASS
  153.       segact,MRIGID
  154.       MMATRI=ICHOLE
  155.       segdes,MRIGID
  156.       segact,MMATRI
  157.       NENSM = NENS
  158.       segdes,MMATRI
  159. *     K est symetriques, mais est elle définie positive?
  160.       CALL DIAGN1(IPRIGI,nvp0K)
  161.       if(iimpi.ge.5) write(IOIMP,*)'nbre de vp<0 pour M (',IPMASS,') =',
  162.      &               nvp0M,' et K (',IPRIGI,') =',nvp0K
  163.       IF (nvp0M.ne.0.and.nvp0K.ne.0) THEN
  164. c         write(IOIMP,*) 'AU MOINS L UNE DES 2 MATRICES (MASSE OU RIGIDITE)'
  165. c         write(IOIMP,*) 'DOIT ETRE DEFINIE POSITIVE POUR GARANTIR UN BON '
  166. c      &    ,'FONCTIONNEMENT DE VIBR SIMUL !'
  167. c         write(IOIMP,*) 'L EXECUTION CONTINUE BIEN QUE '
  168. c      &   ,'LA NUMEROTATION CORRECTE SOIT IMPOSSIBLE...'
  169. cbp,2019 : on fait desormais une erreur ici car la numerotation est vitale
  170. c       dans strate et le numero donné par simul7 est necessairement faux...
  171.         CALL ERREUR(1097)
  172.         RETURN
  173.       ENDIF
  174.  
  175. *ajout bp 13/05/2011: on laisse simul3 calculer toutes les val p >0 et <0.
  176. *     strate fera eventuellement le tri (si .not.limage)
  177. *     en fonction de nvp0 (= numero de la dernière val p negative)
  178.       LIMAG2=.true.
  179.       IF (LIMAGE) THEN
  180.         nvp0 = 0
  181.       ELSE
  182.         if (nvp0M.eq.0) then
  183.           nvp0 = nvp0K
  184.         elseif(nvp0K.eq.0) then
  185.           nvp0 = nvp0M
  186.         else
  187. c         dans ce cas on met nvp0 a 0
  188.           nvp0 = 0
  189.         endif
  190. *       => il y a donc nvp0 valeurs propres lambda < 0
  191. *       on inclut les mode de corps rigides (tq lambda=0)
  192.       ENDIF
  193. c       if(iimpi.ge.4) write(IOIMP,*) '=> nvp0=',nvp0
  194.  
  195. *     besoin de M-orthogonaliser par rapport aux modes deja convergés ?
  196.       Northo = 0
  197.  
  198. *     TCPU pour decomposer K^shift = LDL^T  et creer V aleat
  199.       xktale=0.D0
  200.       call gibtem(xktale)
  201.       xkt1 = xkt1 + xktale
  202.       xktal1 = xktale
  203.  
  204. *     maxmem=taille memoire , inc=nombre d'inconnues du pb
  205.       maxmem=oooval(1,1)
  206.       mchpoi=IPV1
  207.       segact mchpoi
  208.       inc=0
  209.       do iou=1,ipchp(/1)
  210.         msoupo=ipchp(iou)
  211.         segact msoupo
  212.         mpoval=ipoval
  213.         segact mpoval
  214.          inc=inc + vpocha(/1)*vpocha(/2)
  215.         segdes mpoval,msoupo
  216.       enddo
  217.       segdes mchpoi
  218.  
  219. *     incvrai = nombre d'inconnues independantes du pb
  220. *     (recopié depuis chole.eso et simplifié..?)
  221.       MRIGID=IPKW2M
  222.       segact,MRIGID
  223.       MMATRI=ICHOLE
  224.       segdes,MRIGID
  225.       segact,MMATRI
  226.       MILIGN=IILIGN
  227.       segdes,MMATRI
  228.       segact,MILIGN
  229.       NBLAG=0
  230. c     on espere qu'il faut bien regarder tout le tableau ITTR
  231. c     (boucle + compliqué dans chole.eso)
  232.       NITTR=ITTR(/1)
  233.       do II=1,NITTR
  234.         IF(ITTR(II).NE.0) NBLAG=NBLAG+1
  235.       enddo
  236.       segdes,MILIGN
  237.       incvrai = inc - (3*NBLAG/2)
  238. *pb dec 2020: on reintroduit les inconues en pi dans incvrai
  239. c     il faut egalement deduire le nombre d'inconnu PI
  240. *      incvrai = incvrai - IFLU
  241. c     ainsi que le nombre NENSM de valeur propre infinie (M singuliere)
  242. c     (rem bp : cela ne semble pas suffire au calcul de incvrai
  243. c      NENSM n'est pas toujours exact...? ou mauvais raisonnement...?)
  244.       incvrai = incvrai - NENSM
  245.       if(iimpi.ge.5) write(IOIMP,*)'incvrai=inc-1.5*NBLAG-IFLU-NENSM'
  246.      &                         ,incvrai,inc,NBLAG,IFLU,NENSM
  247.  
  248. *     Nbmode = nombre de modes recherchés au total
  249. c       Nbmode=min(Nbmode,incvrai)
  250.       if (incvrai.lt.Nbmode) then
  251.         write(IOIMP,*) ' simul1 : nombre de modes recherches ',
  252.      $             '> nombre d inconnues independantes'
  253.         Nbmode = incvrai
  254.         write(IOIMP,*) ' on reduit le nombre de modes recherches a ',
  255.      $        Nbmode
  256.       endif
  257. *     nvecma = nombre de vecteurs X max. % memoire
  258.       Nvecma= maxmem /inc / 30
  259. *     nombre de cycle a réaliser
  260.       nfois= Nbmode / Nvecma +1
  261.       nfois4 = nfois * 1000
  262. c pb dec20 ! nouvelle strategie
  263. c cbp: 32*Nbmode car pb lorsque Nbmode=1 et mode multiple!
  264. c       nfois4 = min(nfois4,32*Nbmode)
  265. c       Nvecma= min(inc,Nvecma)
  266. c *     Nmod = nombre de modes recherchés / cycle
  267. c       Nmod= min(Nbmode,Nvecma/2)
  268. cbp: 32*Nbmode car pb lorsque Nbmode=1 et mode multiple!
  269.       nfois4 = min(nfois4,32*Nbmode)
  270.       Nmod= min(Nbmode,Nvecma/2)
  271.       Nvecma= min(incvrai,Nvecma)
  272. *     Nmod = nombre de modes recherchés / cycle
  273.       Nmod= min(Nbmode,Nvecma/2)
  274. c
  275. c
  276.       Nbmode0=Nbmode
  277. *     Nmodopt = nombre de mode optimal % efficacité tcpu, Nmodma = limite
  278.       Nmodopt = Nmod
  279.       Nmodma = Nmod
  280. *     Nmodcyc = nombre de modes / cycle demandés par l utilisateur
  281.       CALL LIRENT(Nmodcyc,0,IRETOU)
  282.       if (IRETOU.ne.0) then
  283.         Nmod    = Nmodcyc
  284.         Nmodopt = Nmodcyc
  285.       endif
  286.  
  287.       if (iimpi.ge.4) then
  288.         write(IOIMP,*) '============================================='
  289.         write(IOIMP,*) ' VIBR SIMUL : METHODE DE LANCZOS avec Cycles '
  290.         write(IOIMP,*) '============================================='
  291.         write(IOIMP,*) ' taille memoire , nb inconnues (vraies)',
  292.      $              maxmem,inc,' (',incvrai,')'
  293.         write(IOIMP,*) ' nbre maxi de vecteurs en simultanée ' , nvecma
  294.         write(IOIMP,*) ' nbre modes recherchés et /cycle ',Nbmode,Nmod
  295.         write(IOIMP,*) ' nbre de cycle mini , maxi ' , nfois,nfois4
  296.         write(IOIMP,*) '============================================='
  297.         write(IOIMP,*) ' icycle |  Nbre de modes   freq    ',
  298.      $             '  | Nbre de modes  | Nbre de modes '
  299.         write(IOIMP,*) ' icycle |  cherchés        shift   ',
  300.      $             '  | trouvés        | total'
  301.       endif
  302.       if(iimpi.ge.6) 
  303.      $   write(IOIMP,*) 'precision demandee a simu21=',XPREC21
  304. *
  305. *
  306. *-----Cycle de Lanczos------------------------------------------------*
  307. *
  308.       do icycle=1,nfois4
  309.  
  310.       if (iimpi.ge.5) then
  311.       write(IOIMP,*) '_________________________________________________'
  312.       write(IOIMP,*) 'Simul1: icycle  nmod W2SHIF', icycle, Nmod, W2SHIF
  313.       endif
  314.  
  315. *
  316. *     ------------------------------
  317. *     -- INITIALISATIONS DIVERSES --
  318. *
  319. *     decalage spectral + vecteur initial aleatoire
  320.       if (icycle.ne.1) then
  321. cbp10/2010 : ipsolu mis a 0 a tous les cycles (pas seulement si on shifte)
  322. c            mais nbonZ = nbre de mode pour ce shift (=plusieurs cycles)
  323. c         nbonZ = 0
  324.         IPSOLU = 0
  325. *       strate peut avoir changé Nbmode et  IPKW2M
  326.         Nbmode =  Nbmode0
  327.         if (lshift) then
  328.            CALL DECALE(IPRIGI,IPMASS,W2SHIF, IPKW2M)
  329.            IPKWM0= IPKW2M
  330.            lshift = .false.
  331.             nbonZ = 0
  332. c             IPSOLU = 0
  333. *          l utilisateur 'force' le nombre de modes / cycle
  334.            if (IRETOU.ne.0) then
  335.               Nmod    = Nmodcyc
  336.               Nmodopt = Nmodcyc
  337.            endif
  338.         endif
  339.         call aleat1(IPKW2M,IPV1)
  340.         CALL MUCPRI (IPV1,IPMASS,  IPMV1)
  341.         CALL CORRSP(IPKW2M,IPV1,IPMV1,IPLMOX,IPLMOY)
  342.         CALL INITFL(IPKW2M,IPMASS,IPMV1,IPV1,IFLU)
  343.       endif
  344.       IF(IERR.NE.0) RETURN
  345. *
  346. *     verrue pour le cas ou l utilisateur force le nombre de modes/cycle
  347.       icyc1  = icycle
  348.       if(IRETOU.ne.0) icyc1=1
  349.  
  350. *
  351. *     ce sous programme na plus raison d etre: a supprimer prochainement
  352. *      CALL SIMUL0
  353. *
  354.  
  355. *     ------------------------------------
  356. *     -- CALCUL DES VECTEURS DE LANCZOS --
  357. *
  358.       call gibtem(xkt)
  359.       xkt1 = xkt1 + xkt
  360. *     on cherche a obtenir Nmod modes Z sans depasser nvecma vecteurs X
  361.       CALL LANCZO(IPKW2M,IPMASS,Nbmode,Nmod,Nvecma,Nmodopt
  362. c      $     ,xktal1,iflu,nbonve,IPVALP,IPHI,IPERM,icyc1)
  363.      $     ,xktal1,iflu,nbonve,IPVALP,IPHI,IPERM,icyc1,Northo)
  364. *     on a obtenu nbonve candidats a devenir modes : IPVALP, X*PHI
  365.       xkt1 = xkt1 + xktal1
  366.       xktal1 = xktale
  367.       IF(IERR.NE.0) RETURN
  368.  
  369. *
  370. *     ----------------------------------------------------
  371. *     -- W2FREQ POUR LES VALEURS PROPRES                --
  372. *     -- RECOMBINAISON DES VECTEURS PROPRES Z = [X].PHI --
  373. *     -- CALCUL DU RESIDU (et test de convergence associée) --
  374. *     -- eventuellement, raffinement, purge des Z
  375. *        et elimination des modes deja trouves          --
  376. *     -- CREATION DE IPSOLU de ce cycle                 --
  377. *
  378.       Nramax = Northo
  379.       CALL SIMUL3 (IPKW2M,IPMASS,IPVALP,IPHI,IPERM,Nmod,nbonve,
  380.      $             Nramax,IPSOLU,LIMAG2)
  381. *     on a retenu pour ce cycle nbonve modes
  382. *     soit pour ce shift nbonZ modes stockés dans IPSOLU
  383. *     et au total l ensemble des vecteurs modaux est stocké dans IPVECZ
  384.       nbonZ = nbonZ + nbonve
  385.       call gibtem(xkt3)
  386.       xkt1 = xkt1 + xkt3
  387.       if (iimpi.ge.6) then
  388.         write(IOIMP,*) ' temps passé dans simul3 ' , xkt3
  389.         write(IOIMP,*) ' Modes OK pour ce cycle, ce shift',nbonve,nbonZ
  390.      $       ,' / ',Nmod
  391.       endif
  392.       IF(IERR.NE.0) RETURN
  393.  
  394.  
  395. C
  396. C     ---------------------------------------------------------
  397. C     -- CALCULS MASSE GEN. ET DEPL. GEN. ET NUMERO DE MODES --
  398. c
  399. c     (seulement si on a trouvé des modes supplémentaires...)
  400.       if (nbonve.gt.0) then
  401.         CALL SIMUL7(IPSOLU,IPMASS,IPKW2M,W2SHIF,IPLMOX,IPLMOY,IFLU)
  402.         call gibtem(xkt7)
  403.         xkt1 = xkt1 + xkt7
  404.         if(iimpi.ge.6)  write(IOIMP,*) ' temps passé dans simul7 ',xkt7
  405.         IF(IERR.NE.0) RETURN
  406.       endif
  407.  
  408. c     petit message
  409.       if (iimpi.ge.4)  then
  410.            write(IOIMP,605) icycle,Nmod,frshif,nbonZ,(nvecZ + nbonZ)
  411.  605       FORMAT(2X,I5,2X,'|',2X,I5,8X,F12.3,3X,I5,10X,I5)
  412.       endif
  413.  
  414. c
  415. C     ---------------------------------------------------------
  416. c     -- faut-t-il cycler ? quel shift appliquer? --
  417. c
  418. c     --on a trouvé tous les modes necessaires pour ce shift :
  419. c       on recommence un autre cycle avec un shift determine par strate
  420. c       et pour Nmod modes (estime optimum % temps cpu) < Nmodma
  421.         Nmod = min(Nmodopt,Nvecma/2)
  422.         Nmodma = int(1.05*Nmod)+1
  423. c
  424. c     -- strate :
  425. c        -ajoute les modes de ce cycle (ipsolu) aux precedents (idist),
  426. c        +si besoin,
  427. c        -definit la direction de recherche de modes manquants,
  428. c        -calcule un shift a appliquer au prochain cycle,
  429. c        -verifie la completude du spectre
  430. c
  431.          frtmp = frshif
  432. c
  433.       call strate(IPSOLU,Nmodma,Nbmode,frtmp,Nmod,ifini
  434.      $                  ,shifti,idist,nbonZ,icycle,Northo
  435.      $                  ,IPRIGI,IPMASS,IPKW2M,nvp0,IFLU,incvrai)
  436.       IF(IERR.NE.0) RETURN
  437. c
  438. *     on a trouvé nbonZ modes pour ce shift qui s'ajoutent aux autres
  439.       nvecZ = nvecZ + nbonZ
  440.  
  441. c       msolut = ipsolu
  442. *     si strate decide qu on shifte...
  443. c       if (frtmp.ne.frshif) then
  444.       if ((frtmp.ne.frshif).and.(ifini.ne.1)) then
  445.          frshif = frtmp
  446.          W2SHIF= deuxpi * frshif
  447.          W2SHIF= W2SHIF * W2SHIF
  448.          lshift = .true.
  449. c        il est possible que strate ait modifié tout seul IPKW2M
  450. c        dans ce cas pas besoin de re-shifter (evite une factorisation)
  451.          if (IPKWM0.ne.IPKW2M) then
  452.             IPKWM0= IPKW2M
  453. cbp10/2010 : ipsolu mis a 0 a tous les cycles (pas seulement si on shifte)
  454. c            mais nbonZ = nbre de mode pour ce shift (=plusieurs cycles)
  455.             nbonZ = 0
  456. c             IPSOLU = 0
  457.             lshift = .false.
  458.          endif
  459.       endif
  460.  
  461.       call gibtem(xktstr)
  462.       xkt1 = xkt1 + xktstr
  463.       if(iimpi.ge.6) write(IOIMP,*) ' temps passé dans strate ',xktstr
  464.  
  465. c
  466. C     ---------------------------------------------------
  467. c     --       UN PEU DE MENAGE  et SORTIE ?           --
  468. *
  469. *     -- DESTRUCTION DES OBJETS DE TRAVAIL de ce shift --
  470. *
  471. *     on detruit les rigidites de ce cycle
  472.       if(lshift.or.(ifini.eq.1))  CALL DTRIGI(IPKW2M)
  473.       MLMOTS=IPLMOX
  474.       MLMOT1=IPLMOY
  475.       SEGSUP,MLMOTS,MLMOT1
  476. *
  477. *     -- DESTRUCTION DES OBJETS DE TRAVAIL de ce cycle --
  478. *
  479. *     on detruit les vecteurs de Lanczos X de ce cycle
  480.       mlent1=IPVECX
  481.       segact mlent1
  482.       do iou=1,mlent1.lect(/1)
  483.         mvect1=mlent1.lect(iou)
  484.         segsup,mvect1
  485.       enddo
  486.       segsup mlent1
  487. *
  488. *     ---ON PENSE AVOIR GAGNÉ : ON QUITTE ---
  489. *
  490.          if(ifini.eq.1) goto 999
  491.  
  492.  
  493.       enddo
  494. *-----fin de la boucle des Cycles de Lanczos--------------------------*
  495.  
  496.  
  497.  999  continue
  498. *
  499. *     -- DESTRUCTION DES OBJETS DE TRAVAIL communs a tous les cycles --
  500. *
  501. *     on detruit les modes convergés Z contenus dans IPVECZ
  502.       mlent1=IPVECZ
  503.       segact,mlent1
  504.       do iou=1,mlent1.lect(/1)
  505.         mvect1=mlent1.lect(iou)
  506.         segsup,mvect1
  507.       enddo
  508.       segsup,mlent1
  509.       IPVECZ = 0
  510. *     on detruit les produits convergés M*Z/ZTMT contenus dans IPMZ
  511.       mlent1=IPMZ
  512.       segact,mlent1
  513.       do iou=1,mlent1.lect(/1)
  514.         mvect1=mlent1.lect(iou)
  515.         segsup,mvect1
  516.       enddo
  517.       segsup,mlent1
  518.  
  519.       call gibtem(xkt)
  520.       xkt1 = xkt1 + xkt
  521.       write(IOIMP,*) ' temps passe dans VIBR SIMUL =',xkt1,' cs'
  522.       if(iimpi.ge.4)
  523.      &   write(IOIMP,*) '============================================='
  524.  
  525.       return
  526. *
  527.       END
  528.  
  529.  
  530.  
  531.  
  532.  
  533.  
  534.  
  535.  
  536.  
  537.  
  538.  
  539.  
  540.  
  541.  
  542.  
  543.  
  544.  
  545.  
  546.  

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