Télécharger la plaquette Cast3M


fr en

Télécharger nlia.eso

Retour à la liste

Numérotation des lignes : 

nlia

  1. C NLIA      SOURCE    PV        22/04/27    21:15:08     11344          
  2.       SUBROUTINE NLIA(CGEOME,FACTIV,TABGEO,TABVDC,TATRAV,
  3.      $     METING,LAXI,LERF,LERJ,
  4.      $     MYFALS,MYPGS,MYFPGS,MYQRFS,
  5.      $     TABMAT,
  6.      $     IMPR,IRET)
  7.       IMPLICIT REAL*8 (A-H,O-Z)
  8.       IMPLICIT INTEGER (I-N)
  9. C***********************************************************************
  10. C NOM         : NLIA
  11. C DESCRIPTION : Création d'une matrice intégration des termes de surface
  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                      * JMTLIA (type MCHEVA) : valeurs du champ IMTLIA
  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    : v4, 26/07/06, refonte sur le modele du nlin evolue
  98. C VERSION    : v3, 11/05/04, refonte (ajout comportement)
  99. C VERSION    : v2, 22/09/03, refonte complète (modif SMTNLIN)
  100. C VERSION    : v1, 22/08/2003, version initiale
  101. C HISTORIQUE : v1, 22/08/2003, création
  102. C HISTORIQUE :
  103. C HISTORIQUE :
  104. C HISTORIQUE :
  105. C***********************************************************************
  106. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  107. C en cas de modification de ce sous-programme afin de faciliter
  108. C la maintenance !
  109. C***********************************************************************
  110. -INC PPARAM
  111. -INC CCOPTIO
  112. -INC CCGEOME
  113. -INC TNLIN      
  114. *-INC SELREF
  115.       POINTEUR LRFVOL.ELREF
  116. *-INC SFALRF
  117.       POINTEUR MYFALS.FALRFS
  118. *-INC SPOGAU
  119.       POINTEUR MYPGS.POGAUS
  120. *-INC SFAPG
  121.       POINTEUR MYFPGS.FAPGS
  122. *-INC SLCOMP
  123.       POINTEUR MYCOM.COMP
  124.       POINTEUR IVCOMP.COMP
  125.       POINTEUR IVCOMD.COMP
  126. -INC SMLENTI
  127.       POINTEUR IPOWCO.MLENTI
  128. -INC SMELEME
  129.       POINTEUR CGEOME.MELEME
  130.       POINTEUR SOUGEO.MELEME
  131.       POINTEUR FACVOL.MELEME
  132.       POINTEUR SFAVOL.MELEME
  133. *
  134. *-INC SMCHAEL
  135.       INTEGER N1
  136.       POINTEUR ICOOR.MCHAEL
  137.       POINTEUR MYMCHA.MCHAEL
  138.       POINTEUR JXCOPG.MCHEVA
  139.       POINTEUR JXPOPG.MCHEVA
  140.       POINTEUR JCOOR.MCHEVA,JCOEFF.MCHEVA,JCOEFG.MCHEVA
  141.       POINTEUR JDCOFG.MCHEVA
  142.       POINTEUR JMAJAC.MCHEVA,JMIJAC.MCHEVA,JDTJAC.MCHEVA
  143.       POINTEUR JMAJA2.MCHEVA,JMIJA2.MCHEVA,JDTJA2.MCHEVA
  144.       POINTEUR JDTJA3.MCHEVA
  145.       POINTEUR IPROCO.MCHEVA
  146.       POINTEUR FC.MCHEVA
  147.       POINTEUR FFPG.MCHEVA,DFFPG.MCHEVA,JDFFPG.MCHEVA
  148.       POINTEUR FVPR.MCHEVA,FVDU.MCHEVA
  149.       POINTEUR FCPR.MCHEVA,FCDU.MCHEVA
  150.       POINTEUR JMTLIA.MCHEVA
  151. *-INC SMTNLIN
  152.       INTEGER NUMVPR,NUMVDU,NUMDER,NUMOP
  153.       INTEGER JGVC,KGVC
  154. *-INC SFACTIV
  155. *-INC SIQUAF
  156.       POINTEUR MYQRFS.IQUAFS
  157.       POINTEUR IQUVOL.IQUAF
  158.       POINTEUR IQUFAC.IQUAF
  159. *
  160.       CHARACTER*4 METING
  161.       INTEGER LAXI
  162.       INTEGER LERF
  163.       LOGICAL LERJ,LERJ2
  164.       INTEGER IMPR,IRET
  165. *
  166.       CHARACTER*4 MYDISC
  167. *
  168.       INTEGER NBELEF,NBELFV,NBELEV,NBSOFV,NBSOUV
  169.       INTEGER IBELEF,IBELFV,IBELEV,IBSOFV,IBSOUV
  170.       INTEGER IJVC,IKVC
  171.       INTEGER IVARPR,IVARDU,KDERPR,KDERDU,IOP
  172.       INTEGER ITYVOL,NBELEM
  173.       LOGICAL LF,LDF,LC,LDC
  174.       LOGICAL MVVPR,MVVDU,LVID
  175. *
  176. * Executable statements
  177. *
  178. *      IMPR=0
  179.       lerj2=.false.
  180.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans nlia'
  181. * Activation et intialisation des chapeaux
  182.       SEGACT CGEOME
  183.       SEGACT FACTIV
  184.       SEGACT TABGEO
  185.       SEGACT TABVDC
  186.       SEGACT TATRAV*MOD
  187.       NBSOUV=CGEOME.LISOUS(/1)
  188.       NUMVPR=TABVDC.VVARPR(/1)
  189.       NUMVDU=TABVDC.VVARDU(/1)
  190.       JLCOF=TABVDC.VLCOF(/1)
  191.       JGCOF=TABVDC.VCOMP(/1)
  192.       JGVD=TABVDC.DJSVD(/1)
  193.       KGVD=TABVDC.DISVD(/2)
  194.       NUMDER=TABVDC.ILCPR(/1)-1
  195.       NUMOP=TABVDC.ILCPR(/2)
  196. *
  197.       N1=NBSOUV
  198. * NUMVPR et NUMVDU initialisés ci-dessus
  199.       SEGINI TABMAT
  200. * Cette instruction n'a pas l'air de fonctionner
  201. *      SEGINI TABMAT.VMAT(*)
  202.       DO IVARPR=1,NUMVPR
  203.          DO IVARDU=1,NUMVDU
  204.             SEGINI,MYMCHA
  205.             TABMAT.VMAT(IVARDU,IVARPR)=MYMCHA
  206.          ENDDO
  207.       ENDDO
  208.       SEGACT MYPGS
  209.       ICOOR=TABGEO.JGEO
  210.       SEGACT ICOOR
  211. *      SEGACT TABVC.NOMVC(*)
  212.       DO IJVD=1,JGVD
  213.          MYMCHA=TATRAV.IVD(IJVD)
  214.          IF (MYMCHA.NE.0) THEN
  215.             SEGACT MYMCHA
  216.          ENDIF
  217.       ENDDO
  218. *
  219. * On travaille sur chaque sous-domaine
  220. *
  221.       DO 1 IBSOUV=1,NBSOUV
  222.          SOUGEO=CGEOME.LISOUS(IBSOUV)
  223.          SEGACT SOUGEO
  224.          SFACTI=FACTIV.IFACTI(IBSOUV)
  225.          SEGACT,SFACTI
  226. *
  227.          NBELEV=SOUGEO.NUM(/2)
  228.          ITYVOL=SOUGEO.ITYPEL
  229. * Détermination de la dimension de l'espace de référence
  230.          CALL DIMELE(NOMS(ITYVOL),IESREF,IMPR,IRET)
  231.          IF (IRET.NE.0) GOTO 9999
  232. *
  233.          CALL FIQUAF(ITYVOL,MYQRFS,IQUVOL,IMPR,IRET)
  234.          IF (IRET.NE.0) GOTO 9999
  235. *
  236.          SEGACT IQUVOL
  237.          FACVOL=IQUVOL.LFACE
  238.          SEGDES IQUVOL
  239.          SEGACT FACVOL
  240.          NBSOFV=FACVOL.LISOUS(/1)
  241. *
  242. * On travaille sur chaque type de face pour chaque sous-domaine
  243. *
  244.          DO 12 IBSOFV=1,NBSOFV
  245.             SFAVOL=FACVOL.LISOUS(IBSOFV)
  246.             SEGACT SFAVOL
  247.             NBELFV=SFAVOL.NUM(/2)
  248.             ITYFAC=SFAVOL.ITYPEL
  249.             CALL FIQUAF(ITYFAC,MYQRFS,IQUFAC,IMPR,IRET)
  250.             IF (IRET.NE.0) GOTO 9999
  251.             SSFACT=SFACTI.ISFACT(IBSOFV)
  252. *   On calcule le nb de face pour un type de face d'un sous-domaine
  253.             SEGACT SSFACT
  254.             IBELEF=0
  255.             DO IBELEV=1,NBELEV
  256.                DO IBELFV=1,NBELFV
  257.                   IF (SSFACT.LFACTI(IBELFV,IBELEV)) THEN
  258.                      IBELEF=IBELEF+1
  259.                   ENDIF
  260.                ENDDO
  261.             ENDDO
  262.             SEGDES SSFACT
  263.             NBELEF=IBELEF
  264. *
  265. * Celui-ci peut être nul : Cas des prismes où on ne calcule des intégrales
  266. * de surface que sur les triangles
  267. *
  268.             IF (NBELEF.EQ.0) GOTO 12
  269.  
  270. *    Création des segments contenant les poids et points de Gauss sur
  271. *    toutes les faces de l'élément de référence.
  272. * In CREPG : SEGINI JXCOPG
  273. * In CREPG : SEGINI JXPOPG
  274.             CALL CREPG(IQUVOL,SFAVOL,METING,MYFALS,MYFPGS,
  275.      $           JXCOPG,JXPOPG,
  276.      $           IMPR,IRET)
  277.             IF (IRET.NE.0) GOTO 9999
  278. *
  279. * Géométrie
  280. *
  281.             MYDISC=TABGEO.DISGEO
  282.             CALL KEEF(ITYVOL,MYDISC,
  283.      $           MYFALS,
  284.      $           LRFVOL,
  285.      $           IMPR,IRET)
  286.             IF (IRET.NE.0) GOTO 9999
  287. * In KFNRFF : SEGINI FFPG
  288. * In KFNRFF : SEGINI DFFPG
  289.             CALL KFNRFF(LRFVOL,JXCOPG,
  290.      $           FFPG,DFFPG,
  291.      $           IMPR,IRET)
  292.             IF (IRET.NE.0) GOTO 9999
  293. *
  294. * Création des matrices jacobiennes et déterminants
  295. * pour la transformation : élément volumique de référence <->
  296. *                          élément volumique réel
  297. * Ici, on ne se servira que de l'inverse de la matrice
  298. * jacobienne.
  299. * In GEOLIF : SEGINI JMAJAC
  300. * In GEOLIF : SEGINI JMIJAC
  301. * In GEOLIF : SEGINI JDTJAC
  302.             JCOOR=ICOOR.ICHEVA(IBSOUV)
  303.             CALL GEOLIF(DFFPG,JCOOR,SSFACT,NBELEF,
  304.      $           JMAJAC,JMIJAC,JDTJAC,LERJ,
  305.      $           IMPR,IRET)
  306.             IF (IRET.NE.0) THEN
  307.                IF (LERJ) GOTO 9666
  308.                GOTO 9999
  309.             ENDIF
  310.             SEGSUP DFFPG
  311. *!            SEG SUP JMA JAC
  312. *!            SEG SUP JDT JAC
  313. *
  314. * Création des matrices jacobiennes et déterminants
  315. * pour la transformation : élément surfacique de référence <->
  316. *                          élément surfacique réel
  317. * Ici, on ne se servira que du déterminant de la matrice jacobienne.
  318. * In GEOLF2 : SEGINI JMAJA2
  319. * In GEOLF2 : SEGINI JMIJA2
  320. * In GEOLF2 : SEGINI JDTJA2
  321.             MYDISC=TABGEO.DISGEO
  322.             CALL GEOLF2(LRFVOL,IQUVOL,SFAVOL,
  323.      $           MYDISC,METING,MYFALS,MYFPGS,
  324.      $           JCOOR,SSFACT,NBELEF,
  325.      $           JMAJA2,JMIJA2,JDTJA2,LERJ2,
  326.      $           IMPR,IRET)
  327.             IF (IRET.NE.0) THEN
  328.                IF (LERJ2) THEN
  329.                   LERJ=LERJ2
  330.                   GOTO 9666
  331.                ENDIF
  332.                GOTO 9999
  333.             ENDIF
  334.             IF (IRET.NE.0) GOTO 9999
  335.             SEGSUP JMAJA2
  336.             IF (JMIJA2.NE.0) THEN
  337.                SEGSUP JMIJA2
  338.             ENDIF
  339.             SEGSUP FFPG
  340. C Inutile normalement, on peut se débrouiller avec les coeffs
  341. C* En axi, on multiplie le determinant de la matrice
  342. C* jacobienne par 2piR (ou R est la premiere coordonnee)
  343. C            IF (LAXI.GT.0) THEN
  344. C* In GEOMFT : SEGINI JDTJA3
  345. C               CALL GEOMFT(JCOOR,FFPG,SSFACT,NBELEF,
  346. C     $              JDTJA2,LAXI,
  347. C     $              JDTJA3,
  348. C     $              IMPR,IRET)
  349. C               IF (IRET.NE.0) GOTO 9999
  350. C               SEGSUP JDTJA2
  351. C               JDTJA2=JDTJA3
  352. C            ENDIF
  353. *
  354. * Attention : modif par rapport à nlin !
  355. *
  356.             JPC=0
  357.             JMAREG=0
  358.             JDIAMA=0
  359.             METRIQ=0
  360. *
  361. * Calcul des fonctions de forme et de leurs dérivées
  362. *
  363.             DO IKVD=1,KGVD
  364.                LF=TATRAV.LFFVD(IKVD).EQV..TRUE.
  365.                LDF=TATRAV.LDFFVD(IKVD).EQV..TRUE.
  366.                IF (LF.OR.LDF) THEN
  367.                   MYDISC=TABVDC.DISVD(IKVD)
  368.                   CALL KEEF(ITYVOL,MYDISC,
  369.      $                 MYFALS,
  370.      $                 LRFVOL,
  371.      $                 IMPR,IRET)
  372.                   IF (IRET.NE.0) GOTO 9999
  373. * In KFNRFF : SEGINI FFPG
  374. * In KFNRFF : SEGINI DFFPG
  375.                   CALL KFNRFF(LRFVOL,JXCOPG,
  376.      $                 FFPG,DFFPG,
  377.      $                 IMPR,IRET)
  378.                   IF (IRET.NE.0) GOTO 9999
  379.                   IF (LF) THEN
  380.                      TATRAV.FFVD(IKVD)=FFPG
  381.                   ELSE
  382. *                     segini ffpg
  383.                      SEGSUP FFPG
  384.                   ENDIF
  385.                   IF (LDF) THEN
  386.                      IF (LERF.NE.0) THEN
  387.                         SEGINI,JDFFPG=DFFPG
  388.                         SEGDES JDFFPG
  389.                      ELSE
  390. * In DFNFRF : SEGINI JDFFPG
  391.                         CALL DFNFRF(DFFPG,JMIJAC,SSFACT,NBELEF,
  392.      $                       JDFFPG,
  393.      $                       IMPR,IRET)
  394.                         IF (IRET.NE.0) GOTO 9999
  395.                      ENDIF
  396.                      TATRAV.DFFVD(IKVD)=JDFFPG
  397.                      ENDIF
  398.                      SEGSUP DFFPG
  399.                ENDIF
  400.             ENDDO
  401. *
  402. * Calcul des champs et de leurs dérivées
  403. *
  404.             DO IJVD=1,JGVD
  405.                LC=TATRAV.LVD(IJVD).EQV..TRUE.
  406.                LDC=TATRAV.LDVD(IJVD).EQV..TRUE.
  407.                IF (LC.OR.LDC) THEN
  408.                   MYMCHA=TATRAV.IVD(IJVD)
  409.                   JCOEFF=MYMCHA.ICHEVA(IBSOUV)
  410.                   IF (LC) THEN
  411.                      FFPG=TATRAV.FFVD(TABVDC.DJSVD(IJVD))
  412. * In COGAUF : SEGINI JCOEFG
  413.                      CALL COGAUF(JCOEFF,FFPG,SSFACT,NBELEF,
  414.      $                    JCOEFG,
  415.      $                    IMPR,IRET)
  416.                      IF (IRET.NE.0) GOTO 9999
  417.                      TATRAV.VD(IJVD)=JCOEFG
  418.                   ENDIF
  419.                   IF (LDC) THEN
  420.                      JDFFPG=TATRAV.DFFVD(TABVDC.DJSVD(IJVD))
  421. * In DCOGAF : SEGINI JDCOFG
  422.                      CALL DCOGAF(JCOEFF,JDFFPG,SSFACT,NBELEF,
  423.      $                    JDCOFG,
  424.      $                    IMPR,IRET)
  425.                      IF (IRET.NE.0) GOTO 9999
  426.                      TATRAV.DVD(IJVD)=JDCOFG
  427.                   ENDIF
  428.                ENDIF
  429.             ENDDO
  430. *!!!            SEG DES JMIJAC
  431. *
  432. * Calcul des coefficients
  433. *
  434.             DO IJGCOF=1,JGCOF
  435.                LC=TATRAV.LVCOF(IJGCOF).EQV..TRUE.
  436.                IF (LC) THEN
  437.                   IVCOMP=TABVDC.VCOMP(IJGCOF)
  438.                   IICOMP=TABVDC.VLDAT(IJGCOF)
  439. * In CALCGA : SEGINI FC
  440. * In CALCGA : SEG INI METRIQ.MCHEVA
  441.                   CALL CALCGA(IVCOMP,IICOMP,JMAJAC,JMIJAC,JDTJAC,
  442.      $                 JMAREG,JDIAMA,JPC,METRIQ,
  443.      $                 TATRAV,
  444.      $                 FC,IMPR,IRET)
  445.                   IF (IRET.NE.0) GOTO 9999
  446.                   TATRAV.VCOF(IJGCOF)=FC
  447.                ENDIF
  448.             ENDDO
  449. *
  450. * Calcul des produits de coefficients
  451. *
  452.             DO IJLCOF=1,JLCOF
  453.                IPOWCO=TABVDC.VLCOF(IJLCOF)
  454. * In CALPCO : SEGINI IPROCO
  455.                CALL CALPCO(IPOWCO,TATRAV,
  456.      $              IPROCO,IMPR,IRET)
  457.                IF (IRET.NE.0) GOTO 9999
  458.                TATRAV.VVCOF(IJLCOF)=IPROCO
  459.             ENDDO
  460. *
  461. * On peut faire le ménage dans les coefficients
  462. *
  463.             DO IJGCOF=1,JGCOF
  464.                FC=TATRAV.VCOF(IJGCOF)
  465.                IF (FC.NE.0) THEN
  466.                   SEGSUP,FC
  467.                   TATRAV.VCOF(IJGCOF)=0
  468.                ENDIF
  469.             ENDDO
  470. *
  471. * On effectue le calcul de la matrice
  472. *
  473.             DO IVARPR=1,NUMVPR
  474.                DO IVARDU=1,NUMVDU
  475. *Bug mis en evidence par toimp_3d                  JMTLIA=0
  476.                   MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  477.                   JMTLIA=MYMCHA.ICHEVA(IBSOUV)
  478.                   IJVARP=TABVDC.VVARPR(IVARPR)
  479.                   IJVARD=TABVDC.VVARDU(IVARDU)
  480.                   IKVARP=TABVDC.DJSVD(IJVARP)
  481.                   IKVARD=TABVDC.DJSVD(IJVARD)
  482.                   MVVPR=(TABVDC.MVD(IJVARP).NE.0)
  483.                   MVVDU=(TABVDC.MVD(IJVARD).NE.0)
  484.                   DO IOP=1,NUMOP
  485.                      DO KDERPR=0,NUMDER
  486.                         IJLCPR=TABVDC.ILCPR(KDERPR+1,IOP,IVARPR)
  487.                         IF (IJLCPR.NE.0) THEN
  488.                            FCPR=TATRAV.VVCOF(IJLCPR)
  489. * variable primale
  490.                            IF (KDERPR.EQ.0) THEN
  491.                               IF (MVVPR) THEN
  492.                                  FVPR=TATRAV.VD(IJVARP)
  493.                               ELSE
  494.                                  FVPR=TATRAV.FFVD(IKVARP)
  495.                               ENDIF
  496.                            ELSE
  497.                               IF (MVVPR) THEN
  498.                                  FVPR=TATRAV.DVD(IJVARP)
  499.                               ELSE
  500.                                  FVPR=TATRAV.DFFVD(IKVARP)
  501.                               ENDIF
  502.                            ENDIF
  503.                            DO KDERDU=0,NUMDER
  504.                               IJLCDU=TABVDC.ILCDU(KDERDU+1,IOP,IVARDU)
  505.                               IF (IJLCDU.NE.0) THEN
  506.                                  FCDU=TATRAV.VVCOF(IJLCDU)
  507. * Variable duale
  508.                                  IF (KDERDU.EQ.0) THEN
  509.                                     IF (MVVDU) THEN
  510.                                        FVDU=TATRAV.VD(IJVARD)
  511.                                     ELSE
  512.                                        FVDU=TATRAV.FFVD(IKVARD)
  513.                                     ENDIF
  514.                                  ELSE
  515.                                     IF (MVVDU) THEN
  516.                                        FVDU=TATRAV.DVD(IJVARD)
  517.                                     ELSE
  518.                                        FVDU=TATRAV.DFFVD(IKVARD)
  519.                                     ENDIF
  520.                                  ENDIF
  521. *                              WRITE(IOIMP,*) 'FVPR=',FVPR
  522. *                              WRITE(IOIMP,*) 'FVDU=',FVDU
  523. *                              WRITE(IOIMP,*) 'FCPR=',FCPR
  524. *                              WRITE(IOIMP,*) 'FCDU=',FCDU
  525. *                              WRITE(IOIMP,*) 'KDERPR=',KDERPR
  526. *                              WRITE(IOIMP,*) 'KDERDU=',KDERDU
  527. *                              WRITE(IOIMP,*) 'LDERPR=',LDERPR
  528. *                              WRITE(IOIMP,*) 'LDERDU=',LDERDU
  529. *                                 SEGPRT,JXPOPG
  530. *                                 SEGPRT,FVPR
  531. *                                 SEGPRT,FVDU
  532. *                                 SEGPRT,FCPR
  533. *                                 SEGPRT,FCDU
  534. *                                 SEGPRT,JDTJA2
  535. *                                 WRITE(IOIMP,*) 'KDERPR=',KDERPR
  536. *                                 WRITE(IOIMP,*) 'KDERDU=',KDERDU
  537. C                                 WRITE(IOIMP,*) 'LDERPR=',LDERPR
  538. C                                 WRITE(IOIMP,*) 'LDERDU=',LDERDU
  539. C                                 SEGPRT,JDTJA2
  540. C                                 WRITE(IOIMP,*) 'NBELEF=',NBELEF
  541.                                  CALL LIALIN(JXPOPG,
  542.      $                                FVPR,FVDU,FCPR,FCDU,
  543.      $                                KDERPR,KDERDU,
  544.      $                                JDTJA2,SSFACT,NBELEF,LERF,IESREF,
  545.      $                                JMTLIA,
  546.      $                                IMPR,IRET)
  547.                                  IF (IRET.NE.0) GOTO 9999
  548. C                                 WRITE(IOIMP,*) 'JMTLIA=',JMTLIA
  549. C                                 SEGPRT,JMTLIA
  550. C*                                 STOP 16
  551.                               ENDIF
  552.                            ENDDO
  553.                         ENDIF
  554.                      ENDDO
  555.                   ENDDO
  556.                   MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  557.                   MYMCHA.JMACHE(IBSOUV)=SOUGEO
  558.                   MYMCHA.ICHEVA(IBSOUV)=JMTLIA
  559. *               IF (JMTLIA.NE.0) THEN
  560. *                  SEGPRT,JMTLIA
  561. *               ENDIF
  562. C               WRITE(IOIMP,*) 'IVARPR=',IVARPR
  563. C               WRITE(IOIMP,*) 'IVARDU=',IVARDU
  564. C               WRITE(IOIMP,*) 'JMTLIA=',JMTLIA
  565.                ENDDO
  566.             ENDDO
  567. * Suppression de tous les MCHEVA
  568.             DO IJLCOF=1,JLCOF
  569.                IPROCO=TATRAV.VVCOF(IJLCOF)
  570.                SEGSUP IPROCO
  571.                TATRAV.VVCOF(IJLCOF)=IPROCO
  572.             ENDDO
  573. *
  574.             DO IJVD=1,JGVD
  575.                JCOEFG=TATRAV.VD(IJVD)
  576.                IF (JCOEFG.NE.0) THEN
  577.                   SEGSUP JCOEFG
  578.                   TATRAV.VD(IJVD)=JCOEFG
  579.                ENDIF
  580.                JDCOFG=TATRAV.DVD(IJVD)
  581.                IF (JDCOFG.NE.0) THEN
  582.                   SEGSUP JDCOFG
  583.                   TATRAV.DVD(IJVD)=JDCOFG
  584.                ENDIF
  585.             ENDDO
  586. *
  587.             DO IKVD=1,KGVD
  588.                FFPG=TATRAV.FFVD(IKVD)
  589.                IF (FFPG.NE.0) THEN
  590.                   SEGSUP FFPG
  591.                   TATRAV.FFVD(IKVD)=FFPG
  592.                ENDIF
  593.                JDFFPG=TATRAV.DFFVD(IKVD)
  594.                IF (JDFFPG.NE.0) THEN
  595.                   SEGSUP JDFFPG
  596.                   TATRAV.DFFVD(IKVD)=JDFFPG
  597.                ENDIF
  598.             ENDDO
  599. *
  600.             SEGSUP JDTJA2
  601.             SEGSUP JXPOPG
  602.             SEGSUP JXCOPG
  603.             SEGDES SFAVOL
  604.             SEGSUP JDTJAC
  605.             SEGSUP JMAJAC
  606.             SEGSUP JMIJAC
  607.  12      CONTINUE
  608. *         SEGPRT,JMTLIA
  609.          SEGDES FACVOL
  610.          SEGDES SFACTI
  611.          SEGDES SOUGEO
  612.  1    CONTINUE
  613. *
  614.       DO IJVD=1,JGVD
  615.          MYMCHA=TATRAV.IVD(IJVD)
  616.          IF (MYMCHA.NE.0) THEN
  617.             SEGDES MYMCHA
  618.          ENDIF
  619.       ENDDO
  620. *      SEGDES TABVC.NOMVC(*)
  621.       SEGDES ICOOR
  622.       SEGDES MYPGS
  623. * Cette instruction n'a pas l'air de fonctionner
  624. * Un peu de ménage là où il n'y a pas d'info
  625. *      SEGDES TABMAT.VMAT(*)
  626.       DO IVARPR=1,NUMVPR
  627.          DO IVARDU=1,NUMVDU
  628.             MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  629.             SEGACT MYMCHA
  630.             LVID=.TRUE.
  631.             DO ISOUS=1,NBSOUV
  632.                MCHEVA=MYMCHA.ICHEVA(ISOUS)
  633.                LVID=LVID.AND.(MCHEVA.EQ.0)
  634.             ENDDO
  635.             IF (LVID) THEN
  636.                SEGSUP MYMCHA
  637.                TABMAT.VMAT(IVARDU,IVARPR)=0
  638.             ELSE
  639.                SEGDES,MYMCHA
  640.             ENDIF
  641.          ENDDO
  642.       ENDDO
  643.       SEGDES TATRAV
  644.       SEGDES TABMAT
  645.       SEGDES TABVDC
  646.       SEGDES TABGEO
  647.       SEGDES FACTIV
  648.       SEGDES CGEOME
  649. *
  650. * Normal termination
  651. *
  652.       IRET=0
  653.       RETURN
  654. *
  655. * Format handling
  656. *
  657. *
  658. * Error handling
  659. *
  660.  9666 CONTINUE
  661.       IRET=666
  662.       RETURN
  663.  9999 CONTINUE
  664.       IRET=1
  665.       WRITE(IOIMP,*) 'An error was detected in subroutine nlia'
  666.       RETURN
  667. *
  668. * End of subroutine nlia
  669. *
  670.       END
  671.  
  672.  
  673.  
  674.  
  675.  
  676.  
  677.  
  678.  
  679.  

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