Télécharger la plaquette Cast3M


fr en

Télécharger lekcof.eso

Retour à la liste

Numérotation des lignes : 

lekcof

  1. C LEKCOF    SOURCE    PV        22/04/22    21:15:10     11344          
  2.       SUBROUTINE LEKCOF(TITRE,MTABX,KINC,NU,IXV,
  3.      &                  MCHPOI,MPOVAL,NPT,NC,IK1,IRET)
  4. C----------------------------------------------------------------------
  5. C Ce sous programme lit le NUième coefficient d'un operateur, stocké
  6. C à l'indice ARGnu de la table KIZX de pointeur MTABX associée à
  7. C l'opérateur en cours de traitement.
  8. C Le coefficient est de type ENTIER, FLOTTANT, POINT, CHPOINT ou MOT.
  9. C----------------------------------------------------------------------
  10. C Quel que soit le type de l'objet récupéré, l'objet retourné est un
  11. C CHPOINT. Ce CHPO s'appuie sur un point bidon dans le cas ou la donnée
  12. C est un ENTIER, un FLOTTANT ou un POINT.
  13. C----------------------------------------------------------------------
  14. C HISTORIQUE : 20/09/00 : Les segments MPOVAL sont retournes actif en
  15. C                         lecture seule.
  16. C HISTORIQUE :
  17. C
  18. C
  19. C---------------------------
  20. C Paramètres Entrée/Sortie :
  21. C---------------------------
  22. C
  23. C E/  TITRE  : Commentaires pour les messages d'erreur (à supprimer)
  24. C E/  MTABX  : Pointeur de la table contenant le coefficient
  25. C E/  KINC   : Pointeur de la table INCO dans laquelle on va chercher
  26. C              les valeurs des indices lorsque ceux-ci sont des MOTS.
  27. C E/  NU     : Rang du coefficient a aller chercher (ENTIER)
  28. C E/  IXV(*) : Vecteur d'entier indiquant le type de l'objet cherché
  29. C               IXV(1) = 0 : Objet CHPO non autorisé
  30. C               IXV(1) > 0 : spg du CHPO si une composante (SCAL)
  31. C               IXV(1) < 0 : spg du CHPO si IDIM composante (VECT)
  32. C               IXV(2) = 0 : Objet FLOTTANT ou ENTIER non autorisé                                 in
  33. C               IXV(2) = 1 : Objet FLOTTANT ou ENTIER autorisé
  34. C               IXV(3) = 0 : Objet POINT non autorisé
  35. C               IXV(3) = 1 : Objet POINT autorisé
  36. C               IXV(i),i>3 : Autres spg pour CHPO (similaire à IXV(1))
  37. C                            cf IRET
  38. C  /S MCHPOI : Pointeur du CHPO contenant le coef
  39. C  /S MPOVAL : Pointeur sur le segment du CHPO contenant les coef
  40. C  /S NPT    : Nombre de point du spg du CHPO
  41. C  /S NC     : Nombre de composante du CHPO
  42. C              (on autorise 1 ou IDIM)
  43. C  /S IK1    : Indicateur retournant le type de l'objet trouvé
  44. C               0=CHPO 1=FLOTTANT 2=POINT >3=CHPO de spg IXV(ik1)
  45. C              Dans le cas ou IK1=1 ou 2 la donnée est transformée
  46. C              en CHPO et stocké à l'indice ARGSnu de la table MTABX
  47. C E/S IRET   : En entrée, =0 tentative de lecture seule
  48. C            : En entrée, =1 Si l'objet n existe pas on le cree
  49. C              si CHPOIN autorise et on le met dans la table inco
  50. C              Dans ce cas en sortie IRET=2 (ceci ne marche
  51. C              que si dime de IXV<=3
  52. C            : En entrée, si supérieur à 3 dimension de IXV,
  53. C              En sortie, indicateur de succès (0=problèmes, 1=OK ,
  54. C                                               2 si creation aveugle)
  55. C----------------------------------------------------------------------
  56. C Dans le cas ENTIER, FLOTTANT ou POINT, on construit un CHPOINT
  57. C que l'on stocke à l'indice ARGSnu de la table MTABX.
  58. C Dans le cas MOT, on récupère la donnée se trouvant à l'indice MOT
  59. C de la table INCO que l'on transforme éventuellement en CHPOINT comme
  60. C precedemment.
  61. C----------------------------------------------------------------------
  62.       IMPLICIT INTEGER(I-N)
  63.       IMPLICIT REAL*8 (A-H,O-Z)
  64. -INC PPARAM
  65. -INC CCOPTIO
  66. -INC SMCOORD
  67. -INC SMCHPOI
  68. -INC SMELEME
  69. -INC SMTABLE
  70.       POINTEUR igeom.meleme
  71.       POINTEUR MTABX.MTABLE,KINC.MTABLE
  72.       CHARACTER*(*) TITRE
  73.       CHARACTER*8 TYPE,TYPC,NOM,MARG,NARG,TYPI
  74.       LOGICAL LOGI
  75.       REAL*8 XVAL(3)
  76.       DIMENSION IXV(*)
  77. C
  78. C- Récupération du TYPE du NUième argument de l'opérateur
  79. C
  80. C     write(6,*)' DEBUT LEKCOF'
  81.       IXV1 = IRET
  82.       ISG1 = 1
  83.       IRET = 1
  84.       IF (NU.LE.0 .OR. NU.GE.100) THEN
  85.          INTERR(1) = NU
  86.          INTERR(2) = 1
  87.          INTERR(3) = 99
  88.          CALL ERREUR(789)
  89.          IRET = 0
  90.          RETURN
  91.       ENDIF
  92.       IF (NU.LE.9) THEN
  93.          WRITE(NARG,FMT='(A3,I1)')'ARG',Nu
  94.          WRITE(MARG,FMT='(A4,I1)')'ARGS',Nu
  95.       ELSE
  96.          WRITE(NARG,FMT='(A3,I2)')'ARG',Nu
  97.          WRITE(MARG,FMT='(A4,I2)')'ARGS',Nu
  98.       ENDIF
  99.       TYPE = ' '
  100.       CALL LENCHA(NARG,LC)
  101.       CALL ACCTAB(MTABX,'MOT',   0,0.D0,NARG(1:LC),LOGI,     0,
  102.      &                  TYPE ,IENT,XVAL,       NOM,LOGI,MCHPOI)
  103. C
  104. C- Argument de TYPE ENTIER ou FLOTTANT
  105. C
  106.       IF (TYPE.EQ.'FLOTTANT'.OR.TYPE.EQ.'ENTIER') THEN
  107.          IF (IXV(2).EQ.0) THEN
  108.             MOTERR(1: 8) = NARG
  109.             MOTERR(9:16) = TYPE
  110.             CALL ERREUR(787)
  111.             IRET = 0
  112.             RETURN
  113.          ENDIF
  114.          IF (TYPE.EQ.'ENTIER') XVAL(1)=FLOAT(IENT)
  115. C creation d'un champoin
  116.       NBNN=1
  117.       NBELEM=1
  118.       NBSOUS=0
  119.       NBREF=0
  120.       SEGINI MELEME
  121.       ITYPEL=1
  122.       NUM(1,1)=1
  123.       SEGDES MELEME
  124.  
  125.       NSOUPO=1
  126.       NAT=1
  127.       N=1
  128.       NC=1
  129.       SEGINI MCHPOI,MSOUPO,MPOVAL
  130.       JATTRI(1)=2
  131.       IFOPOI=IFOUR
  132.       MTYPOI=' '
  133.       MOCHDE=' '
  134.       IPCHP(1)=MSOUPO
  135.       IPOVAL=MPOVAL
  136.       NOCOMP(1)='SCAL'
  137.       SEGDES MCHPOI,MSOUPO
  138. C creation d'un champoin fin
  139.  
  140.          VPOCHA(1,1)=XVAL(1)
  141.          IK1 = 1
  142.          NPT = 1
  143.          NC  = 1
  144. C
  145. C- Argument de type CHPOINT
  146. C
  147.       ELSEIF (TYPE.EQ.'CHPOINT') THEN
  148.          IF (IXV(1).EQ.0) THEN
  149.             MOTERR(1: 8) = NARG
  150.             MOTERR(9:16) = TYPE
  151.             CALL ERREUR(787)
  152.             IRET = 0
  153.             RETURN
  154.          ENDIF
  155.          CALL LRCHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  156.  
  157.          NC=VPOCHA(/2)
  158.          MELEME = IXV(1)
  159.          IF (MELEME.LT.0) THEN
  160.             MELEME= -IXV(1)
  161.             ISG1  = -1
  162.          ENDIF
  163.          IF (IGEOM.NE.MELEME) THEN
  164. *         write (6,*) ' lekcof 1-1 ',igeom,meleme
  165.           segact igeom,meleme
  166.           igeom0=abs(igeom)
  167.           call crech1(igeom,0)
  168.           call crech1(meleme,0)
  169.          endif
  170. *         write (6,*) ' lekcof 1-2 ',igeom,meleme
  171.          IF (IGEOM.NE.MELEME) THEN
  172.             IF (IXV1.GT.3) THEN
  173.                IXV2 = IXV1 - 3
  174.                I    = 0
  175.  10            CONTINUE
  176.                I     = I + 1
  177.                IF(NC.GT.1)THEN
  178.                IGEOM=-ABS(IGEOM)
  179.                ISG1=-1
  180.                ENDIF
  181.                IF (IGEOM0.EQ.IXV(I+3)) THEN
  182.                   IK1=I+3
  183.                   GOTO 20
  184.                ENDIF
  185.                IF (I.LT.IXV2) GOTO 10
  186.             ENDIF
  187.             MOTERR(1: 8) = NARG
  188.             MOTERR(9:16) = TYPE
  189.             CALL ERREUR(788)
  190.             IRET = 0
  191.             RETURN
  192.          ELSE
  193.             IK1 = 0
  194.          ENDIF
  195.  20      CONTINUE
  196.          NPT = VPOCHA(/1)
  197.          NC  = VPOCHA(/2)
  198.          IF ( (ISG1.EQ.-1.AND.NC.NE.IDIM) .OR.
  199.      &        (ISG1.EQ.1.AND.NC.NE.1) ) THEN
  200.             MOTERR(1: 8) = NARG
  201.             MOTERR(9:16) = TYPE
  202.             CALL ERREUR(784)
  203.             IRET = 0
  204.             RETURN
  205.          ENDIF
  206. C
  207. C- Argument de type POINT
  208. C
  209.       ELSEIF (TYPE.EQ.'POINT') THEN
  210.          IF (IXV(3).EQ.0)THEN
  211.             MOTERR(1: 8) = NARG
  212.             MOTERR(9:16) = TYPE
  213.             CALL ERREUR(787)
  214.             IRET = 0
  215.             RETURN
  216.          ENDIF
  217.          IP      = MCHPOI
  218.          segact mcoord
  219.          XVAL(1) = XCOOR((IP-1)*(IDIM+1) +1)
  220.          XVAL(2) = XCOOR((IP-1)*(IDIM+1) +2)
  221.          IF (IDIM.EQ.3) XVAL(3)=XCOOR((IP-1)*(IDIM+1) +3)
  222.          IK1 = 2
  223.          NPT = 1
  224.  
  225. C creation d'un champoin
  226.       NBNN=1
  227.       NBELEM=1
  228.       NBSOUS=0
  229.       NBREF=0
  230.       SEGINI MELEME
  231.       ITYPEL=1
  232.       NUM(1,1)=1
  233.       SEGDES MELEME
  234.  
  235.       NSOUPO=1
  236.       NAT=1
  237.       N=1
  238.       NC=IDIM
  239.       SEGINI MCHPOI,MSOUPO,MPOVAL
  240.       JATTRI(1)=2
  241.       IFOPOI=IFOUR
  242.       MTYPOI=' '
  243.       MOCHDE=' '
  244.       IPCHP(1)=MSOUPO
  245.       IPOVAL=MPOVAL
  246.       NOCOMP(1)='SCAL'
  247.       SEGDES MCHPOI,MSOUPO
  248. C creation d'un champoin fin
  249.  
  250.          VPOCHA(1,1) = XVAL(1)
  251.          VPOCHA(1,2) = XVAL(2)
  252.          IF (IDIM.EQ.3) VPOCHA(1,3)=XVAL(3)
  253. C
  254. C- Argument de type MOT
  255. C-
  256. C-    TYPC : TYPE de l'objet rangé à l'indice MOT de la table KINC.
  257. C-    On considère à nouveau les cas ENTIER, FLOTTANT, POINT ou CHPO
  258. C-    que l'on traite de la meme facon que ci-dessus.
  259. C
  260.       ELSEIF(TYPE.EQ.'MOT')THEN
  261.          IF (KINC.EQ.0) THEN
  262.             MOTERR(1: 8) = NARG
  263.             MOTERR(9:16) = 'INCO    '
  264.             CALL ERREUR(785)
  265.             IRET = 0
  266.             RETURN
  267.          ENDIF
  268.          TYPC = ' '
  269.          CALL ACMO(KINC,NOM,TYPC,MCHPOI)
  270.          IF (TYPC.EQ.'CHPOINT ') THEN
  271.             IF (IXV(1).EQ.0) THEN
  272.                MOTERR(1: 8) = NARG
  273.                MOTERR(9:16) = TYPC
  274.                CALL ERREUR(787)
  275.                IRET = 0
  276.                RETURN
  277.             ENDIF
  278.             MELEME = IXV(1)
  279.             IF (MELEME.LT.0) THEN
  280.                MELEME= -IXV(1)
  281.                ISG1  = -1
  282.             ENDIF
  283.             CALL LRCHT(MCHPOI,MPOVAL,TYPE,IGEOM)
  284.             NC=VPOCHA(/2)
  285.             IF (IGEOM.NE.MELEME) THEN
  286. *         write (6,*) ' lekcof 2-1 ',igeom,meleme
  287.              segact igeom,meleme
  288.              igeomo=abs(igeom)
  289. *            call ecmail(igeom,1)
  290. *            call ecmail(meleme,1)
  291. *            segact igeom,meleme
  292.              call crech1(igeom,0)
  293.              call crech1(meleme,0)
  294.             endif
  295.             IF (IGEOM.NE.MELEME) THEN
  296. *         write (6,*) ' lekcof 2-2 ',igeom,meleme,ixv1
  297.                IF (IXV1.GT.3) THEN
  298.                   IXV2 = IXV1 - 3
  299.                   I    = 0
  300.  100              CONTINUE
  301.                   I     = I + 1
  302.                IF(NC.GT.1)THEN
  303.                IGEOM=-ABS(IGEOM)
  304.                ISG1=-1
  305.                ENDIF
  306.                IF (IGEOMO.EQ.IXV(I+3)) THEN
  307.                      IK1=I+3
  308.                      GOTO 110
  309.                   ENDIF
  310.                   IF (I.LT.IXV2) GOTO 100
  311.                ENDIF
  312.                MOTERR(1: 8) = NARG
  313.                MOTERR(9:16) = TYPC
  314.                CALL ERREUR(788)
  315.                IRET = 0
  316.                RETURN
  317.             ELSE
  318.                IK1 = 0
  319.             ENDIF
  320.  110        CONTINUE
  321.             NPT = VPOCHA(/1)
  322.             NC  = VPOCHA(/2)
  323.             IF ( (ISG1.EQ.-1.AND.NC.NE.IDIM) .OR.
  324.      &           (ISG1.EQ.1.AND.NC.NE.1) ) THEN
  325.                MOTERR(1: 8) = NARG
  326.                MOTERR(9:16) = TYPC
  327.                CALL ERREUR(784)
  328.                IRET = 0
  329.                RETURN
  330.             ENDIF
  331.          ELSEIF (TYPC.EQ.'FLOTTANT') THEN
  332.             IF (IXV(2).EQ.0) THEN
  333.                MOTERR(1: 8) = NARG
  334.                MOTERR(9:16) = TYPC
  335.                CALL ERREUR(787)
  336.                IRET = 0
  337.                RETURN
  338.             ENDIF
  339.             CALL ACMF(KINC,NOM,XVAL(1))
  340.             IK1 = 1
  341.  
  342. C creation d'un champoin
  343.       NBNN=1
  344.       NBELEM=1
  345.       NBSOUS=0
  346.       NBREF=0
  347.       SEGINI MELEME
  348.       ITYPEL=1
  349.       NUM(1,1)=1
  350.       SEGDES MELEME
  351.  
  352.       NSOUPO=1
  353.       NAT=1
  354.       N=1
  355.       NC=1
  356.       SEGINI MCHPOI,MSOUPO,MPOVAL
  357.       JATTRI(1)=2
  358.       IFOPOI=IFOUR
  359.       MTYPOI=' '
  360.       MOCHDE=' '
  361.       IPCHP(1)=MSOUPO
  362.       IPOVAL=MPOVAL
  363.       NOCOMP(1)='SCAL'
  364.       SEGDES MCHPOI,MSOUPO
  365. C creation d'un champoin fin
  366.  
  367.             VPOCHA(1,1) = XVAL(1)
  368.             NPT = 1
  369.             NC  = 1
  370.          ELSEIF (TYPC.EQ.'ENTIER') THEN
  371.             IF (IXV(2).EQ.0) THEN
  372.                MOTERR(1: 8) = NARG
  373.                MOTERR(9:16) = TYPC
  374.                CALL ERREUR(787)
  375.                IRET = 0
  376.                RETURN
  377.             ENDIF
  378.             CALL ACME(KINC,NOM,IENT)
  379.             XVAL(1) = FLOAT(IENT)
  380.  
  381. C creation d'un champoin
  382.       NBNN=1
  383.       NBELEM=1
  384.       NBSOUS=0
  385.       NBREF=0
  386.       SEGINI MELEME
  387.       ITYPEL=1
  388.       NUM(1,1)=1
  389.       SEGDES MELEME
  390.  
  391.       NSOUPO=1
  392.       NAT=1
  393.       N=1
  394.       NC=1
  395.       SEGINI MCHPOI,MSOUPO,MPOVAL
  396.       JATTRI(1)=2
  397.       IFOPOI=IFOUR
  398.       MTYPOI=' '
  399.       MOCHDE=' '
  400.       IPCHP(1)=MSOUPO
  401.       IPOVAL=MPOVAL
  402.       NOCOMP(1)='SCAL'
  403.       SEGDES MCHPOI,MSOUPO
  404. C creation d'un champoin fin
  405.  
  406.             VPOCHA(1,1) = XVAL(1)
  407.             IK1 = 1
  408.             NPT = 1
  409.             NC  = 1
  410.          ELSEIF (TYPC.EQ.'POINT') THEN
  411.             IF (IXV(3).EQ.0) THEN
  412.                MOTERR(1: 8) = NARG
  413.                MOTERR(9:16) = TYPC
  414.                CALL ERREUR(787)
  415.                IRET = 0
  416.                RETURN
  417.             ENDIF
  418.             IP      = MCHPOI
  419.          segact mcoord
  420.             XVAL(1) = XCOOR((IP-1)*(IDIM+1) +1)
  421.             XVAL(2) = XCOOR((IP-1)*(IDIM+1) +2)
  422.             IF (IDIM.EQ.3) XVAL(3)=XCOOR((IP-1)*(IDIM+1) +3)
  423.  
  424. C creation d'un champoin
  425.       NBNN=1
  426.       NBELEM=1
  427.       NBSOUS=0
  428.       NBREF=0
  429.       SEGINI MELEME
  430.       ITYPEL=1
  431.       NUM(1,1)=1
  432.       SEGDES MELEME
  433.  
  434.       NSOUPO=1
  435.       NAT=1
  436.       N=1
  437.       NC=IDIM
  438.       SEGINI MCHPOI,MSOUPO,MPOVAL
  439.       JATTRI(1)=2
  440.       IFOPOI=IFOUR
  441.       MTYPOI=' '
  442.       MOCHDE=' '
  443.       IPCHP(1)=MSOUPO
  444.       IPOVAL=MPOVAL
  445.       NOCOMP(1)='SCAL'
  446.       SEGDES MCHPOI,MSOUPO
  447. C creation d'un champoin fin
  448.  
  449.             VPOCHA(1,1) = XVAL(1)
  450.             VPOCHA(1,2) = XVAL(2)
  451.             IF (IDIM.EQ.3) VPOCHA(1,3)=XVAL(3)
  452.             IK1 = 2
  453.             NPT = 1
  454.          ELSE
  455.              IF(IXV1.EQ.1)THEN
  456.               IF(IXV(1).GT.0)THEN
  457.               NC=1
  458.               IGEOM=IXV(1)
  459.               TYPI='LEKCOF'
  460.               TYPC='CHPOINT'
  461.               CALL CRCHPT(TYPI,IGEOM,NC,MCHPOI)
  462.               CALL ECMO(KINC,NOM,TYPC,MCHPOI)
  463.               CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM0)
  464.               IRET=2
  465.               RETURN
  466.               ELSEIF(IXV(1).LT.0)THEN
  467.               NC=IDIM
  468.               IGEOM=-IXV(1)
  469.               TYPI='LEKCOF'
  470.               TYPC='CHPOINT'
  471.               CALL CRCHPT(TYPI,IGEOM,NC,MCHPOI)
  472.               CALL ECMO(KINC,NOM,TYPC,MCHPOI)
  473.               CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM0)
  474.               IRET=2
  475.               RETURN
  476.               ENDIF
  477.              ENDIF
  478.  
  479.             IF (MCHPOI.EQ.0) THEN
  480.                MOTERR( 1: 8) = NARG
  481.                MOTERR( 9:16) = NOM
  482.                MOTERR(17:24) = 'INCO    '
  483.                CALL ERREUR(786)
  484.             ELSE
  485.                MOTERR(1: 8) = NARG
  486.                MOTERR(9:16) = TYPC
  487.                CALL ERREUR(787)
  488.             ENDIF
  489.             IRET = 0
  490.             RETURN
  491.          ENDIF
  492. C
  493. C- Argument de type autre que ENTIER, FLOTTANT, POINT, CHPO ou MOT
  494. C
  495.       ELSE
  496.          MOTERR(1: 8) = NARG
  497.          MOTERR(9:16) = TYPE
  498.          CALL ERREUR(787)
  499.          IRET = 0
  500.          RETURN
  501.       ENDIF
  502. C
  503.       RETURN
  504.       END
  505.  
  506.  
  507.  
  508.  
  509.  
  510.  
  511.  
  512.  
  513.  
  514.  
  515.  
  516.  

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