Télécharger la plaquette Cast3M


fr en

Télécharger prlin3.eso

Retour à la liste

Numérotation des lignes : 

prlin3

  1. C PRLIN3    SOURCE    GOUNAND   24/11/06    21:15:15     12073          
  2.       SUBROUTINE PRLIN3(CGEOMQ,LGDISC,TABCPR,TABCDU,LERF,LCHAM,
  3.      $     MYFALS,MYCOMS,
  4.      $     TABGEO,TABVDC,TATRAV,
  5.      $     IMPR,IRET)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.       IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM         : PRLIN3
  10. C DESCRIPTION : Initialisations, tests et formatage des données et des
  11. C               résultats pour nlin
  12. C               base sur prls93
  13. C
  14. C LANGAGE     : ESOPE
  15. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C               mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES          :
  19. C APPELE PAR       : PRLIN2
  20. C***********************************************************************
  21. C ENTREES            :
  22. C SORTIES            :
  23. C TRAVAIL            :
  24. C
  25. C***********************************************************************
  26. C VERSION    : v1, 10/05/2004, version initiale
  27. C HISTORIQUE : v1, 10/05/2004, création
  28. C HISTORIQUE :     18/05/2021, ajout lecture MCHAML
  29. C HISTORIQUE :
  30. C HISTORIQUE :
  31. C***********************************************************************
  32. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33. C en cas de modification de ce sous-programme afin de faciliter
  34. C la maintenance !
  35. C***********************************************************************
  36.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC SMELEME
  40.       POINTEUR CGEOMQ.MELEME
  41. -INC SMTABLE
  42.       POINTEUR TABCPR.MTABLE
  43.       POINTEUR TABCDU.MTABLE
  44.       POINTEUR TABLC.MTABLE
  45.       POINTEUR TAVAPR.MTABLE
  46.       POINTEUR TAVADU.MTABLE
  47.       POINTEUR TADAPR.MTABLE
  48.       POINTEUR TADADU.MTABLE
  49.       POINTEUR TAVDPD.MTABLE
  50.       POINTEUR TACOPR.MTABLE
  51.       POINTEUR TACODU.MTABLE
  52.       POINTEUR TABCOF.MTABLE
  53.       POINTEUR TABI.MTABLE
  54.       POINTEUR TABJ.MTABLE
  55.       POINTEUR TABK.MTABLE
  56. -INC SMLMOTS
  57.       POINTEUR MYLMOT.MLMOTS
  58. -INC SMLENTI
  59.       POINTEUR MYLENT.MLENTI
  60.       POINTEUR LDAT.MLENTI
  61.       POINTEUR LDAT3.MLENTI
  62.       POINTEUR LCOF.MLENTI
  63.       POINTEUR LCOF3.MLENTI
  64.       POINTEUR POWCOF.MLENTI
  65.       POINTEUR POWCO2.MLENTI
  66.       POINTEUR KREP.MLENTI
  67. * Segments à moi
  68. -INC TNLIN
  69. *-INC SFALRF
  70.       POINTEUR MYFALS.FALRFS
  71. *-INC SLCOMP
  72.       POINTEUR MYCOMS.COMPS
  73.       POINTEUR MYCOM.COMP
  74. -INC SMCHPOI
  75. *      POINTEUR MYCHPO.MCHPOI
  76. -INC SMCHAML
  77. *      POINTEUR MYCHAM.MCHAML
  78. *-INC SMCHAEL
  79.       POINTEUR ICOOR.MCHAEL
  80.       POINTEUR MYMCHA.MCHAEL
  81. *-INC SMTNLIN
  82.       INTEGER NUMOP,NUMDER,NUMVPR,NUMVDU
  83.       INTEGER NUMOP2,NUMDE2
  84.       INTEGER JGVC,KGVC
  85. *
  86.       INTEGER IMPR,IRET
  87. *
  88.       CHARACTER*4 LGDISC
  89.       CHARACTER*4 MYDISC,CNDDL
  90.       CHARACTER*8 CNCOM
  91.       REAL*8 MYFLOT
  92.       CHARACTER*8 TYP0,TYP1,TYP2,BLAN,TYPE,TYPCHA
  93.       CHARACTER*8 TYTABL,TYLMOT,TYCHPO,TYCHAM,TYMOT,TYENT,TYFLO,TYLENT
  94. *
  95.       INTEGER IBID,IVAL,IOBJ,IDAT,ICOF
  96.       REAL*8 XBID,XVAL
  97.       CHARACTER*8 CBID,CVD,CPD
  98.       LOGICAL LBID
  99.       INTEGER IOP,JVARPR,JVARDU,KDER
  100.       INTEGER IJVC,IKGVD
  101.       INTEGER LNMOTS
  102.       LOGICAL LFOUND,LEGDAT,LEGCOF
  103.       INTEGER LERF
  104. *
  105. * Executable statements
  106. *
  107.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prlin3'
  108.       BLAN='        '
  109.       TYTABL='TABLE   '
  110.       TYLMOT='LISTMOTS'
  111.       TYLENT='LISTENTI'
  112.       TYCHPO='CHPOINT '
  113.       TYCHAM='MCHAML  '
  114.       TYMOT ='MOT     '
  115.       TYENT ='ENTIER  '
  116.       TYFLO ='FLOTTANT'
  117. * Récupération des dimensions
  118.       CALL ACME(TABCPR,'NUMDER',NUMDER)
  119.       IF (IERR.NE.0) GOTO 9999
  120. *
  121. * Si les dérivées se font sur les éléments de référence, il
  122. * faut vérifier que tous les éléments de CGEOMQ
  123. * sont de la meme dimension et avoir sa valeur
  124. *
  125.       IF (LERF.NE.0) THEN
  126.          CALL DIMESH(CGEOMQ,IDMESH,IMPR,IRET)
  127.          IF (IRET.NE.0) GOTO 9999
  128.          IESDER=IDMESH
  129.       ELSE
  130.          IESDER=IDIM
  131.       ENDIF
  132. *
  133.       IF (NUMDER.NE.IESDER) THEN
  134.          WRITE(IOIMP,*) 'NUMDER=',NUMDER,' incorrect'
  135.          GOTO 9999
  136.       ENDIF
  137.       CALL ACME(TABCPR,'NUMOP',NUMOP)
  138.       IF (IERR.NE.0) GOTO 9999
  139.       CALL ACME(TABCPR,'NUMVAR',NUMVPR)
  140.       IF (IERR.NE.0) GOTO 9999
  141.       CALL ACME(TABCPR,'NUMDAT',NUMDPR)
  142.       IF (IERR.NE.0) GOTO 9999
  143.       CALL ACME(TABCPR,'NUMCOF',NUMCPR)
  144.       IF (IERR.NE.0) GOTO 9999
  145. *
  146.       CALL ACME(TABCDU,'NUMDER',NUMDE2)
  147.       IF (IERR.NE.0) GOTO 9999
  148.       IF (NUMDE2.NE.IESDER) THEN
  149.          WRITE(IOIMP,*) 'NUMDE2=',NUMDE2,' incorrect'
  150.          GOTO 9999
  151.       ENDIF
  152.       CALL ACME(TABCDU,'NUMOP',NUMOP2)
  153.       IF (IERR.NE.0) GOTO 9999
  154.       IF (NUMOP2.NE.NUMOP) THEN
  155.          WRITE(IOIMP,*) 'NUMOP2.NE.NUMOP'
  156.          GOTO 9999
  157.       ENDIF
  158.       CALL ACME(TABCDU,'NUMVAR',NUMVDU)
  159.       IF (IERR.NE.0) GOTO 9999
  160.       CALL ACME(TABCDU,'NUMDAT',NUMDDU)
  161.       IF (IERR.NE.0) GOTO 9999
  162.       CALL ACME(TABCDU,'NUMCOF',NUMCDU)
  163.       IF (IERR.NE.0) GOTO 9999
  164. *
  165.       CALL ACMO(TABCPR,'VAR',TYTABL,TAVAPR)
  166.       IF (IERR.NE.0) GOTO 9999
  167.       CALL ACMO(TABCDU,'VAR',TYTABL,TAVADU)
  168.       IF (IERR.NE.0) GOTO 9999
  169.       CALL ACMO(TABCPR,'DAT',TYTABL,TADAPR)
  170.       IF (IERR.NE.0) GOTO 9999
  171.       CALL ACMO(TABCDU,'DAT',TYTABL,TADADU)
  172.       IF (IERR.NE.0) GOTO 9999
  173.       CALL ACMO(TABCPR,'COF',TYTABL,TACOPR)
  174.       IF (IERR.NE.0) GOTO 9999
  175.       CALL ACMO(TABCDU,'COF',TYTABL,TACODU)
  176.       IF (IERR.NE.0) GOTO 9999
  177. * Initialisation du gros objet de données
  178.       SEGINI,TABGEO
  179.       JLCOF=(NUMDER+1)*NUMOP*(NUMVPR+NUMVDU)
  180.       JGCOF=NUMCPR+NUMCDU
  181.       JGVD=NUMVPR+NUMVDU+NUMDPR+NUMDDU
  182.       KGVD=JGVD
  183.       IJLCOF=0
  184.       IJGCOF=0
  185.       IJGVD=0
  186.       IKGVD=0
  187.       SEGINI,TABVDC
  188. *   géométrie
  189.       LNMOTS=LEN(LGDISC)
  190.       IF (LNMOTS.NE.4) THEN
  191.          WRITE(IOIMP,*) 'Erreur esp. discr. geometrie'
  192.          GOTO 9999
  193.       ENDIF
  194.       TABGEO.DISGEO=LGDISC
  195. * Pointeur bidon négatif
  196.       IPBID=0
  197. *
  198. * Lecture des variables et des données primales et duales
  199. *
  200.       DO IVADA=1,2
  201.          DO IPRDU=1,2
  202.             IF (IVADA.EQ.1) THEN
  203.                CVD='VARIABLE'
  204.                IF (IPRDU.EQ.1) THEN
  205.                   NUMVAR=NUMVPR
  206.                   CPD='PRIMAL  '
  207.                ELSE
  208.                   NUMVAR=NUMVDU
  209.                   CPD='DUAL    '
  210.                ENDIF
  211.             ELSE
  212.                CVD='DATA    '
  213.                IF (IPRDU.EQ.1) THEN
  214.                   NUMVAR=NUMDPR
  215.                   CPD='PRIMAL  '
  216.                ELSE
  217.                   NUMVAR=NUMDDU
  218.                   CPD='DUAL    '
  219.                ENDIF
  220.             ENDIF
  221. *
  222.             DO JVAR=1,NUMVAR
  223.                IJGVD=IJGVD+1
  224.                IKGVD=IKGVD+1
  225.                IF (IVADA.EQ.1) THEN
  226.                   IF (IPRDU.EQ.1) THEN
  227.                      TABVDC.VVARPR(JVAR)=IJGVD
  228.                      TAVDPD=TAVAPR
  229.                   ELSE
  230.                      TABVDC.VVARDU(JVAR)=IJGVD
  231.                      TAVDPD=TAVADU
  232.                   ENDIF
  233.                ELSE
  234.                   IF (IPRDU.EQ.1) THEN
  235.                      TABVDC.VDATPR(JVAR)=IJGVD
  236.                      TAVDPD=TADAPR
  237.                   ELSE
  238.                      TABVDC.VDATDU(JVAR)=IJGVD
  239.                      TAVDPD=TADADU
  240.                   ENDIF
  241.                ENDIF
  242.                TYPE=TYTABL
  243.                CALL ACCTAB(TAVDPD,'ENTIER',JVAR,XBID,CBID,LBID,IBID,
  244.      $              TYPE,IBID,XBID,CBID,LBID,TABJ)
  245.                IF (IERR.NE.0) GOTO 9999
  246. *
  247.                TYP0=BLAN
  248.                CALL ACCTAB(TABJ,'MOT',IBID,XBID,'VALEUR',LBID,IBID,
  249.      $              TYP0,IVAL,XVAL,CBID,LBID,IOBJ)
  250. * Seules les variables sont autorisées à ne pas avoir de valeur.
  251.                TABVDC.TYPVD(IJGVD)=TYP0
  252.                IF ((TYP0.EQ.BLAN).AND.(IVADA.EQ.1)) THEN
  253.                   TABVDC.MVD(IJGVD)=0
  254.                   TABVDC.XVD(IJGVD)=0.D0
  255.                ELSEIF (TYP0.EQ.TYCHPO.OR.TYP0.EQ.TYCHAM) THEN
  256. *                  write(ioimp,*) 'IOBJ=',IOBJ
  257.                   TABVDC.MVD(IJGVD)=IOBJ
  258.                   TABVDC.XVD(IJGVD)=0.D0
  259.                ELSEIF (TYP0.EQ.TYENT) THEN
  260.                   IPBID=IPBID-1
  261.                   TABVDC.MVD(IJGVD)=IPBID
  262.                   TABVDC.XVD(IJGVD)=DBLE(IVAL)
  263.                ELSEIF (TYP0.EQ.TYFLO) THEN
  264.                   IPBID=IPBID-1
  265.                   TABVDC.MVD(IJGVD)=IPBID
  266.                   TABVDC.XVD(IJGVD)=XVAL
  267.                ELSE
  268.                   WRITE(IOIMP,*) CPD,' ',CVD,' number ',JVAR,' . VALEUR'
  269.                   WRITE(IOIMP,*) 'wrong type = ',TYP0
  270.                   WRITE(IOIMP,*) 'should be = ',TYENT, ' or '
  271.      $                 ,TYFLO,' or ',TYCHPO,' or ',TYCHAM
  272.                   GOTO 9999
  273.                ENDIF
  274. **
  275.                TYP1=BLAN
  276.                CALL ACCTAB(TABJ,'MOT',IBID,XBID,'DISC',LBID,IBID,
  277.      $              TYP1,IBID,XBID,MYDISC,LBID,IBID)
  278.                IF (IERR.NE.0) GOTO 9999
  279.                IF (TYP1.EQ.BLAN) THEN
  280.                   IF (TYP0.EQ.TYENT.OR.TYP0.EQ.TYFLO) THEN
  281.                      TYP1=TYMOT
  282.                      MYDISC='CSTE'
  283.                   ENDIF
  284.                ENDIF
  285.                IF (TYP1.NE.TYMOT) THEN
  286.                   WRITE(IOIMP,*) CPD,' ',CVD,' number ',JVAR,
  287.      $                    ' . DISC'
  288.                   WRITE(IOIMP,*) 'wrong type = ',TYP1
  289.                   WRITE(IOIMP,*) 'should be = ',TYMOT
  290.                   GOTO 9999
  291.                ENDIF
  292.                TABVDC.DISVD(IKGVD)=MYDISC
  293.                TABVDC.DJSVD(IJGVD)=IKGVD
  294. *
  295.                TYP2=BLAN
  296.                CALL ACCTAB(TABJ,'MOT',IBID,XBID,'NOMDDL',LBID,IBID,
  297.      $              TYP2,IBID,XBID,CNDDL,LBID,MYLMOT)
  298.                IF (IERR.NE.0) GOTO 9999
  299.                IF (TYP2.EQ.BLAN) THEN
  300.                   IF (TYP0.EQ.TYENT.OR.TYP0.EQ.TYFLO) THEN
  301.                      TYP2=TYMOT
  302.                      CNDDL='DUMM'
  303.                   ENDIF
  304.                ENDIF
  305.                IF (TYP2.EQ.TYMOT) THEN
  306.                   JGN=LOCHPO
  307.                   JGM=1
  308.                   SEGINI MLMOT1
  309.                   MLMOT1.MOTS(1)=CNDDL
  310.                ELSEIF (TYP2.EQ.TYLMOT) THEN
  311.                   SEGACT MYLMOT
  312.                   JGN=LOCHPO
  313.                   JGM=MYLMOT.MOTS(/2)
  314.                   SEGINI MLMOT1
  315.                   DO IGM=1,JGM
  316.                      MLMOT1.MOTS(IGM)=MYLMOT.MOTS(IGM)
  317.                   ENDDO
  318.                ELSE
  319.                   WRITE(IOIMP,*) CPD,' ',CVD,' number ',JVAR,
  320.      $                    ' . NOMDDL'
  321.                   WRITE(IOIMP,*) 'wrong type = ',TYP2
  322.                   WRITE(IOIMP,*) 'should be = ',TYMOT,' or ',TYLMOT
  323.                   GOTO 9999
  324.                ENDIF
  325.                SEGACT MLMOT1*NOMOD
  326.                TABVDC.NOMVD(IJGVD)=MLMOT1
  327.             ENDDO
  328.          ENDDO
  329.       ENDDO
  330. *
  331.       JGVD=IJGVD
  332.       KGVD=IKGVD
  333.       SEGADJ,TABVDC
  334. *
  335. * Lecture des coefficients primaux et duaux
  336. *
  337.       SEGACT MYCOMS
  338.       CVD='COEFF.  '
  339.       DO IPRDU=1,2
  340.          IF (IPRDU.EQ.1) THEN
  341.             NUMCOF=NUMCPR
  342.             NUMDAT=NUMDPR
  343.             CPD='PRIMAL  '
  344.          ELSE
  345.             NUMCOF=NUMCDU
  346.             NUMDAT=NUMDDU
  347.             CPD='DUAL    '
  348.          ENDIF
  349.          DO JCOF=1,NUMCOF
  350.             IJGCOF=IJGCOF+1
  351.             IF (IPRDU.EQ.1) THEN
  352.                TABVDC.VCOFPR(JCOF)=IJGCOF
  353.                TABCOF=TACOPR
  354.             ELSE
  355.                TABVDC.VCOFDU(JCOF)=IJGCOF
  356.                TABCOF=TACODU
  357.             ENDIF
  358.             TYPE=TYTABL
  359.             CALL ACCTAB(TABCOF,'ENTIER',JCOF,XBID,CBID,LBID,IBID,
  360.      $           TYPE,IBID,XBID,CBID,LBID,TABJ)
  361.             IF (IERR.NE.0) GOTO 9999
  362. **
  363.             TYP0=BLAN
  364.             CALL ACCTAB(TABJ,'MOT',IBID,XBID,'COMPOR',LBID,IBID,
  365.      $           TYP0,IBID,XBID,CNCOM,LBID,IBID)
  366.             IF (IERR.NE.0) GOTO 9999
  367. *
  368.             TYP1=BLAN
  369.             CALL ACCTAB(TABJ,'MOT',IBID,XBID,'LDAT',LBID,IBID,
  370.      $           TYP1,IDAT,XBID,CBID,LBID,MYLENT)
  371.             IF (IERR.NE.0) GOTO 9999
  372. *
  373.             IF (.NOT.(TYP0.EQ.BLAN.AND.TYP1.EQ.BLAN)) THEN
  374.                IF (TYP0.EQ.BLAN) THEN
  375.                   TYP0=TYMOT
  376.                   CNCOM='IDEN    '
  377.                ENDIF
  378.                IF (TYP0.EQ.TYMOT) THEN
  379.                   CALL FICOMP(CNCOM,MYCOMS,MYCOM,IMPR,IRET)
  380.                   IF (IRET.NE.0) GOTO 9999
  381.                   SEGACT MYCOM
  382.                   NCOCO1=MYCOM.DERCOF(/1)
  383.                   SEGDES MYCOM
  384.                   TABVDC.VCOMP(IJGCOF)=MYCOM
  385.                ELSE
  386.                   WRITE(IOIMP,*) CPD,' ',CVD,' number ',JCOF,' . COMPOR'
  387.      $
  388.                   WRITE(IOIMP,*) 'wrong type = ',TYP0
  389.                   WRITE(IOIMP,*) 'should be  = ',TYMOT
  390.                   GOTO 9999
  391.                ENDIF
  392.                IF (TYP1.EQ.BLAN) THEN
  393.                   JG=0
  394.                   SEGINI MLENT1
  395.                   TYP1=TYLENT
  396.                ELSEIF (TYP1.EQ.TYENT) THEN
  397.                   JG=1
  398.                   SEGINI MLENT1
  399.                   MLENT1.LECT(1)=IDAT
  400.                   TYP1=TYLENT
  401.                ELSEIF (TYP1.EQ.TYLENT) THEN
  402.                   SEGINI,MLENT1=MYLENT
  403.                ENDIF
  404.                IF (TYP1.EQ.TYLENT) THEN
  405.                   NCOCO2=MLENT1.LECT(/1)
  406.                   JG=NCOCO2
  407.                   SEGINI LDAT
  408.                   LBID=.TRUE.
  409.                   DO ICOCO2=1,NCOCO2
  410.                      IBID=MLENT1.LECT(ICOCO2)
  411.                      IF (IBID.LT.1.OR.IBID.GT.NUMDAT) LBID=.FALSE.
  412.                      IF (IPRDU.EQ.1) THEN
  413.                         LDAT.LECT(ICOCO2)=TABVDC.VDATPR(IBID)
  414.                      ELSE
  415.                         LDAT.LECT(ICOCO2)=TABVDC.VDATDU(IBID)
  416.                      ENDIF
  417.                   ENDDO
  418.                   SEGSUP MLENT1
  419.                   SEGACT LDAT*NOMOD
  420. C                  SEGDES LDAT
  421.                   IF (.NOT.NCOCO1.EQ.NCOCO2) THEN
  422.                      WRITE(IOIMP,*) CPD,' ',CVD,' number ',JCOF
  423.      $                    ,' . LDAT'
  424.                      WRITE(IOIMP,*) 'wrong length = ',NCOCO2
  425.                      WRITE(IOIMP,*) 'should be    = ',NCOCO1
  426.                      GOTO 9999
  427.                   ENDIF
  428.                   IF (.NOT.LBID) THEN
  429.                      WRITE(IOIMP,*) CPD,' ',CVD,' number ',JCOF
  430.      $                    ,' . LDAT'
  431.                      WRITE(IOIMP,*) 'some values out of range [1,',
  432.      $                    NUMDAT,']'
  433.                      SEGPRT,MLENT1
  434.                      GOTO 9999
  435.                   ENDIF
  436.                   TABVDC.VLDAT(IJGCOF)=LDAT
  437.                ELSE
  438.                   WRITE(IOIMP,*) CPD,' ',CVD,' number ',JCOF
  439.      $                 ,' . LDAT'
  440.                   WRITE(IOIMP,*) 'wrong type = ',TYP1
  441.                   WRITE(IOIMP,*) 'should be  = ',TYLENT,' or ',TYENT
  442.                   GOTO 9999
  443.                ENDIF
  444.             ENDIF
  445.          ENDDO
  446.       ENDDO
  447.       SEGDES MYCOMS
  448.       JGCOF=IJGCOF
  449.       SEGADJ,TABVDC
  450. *
  451. * Lecture des listes de coefficients (pour la table primale et
  452. * et la table duale)
  453. *
  454.       CVD='LISTCOEF'
  455.       DO IPRDU=1,2
  456.          IF (IPRDU.EQ.1) THEN
  457.             NUMVAR=NUMVPR
  458.             TABLC=TABCPR
  459.             CPD='PRIMAL  '
  460.          ELSE
  461.             NUMVAR=NUMVDU
  462.             TABLC=TABCDU
  463.             CPD='DUAL    '
  464.          ENDIF
  465.          DO IOP=1,NUMOP
  466.             TYPE=TYTABL
  467.             CALL ACCTAB(TABLC,'ENTIER',IOP,XBID,CBID,LBID,IBID,
  468.      $           TYPE,IBID,XBID,CBID,LBID,TABI)
  469.             IF (IERR.NE.0) GOTO 9999
  470.             DO JVAR=1,NUMVAR
  471.                TYPE=TYTABL
  472.                CALL ACCTAB(TABI,'ENTIER',JVAR,XBID,CBID,LBID,IBID,
  473.      $              TYPE,IBID,XBID,CBID,LBID,TABJ)
  474.                DO KDER=0,NUMDER
  475.                   TYPE=BLAN
  476.                   CALL ACCTAB(TABJ,'ENTIER',KDER,XBID,CBID,LBID,IBID,
  477.      $                 TYPE,ICOF,XBID,CBID,LBID,MYLENT)
  478. **
  479.                   IF (.NOT.(TYPE.EQ.BLAN)) THEN
  480.                      IF (TYPE.EQ.TYENT.OR.TYPE.EQ.TYLENT) THEN
  481.                         IJLCOF=IJLCOF+1
  482.                         IF (TYPE.EQ.TYENT) THEN
  483.                            IF (ICOF.EQ.0) THEN
  484.                               JG=0
  485.                            ELSE
  486.                               JG=1
  487.                            ENDIF
  488.                            SEGINI MLENT1
  489.                            IF (ICOF.NE.0) THEN
  490.                               MLENT1.LECT(1)=ICOF
  491.                            ENDIF
  492.                         ELSEIF (TYPE.EQ.TYLENT) THEN
  493.                            SEGINI,MLENT1=MYLENT
  494.                         ELSE
  495.                            write(ioimp,*) 'prog error'
  496.                            goto 9999
  497.                         ENDIF
  498.                         NLCOF=MLENT1.LECT(/1)
  499.                         JG=JGCOF
  500.                         SEGINI POWCOF
  501.                         DO ILCOF=1,NLCOF
  502.                            INUC=MLENT1.LECT(ILCOF)
  503.                            IAINUC=ABS(INUC)
  504.                            IF (IPRDU.EQ.1) THEN
  505.                               IF ((IAINUC.LE.0).OR.(IAINUC.GT.NUMCPR))
  506.      $                             THEN
  507.                                  WRITE(IOIMP,*) CPD,' ',CVD,' operator '
  508.      $                                ,IOP
  509.                                  WRITE(IOIMP,*) 'variable ',JVAR,
  510.      $                                ' derivative ',KDER
  511.                                  WRITE(IOIMP,*)
  512.      $                                'some values out of range [1,'
  513.      $                                ,NUMCPR,']U[-',NUMCPR,',-1]'
  514.                                  SEGPRT,MLENT1
  515.                                  GOTO 9999
  516.                               ENDIF
  517.                               IGCOF=TABVDC.VCOFPR(IAINUC)
  518.                            ELSE
  519.                               IF ((IAINUC.LE.0).OR.(IAINUC.GT.NUMCDU))
  520.      $                             THEN
  521.                                  WRITE(IOIMP,*) CPD,' ',CVD,' operator '
  522.      $                                ,IOP
  523.                                  WRITE(IOIMP,*) 'variable ',JVAR,
  524.      $                                ' derivative ',KDER
  525.                                  WRITE(IOIMP,*)
  526.      $                                'some values out of range [1,'
  527.      $                                ,NUMCDU,']',']U[-',NUMCDU,',-1]'
  528.                                  SEGPRT,MLENT1
  529.                                  GOTO 9999
  530.                               ENDIF
  531.                               IGCOF=TABVDC.VCOFDU(IAINUC)
  532.                            ENDIF
  533.                            IF (INUC.GT.0) THEN
  534.                               POWCOF.LECT(IGCOF)=POWCOF.LECT(IGCOF)+1
  535.                            ELSEIF(INUC.LT.0) THEN
  536.                               POWCOF.LECT(IGCOF)=POWCOF.LECT(IGCOF)-1
  537.                            ELSE
  538.                               WRITE(IOIMP,*) 'Programming error 1'
  539.                               GOTO 9999
  540.                            ENDIF
  541.                         ENDDO
  542.                         SEGSUP MLENT1
  543. *                        SEGDES POWCOF
  544.                         SEGACT POWCOF*NOMOD
  545.                         TABVDC.VLCOF(IJLCOF)=POWCOF
  546.                         IF (IPRDU.EQ.1) THEN
  547.                            TABVDC.ILCPR(KDER+1,IOP,JVAR)=IJLCOF
  548.                         ELSE
  549.                            TABVDC.ILCDU(KDER+1,IOP,JVAR)=IJLCOF
  550.                         ENDIF
  551.                      ELSE
  552.                         WRITE(IOIMP,*) CPD,' ',CVD,' operator ',IOP
  553.                         WRITE(IOIMP,*) 'variable ',JVAR,
  554.      $                       ' derivative ',KDER
  555.                         WRITE(IOIMP,*) 'wrong type = ',TYPE
  556.                         WRITE(IOIMP,*) 'should be = ',TYLENT,' or ',
  557.      $                       TYENT
  558.                         GOTO 9999
  559.                      ENDIF
  560.                   ELSE
  561.                      IF (IPRDU.EQ.1) THEN
  562.                         TABVDC.ILCPR(KDER+1,IOP,JVAR)=0
  563.                      ELSE
  564.                         TABVDC.ILCDU(KDER+1,IOP,JVAR)=0
  565.                      ENDIF
  566.                   ENDIF
  567.                ENDDO
  568.             ENDDO
  569.          ENDDO
  570.       ENDDO
  571.       JLCOF=IJLCOF
  572.       SEGADJ,TABVDC
  573. *
  574. * On supprime les doublons dans les listes d'espaces de discrétisation
  575. * et on corrige les pointeurs sur cette liste
  576. *
  577.       JG=KGVD
  578.       JG=KGVD
  579.       SEGINI KREP
  580.       IKGVD2=1
  581.       KREP.LECT(1)=IKGVD2
  582.       DO IKGVD=2,KGVD
  583.          LFOUND=.FALSE.
  584.          IKGVD3=0
  585.  12      CONTINUE
  586.          IKGVD3=IKGVD3+1
  587.          IF (TABVDC.DISVD(IKGVD3).EQ.TABVDC.DISVD(IKGVD)) THEN
  588.             LFOUND=.TRUE.
  589.          ELSE
  590.             IF (IKGVD3.LT.IKGVD2) THEN
  591.                GOTO 12
  592.             ENDIF
  593.          ENDIF
  594.          IF (.NOT.LFOUND) THEN
  595.             IKGVD2=IKGVD2+1
  596.             KREP.LECT(IKGVD)=IKGVD2
  597.             TABVDC.DISVD(IKGVD2)=TABVDC.DISVD(IKGVD)
  598.          ELSE
  599.             KREP.LECT(IKGVD)=IKGVD3
  600.          ENDIF
  601.       ENDDO
  602.       KGVD=IKGVD2
  603.       SEGADJ,TABVDC
  604. *
  605.       DO IJGVD=1,JGVD
  606.          TABVDC.DJSVD(IJGVD)=KREP.LECT(TABVDC.DJSVD(IJGVD))
  607.       ENDDO
  608.       SEGSUP KREP
  609. *
  610. * On supprime les doublons dans les listes d'espaces de champs
  611. * et on corrige les pointeurs sur cette liste
  612. *
  613.       JG=JGVD
  614.       SEGINI KREP
  615.       IJGVD2=1
  616.       KREP.LECT(1)=IJGVD2
  617.       DO IJGVD=2,JGVD
  618.          LFOUND=.FALSE.
  619.          IJGVD3=0
  620.  22      CONTINUE
  621.          IJGVD3=IJGVD3+1
  622.          IF (TABVDC.DJSVD(IJGVD3).EQ.TABVDC.DJSVD(IJGVD)
  623.      $        .AND.TABVDC.NOMVD(IJGVD3).EQ.TABVDC.NOMVD(IJGVD)
  624.      $        .AND.TABVDC.TYPVD(IJGVD3).EQ.TABVDC.TYPVD(IJGVD)
  625.      $        .AND.TABVDC.MVD(IJGVD3).EQ.TABVDC.MVD(IJGVD)
  626.      $        ) THEN
  627.             LFOUND=.TRUE.
  628.          ELSE
  629.             IF (IJGVD3.LT.IJGVD2) THEN
  630.                GOTO 22
  631.             ENDIF
  632.          ENDIF
  633.          IF (.NOT.LFOUND) THEN
  634.             IJGVD2=IJGVD2+1
  635.             KREP.LECT(IJGVD)=IJGVD2
  636.             TABVDC.DJSVD(IJGVD2)=TABVDC.DJSVD(IJGVD)
  637.             TABVDC.NOMVD(IJGVD2)=TABVDC.NOMVD(IJGVD)
  638.             TABVDC.TYPVD(IJGVD2)=TABVDC.TYPVD(IJGVD)
  639.             TABVDC.MVD(IJGVD2)=TABVDC.MVD(IJGVD)
  640.             TABVDC.XVD(IJGVD2)=TABVDC.XVD(IJGVD)
  641.          ELSE
  642.             KREP.LECT(IJGVD)=IJGVD3
  643.          ENDIF
  644.       ENDDO
  645.       JGVD=IJGVD2
  646.       SEGADJ,TABVDC
  647. *
  648.       DO JVARPR=1,NUMVPR
  649.          TABVDC.VVARPR(JVARPR)=KREP.LECT(TABVDC.VVARPR(JVARPR))
  650.       ENDDO
  651.       DO JVARDU=1,NUMVDU
  652.          TABVDC.VVARDU(JVARDU)=KREP.LECT(TABVDC.VVARDU(JVARDU))
  653.       ENDDO
  654.       DO JDATPR=1,NUMDPR
  655.          TABVDC.VDATPR(JDATPR)=KREP.LECT(TABVDC.VDATPR(JDATPR))
  656.       ENDDO
  657.       DO JDATDU=1,NUMDDU
  658.          TABVDC.VDATDU(JDATDU)=KREP.LECT(TABVDC.VDATDU(JDATDU))
  659.       ENDDO
  660.       DO IJGCOF=1,JGCOF
  661.          LDAT=TABVDC.VLDAT(IJGCOF)
  662.          SEGACT LDAT*MOD
  663.          NLDAT=LDAT.LECT(/1)
  664.          DO ILDAT=1,NLDAT
  665.             LDAT.LECT(ILDAT)=KREP.LECT(LDAT.LECT(ILDAT))
  666.          ENDDO
  667.          SEGDES LDAT
  668.       ENDDO
  669.       SEGSUP KREP
  670. * On supprime les doublons dans les coefficients
  671. * et on corrige les pointeurs sur cette liste
  672.       IF (JGCOF.GT.1) THEN
  673.          JG=JGCOF
  674.          SEGINI KREP
  675.          IJGCO2=1
  676.          KREP.LECT(1)=IJGCO2
  677.          DO IJGCOF=2,JGCOF
  678.             LFOUND=.FALSE.
  679.             LDAT=TABVDC.VLDAT(IJGCOF)
  680.             IJGCO3=0
  681.  32         CONTINUE
  682.             IJGCO3=IJGCO3+1
  683.             IF (TABVDC.VCOMP(IJGCO3).EQ.TABVDC.VCOMP(IJGCOF)) THEN
  684.                LDAT3=TABVDC.VLDAT(IJGCO3)
  685.                CALL EGLENT(LDAT3,LDAT,LEGDAT,IMPR,IRET)
  686.                IF (IRET.NE.0) GOTO 9999
  687.                IF (LEGDAT) THEN
  688.                   LFOUND=.TRUE.
  689.                ENDIF
  690.             ELSE
  691.                IF (IJGCO3.LT.IJGCO2) THEN
  692.                   GOTO 32
  693.                ENDIF
  694.             ENDIF
  695.             IF (.NOT.LFOUND) THEN
  696.                IJGCO2=IJGCO2+1
  697.                KREP.LECT(IJGCOF)=IJGCO2
  698.                TABVDC.VCOMP(IJGCO2)=TABVDC.VCOMP(IJGCOF)
  699. C Je ne suis pas arrivé à savoir quand il faut supprimmer les segments
  700. C               LDAT=TABVDC.VLDAT(IJGCO2)
  701. C*               SEGACT LDAT*MOD
  702. C               SEGSUP LDAT
  703.                TABVDC.VLDAT(IJGCO2)=TABVDC.VLDAT(IJGCOF)
  704.             ELSE
  705.                KREP.LECT(IJGCOF)=IJGCO3
  706. C               LDAT=TABVDC.VLDAT(IJGCO3)
  707. C*               SEGACT LDAT*MOD
  708. C               SEGSUP LDAT
  709.             ENDIF
  710.          ENDDO
  711. C         DO IJGCOF=IJGCO2+1,JGCOF
  712. C            LDAT=TABVDC.VLDAT(IJGCOF)
  713. C*         SEGACT LDAT*MOD
  714. C            SEGSUP LDAT
  715. C         ENDDO
  716.          JGCOF=IJGCO2
  717.          SEGADJ,TABVDC
  718. *
  719.          DO JCOFPR=1,NUMCPR
  720.             TABVDC.VCOFPR(JCOFPR)=KREP.LECT(TABVDC.VCOFPR(JCOFPR))
  721.          ENDDO
  722.          DO JCOFDU=1,NUMCDU
  723.             TABVDC.VCOFDU(JCOFDU)=KREP.LECT(TABVDC.VCOFDU(JCOFDU))
  724.          ENDDO
  725. *
  726.          DO IJLCOF=1,JLCOF
  727.             POWCOF=TABVDC.VLCOF(IJLCOF)
  728.             SEGACT POWCOF
  729.             JG=JGCOF
  730.             SEGINI POWCO2
  731.             DO IPC=1,POWCOF.LECT(/1)
  732.                IPC2=KREP.LECT(IPC)
  733.                POWCO2.LECT(IPC2)=POWCO2.LECT(IPC2)+POWCOF.LECT(IPC)
  734.             ENDDO
  735.             SEGDES POWCO2
  736.             SEGSUP POWCOF
  737.             TABVDC.VLCOF(IJLCOF)=POWCO2
  738.          ENDDO
  739.          SEGSUP KREP
  740.       ENDIF
  741.  
  742. * On supprime les doublons dans les listes de coefficients
  743. * et on corrige les pointeurs sur cette liste
  744.       IF (JLCOF.GT.1) THEN
  745.          JG=JLCOF
  746.          SEGINI KREP
  747.          IJLCO2=1
  748.          KREP.LECT(1)=IJLCO2
  749.          DO IJLCOF=2,JLCOF
  750.             LFOUND=.FALSE.
  751.             LCOF=TABVDC.VLCOF(IJLCOF)
  752.             IJLCO3=0
  753.  42         CONTINUE
  754.             IJLCO3=IJLCO3+1
  755.             LCOF3=TABVDC.VLCOF(IJLCO3)
  756.             CALL EGLENT(LCOF3,LCOF,LEGCOF,IMPR,IRET)
  757.             IF (LEGCOF) THEN
  758.                LFOUND=.TRUE.
  759.             ELSE
  760.                IF (IJLCO3.LT.IJLCO2) THEN
  761.                   GOTO 42
  762.                ENDIF
  763.             ENDIF
  764.             IF (.NOT.LFOUND) THEN
  765.                IJLCO2=IJLCO2+1
  766.                KREP.LECT(IJLCOF)=IJLCO2
  767. C Je ne suis pas arrivé à savoir quand il faut supprimmer les segments
  768. C               LCOF=TABVDC.VLCOF(IJLCO2)
  769. C*               SEGACT LCOF*MOD
  770. C               SEGSUP LCOF
  771.                TABVDC.VLCOF(IJLCO2)=TABVDC.VLCOF(IJLCOF)
  772.             ELSE
  773.                KREP.LECT(IJLCOF)=IJLCO3
  774. C               LCOF=TABVDC.VLCOF(IJLCO3)
  775. C*               SEGACT LCOF*MOD
  776. C               SEGSUP LCOF
  777.             ENDIF
  778.          ENDDO
  779. C         DO IJLCOF=IJLCO2+1,JLCOF
  780. C            LCOF=TABVDC.VLCOF(IJLCOF)
  781. C*         SEGACT LCOF*MOD
  782. C            SEGSUP LCOF
  783. C         ENDDO
  784.          JLCOF=IJLCO2
  785.          SEGADJ,TABVDC
  786. *
  787.          DO IOP=1,NUMOP
  788.             DO IDER=1,NUMDER+1
  789.                DO JVARPR=1,NUMVPR
  790.                   IJLCOF=TABVDC.ILCPR(IDER,IOP,JVARPR)
  791.                   IF (IJLCOF.NE.0) THEN
  792.                      TABVDC.ILCPR(IDER,IOP,JVARPR)=
  793.      $                    KREP.LECT(IJLCOF)
  794.                   ENDIF
  795.                ENDDO
  796.                DO JVARDU=1,NUMVDU
  797.                   IJLCOF=TABVDC.ILCDU(IDER,IOP,JVARDU)
  798.                   IF (IJLCOF.NE.0) THEN
  799.                      TABVDC.ILCDU(IDER,IOP,JVARDU)=
  800.      $                    KREP.LECT(IJLCOF)
  801.                   ENDIF
  802.                ENDDO
  803.             ENDDO
  804.          ENDDO
  805.          SEGSUP KREP
  806.       ENDIF
  807. *
  808. *  On crée le champ par éléments contenant les coordonnées
  809. *  des points servant pour la transformation géométrique
  810. *  (ddl de la transformation géométrique)...
  811. *
  812.       MYDISC=TABGEO.DISGEO
  813.       CALL MKCOOR(CGEOMQ,MYDISC,
  814.      $     MYFALS,
  815.      $     ICOOR,
  816.      $     IMPR,IRET)
  817.       IF (IRET.NE.0) GOTO 9999
  818.       TABGEO.JGEO=ICOOR
  819. *
  820. *  On teste les noms des ddls des variables et des coefficients
  821. *  On verifie egalement qu'il n'y a pas de noeuds à numéro nul dans CGEOMQ
  822. *  qui pourrait etre utilises. Ces noeuds nuls sont eventuellement
  823. *  cree par TRQUAF (cf. PRLIN2) pour permettre l'utilisation d'un
  824. *  maillage non QUAF en entree de NLIN.
  825. *
  826.       DO IJGVD=1,JGVD
  827.          MYDISC=TABVDC.DISVD(TABVDC.DJSVD(IJGVD))
  828.          MYLMOT=TABVDC.NOMVD(IJGVD)
  829.          TYPCHA=TABVDC.TYPVD(IJGVD)
  830.          ICHAM=TABVDC.MVD(IJGVD)
  831.          CALL KECOM6(CGEOMQ,MYLMOT,MYDISC,TYPCHA,ICHAM,LCHAM,
  832.      $        MYFALS)
  833.          IF (IERR.NE.0) GOTO 9999
  834.       ENDDO
  835. *
  836. * On crée les champs par éléments correspondant aux éventuels
  837. * champs de variables et aux champs coefficients (globaux)
  838. *
  839.       SEGINI,TATRAV
  840.       DO IJGVD=1,JGVD
  841.          MYDISC=TABVDC.DISVD(TABVDC.DJSVD(IJGVD))
  842.          MYLMOT=TABVDC.NOMVD(IJGVD)
  843.          TYPCHA=TABVDC.TYPVD(IJGVD)
  844.          ICHAM=TABVDC.MVD(IJGVD)
  845.          MYFLOT=TABVDC.XVD(IJGVD)
  846. *         segprt,mychpo
  847.          CALL CP2CV7(CGEOMQ,MYLMOT,MYDISC,TYPCHA,ICHAM,MYFLOT,
  848.      $        MYFALS,
  849.      $        MYMCHA,
  850.      $        IMPR,IRET)
  851.          IF (IRET.NE.0) GOTO 9999
  852. *         segprt,mymcha
  853.          TATRAV.IVD(IJGVD)=MYMCHA
  854.       ENDDO
  855. *
  856. * Fin...
  857. *
  858.       SEGDES,TATRAV
  859.       SEGDES,TABVDC
  860.       SEGDES,TABGEO
  861. *      SEGPRT,TABGEO
  862. *      SEGPRT,TABVDC
  863. *
  864. * Normal termination
  865. *
  866.       IRET=0
  867.       RETURN
  868. *
  869. * Format handling
  870. *
  871. *
  872. * Error handling
  873. *
  874.  9999 CONTINUE
  875.       IRET=1
  876.       WRITE(IOIMP,*) 'An error was detected in subroutine prlin3'
  877.       RETURN
  878. *
  879. * End of subroutine PRLIN3
  880. *
  881.       END
  882.  
  883.  

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