Télécharger la plaquette Cast3M


fr en

Télécharger hbmco2.eso

Retour à la liste

Numérotation des lignes : 

hbmco2

  1. C HBMCO2    SOURCE    CB215821  23/01/25    21:15:19     11573          
  2.  
  3.        SUBROUTINE HBMCO2(KTKAM,KTQ,KTFEX,KTPAS,KTLIAA,KTEMP,KTLIAB,KTPHI
  4.      &            ,KCPR,KOCLFA,KOCLB1,NHBM,NFFT,KPARNUM,KSORT,SPAS,ITER) 
  5.  
  6. *=======================================================================
  7. *                Continuation par pseudo longueur d'arc
  8. *                     Cas des systemes autonomes 
  9. *======================================================================= 
  10.  
  11.        IMPLICIT INTEGER (I-N)
  12.        IMPLICIT REAL*8  (A-H,O-Z)
  13.  
  14.        INTEGER SPAS, IREDU, METSTB 
  15.        LOGICAL CHECK, CHECKBIF
  16.        LOGICAL ZINIT,ZSTAB
  17.        CHARACTER*8 FLAG
  18.        REAL*8 FTEST(4), FTEST0(4)
  19.        REAL*8 XAUX(NFFT),nrmR
  20.        REAL*8 VCTCS(7),AiDi(2),Di(2),bi(2)
  21.        segment mwork
  22.          REAL*8 XT(NDDL,NFFT), LAMBD(NDDL)
  23.        ENDSEGMENT
  24. -INC SMLREEL    
  25. -INC PPARAM    
  26. -INC CCOPTIO    
  27. *-INC TMDYNC.INC
  28. ************************** debut TMDYNC.INC ****************************
  29.  
  30. *    TMDYNC : FUTUR INCLUDE POUR LES SEGMENTS DE L'OPERATEUR DYNC
  31. *    TODO   : a extraire dans un include des que stabilise
  32. *
  33. *     Segment des variables generalisees:
  34. *     -----------------------------------
  35.       SEGMENT MTQ
  36.          REAL*8 Q1(NT1)
  37.          REAL*8 OMEG,XPARA
  38.          REAL*8 JAC(NT1,NT1),ZZ(NT1,NT1),RX(NT1,NT1)
  39.          REAL*8 dX(NT1), dw, dv
  40.       ENDSEGMENT
  41. *     Q1   : vecteur des inconnues frequentielles de dimension (2h+1)*n
  42. *            Q1 = {q_0 q_c1 q_s1 ... q_sh}
  43. *            avec q_i vecteur de dimension n ou n=nombre de modes
  44. *     OMEG : frequence fondamentale de l'approximation
  45. *     XPARA: parametre de continuation (par defaut la frequence) 
  46. *            \in [PARINI,PARFIN]
  47. *     RX   : matrice jacobienne = ZZ + dFnl/dX
  48. *     JAC  : jacobienne des efforts non-lineaires  = dFnl/dX
  49. *     ZZ   : matrice dynamique associee aux matrices modales K, M et C 
  50. *            lineaires et constantes
  51. *     {dX,dw,(dv)} : vecteur tangent utilise pour la prediction
  52. *
  53. *
  54. *     Segment contenant les matrices XK, XASM et XM:
  55. *     ---------------------------------------------
  56.       SEGMENT MTKAM
  57.          REAL*8 XK(NA1,NB1K),XASM(NA1,NB1C),XM(NA1,NB1M)
  58.          REAL*8 GAM(NPC1,nl1),IGAM(nl1,NPC1),DL(nl1)
  59. *         REAL*8 GAMFIN(NPC2,nl1)
  60.       ENDSEGMENT
  61. *     XK,XASM et XM : matrices de raideur, amortissement et masse
  62. *     GAM et IGAM : matrices pour la FFT et son inverse
  63. *     GAMFIN      : 
  64. *
  65. *     Segment des deformees modales:
  66. *     ------------------------------
  67. *     (idem DYNE)
  68.       SEGMENT MTPHI
  69.          INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
  70.          INTEGER IAROTA(NSB)
  71.          REAL*8  XPHILB(NSB,NPLSB,NA2,IDIMB)
  72.       ENDSEGMENT
  73. *
  74. *     Segment descriptif des liaisons en base A:
  75. *     ------------------------------------------
  76. *     (idem DYNE)
  77.       SEGMENT MTLIAA
  78.          INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA)
  79.          REAL*8  XPALA(NLIAA,NXPALA)
  80.       ENDSEGMENT
  81. *
  82. *     Segment descriptif des liaisons en base B:
  83. *     ------------------------------------------
  84. *     (idem DYNE)
  85.       SEGMENT MTLIAB
  86.          INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  87.          REAL*8  XPALB(NLIAB,NXPALB)
  88.          REAL*8  XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  89.       ENDSEGMENT
  90. *
  91. *     Segment representant les chargements exterieurs:
  92. *     -----------------------------------------------
  93.       SEGMENT MTFEX
  94.          REAL*8  FEXA(NT1)
  95.          REAL*8  FEXPSM(NPLB,NPC1,2,IDIMB)
  96.          INTEGER BAL
  97.       ENDSEGMENT
  98. *     FEXA : Vecteur des efforts ext. sous la forme de coefficients de
  99. *            Fourier et exprimes en base A
  100. *     FEXPSM: chargement/deplacement statique lie aux modes negliges
  101. *             (neglige aussi les Fnl). Dans DYNC toujours =0, cree pour
  102. *             compatibilite avec calcul des Fnl.
  103. *     BAL  : indique s'il s'agit d'un chargement de type balourd
  104. *            (cad proportionnel a OMEG**2)
  105. *
  106. *     Segment "local" pour DEVLFA:
  107. *     ----------------------------
  108.       SEGMENT LOCLFA
  109.          REAL*8 FTEST(NA1,4)
  110.       ENDSEGMENT
  111. *      
  112. *     Segment "local" pour DEVLB1:
  113. *     ----------------------------
  114.       SEGMENT LOCLB1
  115.          REAL*8 FTEST2(NPLB,6)
  116.       ENDSEGMENT
  117. *      
  118. *     Segment contenant les variables au cours d un pas de temps:
  119. *     ----------------------------------------------------------
  120.       SEGMENT MTPAS
  121.          REAL*8 FTOTA(NA1,4),FTOTB(NPLB,IDIMB),FTOTBA(NA1)
  122.          REAL*8 XPTB(NPLB,2,IDIMB),FINERT(NA1,4)
  123.          REAL*8 XVALA(NLIAA,4,NTVAR),XVALB(NLIAB,4,NTVAR)
  124.          REAL*8 FEXB(NPLB,2,IDIM),XCHPFB(2,NLIAB,4,NPLB)
  125.          REAL*8 KTOTXA(NA1,NA1),KTOTVA(NA1,NA1)
  126.          REAL*8 KTOTXB(NPLB,IDIMB,IDIMB), KTOTVB(NPLB,IDIMB,IDIMB) 
  127.       ENDSEGMENT
  128. *     FTOTA/B/BA : forces sur base A, B et B projetees sur A
  129. *     XPTB       : deplacement du point d'une liaison en base B
  130. *     XVALA/B    : grandeurs de la liaison en base A/B a stocker
  131. *     FEXB       : forces exterieures en base B (a priori uniquement 
  132. *                  pour les moments appliques aux rotations rigides ?)
  133. *     XCHPFB     : forces de contact en base B (lorsqu'on  considere un
  134. *                  maillage de contact dans certaines liaisons)
  135. *     KTOTXA/XB/VA/VB : Jacobienne par rapport au deplacement/vitesse en
  136. *                       base A/B (= contributions a dFnl/dX)
  137. *
  138. *
  139. *     Segment des points de reference des modes (base A):
  140. *     --------------------------------------------------
  141.       SEGMENT MPREF
  142.          INTEGER IPOREF(NPREF)
  143.       ENDSEGMENT
  144. *
  145. *     Segment des points en base B:
  146. *     -----------------------------
  147.       SEGMENT NCPR(NBPTS)
  148. *     NCRP(#global) = #local dans XPTB (1er indice)      
  149. *
  150. *     Segment des parametres numeriques pour la continuation: 
  151. *     ------------------------------------------------------
  152.       SEGMENT PARNUM
  153.          CHARACTER*4 TYPS
  154.          REAL*8   DS,DSMAX,DSMIN,ANGMIN,ANGMAX,ITERMOY,ISENS,TOLMIN
  155.          REAL*8   PARINI,PARFIN
  156.          INTEGER  ITERMAX,NBPAS
  157.          LOGICAL  JANAL
  158.       ENDSEGMENT
  159. *
  160. *     Segment des resultats:
  161. *     ---------------------
  162.       SEGMENT  PSORT
  163.         REAL*8 QSAVE(NT1,NPAS),WSAVE(NPAS),LSAVE(2,2*NA1,NPAS)
  164.         REAL*8 VSAVE(NPAS)
  165.         LOGICAL ZSAVE(NPAS)
  166.         CHARACTER*2 TYPBIF(NBIFU)
  167.         REAL*8 QBIFU(NT1,NBIFU),WBIFU(NBIFU),WBIF2(NBIFU)
  168.         REAL*8 QPSIR(NT1,NBIFU),QPSII(NT1,NBIFU)
  169.         INTEGER CBIF
  170.       ENDSEGMENT
  171. *     QSAVE(i,j) = Q harmonique i au pas j
  172. *     VSAVE(j)   = parametre de continuation (si non w) au j-eme pas
  173. *     ZSAVE(j)   = stabilite au j-eme pas
  174. *     LSAVE(1,j) : partie reelle de l'exposant de Floquet
  175. *     LSAVE(2,j) : partie imaginaire de l'exposant de Floquet
  176. *     TYPBIF = {LimitPoint, BranchPoint, NeimarkSacker, PeriodDoubling}
  177. *     QBIFU,WBIFU : vecteur Q et w au point de bifurcation
  178. *           WBIF2 : partie imaginaire de l'exposant de Floquet
  179. *     QPSIR,QPSII : vecteur propre au point de bifurcation
  180.  
  181. *     Segment des tableaux de travail:
  182. *     -------------------------------
  183.       SEGMENT  MTEMP
  184.          REAL*8 RW(NT1),A,T0(NT1+1),TP(NT1+1),AMPX,AUX
  185.          REAL*8 T02(NT1+2), TP2(NT1+2)
  186.          INTEGER IPIV(NT1),IPIV2(NT1+1),IPIV3(NT1+2)
  187.          REAL*8 res
  188.          REAL*8 RHS(NT1+1),Ja(NT1+1,NT1+1)
  189.          REAL*8 QOLD(NT1),OMEGOLD
  190.          REAL*8 MATJA(NT1+1,NT1+1),Rw2(NT1)
  191.          REAL*8 Jaa(NT1+2,NT1+2),RHS2(NT1+2),Ra(NT1),VV,VVOLD
  192.       ENDSEGMENT
  193. *     Jacobiennes augmentees 
  194. *     Ja : [ RX  Rw ; dX dw]
  195. *     Jaa: [ RX  Rw Ra; gx 0 0; dX dw da]
  196.  
  197. *      SEGMENT  NNNN
  198. *         REAL*8 IGAM2(nl1,NPC2),DL2(nl1)
  199. *      ENDSEGMENT
  200.  
  201. *************************** fin TMDYNC.INC *****************************
  202.  
  203.        REAL*8 ZERO,ONE,TWO,FOUR
  204.        PARAMETER (ZERO=0.D0, ONE=1.D0, TWO=2.D0, FOUR=4.D0)
  205.  
  206. C Fonctions BLAS/LAPACK
  207.        REAL*8    DDOT, DNRM2
  208.        EXTERNAL  DDOT, DNRM2
  209.  
  210. *      Variables generalisees
  211.        MTQ = KTQ
  212. *      Partie lineaire
  213.        MTKAM = KTKAM
  214. *      Parametres numeriques
  215.        PARNUM = KPARNUM 
  216. *      Reste des segments 
  217.        MTPHI  = KTPHI
  218.        MTFEX  = KTFEX
  219.        MTPAS  = KTPAS
  220.        MTLIAA = KTLIAA
  221.        MTLIAB = KTLIAB
  222.        LOCLFA = KOCLFA
  223.        LOCLB1 = KOCLB1     
  224.        MTEMP  = KTEMP
  225. *      Tableau des resultats
  226.        PSORT  = KSORT    
  227. *
  228.        NT = Q1(/1)
  229.        NDDL = NT/(2*NHBM+1)
  230.        PDT = 1./NFFT
  231.        segini,MWORK
  232.  
  233. *======================================================================= 
  234. *===   INITIALISATION 
  235. *======================================================================= 
  236.  
  237.        II=1
  238. *  Recuperation des coefficients si modele GP
  239.        DO J = 1,IPALA(/1)
  240.          IF (IPALA(J,1).EQ.5 .AND. IPALA(J,3).EQ.101) THEN
  241.           DO IJ = 1,7
  242.             VCTCS(IJ) = XPALA(J,IJ)
  243.           ENDDO
  244.           JG = NDDL
  245.           MLREE1 = IPALA(J,7)
  246.           SEGACT, MLREE1
  247.           DO IJ = 1,JG
  248.             LAMBD(IJ) = MLREE1.PROG(IJ)
  249.           ENDDO
  250. *         Nombre de termes fixe, a generaliser si besoin.            
  251.              JG = 2
  252.           MLREE2 = IPALA(J,4)
  253.           MLREE3 = IPALA(J,8)
  254.           SEGACT, MLREE2,MLREE3
  255.           DO IJ = 1,JG
  256.             AiDi(IJ) = MLREE2.PROG(IJ)
  257.             Di(IJ) = MLREE3.PROG(IJ)
  258.           ENDDO
  259.           SEGDES,MLREE1,MLREE2,MLREE3
  260.          ENDIF
  261.        ENDDO    
  262.        VV = VCTCS(4)
  263.        DO I=1,NT
  264.           QOLD(I) = Q1(I)
  265.        ENDDO
  266.        OMEGOLD = OMEG
  267.        VVOLD = VV
  268. *      Derivee du residu par rapport au parametre de continuation: dR/da
  269. *      ATTENTION:
  270. *      L'appel direct a calcRv est a remplacer par l'appel a une sous-
  271. *      routine qui distingue selon les differentes possibilites associees
  272. *      a chaque liaison.      
  273.        CALL HBMRV(NT,NDDL,OMEG,Q1,AiDi,Di,LAMBD,VCTCS,Ra) 
  274.        DO I = 1,NT
  275.           RHS(I) = Ra(I)
  276.        ENDDO
  277.        RHS(NT+1) = ZERO
  278. *      DO I = 1,NT+1 
  279. *       WRITE(*,*) 'Ja(',I,',:)=',(Ja(I,IOU),IOU=1,NT+1)
  280. *      ENDDO
  281. *      CALL COPYMAT(NT+1,Ja,J2)
  282. *      WRITE(*,*) 'RHS=',(RHS(IOU),IOU=1,NT+1)
  283.        CALL DGESV(NT+1,1,Ja,NT+1,IPIV2,RHS,NT+1,INFO)
  284. *      WRITE(*,*) 'INFO=',INFO
  285. *      WRITE(*,*) 'pasT=',(RHS(IOU),IOU=1,NT+1)
  286. *      STOP
  287.        DO I=1,NT
  288.           dX(I) = -RHS(I)
  289.        ENDDO 
  290.        dw = -RHS(NT+1)
  291. *       WRITE(*,*) 'dX=',(dX(IOU),IOU=1,NT)
  292.        a = dnrm2(NT,dX,1)
  293.        dv = ONE/sqrt(a**2+dw**2+ONE)
  294. *       WRITE(*,*) 'dw=',dw
  295. *       WRITE(*,*) 'dv=',dv
  296.        IF (ISENS.LT.ZERO) THEN
  297.          dv = -dv
  298.        ENDIF     
  299.        t02(NT+2)=dv
  300.        DO J=1,NT
  301.           dX(J)  = dX(J)*dv
  302.           t02(J) = dX(J)
  303.        ENDDO
  304.        dw = dw*dv
  305.        t02(NT+1) = dw         
  306. *       WRITE(*,*) 't0 = ', (t02(IOU),IOU=1,NT+2)
  307. *       STOP
  308. *      Sauvegarde des donnees de sortie
  309.        DO I=1,NT
  310.          QSAVE(I,II)=Q1(I)
  311.        ENDDO
  312.        WSAVE(II)=OMEG  
  313.        VSAVE(II)= VV
  314.        ZSAVE(II)= .TRUE.
  315.  
  316. *      Message relatif au pas #0 (solution initiale)
  317.        IF(IIMPI.GE.1) THEN
  318.          WRITE(IOIMP,*) '+------+------+---------+---------+------+'
  319.          WRITE(IOIMP,*) '| Pas  | Iter |    w    |    Q    | Stab |'
  320.          WRITE(IOIMP,*) '+------+------+---------+---------+------+'
  321.          Q1NRM2=dnrm2(NT,Q1,1)
  322.          WRITE(IOIMP,666) (II-1),ITER,VV,Q1NRM2,ZSAVE(II)
  323.        ENDIF
  324.  666   FORMAT(' | ',I4,' | ',I4,' | ',F7.3,' | ',F7.3,' | ',L3,'  |')
  325.  
  326. *=======================================================================  
  327. *      1ere prediction
  328. *=======================================================================  
  329.        OMEG = OMEG + DS*dw
  330.        DO J=1,NT
  331.          Q1(J) = Q1(J)+DS*dX(J)
  332.        ENDDO   
  333.        VV    = VV + DS*dv    
  334.        IREDU = 0
  335.        II = 2 
  336.  
  337. *=======================================================================  
  338. *=============== Boucle sur le parametre de continuation ===============        
  339. *=======================================================================  
  340.        DO WHILE (II .LE. NBPAS)
  341.  
  342. *       === Correction =================================================
  343.         CALL HBMNEWT(NT,NHBM,NDDL,NFFT,MTQ,MTKAM,MTPHI,MTEMP,PARNUM,
  344.      &       MTLIAA,MTLIAB,MTFEX,MTPAS,LOCLFA,LOCLB1,CHECK,'CA',ITER)   
  345.  
  346. *       -----------------------------
  347. *       ---- si NEWT a converge, ----
  348. *       -----------------------------
  349.         IF (.NOT.CHECK) THEN
  350.  
  351. *          Sauvegarde des donnees de sortie:
  352. *          Frequence, coeffs de Fourier, Norme des coeffs de Fourier           
  353. *          et parametre de continuation         
  354.            DO I=1,NT
  355.              QSAVE(I,II)=Q1(I)
  356.            ENDDO
  357.            WSAVE(II)=OMEG    
  358.            VSAVE(II)=VV    
  359.            ZSAVE(II)= .TRUE.           
  360. *
  361. *          === Prediction ==============================================
  362. *          Pas tangent a la courbe 
  363.            CALL HBMRW(NT,NDDL,1,Q1,OMEG,XM,XASM,XK,Rw,.true.)
  364.            DO J = 1,IPALA(/1)
  365.               IF (IPALA(J,1).EQ.5 .AND. IPALA(J,3).EQ.101) THEN
  366.                 VCTCS(4) = VV
  367.                 CALL HBMRWF(NT,NDDL,OMEG,Q1,AiDi,Di,LAMBD,VCTCS,Rw)     
  368.               ENDIF
  369.            ENDDO 
  370.            CALL HBMRV(NT,NDDL,OMEG,Q1,AiDi,Di,LAMBD,VCTCS,Ra)         
  371.            DO KK= 1,NT
  372.              DO JJ = 1,NT
  373.                Ja(JJ,KK) = RX(JJ,KK)
  374.              ENDDO
  375.              Ja(KK,NT+1) = Rw(KK)
  376.              Ja(NT+1,KK)  = ZERO
  377.            ENDDO
  378.            DO JJ = 2,2*NHBM,2
  379.              Ja(NT+1,JJ*NDDL+1) = JJ/TWO
  380.            ENDDO
  381.            DO I = 1,NT
  382.              RHS(I) = Ra(I)
  383.            ENDDO
  384.            RHS(NT+1) = ZERO
  385.            Ja(NT+1,NT+1) = ZERO
  386.            CALL DGESV(NT+1,1,Ja,NT+1,IPIV2,RHS,NT+1,INFO)
  387.            DO J=1,NT
  388.               dX(J) = -RHS(J)
  389.               tp2(J) = dX(J)
  390.            ENDDO
  391.            dw = -RHS(NT+1)
  392.            tp2(NT+1) = dw
  393.            tp2(NT+2) = ONE
  394.            a=dnrm2(NT,dX,1)
  395.            dv = ONE/sqrt(ONE+a**2+dw**2)
  396.            IF (II.EQ.2) THEN
  397.              IF (ISENS.LT.ZERO) THEN
  398.                dv = -dv
  399.              ENDIF
  400.            ELSE 
  401.              aux = DDOT(NT+2,t02,1,tp2,1)
  402.              dv = (SIGN(dv,aux))
  403.            ENDIF
  404.            DO K = 1,NT
  405.               dX(K) = dX(K)*dv
  406.               tp2(K) = dX(K)
  407.            ENDDO 
  408.            dw = dw*dv
  409.            tp2(NT+1) = dw
  410.            tp2(NT+2) = dv
  411.  
  412. *          === Message relatif au pas #II ==========
  413.            IF(IIMPI.GE.1) THEN
  414.               Q1NRM2=dnrm2(NT,Q1,1)
  415.               WRITE(IOIMP,666) (II-1),ITER,VV,Q1NRM2,.true.
  416.            ENDIF
  417. *  
  418.  
  419. *          === Tests d'arret ===========================================       
  420. *          On verifie la condition d'arret par rapport a VV
  421. c            IF ((VV.GT.PARFIN).OR.(VV.LT.PARINI)) THEN
  422.            IF ((VV-PARFIN)*(PARFIN-PARINI).GE.0) THEN
  423.                WRITE(IOIMP,*) 'Fin de la continuation apres',II,' pas.'
  424.                IF (II.LT.NBPAS) THEN
  425. *                  WRITE(*,*) 'NPAS sera egal a:',II
  426.                   NT1 = QSAVE(/1)
  427.                   NA1 = LSAVE(/2)/2
  428. *                  NPAS = QSAVE(/2)
  429.                   NBIFU = QBIFU(/1)
  430. *                  write(*,*) NT1,NA1,NPAS,NBIFU
  431.                   NPAS = II
  432.                   SEGADJ, PSORT
  433.                ENDIF
  434.                KSORT = PSORT
  435.                RETURN
  436.            ENDIF
  437.  
  438. *          === pour le prochain pas, ===================================
  439. *          ajustement automatique de la longueur du pas
  440.            CALL ADPAS(DS,DSMIN,DSMAX,ITER,ITERMOY,ANGMIN,ANGMAX,NT+2,
  441.      &                t02,tp2)
  442. *          donnees utiles
  443.            DO I=1,NT+2
  444.               t02(I) = tp2(I)
  445.            ENDDO
  446.            DO KK = 1,NT
  447.               QOLD(KK) = Q1(KK)+DS*dX(KK)/FOUR
  448.               Q1(KK) = Q1(KK)+DS*dX(KK)
  449.            ENDDO
  450.            OMEGOLD = OMEG + DS*dw/FOUR
  451.            VVOLD   = VV + DS*dv/FOUR
  452.            OMEG = OMEG + DS*dw
  453.            VV   = VV   + DS*dv
  454.            IREDU = 0
  455.  
  456. *       -----------------------------------
  457. *       ---- si NEWT n'a pas converge, ----
  458. *       -----------------------------------
  459.         ELSE
  460.  
  461. *          Revenir en arriere, en diminuant le pas       
  462.            IF (II.GT.1) THEN
  463.              DO I=1,NT
  464.                Q1(I) = QOLD(I)
  465.              ENDDO
  466.              OMEG = OMEGOLD
  467.              VV = VVOLD
  468.              DS = DS/FOUR
  469.              II = II-1
  470.            ENDIF
  471. c          apres reduction de 0.25**10 = 1.E-6 , echec !
  472. c                             0.25**5  = 1.E-3
  473. c            IF (IREDU.GT.10) THEN        
  474.            IF (IREDU.GT.5) THEN        
  475.               WRITE(IOIMP,*)'Non-convergence apres ',IREDU,' reductions'
  476.               IF (II.LT.NBPAS) THEN
  477.                   NT1 = QSAVE(/1)
  478.                   NA1 = LSAVE(/2)/2
  479. *                  NPAS = QSAVE(/2)
  480.                   NBIFU = QBIFU(/1)
  481.                   NPAS = II
  482.                   SEGADJ, PSORT
  483.                ENDIF
  484.                KSORT = PSORT
  485.                RETURN
  486.            ENDIF
  487.            IREDU = IREDU + 1
  488.            IF (IIMPI.GE.3) THEN  
  489.              WRITE(IOIMP,*) 'Reduction du pas #',IREDU
  490.            ENDIF
  491.  
  492.         ENDIF 
  493. *       ----------------------------------------------
  494. *       ---- fin distinction NEWT converge ou pas ----  
  495. *       ----------------------------------------------
  496.  
  497.  
  498. *        incrementation du compteur
  499.          II = II+1
  500.         ENDDO
  501. *=======================================================================  
  502. *       fin de la boucle sur le parametre de continuation         
  503. *======================================================================= 
  504.  
  505.  
  506. *       message
  507.         WRITE(IOIMP,*) NBPAS, 'pas de continuation realises!' 
  508.         KSORT = PSORT
  509.  
  510.         segsup,MWORK
  511.  
  512.       END
  513.  
  514.  
  515.  
  516.  
  517.  
  518.  
  519.  

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