Télécharger la plaquette Cast3M


fr en

Télécharger sormat.eso

Retour à la liste

Numérotation des lignes : 

sormat

  1. C SORMAT    SOURCE    FANDEUR   22/03/10    21:15:06     11313          
  2. ************************************************************************
  3. * NOM         : sormat.eso
  4. * DESCRIPTION : Sortie d'objets de type RIGIDITE/CHPOINT définissant
  5. *               un problème physique sous forme matricielle
  6. * REFERENCES  : - The Matrix Market Exchange Formats: Initial Design,
  7. *                 Boisvert R. F., Pozo R., Remington K. A. (Dec 1996)
  8. *               - The Rutherford-Boeing Sparse Matrix Collection,
  9. *                 Duff I. S., Grimes R. G., Lewis G. L. (Sep 1997)
  10. ************************************************************************
  11. * HISTORIQUE :  7/06/2012 : JCARDO : création de la subroutine
  12. * HISTORIQUE :  4/12/2012 : JCARDO : ajout de la sortie RB
  13. *                                    + formes ELEMEN et TRIANG
  14. *                                    + mots-clés RHS, SOL et RES
  15. * HISTORIQUE : 16/07/2019 : GOUNAND : implem RESU, FORC (MM assemblé) 
  16. * HISTORIQUE :  8/11/2019 : JCARDO : COERIG n'etait pas pris en compte
  17. ************************************************************************
  18. * ENTRÉES :: aucune
  19. * SORTIES :: aucune (sur fichier uniquement)
  20. ************************************************************************
  21. * SYNTAXE (GIBIANE) :
  22. *
  23. *    SORT 'MAT' MOT1 MOT2 RIG1
  24. *        ('TITR' MOT3)
  25. *        ('INCO')
  26. *        ('GEOM')
  27. *        ('FORC' CHP1)
  28. *        ('CONN' CHP2)
  29. *        ('RESU' CHP3)
  30. *        ('SOLU' CHP4) ;
  31. *
  32. ************************************************************************
  33.       SUBROUTINE SORMAT
  34.  
  35.       IMPLICIT INTEGER(I-N)
  36.       IMPLICIT REAL*8(A-H,O-Z)
  37.       LOGICAL LDBG
  38.       EXTERNAL LONG
  39.  
  40.  
  41. -INC PPARAM
  42. -INC CCOPTIO
  43. *
  44. -INC SMLMOTS
  45. -INC SMCHPOI
  46. -INC SMRIGID
  47. -INC SMMATRI
  48. -INC SMVECTD
  49.       POINTEUR ISMBR.MVECTD
  50.       POINTEUR INCX.MVECTD
  51.       POINTEUR IR.MVECTD
  52. -INC SMELEME
  53. -INC SMCOORD
  54.  
  55. *
  56. *     NPOTOT = nombre de noeuds distincts au total
  57. *     NELTOT = nombre d'éléments au total
  58. *     NINTOT = nombre d'indices au total
  59. *     NVATOT = nombre de valeurs au total dans la matrice creuse
  60. *     NBCOPR = nombre de composantes primales
  61. *     NBCODU = nombre de composantes duales
  62. *     NBPTOT = nombre d'inconnues primales au total
  63. *     NBDTOT = nombre d'inconnues duales au total
  64. *
  65. *
  66. *     DECLARATIONS DES SEGMENTS ET DES POINTEURS
  67. *     ------------------------------------------
  68.  
  69. *     Stockage morse provenant de l'include SMMATRIK
  70.       SEGMENT PMORS
  71.           INTEGER IA(NTT+1)
  72.           INTEGER JA(NJA)
  73.       ENDSEGMENT
  74.       SEGMENT IZA
  75.           REAL*8  A(NBVA)
  76.       ENDSEGMENT
  77.       POINTEUR KMORS.PMORS,KMOR2.PMORS
  78.       POINTEUR KIZA.IZA,KIZA2.IZA
  79.  
  80. *     Tableaux temporaires permettant de concatener des données avant
  81. *     de les imprimer en un seul bloc
  82.       SEGMENT MIDATA
  83.           INTEGER IWRIT(NBWR)
  84.       ENDSEGMENT
  85.       SEGMENT MRDATA
  86.           REAL*8 XWRIT(NBWR)
  87.       ENDSEGMENT
  88.  
  89. *     Correspondance local/global pour les noeuds
  90.       SEGMENT IPOG2L(NPOMAX)
  91.  
  92. *     Tableaux temporaires permettant de mémoriser les indices des
  93. *     composantes primales/duales de chaque sous-matrice dans la liste
  94. *     globale IMIK/IDUA
  95.       SEGMENT MCONUM(NRIGEL)
  96.       SEGMENT ICONUM
  97.           INTEGER IICOPR(NLIGRP),IICODU(NLIGRD)
  98.       ENDSEGMENT
  99.  
  100. *     Tableaux indiquant le numéro du d.d.l. primal/dual en fonction du
  101. *     numéro du noeud et du numéro de la composante
  102.       POINTEUR IDDLPR.MINCPO,IDDLDU.MINCPO
  103.  
  104. *     Maillage répertoriant tous les noeuds supportant la matrice
  105.       POINTEUR MNOEUD.MELEME
  106.  
  107.  
  108. *     LISTES DE MOTS-CLÉS
  109. *     -------------------
  110.       PARAMETER (NCLE=7)
  111.       CHARACTER*4 LCLE(NCLE)
  112.       DATA LCLE/'TITR','GEOM','INCO','FORC','CONN','SOLU','RESU'/
  113.  
  114.       PARAMETER (NTYP=2)
  115.       CHARACTER*4 LTYP(NTYP)
  116.       DATA LTYP/'ELEM','ASSE'/
  117.  
  118.       CHARACTER*20 MYFMT
  119.  
  120.       CHARACTER*16 PTRFMT,INDFMT
  121.       CHARACTER*20 VALFMT
  122.       INTEGER      PTRCRD,INDCRD,VALCRD,TOTCRD
  123.       PARAMETER (PTRFMT='(6I12)')
  124.       PARAMETER (INDFMT='(6I12)')
  125.       PARAMETER (VALFMT='(3E25.16)')
  126.       PARAMETER (NPTRFMT=5)
  127.       PARAMETER (NINDFMT=5)
  128.       PARAMETER (NVALFMT=3)
  129.  
  130. *     VARIABLES BOOLÉENNES
  131. *     --------------------
  132.       LOGICAL ZTITR,ZGEOM,ZINCO,ZFORC,ZELEM,ZSOLU,ZRESU,ZNZER
  133.       LOGICAL ZOPEN
  134.  
  135.  
  136. *     AUTRES DÉCLARATIONS
  137. *     -------------------
  138.  
  139. *     Format de sortie des fichiers
  140.       CHARACTER*17 CEXTN
  141.  
  142. *     Chaîne imprimée dans la section TITRE
  143.       CHARACTER*128 CTITR,CTIT2
  144.       DATA CTITR/' '/
  145.  
  146. *     Nom du fichier
  147.       CHARACTER*(LOCHAI) NOMFIC
  148.  
  149. *     Coefficient multiplicateur d'une sous-rigidite
  150.       REAL*8 COEF
  151.  
  152.  
  153.       IDIM1=IDIM+1
  154.       LDBG=.FALSE.
  155.  
  156. *     +---------------------------------------------------------------+
  157. *     |                                                               |
  158. *     |           L E C T U R E   D E S   A R G U M E N T S           |
  159. *     |                                                               |
  160. *     +---------------------------------------------------------------+
  161.  
  162. *     =========================
  163. *     FORMAT STANDARD DE SORTIE
  164. *     =========================
  165.  
  166. *     CEXTN='mm' / IEXTN=1 : format Matrix Market
  167. *     CEXTN='rb' / IEXTN=2 : format Rutherford Boeing
  168.       CALL LIRCHA(CEXTN,1,LEXTN)
  169.       IF (CEXTN(1:LEXTN).EQ.'MM'.OR.
  170.      &    CEXTN(1:LEXTN).EQ.'MATRIX_MARKET') THEN
  171.           CEXTN='mm'
  172.           IEXTN=1
  173.       ELSEIF (CEXTN(1:LEXTN).EQ.'RB'.OR.
  174.      &    CEXTN(1:LEXTN).EQ.'RUTHERFORD_BOEING') THEN
  175.           CEXTN='rb'
  176.           IEXTN=2
  177.       ELSE
  178.           WRITE(*,*) 'erreur : mm ou rb ?'
  179.           CALL ERREUR(21)
  180.           RETURN
  181.       ENDIF
  182.  
  183.  
  184. *     =========================
  185. *     TYPE DE MATRICE EN SORTIE
  186. *     =========================
  187.  
  188. *     ITYP=1 : matrices élémentaires
  189. *     ITYP=2 : matrice assemblée
  190.       CALL LIRMOT(LTYP,NTYP,ITYP,1)
  191.       IF (IERR.NE.0) RETURN
  192.  
  193.  
  194. *     ===========================
  195. *     LECTURE DE L'OBJET RIGIDITE
  196. *     ===========================
  197.  
  198.       CALL LIROBJ('RIGIDITE',MRIGID,1,IRETOU)
  199.       IF (IERR.NE.0) RETURN
  200.  
  201.  
  202. *     =====================
  203. *     LECTURE DES MOTS-CLÉS
  204. *     =====================
  205.  
  206.       ZTITR=.FALSE.
  207.       ZGEOM=.FALSE.
  208.       ZINCO=.FALSE.
  209.       ZFORC=.FALSE.
  210.       ISMBR=0
  211.       ZELEM=.FALSE.
  212.       ZSOLU=.FALSE.
  213.       ZRESU=.FALSE.
  214.       INCX=0
  215.  
  216.  1    CALL LIRMOT(LCLE,NCLE,ICLE,0)
  217.       IF (ICLE.EQ.0) GOTO 100
  218.  
  219.       GOTO (10,11,12,13,14,15,16),ICLE
  220.  
  221. *     Mot-clé TITR
  222.  10   CONTINUE
  223.       CALL LIRCHA(CTITR,1,LTITR)
  224.       IF (IERR.NE.0) RETURN
  225.       ZTITR=.TRUE.
  226.       GOTO 1
  227.  
  228. *     Mot-clé GEOM
  229.  11   CONTINUE
  230.       ZGEOM=.TRUE.
  231.       GOTO 1
  232.  
  233. *     Mot-clé INCO
  234.  12   CONTINUE
  235.       ZINCO=.TRUE.
  236.       GOTO 1
  237.  
  238. *     Mot-clé FORC
  239.  13   CONTINUE
  240.       CALL LIROBJ('CHPOINT',IFORC,1,IRETOU)
  241.       IF (IERR.NE.0) RETURN
  242.       ZFORC=.TRUE.
  243.       GOTO 1
  244.  
  245. *     Mot-clé ELEM
  246.  14   CONTINUE
  247.       ZELEM=.TRUE.
  248.       GOTO 1
  249.  
  250. *     Mot-clé SOLU
  251.  15   CONTINUE
  252.       CALL LIROBJ('CHPOINT',ISOLU,1,IRETOU)
  253.       IF (IERR.NE.0) RETURN
  254.       ZSOLU=.TRUE.
  255.       GOTO 1
  256.  
  257. *     Mot-clé RESU
  258.  16   CONTINUE
  259.       CALL LIROBJ('CHPOINT',IRESU,1,IRETOU)
  260.       IF (IERR.NE.0) RETURN
  261.       ZRESU=.TRUE.
  262.       GOTO 1
  263.  
  264.  
  265.  
  266.  
  267. c       WRITE(*,*) 'IEXTN=',IEXTN
  268. c       WRITE(*,*) 'ITYP=',ITYP
  269. c       WRITE(*,*) 'ZTITR=',ZTITR
  270. c       WRITE(*,*) 'ZGEOM=',ZGEOM
  271. c       WRITE(*,*) 'ZINCO=',ZINCO
  272. c       WRITE(*,*) 'ZFORC=',ZFORC
  273. c       WRITE(*,*) 'ZELEM=',ZELEM
  274. c       WRITE(*,*) 'ZSOLU=',ZSOLU
  275. c       WRITE(*,*) 'ZRESU=',ZRESU
  276.  
  277.  
  278.  
  279.  
  280.  
  281. *     +---------------------------------------------------------------+
  282. *     |                                                               |
  283. *     |           M A T R I C E  =  F I C H I E R   . M T X           |
  284. *     |                                                               |
  285. *     +---------------------------------------------------------------+
  286. *
  287.  
  288.  100  CONTINUE
  289.  
  290.  
  291. *     On s'assure que la matrice n'est pas vide
  292.       SEGACT,MRIGID*MOD
  293.       NRIGEL=IRIGEL(/2)
  294.       IF (NRIGEL.EQ.0) THEN
  295.          MOTERR(1:8)='RIGIDITE'
  296.          CALL ERREUR(1027)
  297.          RETURN
  298.       ENDIF
  299.  
  300.  
  301.  
  302. *     ======================================
  303. *     RÉCUPÉRATION DU NOM DE BASE DU FICHIER
  304. *     ======================================
  305.  
  306.       INQUIRE(UNIT=IOPER,OPENED=ZOPEN)
  307.       IF (.NOT.ZOPEN) THEN
  308.           CALL ERREUR(-212)
  309.           WRITE(IOIMP,*) '(via OPTI "SORT")'
  310.           MOTERR(1:8)='.'//CEXTN(1:7)
  311.           CALL ERREUR(705)
  312.           RETURN
  313.       ENDIF
  314.  
  315.       INQUIRE(UNIT=IOPER,NAME=NOMFIC)
  316.       CLOSE(UNIT=IOPER,STATUS='DELETE')
  317.       CALL LENCHA(NOMFIC,LC)
  318.  
  319.  
  320.  
  321. *     ========================================
  322. *     SORTIE DE MATRICE SOUS FORME ÉLÉMENTAIRE
  323. *     ========================================
  324.  
  325.       IF (ITYP.EQ.1) THEN
  326.  
  327.  
  328. *         ***********************************
  329. *         LISTE DES NOEUDS ET DES COMPOSANTES
  330. *         ***********************************
  331.  
  332. *         On stocke les noeuds rencontrés dans un MELEME
  333.           NPOMAX=nbpts
  334.           NBSOUS=0
  335.           NBREF=0
  336.           NBNN=1
  337.           NBELEM=NPOMAX
  338.           SEGINI,IPOG2L,MNOEUD
  339.           MNOEUD.ITYPEL=1
  340.  
  341. *         On stocke les noms des composantes primales/duales dans les
  342. *         tableaux IMIK et IDUA (analogues à ceux existant dans SMMATRI
  343. *         pour les matrices assemblées). Les tableaux ICONUM (un par
  344. *         sous-rigidité) mémorisent pour chaque variable primale/duale
  345. *         l'indice de la composante correspondante dans IMIK/IDUA.
  346.           SEGINI,MIMIK,MIDUA,MCONUM
  347.  
  348. *         (boucle sur les sous-rigidités)
  349.           NPOTOT=0
  350.           NELTOT=0
  351.           NVATOT=0
  352.           NINTOT=0
  353.           DO IRIG=1,NRIGEL
  354.  
  355. *             Construction du MELEME
  356. *             ----------------------
  357.               IPT1=IRIGEL(1,IRIG)
  358.               SEGACT,IPT1
  359.               NEL1=IPT1.NUM(/2)
  360.               NNO1=IPT1.NUM(/1)
  361.               NELTOT=NELTOT+NEL1
  362.               DO I=1,NEL1
  363.                   DO J=1,NNO1
  364.                       IF (IPOG2L(IPT1.NUM(J,I)).EQ.0) THEN
  365.                           NPOTOT=NPOTOT+1
  366.                           IPOG2L(IPT1.NUM(J,I))=NPOTOT
  367.                           MNOEUD.NUM(1,NPOTOT)=IPT1.NUM(J,I)
  368.                       ENDIF
  369.                   ENDDO
  370.               ENDDO
  371.  
  372.  
  373. *             Construction des listes IMIK/IDUA
  374. *             ---------------------------------
  375.               DESCR=IRIGEL(3,IRIG)
  376.               SEGACT,DESCR
  377.               NLIGRP=LISINC(/2)
  378.               NLIGRD=LISDUA(/2)
  379.               NINTOT=NINTOT+((NLIGRP+NLIGRD)*NEL1)
  380.               NVATOT=NVATOT+(NLIGRP*NLIGRD*NEL1)
  381.               SEGINI,ICONUM
  382.               MCONUM(IRIG)=ICONUM
  383.  
  384. *             composantes primales
  385.               DO 101 K=1,NLIGRP
  386.                   DO J=1,IMIK(/2)
  387.                       IF (IMIK(J).EQ.LISINC(K)) THEN
  388.                           IICOPR(K)=J
  389.                           GOTO 101
  390.                       ENDIF
  391.                   ENDDO
  392.                   IMIK(**)=LISINC(K)
  393.                   IICOPR(K)=IMIK(/2)
  394.  101          CONTINUE
  395.  
  396. *             composantes duales
  397.               DO 102 K=1,NLIGRD
  398.                   DO J=1,IDUA(/2)
  399.                       IF (IDUA(J).EQ.LISDUA(K)) THEN
  400.                           IICODU(K)=J
  401.                           GOTO 102
  402.                       ENDIF
  403.                   ENDDO
  404.                   IDUA(**)=LISDUA(K)
  405.                   IICODU(K)=IDUA(/2)
  406.  102          CONTINUE
  407.  
  408.           ENDDO
  409.           NBELEM=NPOTOT
  410.           SEGADJ,MNOEUD
  411.  
  412.  
  413. *         *********************************************************
  414. *         LISTE DES INCONNUES (= DDL) PRIMALES/DUALES DE LA MATRICE
  415. *         *********************************************************
  416.  
  417.           NBPTOT=0
  418.           NBDTOT=0
  419.  
  420.           NNOE=NPOTOT
  421.           MAXI=IMIK(/2)
  422.           SEGINI,IDDLPR
  423.           MAXI=IDUA(/2)
  424.           SEGINI,IDDLDU
  425.  
  426.           DO IRIG=1,NRIGEL
  427.  
  428.               IPT1=IRIGEL(1,IRIG)
  429.               DESCR=IRIGEL(3,IRIG)
  430.               ICONUM=MCONUM(IRIG)
  431.               NEL1=IPT1.NUM(/2)
  432.               NBP1=IICOPR(/1)
  433.               NBD1=IICODU(/1)
  434.               DO I=1,NEL1
  435.  
  436. *                 inconnues primales
  437.                   DO K=1,NBP1
  438.                       ICOP=IICOPR(K)
  439.                       INOP=IPOG2L(IPT1.NUM(NOELEP(K),I))
  440.                       IF (IDDLPR.INCPO(ICOP,INOP).EQ.0) THEN
  441.                           NBPTOT=NBPTOT+1
  442.                           IDDLPR.INCPO(ICOP,INOP)=NBPTOT
  443.                       ENDIF
  444.                   ENDDO
  445.  
  446. *                 inconnues duales
  447.                   DO K=1,NBD1
  448.                       ICOD=IICODU(K)
  449.                       INOD=IPOG2L(IPT1.NUM(NOELED(K),I))
  450.                       IF (IDDLDU.INCPO(ICOD,INOD).EQ.0) THEN
  451.                           NBDTOT=NBDTOT+1
  452.                           IDDLDU.INCPO(ICOD,INOD)=NBDTOT
  453.                       ENDIF
  454.                   ENDDO
  455.  
  456.               ENDDO
  457.  
  458.           ENDDO
  459.  
  460.  
  461.  
  462. *         ********************************
  463. *      => Sortie MATRIX_MARKET élémentaire
  464. *         ********************************
  465.  
  466.           IF (IEXTN.EQ.1) THEN
  467.  
  468. *             Création du fichier .mtx.mm
  469.               M=NBPTOT
  470.               N=NBDTOT
  471.               NNZER=NELTOT
  472.               CALL OPENMM(NOMFIC,'mtx',CTITR,
  473.      &                    M,N,NNZER,'matrix elemental real general')
  474.  
  475.  
  476.               DO IRIG=1,NRIGEL
  477.  
  478.                   COEF=COERIG(IRIG)
  479.                   IPT1=IRIGEL(1,IRIG)
  480.                   SEGACT,IPT1
  481.                   DESCR=IRIGEL(3,IRIG)
  482.                   XMATRI=IRIGEL(4,IRIG)
  483.                   ICONUM=MCONUM(IRIG)
  484.                   SEGACT,XMATRI
  485.  
  486.                   DO KEL=1,IPT1.NUM(/2)
  487.  
  488.                       NPR1=LISINC(/2)
  489.                       NDU1=LISDUA(/2)
  490.                       WRITE(IOPER,FMT='(I12,1X,I12)')
  491.      &                NPR1,NDU1
  492.  
  493.                       DO KDU=1,NDU1
  494.                           ICOD=IICODU(KDU)
  495.                           INOD=IPOG2L(IPT1.NUM(NOELED(KDU),KEL))
  496.                           WRITE(IOPER,FMT='(I15)')
  497.      &                    IDDLDU.INCPO(ICOD,INOD)
  498.                       ENDDO
  499.  
  500.                       DO KPR=1,NPR1
  501.                           ICOP=IICOPR(KPR)
  502.                           INOP=IPOG2L(IPT1.NUM(NOELEP(KPR),KEL))
  503.                           WRITE(IOPER,FMT='(I15)')
  504.      &                    IDDLPR.INCPO(ICOP,INOP)
  505.                       ENDDO
  506.  
  507.                       DO KDU=1,NDU1
  508.                           DO KPR=1,NPR1
  509.                               WRITE(IOPER,FMT='(E25.16)')
  510.      &                        COEF*RE(KDU,KPR,KEL)
  511.                           ENDDO
  512.                       ENDDO
  513.  
  514.                   ENDDO
  515.  
  516.                   SEGDES,IPT1,DESCR,XMATRI
  517.                   SEGSUP,ICONUM
  518.  
  519.               ENDDO
  520.  
  521.  
  522. *         ************************************
  523. *      => Sortie RUTHERFORD_BOEING élémentaire
  524. *         ************************************
  525.  
  526.           ELSEIF (IEXTN.EQ.2) THEN
  527.  
  528. *             Création du fichier .mtx.rb
  529.               PTRCRD=2*NELTOT+1
  530.               INDCRD=NBPTOT+NBDTOT
  531.               VALCRD=NVATOT
  532.               TOTCRD=PTRCRD+INDCRD+VALCRD
  533.               MVAR=MAX(NBPTOT,NBDTOT)
  534.               NELT=NELTOT
  535.               NVARIX=NINTOT
  536.               NELTVL=NVATOT
  537.               CALL OPENRB(NOMFIC,'mtx',CTITR,
  538.      &                    TOTCRD,PTRCRD,INDCRD,VALCRD,
  539.      &                    MVAR,NELT,NVARIX,NELTVL,
  540.      &                    'rre','(I15)','(I15)','(E25.16)')
  541.               IF (IERR.NE.0) RETURN
  542.  
  543.  
  544. *             ECRITURE DES POINTEURS
  545. *             ----------------------
  546.               IPTR=1
  547.               WRITE(IOPER,FMT='(I15)')
  548.      &        IPTR
  549.               DO IRIG=1,NRIGEL
  550.  
  551.                   IPT1=IRIGEL(1,IRIG)
  552.                   DESCR=IRIGEL(3,IRIG)
  553.  
  554.                   DO KEL=1,IPT1.NUM(/2)
  555.                       IPTR=IPTR+LISINC(/2)
  556.                       WRITE(IOPER,FMT='(I15)')
  557.      &                IPTR
  558.                       IPTR=IPTR+LISDUA(/2)
  559.                       WRITE(IOPER,FMT='(I15)')
  560.      &                IPTR
  561.                   ENDDO
  562.  
  563.               ENDDO
  564.  
  565. *             ECRITURE DES NUMEROS D'INCONNUES
  566. *             --------------------------------
  567.               DO IRIG=1,NRIGEL
  568.  
  569.                   COEF=COERIG(IRIG)
  570.                   IPT1=IRIGEL(1,IRIG)
  571.                   DESCR=IRIGEL(3,IRIG)
  572.                   ICONUM=MCONUM(IRIG)
  573.  
  574.                   DO KEL=1,IPT1.NUM(/2)
  575.  
  576.                       DO KDU=1,LISDUA(/2)
  577.                           ICOD=IICODU(KDU)
  578.                           INOD=IPOG2L(IPT1.NUM(NOELED(KDU),KEL))
  579.                           WRITE(IOPER,FMT='(I15)')
  580.      &                    IDDLDU.INCPO(ICOD,INOD)
  581.                       ENDDO
  582.  
  583.                       DO KPR=1,LISINC(/2)
  584.                           ICOP=IICOPR(KPR)
  585.                           INOP=IPOG2L(IPT1.NUM(NOELEP(KPR),KEL))
  586.                           WRITE(IOPER,FMT='(I15)')
  587.      &                    IDDLPR.INCPO(ICOP,INOP)
  588.                       ENDDO
  589.  
  590.                   ENDDO
  591.  
  592.                   SEGSUP,ICONUM
  593.  
  594.               ENDDO
  595.  
  596. *             ECRITURE DES VALEURS
  597. *             --------------------
  598.               DO IRIG=1,NRIGEL
  599.  
  600.                   IPT1=IRIGEL(1,IRIG)
  601.                   SEGACT,IPT1
  602.                   DESCR=IRIGEL(3,IRIG)
  603.                   XMATRI=IRIGEL(4,IRIG)
  604.                   SEGACT,XMATRI
  605.  
  606.                   DO KEL=1,IPT1.NUM(/2)
  607.                       DO KDU=1,LISDUA(/2)
  608.                           DO KPR=1,LISINC(/2)
  609.                               WRITE(IOPER,FMT='(E25.16)')
  610.      &                        COEF*RE(KDU,KPR,KEL)
  611.                           ENDDO
  612.                       ENDDO
  613.                   ENDDO
  614.  
  615.                   SEGDES,IPT1,DESCR,XMATRI
  616.  
  617.               ENDDO
  618.  
  619.           ENDIF
  620.  
  621.           SEGSUP,IPOG2L,MCONUM
  622.  
  623.  
  624.  
  625. *     ======================================
  626. *     SORTIE DE MATRICE SOUS FORME ASSEMBLÉE
  627. *     ======================================
  628. *
  629.  
  630.       ELSEIF (ITYP.EQ.2) THEN
  631.  
  632.           IF (ICHOLE.NE.0) ICHOLE=0
  633.  
  634. *         Assemblage des matrices élémentaires
  635. *         ************************************
  636. *
  637. *     SG 2019/07 : a noter que INORMU ne sert pas car normalement c'est
  638. *     la normalisation des multiplicateurs de Lagrange et ceux-ci ne sont
  639. *     pas gérés par sormat.eso (voir plus loin).
  640. *     De même la normalisation AUTO ne marche pas car on utilise
  641. *     l'assembleur non symétrique (asns1.eso via kres9)
  642. *     Par contre la normalisation faite à la main semble marcher mais
  643. *     pas très utile.
  644. *          
  645.           IF (NORINC.EQ.0.AND.NORIND.EQ.0) THEN
  646.               INORMU=0
  647.           ELSE
  648.               INORMU=1
  649.            ENDIF
  650. *dbg          write(ioimp,*) 'NORINC,NORIND,INORMU=',NORINC,NORIND,INORMU
  651. *dbg           write(ioimp,*) 'Assemblage...'
  652.           CALL KRES9(MRIGID,INORMU)
  653.           IF (IERR.NE.0) RETURN
  654. *dbg           write(ioimp,*) 'Assemblage fini'
  655.  
  656. *         Mise sous forme morse = CSR (Compressed Sparse Row)
  657. *         ***************************************************
  658. *         /!\ Même après transformation en morse, les inconnues restent
  659. *             decrites par les segments IINCPO et IDUAPO du SMMATRI
  660. *             pointé par ICHOLE dans le MRIGID d'origine.
  661. *             En theorie, la matrice qui sort de l'assemblage par KRES9
  662. *             est carrée, structurellement symétrique. On forcera alors
  663. *             NBDTOT = NBPTOT mais on distinguera tout de meme les
  664. *             inconnues primales et duales via IINCPO et IDUAPO.
  665. *dbg           write(ioimp,*) 'Passage au format Morse...'
  666.           CALL KRES10(MRIGID,KMORS,KIZA)
  667.           IF (IERR.NE.0) RETURN
  668. *dbg          write(ioimp,*) 'Passage au format Morse fini'
  669.           IF (LDBG) THEN
  670.              IMPR=3
  671.              CALL INFMAT(KMORS,KIZA,IMPR,IRET)
  672.           ENDIF
  673. *          
  674.           SEGACT,KMORS,KIZA
  675.           NBPTOT=KMORS.IA(/1)-1
  676.           NBDTOT=NBPTOT
  677. *         /!\ KIZA.A est rempli de 0 inutiles en fin
  678. *             => à ne pas utiliser pour déterminer NVATOT
  679.           NVATOT=KMORS.JA(/1)
  680.  
  681. *dbg          CALL ECMORS(KMORS,KIZA,4)
  682.  
  683. C
  684. C               - Conversion du second membre en MVECTD 
  685. C                 et initialisation du résultat 
  686. C     Cette partie est reprise de KRES8.ESO
  687.           IF (ZFORC) THEN
  688.              SEGACT MRIGID
  689.              ICHOLX=ICHOLE
  690. C On vérifie que le second membre doit être dans le dual
  691.              NOID=1
  692.              CALL CHVNS(ICHOLX,IFORC,ISMBR,NOID)
  693.              IF (IERR.NE.0) RETURN
  694. C      
  695. C     Gestion normalisation et Lagrange (repris de MONDES)
  696. C      
  697.              SEGACT ISMBR*MOD
  698.              MMATRI=ICHOLE
  699.              SEGACT MMATRI
  700. * SG 2019/07 
  701. *     Verif que ITTR=0 (en effet, on ne traite pas les multiplicateurs
  702. *     de Lagrange donc on n'en veut pas pour l'instant)
  703. *     En particulier, si on veut les traiter, il faut les dualiser avant
  704. *     assemblage car c'est aujourd'hui un prérequis de l'assemblage de
  705. *     RESO 
  706.              IF (IILIGN.NE.0) THEN
  707.                 MILIGN=IILIGN
  708.                 SEGACT MILIGN
  709.                 DO II=1,ITTR(/1)
  710.                    if (ITTR(II).NE.0) goto 666
  711.                 ENDDO
  712.              ENDIF
  713.              IF (IILIGS.NE.0) THEN
  714.                 MILIGN=IILIGS
  715.                 SEGACT MILIGN
  716.                 DO II=1,ITTR(/1)
  717.                    if (ITTR(II).NE.0) goto 666
  718.                 ENDDO
  719.              ENDIF
  720. *
  721.              IF(IDNORD.GT.0) THEN
  722.                 MDNO1=IDNORD
  723.              ELSE
  724.                 MDNO1=IDNORM
  725.              ENDIF
  726.              SEGACT MDNO1
  727.              INC=MDNO1.DNOR(/1)
  728.              DO 45 I=1,INC
  729.                 ISMBR.VECTBB(I)=ISMBR.VECTBB(I)*MDNO1.DNOR(I)
  730.  45          CONTINUE
  731.              SEGDES MDNO1
  732.              SEGDES MMATRI
  733.           ENDIF
  734. C
  735. C               - Conversion du résultat (inconnue)  en MVECTD 
  736. C
  737.           IF (ZRESU) THEN
  738.              SEGACT MRIGID
  739.              ICHOLX=ICHOLE
  740. C     Changement de noms d'inconnues pour le résultat (passage primal ->
  741. C     dual)
  742.              CALL ECROBJ('CHPOINT ',IRESU)
  743.              CALL MACHI2(2)
  744.              CALL LIROBJ('CHPOINT ',IRESU,1,IRET)
  745.              IF (IERR.NE.0) RETURN
  746. C On vérifie que le second membre doit être dans le dual
  747.              NOID=1
  748.              CALL CHVNS(ICHOLX,IRESU,INCX,NOID)
  749.              IF (IERR.NE.0) RETURN
  750. * Peu utile             SEGSUP,IRESU
  751. C      
  752. C     Gestion normalisation et Lagrange (repris de MONDES)
  753. C      
  754.              SEGACT INCX*MOD
  755.              MMATRI=ICHOLE
  756.              SEGACT MMATRI
  757. * SG 2019/07 
  758. *     Verif que ITTR=0 (en effet, on ne traite pas les multiplicateurs
  759. *     de Lagrange donc on n'en veut pas pour l'instant)
  760. *     En particulier, si on veut les traiter, il faut les dualiser avant
  761. *     assemblage car c'est aujourd'hui un prérequis de l'assemblage de
  762. *     RESO 
  763.              IF (IILIGN.NE.0) THEN
  764.                 MILIGN=IILIGN
  765.                 SEGACT MILIGN
  766.                 DO II=1,ITTR(/1)
  767.                    if (ITTR(II).NE.0) goto 666
  768.                 ENDDO
  769.              ENDIF
  770.              IF (IILIGS.NE.0) THEN
  771.                 MILIGN=IILIGS
  772.                 SEGACT MILIGN
  773.                 DO II=1,ITTR(/1)
  774.                    if (ITTR(II).NE.0) goto 666
  775.                 ENDDO
  776.              ENDIF
  777. *
  778.              MDNOR=IDNORM
  779.              SEGACT MDNOR
  780.              INC=DNOR(/1)
  781.              DO 35 I=1,INC
  782.                 INCX.VECTBB(I)=INCX.VECTBB(I)/DNOR(I)
  783.  35          CONTINUE
  784.              SEGDES MDNOR
  785.              SEGDES MMATRI
  786.           ENDIF
  787. *     Un petit calcul de résidu pour la route !
  788.           IF (ZFORC.AND.ZRESU.AND.LDBG) THEN
  789.              IMVEC=2
  790.              ith=oothrd
  791.              IF(ITH.NE.0)THEN
  792.                 IMVEC=0
  793.              ENDIF
  794.              SEGINI,IR=ISMBR
  795. C                    r(0)=b-Ax
  796.              CALL GMOMV(IMVEC,'N',-1.D0,KMORS,KIZA,INCX,1.D0,IR)
  797.              RNRM2 = GNRM2(IR)
  798.              WRITE(IOIMP,*) 'SORT MAT : ||R||=',RNRM2
  799.              SEGSUP IR
  800.           ENDIF
  801.  
  802. *         On (re)active les segments pour la suite de la subroutine
  803. *         *********************************************************
  804.           SEGACT,MRIGID
  805.           MMATRI=ICHOLE
  806.           SEGACT,MMATRI
  807.  
  808.  
  809. *         ******************************
  810. *      => Sortie MATRIX_MARKET assemblée
  811. *         ******************************
  812.  
  813.           IF (IEXTN.EQ.1) THEN
  814.  
  815. *             Création du fichier .mtx.mm
  816.               M=NBDTOT
  817.               N=NBPTOT
  818.               NNZER=NVATOT
  819.               CALL OPENMM(NOMFIC,'mtx',CTITR,
  820.      &                    M,N,NNZER,'matrix coordinate real general')
  821.      &
  822.  
  823. *             Ecriture de la matrice
  824.               NTVA=0
  825.               DO I=1,M
  826.                   NIVA=KMORS.IA(I+1)-KMORS.IA(I)
  827.                   DO J=1,NIVA
  828.                       WRITE(IOPER,FMT='(I12,1X,I12,1X,E25.16)')
  829.      &                I,KMORS.JA(NTVA+J),KIZA.A(NTVA+J)
  830.                   ENDDO
  831.                   NTVA=NTVA+NIVA
  832.               ENDDO
  833.  
  834.  
  835. *         **********************************
  836. *      => Sortie RUTHERFORD_BOEING assemblée
  837. *         **********************************
  838.  
  839.           ELSEIF (IEXTN.EQ.2) THEN
  840.  
  841. *             Création du fichier .mtx.rb
  842.               M=NBDTOT
  843.               NVEC=NBPTOT
  844.               NAUXD=NVATOT
  845. c               PTRCRD=CEILING((NBPTOT+1)/NPTRFMT)
  846. c               INDCRD=CEILING(NVATOT/NINDFMT)
  847. c               VALCRD=CEILING(NVATOT/NVALFMT)
  848.               PTRCRD=(NBPTOT+1)/NPTRFMT
  849.               INDCRD=NVATOT/NINDFMT
  850.               VALCRD=NVATOT/NVALFMT
  851.               IF (MOD((NBPTOT+1),NPTRFMT).GT.0) PTRCRD=PTRCRD+1
  852.               IF (MOD(NVATOT,NINDFMT).GT.0) INDCRD=INDCRD+1
  853.               IF (MOD(NVATOT,NVALFMT).GT.0) VALCRD=VALCRD+1
  854.               TOTCRD=PTRCRD+INDCRD+VALCRD
  855.  
  856.               CALL OPENRB(NOMFIC,'mtx',CTITR,
  857.      &                    TOTCRD,PTRCRD,INDCRD,VALCRD,
  858.      &                    M,NVEC,NAUXD,0,
  859.      &                    'rua',PTRFMT,INDFMT,VALFMT)
  860.               IF (IERR.NE.0) RETURN
  861. *
  862. *         Conversion du stockage CSR (Compressed Sparse Row) vers
  863. *         CSC (Compressed Sparse Column) = transposition
  864. *         *******************************************************
  865.               NTT=NBPTOT
  866.               NJA=NVATOT
  867.               NBVA=NJA
  868.               SEGINI,KMOR2,KIZA2
  869. *              CALL TRPMOR(NTT,NJA,KMORS.JA,KMORS.IA,KMOR2.JA,KMOR2.IA,
  870. *     &             0,IRET)
  871.               CALL TRMORS(NTT,NJA,KIZA.A,KMORS.JA,KMORS.IA,
  872.      $             KIZA2.A,KMOR2.JA,KMOR2.IA)
  873. *             Ecriture de la matrice
  874.               WRITE(IOPER,PTRFMT) (KMOR2.IA(K),K=1,NBPTOT+1)
  875.               WRITE(IOPER,INDFMT) (KMOR2.JA(K),K=1,NVATOT)
  876.               WRITE(IOPER,VALFMT) (KIZA2.A(K),K=1,NVATOT)
  877.               SEGSUP,KMOR2,KIZA2
  878.           ENDIF
  879.  
  880.           SEGSUP,KMORS,KIZA
  881.  
  882.       ENDIF
  883.  
  884.       CLOSE(UNIT=IOPER)
  885.  
  886.  
  887.  
  888. *     +---------------------------------------------------------------+
  889. *     |                                                               |
  890. *     |       G E O M E T R I E   =   F I C H I E R   . G E O M       |
  891. *     |                                                               |
  892. *     +---------------------------------------------------------------+
  893.  
  894.  200  CONTINUE
  895.       IF (.NOT.ZGEOM) THEN
  896.           OPEN(UNIT=IOPER,FILE=NOMFIC(1:LONG(NOMFIC))//'.geom'//CEXTN)
  897.           CLOSE(UNIT=IOPER,STATUS='DELETE')
  898.           GOTO 300
  899.       ENDIF
  900.  
  901.       IF (ITYP.EQ.2) THEN
  902.           MNOEUD=IGEOMA
  903.           SEGACT,MNOEUD
  904.           NPOTOT=MNOEUD.NUM(/2)
  905.       ENDIF
  906.  
  907.       MYFMT='(E25.16)'
  908.  
  909. *     Création du fichier .geom.mm
  910. *     ****************************
  911.       IF (IEXTN.EQ.1) THEN
  912.           M=NPOTOT
  913.           N=IDIM1
  914.           NNZER=0
  915.           CALL OPENMM(NOMFIC,'geom',CTITR,
  916.      &                M,N,NNZER,'matrix array real general')
  917.  
  918. *     Création du fichier .geom.rb
  919. *     ****************************
  920.       ELSEIF (IEXTN.EQ.2) THEN
  921.           M=NPOTOT
  922.           NVEC=IDIM1
  923.           NAUXD=0
  924.           CALL OPENRB(NOMFIC,'geom',CTITR,
  925.      &                M,NVEC,NAUXD,0,
  926.      &                0,0,0,0,
  927.      &                'geos         r',MYFMT,' ',' ')
  928.           IF (IERR.NE.0) RETURN
  929.       ENDIF
  930.  
  931. *     Ecriture des coordonnées du maillage
  932. * SG 2021/03 : ajout segact mcoord suite chgt paradigme MCOORD
  933.       SEGACT MCOORD
  934.       WRITE(IOPER,FMT=MYFMT)
  935.      &((XCOOR((MNOEUD.NUM(1,K)-1)*IDIM1+J),K=1,NPOTOT),J=1,IDIM)
  936.       WRITE(IOPER,FMT='(I12)')
  937.      &(MNOEUD.NUM(1,K),K=1,NPOTOT)
  938.  
  939.       IF (ITYP.EQ.2) SEGDES,MNOEUD
  940.       CLOSE(UNIT=IOPER)
  941.  
  942.  
  943.  
  944. *     +---------------------------------------------------------------+
  945. *     |                                                               |
  946. *     |       I N C O N N U E S   =   F I C H I E R   . I N C O       |
  947. *     |                                                               |
  948. *     +---------------------------------------------------------------+
  949.  
  950.  300  CONTINUE
  951.       IF (.NOT.ZINCO) THEN
  952.           OPEN(UNIT=IOPER,FILE=NOMFIC(1:LONG(NOMFIC))//'.inco'//CEXTN)
  953.           CLOSE(UNIT=IOPER,STATUS='DELETE')
  954.           GOTO 400
  955.       ENDIF
  956.  
  957.       IF (ITYP.EQ.2) THEN
  958.           IDDLPR=IINCPO
  959.           IDDLDU=IDUAPO
  960.           SEGACT,IDDLPR,IDDLDU
  961.  
  962.           MIMIK=IIMIK
  963.           MIDUA=IIDUA
  964.           SEGACT,MIMIK,MIDUA
  965.       ENDIF
  966.  
  967.       NBVAR=NBPTOT+NBDTOT
  968.       NBWR=2*NBVAR
  969.       SEGINI,MIDATA
  970.  
  971.       NBCOPR=IDDLPR.INCPO(/1)
  972.       NBNOPR=IDDLPR.INCPO(/2)
  973.       NBCODU=IDDLDU.INCPO(/1)
  974.       NBNODU=IDDLDU.INCPO(/2)
  975.  
  976. *     Inconnues primales
  977.       DO J=1,NBCOPR
  978.           DO I=1,NBNOPR
  979.               IINC=IDDLPR.INCPO(J,I)
  980.               IF (IINC.GT.0) THEN
  981.                   IWRIT(IINC)=I
  982.                   IWRIT(NBVAR+IINC)=J
  983.               ENDIF
  984.           ENDDO
  985.       ENDDO
  986.  
  987. *     Inconnues duales
  988.       DO J=1,NBCODU
  989.           DO I=1,NBNODU
  990.               IINC=IDDLDU.INCPO(J,I)
  991.               IF (IINC.GT.0) THEN
  992.                   IWRIT(NBPTOT+IINC)=I
  993.                   IWRIT(NBVAR+NBPTOT+IINC)=J
  994.               ENDIF
  995.           ENDDO
  996.       ENDDO
  997.  
  998.  
  999. *     Création du fichier .inco.mm
  1000. *     ****************************
  1001.       IF (IEXTN.EQ.1) THEN
  1002.           M=NBVAR
  1003.           N=2
  1004.           NNZER=0
  1005.           MYFMT='(I12)'
  1006.           CALL OPENMM(NOMFIC,'inco',CTITR,
  1007.      &                M,N,NNZER,'matrix array real general')
  1008.  
  1009. *         On ajoute le nom des composantes dans l'entête...
  1010.           BACKSPACE(UNIT=IOPER)
  1011.           WRITE(UNIT=IOPER,FMT='("%",/,A)')
  1012.      &    '% COMPOSANTES'
  1013.           WRITE(UNIT=IOPER,FMT='("% PRIM ",I6,"   ",A4)')
  1014.      &    (J,IMIK(J),J=1,NBCOPR)
  1015.           WRITE(UNIT=IOPER,FMT='("% DUAL ",I6,"   ",A4)')
  1016.      &    (J,IDUA(J),J=1,NBCODU)
  1017.  
  1018. *         ...puis on reecrit ce que l'on avait effacé
  1019.           WRITE(UNIT=IOPER,FMT='("%")')
  1020.           WRITE(IOPER,FMT='(I12,1X,I12)') M,N
  1021.  
  1022. *         Ecriture des noeud et composante associés à chaque variable
  1023.           WRITE(IOPER,FMT=MYFMT) (IWRIT(K),K=1,NBWR)
  1024.  
  1025.  
  1026. *     Création du fichier .inco.rb
  1027. *     ****************************
  1028.       ELSEIF (IEXTN.EQ.2) THEN
  1029.           M=NBVAR
  1030.           NVEC=2
  1031.           NAUXD=0
  1032.           MYFMT='(I12)'
  1033.           CALL OPENRB(NOMFIC,'inco',CTITR,
  1034.      &                M,NVEC,NAUXD,0,
  1035.      &                0,0,0,0,
  1036.      &                'avl          r',MYFMT,' ',' ')
  1037.           IF (IERR.NE.0) RETURN
  1038.  
  1039. *         Ecriture des noeud et composante associés à chaque variable
  1040.           WRITE(IOPER,FMT=MYFMT) (IWRIT(K),K=1,NBWR)
  1041.  
  1042. *         On ajoute le nom des composantes en fin de fichier
  1043.           WRITE(UNIT=IOPER,FMT='("%",/,A)')
  1044.      &    '% COMPOSANTES'
  1045.           WRITE(UNIT=IOPER,FMT='("% PRIM ",I6,"   ",A4)')
  1046.      &    (J,IMIK(J),J=1,NBCOPR)
  1047.           WRITE(UNIT=IOPER,FMT='("% DUAL ",I6,"   ",A4)')
  1048.      &    (J,IDUA(J),J=1,NBCODU)
  1049.  
  1050.       ENDIF
  1051.  
  1052.  
  1053.       CLOSE(UNIT=IOPER)
  1054.       IF (ITYP.EQ.2) SEGDES,MIMIK,MIDUA,IDDLPR,IDDLDU
  1055.       SEGSUP,MIDATA
  1056.  
  1057.  
  1058.  
  1059.  
  1060.  
  1061.  
  1062. *     +---------------------------------------------------------------+
  1063. *     |                                                               |
  1064. *     |    S E C O N D - M E M B R E   =   F I C H I E R   . R H S    |
  1065. *     |                                                               |
  1066. *     +---------------------------------------------------------------+
  1067.  
  1068.  400  CONTINUE
  1069.       IF (.NOT.ZFORC) THEN
  1070.          OPEN(UNIT=IOPER,FILE=NOMFIC(1:LONG(NOMFIC))//'.rhs'//CEXTN)
  1071.          CLOSE(UNIT=IOPER,STATUS='DELETE')
  1072.          GOTO 500
  1073.       ENDIF
  1074.  
  1075.       MYFMT='(E25.16)'
  1076.  
  1077. *     Création du fichier .rhs.mm
  1078. *     ****************************
  1079.       IF (IEXTN.EQ.1.AND.ISMBR.NE.0) THEN
  1080.          M=NBDTOT
  1081.          N=1
  1082.          NNZER=0
  1083.          CALL OPENMM(NOMFIC,'rhs',CTITR,
  1084.      &        M,N,NNZER,'matrix array real general')
  1085.  
  1086. *     Ecriture des valeur du second membre
  1087.          WRITE(IOPER,FMT=MYFMT)
  1088.      &        (ISMBR.VECTBB(K),K=1,NBDTOT)
  1089.          SEGSUP,ISMBR
  1090.       ELSE
  1091.          WRITE(IOIMP,*) 'Pas de sortie FORC pour le moment'
  1092.          CALL ERREUR(251)
  1093.       ENDIF
  1094.  
  1095.       IF (IERR.NE.0) RETURN
  1096.  
  1097.  
  1098. *     +---------------------------------------------------------------+
  1099. *     |                                                               |
  1100. *     |    C O N N E C T I V I T É   =   F I C H I E R   . C O N N    |
  1101. *     |                                                               |
  1102. *     +---------------------------------------------------------------+
  1103.  
  1104.  500  CONTINUE
  1105.       IF (.NOT.ZELEM) GOTO 600
  1106.       WRITE(IOIMP,*) 'Pas de sortie CONN pour le moment'
  1107.       CALL ERREUR(251)
  1108.       IF (IERR.NE.0) RETURN
  1109.  
  1110.  
  1111.  
  1112. *     +---------------------------------------------------------------+
  1113. *     |                                                               |
  1114. *     |   S O L U T I O N   D E   R E F E R E N C E                   |
  1115. *     |                               =   F I C H I E R   . S O L U   |
  1116. *     |                                                               |
  1117. *     +---------------------------------------------------------------+
  1118.  
  1119.  600  CONTINUE
  1120.       IF (.NOT.ZSOLU) GOTO 700
  1121.       WRITE(IOIMP,*) 'Pas de sortie SOLU pour le moment'
  1122.       CALL ERREUR(251)
  1123.       IF (IERR.NE.0) RETURN
  1124.  
  1125.  
  1126. *     +---------------------------------------------------------------+
  1127. *     |                                                               |
  1128. *     |   R É S U L T A T   D E   C A L C U L                         |
  1129. *     |                               =   F I C H I E R   . R E S U   |
  1130. *     |                                                               |
  1131. *     +---------------------------------------------------------------+
  1132.  
  1133.  700  CONTINUE
  1134.       IF (.NOT.ZRESU) THEN
  1135.          OPEN(UNIT=IOPER,FILE=NOMFIC(1:LONG(NOMFIC))//'.resu'//CEXTN)
  1136.          CLOSE(UNIT=IOPER,STATUS='DELETE')
  1137.          GOTO 999
  1138.       ENDIF
  1139.  
  1140.       MYFMT='(E25.16)'
  1141.  
  1142. *     Création du fichier .resu.mm
  1143. *     ****************************
  1144.       IF (IEXTN.EQ.1.AND.INCX.NE.0) THEN
  1145.          M=NBPTOT
  1146.          N=1
  1147.          NNZER=0
  1148.          CALL OPENMM(NOMFIC,'resu',CTITR,
  1149.      &        M,N,NNZER,'matrix array real general')
  1150.  
  1151. *     Ecriture des valeur du second membre
  1152.          WRITE(IOPER,FMT=MYFMT)
  1153.      &        (INCX.VECTBB(K),K=1,NBPTOT)
  1154.          SEGSUP,INCX
  1155.       ELSE
  1156.          WRITE(IOIMP,*) 'Pas de sortie RESU pour le moment'
  1157.          CALL ERREUR(251)
  1158.       ENDIF
  1159.       IF (IERR.NE.0) RETURN
  1160.  
  1161.  
  1162. *     +---------------------------------------------------------------+
  1163. *     |                                                               |
  1164. *     |                M É N A G E   E T   S O R T I E                |
  1165. *     |                                                               |
  1166. *     +---------------------------------------------------------------+
  1167.  
  1168.  999  CONTINUE
  1169.  
  1170.  
  1171.       IF (ITYP.EQ.1) SEGSUP,MNOEUD,MIMIK,MIDUA,IDDLPR,IDDLDU
  1172.       IF (ITYP.EQ.2) SEGDES,MMATRI
  1173.       SEGDES,MRIGID
  1174.       RETURN
  1175.  
  1176.  666  CONTINUE
  1177.       WRITE(IOIMP,*) 'Lagrangian multiplier detected. Untreated case'
  1178.       MOTERR(1:8)='SORMAT  '
  1179.       CALL ERREUR(349)
  1180.       RETURN
  1181.  
  1182.       END
  1183.  
  1184.  
  1185.  
  1186.  
  1187.  
  1188.  
  1189.  
  1190.  
  1191.  
  1192.  
  1193.  
  1194.  
  1195.  
  1196.  

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