Télécharger la plaquette Cast3M


fr en

Télécharger nlin.eso

Retour à la liste

Numérotation des lignes : 

nlin

  1. C NLIN      SOURCE    GOUNAND   21/06/02    21:17:17     11022          
  2.       SUBROUTINE NLIN(CGEOME,TABGEO,TABVDC,TATRAV,
  3.      $     METING,LAXI,LERF,LERJ,IMREG,
  4.      $     MYFALS,MYPGS,MYFPGS,
  5.      $     TABMAT,
  6.      $     IMPR,IRET)
  7.       IMPLICIT REAL*8 (A-H,O-Z)
  8.       IMPLICIT INTEGER (I-N)
  9. C***********************************************************************
  10. C NOM         : NLIN
  11. C DESCRIPTION : Création d'une matrice.
  12. C
  13. C LANGAGE     : ESOPE
  14. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C               mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES          :
  18. C APPELE PAR       : PRLIN2
  19. C***********************************************************************
  20. C ENTREES            :
  21. C ENTREES/SORTIES    : -
  22. C SORTIES            :
  23. C TRAVAIL            : * SOUGEO (type MELEME) : maillage élémentaire.
  24. C                      * MLLRFS (type MLLRFS) : pointeurs sur les
  25. C                        éléments de référence associés aux 4 espaces de
  26. C                        discrétisation (géométrie, coefficient, primal,
  27. C                        dual) sur le maillage élémentaire.
  28. C                      * PGCOUR (type POGAU)  : méthode d'intégration
  29. C                        courante.
  30. C                      * JCOOR  (type MCHEVA) : valeurs du champ ICOOR
  31. C                        sur le maillage élémentaire.
  32. C                        Structure (cf.include SMCHAEL) :
  33. C                        (1, nb. ddl, 1, dim. esp. réel,
  34. C                         1, nb. éléments)
  35. C                      * JCOEFF (type MCHEVA) : valeurs du champ ICOEFF
  36. C                        sur le maillage élémentaire.
  37. C                        Structure (cf.include SMCHAEL) :
  38. C                        (1, nb. ddl, nb. comp. duales,
  39. C                         nb. comp. primales, 1, nb. éléments)
  40. C                      * JMTLIN (type MCHEVA) : valeurs du champ IMTLIN
  41. C                        sur le maillage élémentaire.
  42. C                        Structure (cf.include SMCHAEL) :
  43. C                        (nb. ddl dual, nb. ddl primal,
  44. C                         nb. comp. duales, nb. comp. primales,
  45. C                         1, nb. éléments)
  46. C                        nb. ddl primal=1 si la matrice est condensée.
  47. C                      * JMAJAC (type MCHEVA) : valeurs de la matrice
  48. C                        jacobienne aux points de Gauss sur le maillage
  49. C                        élémentaire.
  50. C                        Structure (cf.include SMCHAEL) :
  51. C                        (1, 1, dim. esp. réel, dim. esp. référence,
  52. C                         nb. poi. gauss, nb. éléments)
  53. C                      * JMIJAC (type MCHEVA) : valeurs de l'inverse de
  54. C                        la matrice jacobienne aux points de Gauss sur
  55. C                        le maillage élémentaire.
  56. C                        Structure (cf.include SMCHAEL) :
  57. C                        (1, 1, dim. esp. référence, dim. esp. réel,
  58. C                         nb. poi. gauss, nb. éléments)
  59. C                        JMIJAC n'existe que si dim.esp.réf=dim.esp.réel
  60. C                      * JDTJAC (type MCHEVA) : valeurs du déterminant
  61. C                        de la matrice jacobienne aux points de Gauss
  62. C                        sur le maillage élémentaire.
  63. C                        Structure (cf.include SMCHAEL) :
  64. C                        (1, 1, 1, 1, nb. poi. gauss, nb. éléments)
  65. C                        Si la matrice jacobienne n'est pas carrée, on
  66. C                        a calculé sqrt(det(trans(J).J))
  67. C                      * JCOEFG (type MCHEVA) : valeurs du coefficient
  68. C                        tensoriel aux points de Gauss sur le maillage
  69. C                        élémentaire.
  70. C                        Structure (cf.include SMCHAEL) :
  71. C                        (1, 1, nb. comp. duales, nb. comp. primales,
  72. C                         nb. poi. gauss, nb. éléments)
  73. C                      * FFPG (type MCHEVA) : valeurs des fonctions
  74. C                        d'interpolation aux points de gauss sur
  75. C                        l'élément de référence.
  76. C                        Structure (cf.include SMCHAEL) :
  77. C                        (1, nb. ddl, 1, 1, nb. poi. gauss, 1)
  78. C                      * DFFPG (type MCHEVA) : valeurs des dérivées
  79. C                        premières des fonctions d'interpolation aux
  80. C                        points de gauss sur l'élément de référence.
  81. C                        Structure (cf.include SMCHAEL) :
  82. C                        (1, nb. ddl, 1, dim.esp.réf, nb. poi. gauss, 1)
  83. C                      * JDFFPG (type MCHEVA) : valeurs des dérivées
  84. C                        premières des fonctions d'interpolation
  85. C                        primales aux points de gauss sur l'élément
  86. C                        réel.
  87. C                        Structure (cf.include SMCHAEL) :
  88. C                        (1, nb. ddl, 1, dim.esp.réel, nb. poi. gauss,
  89. C                         nb. élém.)
  90. C                      * JDFFDG (type MCHEVA) : valeurs des dérivées
  91. C                        premières des fonctions d'interpolation
  92. C                        duales aux points de gauss sur l'élément réel.
  93. C                        Structure (cf.include SMCHAEL) :
  94. C                        (1, nb. ddl, 1, dim.esp.réel, nb. poi. gauss,
  95. C                         nb. élém.)
  96. C***********************************************************************
  97. C VERSION    : v3.1, 30/07/04, possiblité de travailler
  98. C                              dans l'espace de référence
  99. C VERSION    : v1, 10/05/2004, version initiale
  100. C HISTORIQUE : v1, 10/05/2004, création
  101. C HISTORIQUE :
  102. C HISTORIQUE :
  103. C HISTORIQUE :
  104. C***********************************************************************
  105. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  106. C en cas de modification de ce sous-programme afin de faciliter
  107. C la maintenance !
  108. C***********************************************************************
  109.  
  110. -INC PPARAM
  111. -INC CCOPTIO
  112. -INC CCGEOME
  113. -INC TNLIN      
  114. *-INC SELREF
  115.       POINTEUR ELCOUR.ELREF
  116. *-INC SFALRF
  117.       POINTEUR MYFALS.FALRFS
  118. *-INC SPOGAU
  119.       POINTEUR MYPGS.POGAUS
  120.       POINTEUR PGCOUR.POGAU
  121. *-INC SFAPG
  122.       POINTEUR MYFPGS.FAPGS
  123. *-INC SLCOMP
  124.       POINTEUR MYCOMP.COMP
  125.       POINTEUR IVCOMP.COMP
  126.       POINTEUR IVCOMD.COMP
  127. -INC SMLENTI
  128.       POINTEUR IPOWCO.MLENTI
  129. -INC SMELEME
  130.       POINTEUR CGEOME.MELEME
  131.       POINTEUR SOUGEO.MELEME
  132. *
  133. *-INC SMCHAEL
  134.       INTEGER N1
  135.       POINTEUR ICOOR.MCHAEL
  136.       POINTEUR MYMCHA.MCHAEL
  137.       POINTEUR JCOOR.MCHEVA,JCOEFF.MCHEVA,JCOEFG.MCHEVA
  138.       POINTEUR JDCOFG.MCHEVA
  139.       POINTEUR JMAJAC.MCHEVA,JMIJAC.MCHEVA,JDTJAC.MCHEVA
  140.       POINTEUR JDTJA2.MCHEVA
  141.       POINTEUR JMAREG.MCHEVA
  142.       POINTEUR JDIAMA.MCHEVA
  143.       POINTEUR JPC.MCHEVA
  144.       POINTEUR IPROCO.MCHEVA
  145.       POINTEUR FC.MCHEVA
  146.       POINTEUR FFPG.MCHEVA,DFFPG.MCHEVA,JDFFPG.MCHEVA
  147.       POINTEUR FVPR.MCHEVA,FVDU.MCHEVA
  148.       POINTEUR FCPR.MCHEVA,FCDU.MCHEVA
  149.       POINTEUR JMTLIN.MCHEVA
  150. *-INC SMTNLIN
  151.       INTEGER NUMVPR,NUMVDU,NUMDER,NUMOP
  152.       INTEGER JGVC,KGVC
  153. *-INC TMPREC
  154.       POINTEUR METRIQ.MPREC
  155. *
  156.       CHARACTER*4 METING
  157.       INTEGER LAXI
  158.       INTEGER LERF
  159.       LOGICAL LERJ
  160.       INTEGER IMPR,IRET
  161. *
  162.       CHARACTER*4 MYDISC
  163. *
  164.       INTEGER ISOUS
  165.       INTEGER IVARPR,IVARDU,KDERPR,KDERDU,IOP
  166.       INTEGER ITQUAF,NBRSOU,NBELEM
  167.       LOGICAL LF,LDF,LC,LDC
  168.       LOGICAL MVVPR,MVVDU,LVID
  169. *
  170. * Executable statements
  171. *
  172. *      IMPR=5
  173.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans nlin'
  174. * Activation et intialisation des chapeaux
  175.       SEGACT CGEOME
  176.       SEGACT TABGEO
  177.       SEGACT TABVDC
  178.       SEGACT TATRAV*MOD
  179.       NBRSOU=CGEOME.LISOUS(/1)
  180.       NUMVPR=TABVDC.VVARPR(/1)
  181.       NUMVDU=TABVDC.VVARDU(/1)
  182.       JLCOF=TABVDC.VLCOF(/1)
  183.       JGCOF=TABVDC.VCOMP(/1)
  184.       JGVD=TABVDC.DJSVD(/1)
  185.       KGVD=TABVDC.DISVD(/2)
  186.       NUMDER=TABVDC.ILCPR(/1)-1
  187.       NUMOP=TABVDC.ILCPR(/2)
  188. *
  189.       N1=NBRSOU
  190. * NUMVPR et NUMVDU initialisés ci-dessus
  191.       SEGINI TABMAT
  192. * Cette instruction n'a pas l'air de fonctionner
  193. *      SEGINI TABMAT.VMAT(*)
  194.       DO IVARPR=1,NUMVPR
  195.          DO IVARDU=1,NUMVDU
  196.             SEGINI,MYMCHA
  197.             TABMAT.VMAT(IVARDU,IVARPR)=MYMCHA
  198.          ENDDO
  199.       ENDDO
  200.       SEGACT MYPGS
  201.       ICOOR=TABGEO.JGEO
  202.       SEGACT ICOOR
  203. *      SEGACT TABVDC.NOMVC(*)
  204.       DO IJVD=1,JGVD
  205.          MYMCHA=TATRAV.IVD(IJVD)
  206.          IF (MYMCHA.NE.0) THEN
  207.             SEGACT MYMCHA
  208.          ENDIF
  209.       ENDDO
  210. *
  211. * On travaille sur chaque sous-domaine
  212. *
  213.       DO 1 ISOUS=1,NBRSOU
  214.          SOUGEO=CGEOME.LISOUS(ISOUS)
  215.          SEGACT SOUGEO
  216.          ITQUAF=SOUGEO.ITYPEL
  217. * Détermination de la dimension de l'espace de référence
  218.          CALL DIMELE(NOMS(ITQUAF),IESREF,IMPR,IRET)
  219.          IF (IRET.NE.0) GOTO 9999
  220.          NBELEM=SOUGEO.NUM(/2)
  221.          IF (IMPR.GT.2) THEN
  222.             WRITE(IOIMP,*) 'Sous-domaine :',ISOUS
  223.          ENDIF
  224.          SEGDES SOUGEO
  225. *
  226. * Quel est la méthode d'intégration que l'on va utiliser si on n'en a
  227. * pas précisé ?
  228. * FIPGS est là pour nous le dire.
  229. *
  230.          IF (METING.EQ.'    ') THEN
  231.             WRITE(IOIMP,*) 'Le choix automatique de la méthode '
  232.      $           ,'d''integration est désactivé'
  233.             GOTO 9999
  234. *            CALL FIPGS(MLLRFS,MYPGS,
  235. *     $           PGCOUR,
  236. *     $           IMPR,IRET)
  237. *            IF (IRET.GT.0) GOTO 9999
  238.          ELSE
  239.             CALL KEPG(ITQUAF,METING,
  240.      $           MYFPGS,
  241.      $           PGCOUR,
  242.      $           IMPR,IRET)
  243.             IF (IRET.NE.0) GOTO 9999
  244.          ENDIF
  245. *
  246. * Géométrie
  247. *
  248.          MYDISC=TABGEO.DISGEO
  249.          CALL KEEF(ITQUAF,MYDISC,
  250.      $        MYFALS,
  251.      $        ELCOUR,
  252.      $        IMPR,IRET)
  253.          IF (IRET.NE.0) GOTO 9999
  254. * In KFNREF : SEGINI FFPG
  255. * In KFNREF : SEGINI DFFPG
  256.          CALL KFNREF(ELCOUR,PGCOUR,
  257.      $        FFPG,DFFPG,
  258.      $        IMPR,IRET)
  259.          IF (IRET.NE.0) GOTO 9999
  260. *
  261. * Création des matrices jacobiennes et déterminants
  262. * pour la transformation : élément volumique de référence <->
  263. *                          élément volumique réel
  264. * Ici, on ne se servira que de l'inverse et du déterminant
  265. * de la matrice jacobienne.
  266. * In GEOLIN : SEGINI JMAJAC
  267. * In GEOLIN : SEGINI JMIJAC
  268. * In GEOLIN : SEGINI JDTJAC
  269.          JCOOR=ICOOR.ICHEVA(ISOUS)
  270.          CALL GEOLIK(DFFPG,JCOOR,NBELEM,
  271.      $        JMAJAC,JMIJAC,JDTJAC,LERJ,IMREG,
  272.      $        IMPR,IRET)
  273.          IF (IRET.NE.0) THEN
  274.             IF (LERJ) GOTO 9666
  275.             GOTO 9999
  276.          ENDIF
  277. *!         SEG SUP JMAJAC
  278.          SEGSUP DFFPG
  279. C Inutile normalement, on peut se débrouiller avec les coeffs
  280. C* En axi, on multiplie le determinant de la matrice
  281. C* jacobienne par 2piR (ou R est la premiere coordonnee)
  282. C         IF (LAXI.GT.0) THEN
  283. C* In GEOMET : SEGINI JDTJA2
  284. C            CALL GEOMET(JCOOR,FFPG,
  285. C     $           JDTJAC,LAXI,
  286. C     $           JDTJA2,
  287. C     $           IMPR,IRET)
  288. C            IF (IRET.NE.0) GOTO 9999
  289. C            SEGSUP JDTJAC
  290. C            JDTJAC=JDTJA2
  291. C         ENDIF
  292. *
  293. * On récupère la première coordonnée si LAXI(=IFOMOD).NE.-1
  294. *
  295.          IF (IFOMOD.NE.-1) THEN
  296. C* In GEOPC : SEGINI JPC
  297.             CALL GEOPC(JCOOR,FFPG,
  298.      $           JPC,
  299.      $           IMPR,IRET)
  300.             IF (IRET.NE.0) GOTO 9999
  301.          ELSE
  302.             JPC=0
  303.          ENDIF
  304.          SEGSUP FFPG
  305. *
  306. * Calcul du jacobien de la transformation :
  307. * élément volumique de référence -> élément réguliers
  308. * de côté 1
  309. * Cela sert pour l'adaptativité.
  310. * In GEOREG : SEGINI JMAREG
  311. *
  312.          CALL GEOREG(ITQUAF,MYFALS,MYFPGS,
  313.      $        JMAREG,
  314.      $        IMPR,IRET)
  315.          IF (IRET.NE.0) GOTO 9999
  316. *
  317. * Calcul d'une propriété géométrique d'un QUAF régulier de côté 1 :
  318. * ici le diamètre du cercle circonscrit.
  319. * Cela sert pour le decentrement.
  320. * In GEOQUA : SEGINI JDIAMA
  321. *
  322.          CALL GEOQUA(ITQUAF,
  323.      $        JDIAMA,
  324.      $        IMPR,IRET)
  325.          IF (IRET.NE.0) GOTO 9999
  326. C
  327. C Initialisation d'une table de préconditionnement pour l'adaptation
  328. C contenant des infos sur la métrique (fait dans les subroutines qui
  329. C utilisent METRIQ
  330. C
  331. C SEGINI METRIQ
  332.          METRIQ=0
  333. *
  334. * Calcul des fonctions de forme et de leurs dérivées
  335. *
  336.          DO IKVD=1,KGVD
  337.             LF=TATRAV.LFFVD(IKVD).EQV..TRUE.
  338.             LDF=TATRAV.LDFFVD(IKVD).EQV..TRUE.
  339.             IF (LF.OR.LDF) THEN
  340.                MYDISC=TABVDC.DISVD(IKVD)
  341.                CALL KEEF(ITQUAF,MYDISC,
  342.      $              MYFALS,
  343.      $              ELCOUR,
  344.      $              IMPR,IRET)
  345.                IF (IRET.NE.0) GOTO 9999
  346. * In KFNREF : SEGINI FFPG
  347. * In KFNREF : SEGINI DFFPG
  348.                CALL KFNREF(ELCOUR,PGCOUR,
  349.      $              FFPG,DFFPG,
  350.      $              IMPR,IRET)
  351.                IF (IRET.NE.0) GOTO 9999
  352.                IF (LF) THEN
  353.                   TATRAV.FFVD(IKVD)=FFPG
  354.                ELSE
  355. *                  segini ffpg
  356.                   SEGSUP FFPG
  357.                ENDIF
  358.                IF (LDF) THEN
  359.                   IF (LERF.NE.0) THEN
  360.                      SEGINI,JDFFPG=DFFPG
  361.                      SEGDES JDFFPG
  362.                   ELSE
  363. * In DFNFR : SEGINI JDFFPG
  364.                      CALL DFNFR(DFFPG,JMIJAC,
  365.      $                    JDFFPG,
  366.      $                    IMPR,IRET)
  367.                      IF (IRET.NE.0) GOTO 9999
  368.                   ENDIF
  369.                   TATRAV.DFFVD(IKVD)=JDFFPG
  370.                ENDIF
  371.                SEGSUP DFFPG
  372.             ENDIF
  373.          ENDDO
  374. *
  375. * Calcul des champs et de leurs dérivées
  376. *
  377.          DO IJVD=1,JGVD
  378.             LC=TATRAV.LVD(IJVD).EQV..TRUE.
  379.             LDC=TATRAV.LDVD(IJVD).EQV..TRUE.
  380.             IF (LC.OR.LDC) THEN
  381.                MYMCHA=TATRAV.IVD(IJVD)
  382.                JCOEFF=MYMCHA.ICHEVA(ISOUS)
  383.                IF (LC) THEN
  384.                   FFPG=TATRAV.FFVD(TABVDC.DJSVD(IJVD))
  385. * In COGAU : SEGINI JCOEFG
  386.                   CALL COGAU(JCOEFF,FFPG,
  387.      $                 JCOEFG,
  388.      $                 IMPR,IRET)
  389.                   IF (IRET.NE.0) GOTO 9999
  390.                   TATRAV.VD(IJVD)=JCOEFG
  391.                ENDIF
  392.                IF (LDC) THEN
  393.                   JDFFPG=TATRAV.DFFVD(TABVDC.DJSVD(IJVD))
  394. * In DCOGAU : SEGINI JDCOFG
  395.                   CALL DCOGAU(JCOEFF,JDFFPG,
  396.      $                 JDCOFG,
  397.      $                 IMPR,IRET)
  398.                   IF (IRET.NE.0) GOTO 9999
  399.                   TATRAV.DVD(IJVD)=JDCOFG
  400.                ENDIF
  401.             ENDIF
  402.          ENDDO
  403. *!!!         SEG DES JMIJAC
  404. *
  405. * Calcul des coefficients
  406. *
  407.          DO IJGCOF=1,JGCOF
  408.             LC=TATRAV.LVCOF(IJGCOF).EQV..TRUE.
  409.             IF (LC) THEN
  410.                IVCOMP=TABVDC.VCOMP(IJGCOF)
  411.                IICOMP=TABVDC.VLDAT(IJGCOF)
  412. * In CALCGA : SEGINI FC
  413. * In CALCGA : SEGINI METRIQ.MCHEVA
  414.                CALL CALCGA(IVCOMP,IICOMP,JMAJAC,JMIJAC,JDTJAC,
  415.      $              JMAREG,JDIAMA,JPC,METRIQ,
  416.      $              TATRAV,
  417.      $              FC,IMPR,IRET)
  418.                IF (IRET.NE.0) GOTO 9999
  419.                TATRAV.VCOF(IJGCOF)=FC
  420.             ENDIF
  421.          ENDDO
  422. *
  423. * Calcul des produits de coefficients
  424. *
  425.          DO IJLCOF=1,JLCOF
  426.             IPOWCO=TABVDC.VLCOF(IJLCOF)
  427. * In CALPCO : SEGINI IPROCO
  428.             CALL CALPCO(IPOWCO,TATRAV,
  429.      $           IPROCO,IMPR,IRET)
  430.             IF (IRET.NE.0) GOTO 9999
  431.             TATRAV.VVCOF(IJLCOF)=IPROCO
  432.          ENDDO
  433. *
  434. * On peut faire le ménage dans les coefficients
  435. *
  436.          DO IJGCOF=1,JGCOF
  437.             FC=TATRAV.VCOF(IJGCOF)
  438.             IF (FC.NE.0) THEN
  439.                SEGSUP,FC
  440.                TATRAV.VCOF(IJGCOF)=0
  441.             ENDIF
  442.          ENDDO
  443. *
  444. * On effectue le calcul de la matrice
  445. *
  446.          DO IVARPR=1,NUMVPR
  447.             DO IVARDU=1,NUMVDU
  448. C               WRITE(IOIMP,*) 'IVARPR= ',IVARPR,'  IVARDU= ',IVARDU
  449. * Repris de nlia               JMTLIN=0
  450.                MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  451.                JMTLIN=MYMCHA.ICHEVA(ISOUS)
  452. *
  453.                IJVARP=TABVDC.VVARPR(IVARPR)
  454.                IJVARD=TABVDC.VVARDU(IVARDU)
  455.                IKVARP=TABVDC.DJSVD(IJVARP)
  456.                IKVARD=TABVDC.DJSVD(IJVARD)
  457.                MVVPR=(TABVDC.MVD(IJVARP).NE.0)
  458.                MVVDU=(TABVDC.MVD(IJVARD).NE.0)
  459.                DO IOP=1,NUMOP
  460.                   DO KDERPR=0,NUMDER
  461.                      IJLCPR=TABVDC.ILCPR(KDERPR+1,IOP,IVARPR)
  462.                      IF (IJLCPR.NE.0) THEN
  463.                         FCPR=TATRAV.VVCOF(IJLCPR)
  464. * variable primale
  465.                         IF (KDERPR.EQ.0) THEN
  466.                            IF (MVVPR) THEN
  467.                               FVPR=TATRAV.VD(IJVARP)
  468.                            ELSE
  469.                               FVPR=TATRAV.FFVD(IKVARP)
  470.                            ENDIF
  471.                         ELSE
  472.                            IF (MVVPR) THEN
  473.                               FVPR=TATRAV.DVD(IJVARP)
  474.                            ELSE
  475.                               FVPR=TATRAV.DFFVD(IKVARP)
  476.                            ENDIF
  477.                         ENDIF
  478.                         DO KDERDU=0,NUMDER
  479.                            IJLCDU=TABVDC.ILCDU(KDERDU+1,IOP,IVARDU)
  480.                            IF (IJLCDU.NE.0) THEN
  481.                               FCDU=TATRAV.VVCOF(IJLCDU)
  482. * Variable duale
  483.                               IF (KDERDU.EQ.0) THEN
  484.                                  IF (MVVDU) THEN
  485.                                     FVDU=TATRAV.VD(IJVARD)
  486.                                  ELSE
  487.                                     FVDU=TATRAV.FFVD(IKVARD)
  488.                                  ENDIF
  489.                               ELSE
  490.                                  IF (MVVDU) THEN
  491.                                     FVDU=TATRAV.DVD(IJVARD)
  492.                                  ELSE
  493.                                     FVDU=TATRAV.DFFVD(IKVARD)
  494.                                  ENDIF
  495.                               ENDIF
  496. C                              WRITE(IOIMP,*) 'FVPR=',FVPR
  497. C                              WRITE(IOIMP,*) 'FVDU=',FVDU
  498. C                              WRITE(IOIMP,*) 'FCPR=',FCPR
  499. C                              WRITE(IOIMP,*) 'FCDU=',FCDU
  500. C                              WRITE(IOIMP,*) 'KDERPR=',KDERPR
  501. C                              WRITE(IOIMP,*) 'KDERDU=',KDERDU
  502. C                              WRITE(IOIMP,*) 'LDERPR=',LDERPR
  503. C                              WRITE(IOIMP,*) 'LDERDU=',LDERDU
  504. C                                SEGPRT,PGCOUR
  505. C                                 SEGPRT,FVPR
  506. C                                 SEGPRT,FVDU
  507. C                                 SEGPRT,FCPR
  508. C                                 SEGPRT,FCDU
  509. C                                 WRITE(IOIMP,*) 'KDERPR=',KDERPR
  510. C                                 WRITE(IOIMP,*) 'KDERDU=',KDERDU
  511. C                                 WRITE(IOIMP,*) 'LDERPR=',LDERPR
  512. C                                 WRITE(IOIMP,*) 'LDERDU=',LDERDU
  513. C                                 SEGPRT,JDTJAC
  514. C                                 WRITE(IOIMP,*) 'NBELEM=',NBELEM
  515.                               CALL LINLIN(PGCOUR,
  516.      $                             FVPR,FVDU,FCPR,FCDU,
  517.      $                             KDERPR,KDERDU,
  518.      $                             JDTJAC,NBELEM,LERF,IESREF,
  519.      $                             JMTLIN,
  520.      $                             IMPR,IRET)
  521.                               IF (IRET.NE.0) GOTO 9999
  522. C                              WRITE(IOIMP,*) 'JMTLIN=',JMTLIN
  523. C                                 SEGPRT,JMTLIN
  524. C*                                 STOP 16
  525.                            ENDIF
  526.                         ENDDO
  527.                      ENDIF
  528.                   ENDDO
  529.                ENDDO
  530.                MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  531.                MYMCHA.JMACHE(ISOUS)=SOUGEO
  532.                MYMCHA.ICHEVA(ISOUS)=JMTLIN
  533. *               IF (JMTLIN.NE.0) THEN
  534. *                  SEGPRT,JMTLIN
  535. *               ENDIF
  536. C               WRITE(IOIMP,*) 'IVARPR=',IVARPR
  537. C               WRITE(IOIMP,*) 'IVARDU=',IVARDU
  538. C               WRITE(IOIMP,*) 'JMTLIN=',JMTLIN
  539.             ENDDO
  540.          ENDDO
  541. * Suppression de tous les MCHEVA
  542.          DO IJLCOF=1,JLCOF
  543.             IPROCO=TATRAV.VVCOF(IJLCOF)
  544.             SEGSUP IPROCO
  545.             TATRAV.VVCOF(IJLCOF)=IPROCO
  546.          ENDDO
  547. *
  548.          DO IJVD=1,JGVD
  549.             JCOEFG=TATRAV.VD(IJVD)
  550.             IF (JCOEFG.NE.0) THEN
  551.                SEGSUP JCOEFG
  552.                TATRAV.VD(IJVD)=JCOEFG
  553.             ENDIF
  554.             JDCOFG=TATRAV.DVD(IJVD)
  555.             IF (JDCOFG.NE.0) THEN
  556.                SEGSUP JDCOFG
  557.                TATRAV.DVD(IJVD)=JDCOFG
  558.             ENDIF
  559.          ENDDO
  560. *
  561.          DO IKVD=1,KGVD
  562.             FFPG=TATRAV.FFVD(IKVD)
  563.             IF (FFPG.NE.0) THEN
  564.                SEGSUP FFPG
  565.                TATRAV.FFVD(IKVD)=FFPG
  566.             ENDIF
  567.             JDFFPG=TATRAV.DFFVD(IKVD)
  568.             IF (JDFFPG.NE.0) THEN
  569.                SEGSUP JDFFPG
  570.                TATRAV.DFFVD(IKVD)=JDFFPG
  571.             ENDIF
  572.          ENDDO
  573. *
  574. * Suppression table de préconditionnement métrique
  575. *
  576.          IF (METRIQ.NE.0) THEN
  577.             SEGACT,METRIQ
  578.             NCH=METRIQ.PREC(/1)
  579.             DO ICH=1,NCH
  580.                MCHEVA=METRIQ.PREC(ICH)
  581.                IF (MCHEVA.NE.0) THEN
  582.                   SEGSUP MCHEVA
  583.                ENDIF
  584.             ENDDO
  585. C         SEGDES METRIQ
  586.             SEGSUP METRIQ
  587.          ENDIF
  588.          SEGSUP JMAREG
  589.          SEGSUP JDIAMA
  590.          IF (JPC.NE.0) THEN
  591.             SEGSUP JPC
  592.          ENDIF
  593.          SEGSUP JDTJAC
  594.          SEGSUP JMAJAC
  595.          SEGSUP JMIJAC
  596. *         SEGPRT,JMTLIN
  597.  1    CONTINUE
  598. *
  599.       DO IJVD=1,JGVD
  600.          MYMCHA=TATRAV.IVD(IJVD)
  601.          IF (MYMCHA.NE.0) THEN
  602.             SEGDES MYMCHA
  603.          ENDIF
  604.       ENDDO
  605. *      SEGDES TABVDC.NOMVC(*)
  606.       SEGDES ICOOR
  607.       SEGDES MYPGS
  608. *
  609. * Cette instruction n'a pas l'air de fonctionner
  610. * Un peu de ménage là où il n'y a pas d'info
  611. *      SEGDES TABMAT.VMAT(*)
  612.       DO IVARPR=1,NUMVPR
  613.          DO IVARDU=1,NUMVDU
  614.             MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  615.             SEGACT MYMCHA
  616.             LVID=.TRUE.
  617.             DO ISOUS=1,NBRSOU
  618.                MCHEVA=MYMCHA.ICHEVA(ISOUS)
  619.                LVID=LVID.AND.(MCHEVA.EQ.0)
  620.             ENDDO
  621.             IF (LVID) THEN
  622.                SEGSUP MYMCHA
  623.                TABMAT.VMAT(IVARDU,IVARPR)=0
  624.             ELSE
  625.                SEGDES,MYMCHA
  626.             ENDIF
  627.          ENDDO
  628.       ENDDO
  629.       SEGDES TATRAV
  630.       SEGDES TABMAT
  631.       SEGDES TABVDC
  632.       SEGDES TABGEO
  633.       SEGDES CGEOME
  634. *
  635. * Normal termination
  636. *
  637.       IRET=0
  638.       RETURN
  639. *
  640. * Format handling
  641. *
  642. *
  643. * Error handling
  644. *
  645.  9666 CONTINUE
  646.       IRET=666
  647.       RETURN
  648.  9999 CONTINUE
  649.       IRET=1
  650.       WRITE(IOIMP,*) 'An error was detected in subroutine nlin'
  651.       RETURN
  652. *
  653. * End of subroutine nlin
  654. *
  655.       END
  656.  
  657.  
  658.  
  659.  
  660.  
  661.  
  662.  
  663.  
  664.  
  665.  
  666.  
  667.  

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