Télécharger la plaquette Cast3M


fr en

Télécharger kres8.eso

Retour à la liste

Numérotation des lignes : 

kres8

  1. C KRES8     SOURCE    CB215821  20/11/25    13:33:04     10792          
  2.       SUBROUTINE KRES8(MRIGID,KSMBR,INORMU,
  3.      $           KTYPI,ITER,RESID,ICALRS,IRSTRT,LBCG,BRTOL,IDDOT,IMVEC,
  4.      $           KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,
  5.      $           KTIME,LTIME,
  6.      $           MCHSOL,LRES,LNMV,ICVG,IMPR)
  7.       IMPLICIT REAL*8 (A-H,O-Z)
  8.       IMPLICIT INTEGER (I-N)
  9. C***********************************************************************
  10. C NOM         : KRES8
  11. C DESCRIPTION : - Assemblage par RESOU
  12. C               - Conversion au format Morse de la matrice
  13. C               - Conversion du second membre en MVECTD
  14. C               - Construction du préconditionneur
  15. C               - Appel des solveurs itératifs
  16. C               - Conversion du résultat en CHPOINT
  17. C
  18. C
  19. C LANGAGE     : ESOPE
  20. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  21. C               mél : gounand@semt2.smts.cea.fr
  22. C***********************************************************************
  23. C VERSION    : v1, 04/08/2011, version initiale
  24. C HISTORIQUE : v1, 04/08/2011, création
  25. C HISTORIQUE :
  26. C HISTORIQUE :
  27. C***********************************************************************
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC SMCHPOI
  32.       POINTEUR MCHSOL.MCHPOI
  33. -INC SMRIGID
  34. -INC SMVECTD
  35.       POINTEUR ISMBR.MVECTD
  36.       POINTEUR INCX.MVECTD
  37.       POINTEUR IR.MVECTD
  38. -INC SMMATRI
  39.       SEGMENT PMORS
  40.       INTEGER IA (NTT+1)
  41.       INTEGER JA (NJA)
  42.       ENDSEGMENT
  43.       POINTEUR PMS1.PMORS,PMS2.PMORS
  44.       POINTEUR KMORS.PMORS
  45. C Segment de stokage
  46.       SEGMENT IZA
  47.       REAL*8  A(NBVA)
  48.       ENDSEGMENT
  49.       POINTEUR IZA1.IZA,IZA2.IZA,IZAU.IZA,IZAL.IZA,ISA.IZA
  50.       POINTEUR KIZA.IZA
  51.  
  52. -INC SMLENTI
  53.       POINTEUR KTYP.MLENTI
  54. -INC SMTABLE
  55.       POINTEUR KTIME.MTABLE
  56.       DIMENSION ITTIME(4)
  57.       CHARACTER*8 CHARI
  58.       CHARACTER*1 CCOMP
  59.       LOGICAL LTIME,LOGII
  60.       REAL*8 GNRM2
  61. C     ..
  62. C     .. External subroutines and functions..
  63. *inutile      EXTERNAL GAXPY,GCOPY,GDOT,GNRM2
  64.  
  65.       IVALI=0
  66.       XVALI=0.D0
  67.       LOGII=.FALSE.
  68.       IRETI=0
  69.       XVALR=0.D0
  70. *inutile      IOBRE=0
  71.       IRETR=0
  72. C
  73. C Executable statements
  74. C
  75.       IF (LTIME) THEN
  76.          CALL CRTABL(KTIME)
  77.          call timespv(ittime,oothrd)
  78.          ITI1=(ITTIME(1)+ITTIME(2))/10
  79.       ELSE
  80.          KTIME=0
  81.       ENDIF
  82. C
  83. C  CAS PARTICULIER : Si la matrice est vide (toutes les inconnues
  84. C      éliminées, par exemple)
  85. C
  86.       SEGACT MRIGID
  87.       IF (IRIGEL(/2).EQ.0) THEN
  88.          NSOUPO=0
  89.          NAT=0
  90.          SEGINI MCHSOL
  91.          SEGDES MCHSOL
  92.          ICVG=0
  93.          LNMV=0
  94.          LRES=0
  95.          IF (LTIME) THEN
  96.             call timespv(ittime,oothrd)
  97.             ITI2=(ITTIME(1)+ITTIME(2))/10
  98.             CHARI='MATVIDE'
  99.             CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  100.      $           'ENTIER  ',ITI2-ITI1,XVALR,CHARR,LOGIR,IRETR)
  101.             SEGDES KTIME
  102.          ENDIF
  103.          SEGDES MRIGID
  104.          RETURN
  105.       ENDIF
  106. C
  107. C               - Assemblage par RESOU
  108. C
  109. C  old INORMU=1 : Normalisation des mutiplicateurs de Lagrange
  110. *     INORMU est transmis à la subroutine
  111. *     Le problème est que si MRIGID est deja assemblée, INORMU n'est pas
  112. *     pris en compte... mais où le stocker ??
  113.       CALL KRES9(MRIGID,INORMU)
  114.       IF (IERR.NE.0) RETURN
  115.       IF (LTIME) THEN
  116.          call timespv(ittime,oothrd)
  117.          ITI2=(ITTIME(1)+ITTIME(2))/10
  118.       ENDIF
  119. C
  120. C               - Conversion au format Morse de la matrice
  121. C
  122.       CALL KRES10(MRIGID,KMORS,KIZA)
  123.       IF (IERR.NE.0) RETURN
  124.       IF (LTIME) THEN
  125.          call timespv(ittime,oothrd)
  126.          ITI3=(ITTIME(1)+ITTIME(2))/10
  127.       ENDIF
  128. C
  129. C On donne des infos sur la matrice
  130. C
  131. *      SEGACT MRIGID
  132. *     ICHOLX=ICHOLE
  133. **    INFDDL.ESO est dans ~/triou/p1nc
  134. **      CALL INFDDL(ICHOLX)
  135. C      WRITE(IOIMP,*) 'IMPR=',IMPR
  136.       CALL INFMAT(KMORS,KIZA,IMPR,IRET)
  137. C      IF (IRET.NE.0) GOTO 9999
  138. C      WRITE(IOIMP,*) 'Apres KRES10'
  139. C      WRITE(IOIMP,*) 'KMORS=',KMORS
  140. C      WRITE(IOIMP,*) 'KIZA=',KIZA
  141.  
  142. C
  143. C               - Conversion du second membre en MVECTD
  144. C                 et initialisation du résultat
  145. C
  146.       SEGACT MRIGID
  147.       ICHOLX=ICHOLE
  148.       ISECO=KSMBR
  149. C On ne vérifie pas que le second membre doit être dans le dual
  150.       NOID=1
  151.       CALL CHVNS(ICHOLX,ISECO,ISMBR,NOID)
  152.       IF (IERR.NE.0) RETURN
  153.       IF (LTIME) THEN
  154.          call timespv(ittime,oothrd)
  155.          ITI4=(ITTIME(1)+ITTIME(2))/10
  156.       ENDIF
  157.  
  158. C      SEGACT ISMBR
  159. C      WRITE(IOIMP,*) 'Second membre sous forme vecteur'
  160. C      INC=ISMBR.VECTBB(/1)
  161. C      WRITE(IOIMP,*) '     ISMBR, INC=',INC
  162. C      WRITE(IOIMP,2022) (ISMBR.VECTBB(II),II=1,ISMBR.VECTBB(/1))
  163. C      
  164. C     Gestion normalisation Lagrange (repris de MONDES)
  165. C      
  166. *      IF (INORMU.EQ.1) THEN
  167.          SEGACT ISMBR*MOD
  168.          MMATRI=ICHOLE
  169.          SEGACT MMATRI
  170.          IF(IDNORD.GT.0) THEN
  171.             MDNO1=IDNORD
  172.          ELSE
  173.             MDNO1=IDNORM
  174.          ENDIF
  175.          SEGACT MDNO1
  176.          INC=MDNO1.DNOR(/1)
  177.          DO 45 I=1,INC
  178.             ISMBR.VECTBB(I)=ISMBR.VECTBB(I)*MDNO1.DNOR(I)
  179.  45      CONTINUE
  180.          SEGDES MDNO1
  181.          SEGDES MMATRI
  182.          SEGDES ISMBR
  183. *      ENDIF
  184. C
  185. C               - Construction du préconditionneur (repris sur kres5)
  186. C               - Appel des solveurs itératifs
  187. C
  188. C Si solveur multigrille, il faut un segment permettant de distinguer
  189. C les inconnues
  190.       IF (KTYPI.EQ.7.OR.KTYPI.EQ.8) THEN
  191.          MMATRI=ICHOLE
  192.          SEGACT MMATRI
  193.          MINCPO=IINCPO
  194.          SEGACT MINCPO
  195.          NCOMP=INCPO(/1)
  196.          NNOE=INCPO(/2)
  197.          SEGACT ISMBR
  198.          INC=ISMBR.VECTBB(/1)
  199.          SEGDES ISMBR
  200.          JG=INC
  201.          SEGINI KTYP
  202.          DO ICOMP=1,NCOMP
  203.             DO INOE=1,NNOE
  204.                IG=INCPO(ICOMP,INOE)
  205.                IF (IG.GT.0) KTYP.LECT(IG)=ICOMP
  206.             ENDDO
  207.          ENDDO
  208.          SEGDES KTYP
  209.          SEGDES MINCPO
  210.          SEGDES MMATRI
  211.       ELSE
  212.          KTYP=0
  213.       ENDIF
  214. C
  215. C Warning KMORS, KIZA et KTYP sont détruits dans KRES11 et KRES12
  216. C si inodet=0
  217.       INODET=1
  218. C         CALL ECMORS(KMORS,KIZA,4)
  219. C      SEGACT ISMBR
  220. C      WRITE(IOIMP,*) 'Second membre sous forme vecteur'
  221. C      INC=ISMBR.VECTBB(/1)
  222. C      WRITE(IOIMP,*) '     ISMBR, INC=',INC
  223. C      WRITE(IOIMP,2022) (ISMBR.VECTBB(II),II=1,ISMBR.VECTBB(/1))
  224. C Solveur Direct
  225.       IF (KTYPI.EQ.1) THEN
  226.          SEGINI,INCX=ISMBR
  227.          CALL KRES12(KMORS,KIZA,INCX,
  228. C         CALL KRES12(KMORS,KIZA,ISMBR,
  229.      $        KTIME,LTIME,
  230.      $        INCX,LRES,LNMV,ICVG,IMPR,INODET)
  231.       ELSE
  232. C Solveur Itératif
  233.          CALL KRES11(KMORS,KIZA,KTYP,ISMBR,
  234.      $        KTYPI,ITER,RESID,ICALRS,IRSTRT,LBCG,BRTOL,IDDOT,IMVEC,
  235.      $        KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,
  236.      $        KTIME,LTIME,
  237.      $        INCX,LRES,LNMV,ICVG,IMPR,INODET)
  238. C      WRITE(IOIMP,*) 'Apres KRES11'
  239.       ENDIF
  240.       IF(IERR.NE.0) RETURN
  241. C      SEGACT INCX
  242. C      WRITE(IOIMP,*) 'Inconnue sous forme vecteur'
  243. C      INC=INCX.VECTBB(/1)
  244. C      WRITE(IOIMP,*) '     INCX, INC=',INC
  245. C      WRITE(IOIMP,2022) (INCX.VECTBB(II),II=1,INCX.VECTBB(/1))
  246. C      IF(IERR.NE.0) RETURN
  247. C                    r(0)=b
  248. C      SEGINI,IR=ISMBR
  249. C      SEGACT INCX
  250. C      SEGACT KMORS
  251. C      SEGACT KIZA
  252. CC                    r(0)=b-Ax
  253. C      CALL GMOMV(IMVEC,'N',-1.D0,KMORS,KIZA,INCX,1.D0,IR)
  254. C      RNRM2 = GNRM2(IR)
  255. C      WRITE(IOIMP,*) '||R||=',RNRM2
  256. C      
  257. C     Gestion normalisation Lagrange (repris de MONDES)
  258. C     + égalité multiplicateurs 
  259. *      IF (INORMU.EQ.1) THEN
  260.          SEGACT INCX*MOD
  261.          MMATRI=ICHOLE
  262.          SEGACT MMATRI
  263.          MDNOR=IDNORM
  264.          SEGACT MDNOR
  265.          INC=DNOR(/1)
  266.          DO 35 I=1,INC
  267.             INCX.VECTBB(I)=INCX.VECTBB(I)*DNOR(I)
  268.  35      CONTINUE
  269.          SEGDES MDNOR
  270.          MILIGN=IILIGN
  271.          SEGACT,MILIGN
  272.          DO 36 I = 1, INC
  273.             if (ITTR(I).ne.0) then
  274. *            write (6,*) ' dans mondes ',i,ittr(i)
  275.                if (incx.vectbb(i).eq.0.d0
  276.      $              .or.incx.vectbb(ittr(i)).eq.0.d0) then
  277. *      write (6,*) ' mondes vectbbs ',vectbb(i+k),vectbb(ittr(i)+k)
  278.                   incx.vectbb(i)=0.d0
  279.                   incx.vectbb(ittr(i))=0.d0
  280.                   goto 36
  281.                endif
  282.                incx.vectbb(i)=(incx.vectbb(i)+incx.vectbb(ittr(i)))/2
  283.                incx.vectbb(ittr(i))=incx.vectbb(i)
  284.             endif
  285.  36      CONTINUE
  286.          SEGDES MILIGN
  287.          SEGDES MMATRI
  288.          SEGDES INCX
  289. *      ENDIF
  290. C
  291. C
  292. C      SEGACT INCX
  293. C      WRITE(IOIMP,*) 'Inconnue sous forme vecteur'
  294. C      INC=INCX.VECTBB(/1)
  295. C      WRITE(IOIMP,*) '     INCX, INC=',INC
  296. C      WRITE(IOIMP,2022) (INCX.VECTBB(II),II=1,INCX.VECTBB(/1))
  297. C      IF(IERR.NE.0) RETURN
  298.  
  299.       IF (LTIME) THEN
  300.          call timespv(ittime,oothrd)
  301.          ITI5=(ITTIME(1)+ITTIME(2))/10
  302.       ENDIF
  303. C
  304. C               - Conversion du résultat en CHPOINT
  305. C
  306.       CALL VCH1(ICHOLX,INCX,MCHSOL,MRIGID)
  307. C      WRITE(IOIMP,*) 'Apres VCH1'
  308.       IF(IERR.NE.0) RETURN
  309.       IF (LTIME) THEN
  310.          call timespv(ittime,oothrd)
  311.          ITI6=(ITTIME(1)+ITTIME(2))/10
  312.          CHARI='ASS+RENU'
  313.          CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  314.      $                     'ENTIER  ',ITI2-ITI1,XVALR,CHARR,LOGIR,IRETR)
  315.          CHARI='CONVMORS'
  316.          CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  317.      $                     'ENTIER  ',ITI3-ITI2,XVALR,CHARR,LOGIR,IRETR)
  318. C         CHARI='CONVSMB '
  319. C         CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  320. C     $                     'ENTIER  ',ITI4-ITI3,XVALR,CHARR,LOGIR,IRETR)
  321.          IF (KTYPI.EQ.1) THEN
  322.             CHARI='FAC+RESO'
  323.          ELSE
  324.             CHARI='PRE+RESO'
  325.          ENDIF
  326.          CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  327.      $                     'ENTIER  ',ITI5-ITI4,XVALR,CHARR,LOGIR,IRETR)
  328. C         CHARI='CONVINC'
  329. C         CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  330. C     $                     'ENTIER  ',ITI6-ITI5,XVALR,CHARR,LOGIR,IRETR)
  331.          CHARI='TOTAL   '
  332.          CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  333.      $                     'ENTIER  ',ITI6-ITI1,XVALR,CHARR,LOGIR,IRETR)
  334.          SEGDES KTIME
  335.       ENDIF
  336. C     Le solveur direct surcharge le second membre
  337.       IF (ISMBR.NE.INCX) SEGSUP ISMBR
  338.       SEGSUP INCX
  339.       SEGDES MRIGID
  340. C
  341. C Normal termination
  342. C
  343.       RETURN
  344. C
  345. C Format handling
  346. C
  347.  2022 FORMAT(10(1X,1PG12.5))
  348. C
  349. C End of subroutine KRES8
  350. C
  351.       END
  352.  
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  

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