Télécharger la plaquette Cast3M


fr en

Télécharger kops.eso

Retour à la liste

Numérotation des lignes : 

kops

  1. C KOPS      SOURCE    PV090527  24/08/21    16:15:42     11985          
  2. C Retour à la version de Stéphane
  3. C KOPS      SOURCE    GOUNAND   11/05/25    21:15:20     6980
  4.       SUBROUTINE KOPS
  5. C*************************************************************************
  6. C
  7. C  cet operateur effectue des operations speciales entre les CHPOINT-TRIO
  8. C
  9. C
  10. C
  11. C
  12. C*************************************************************************
  13.  
  14.       IMPLICIT INTEGER(I-N)
  15.       IMPLICIT REAL*8 (A-H,O-Z)
  16.  
  17.  
  18. -INC PPARAM
  19. -INC CCOPTIO
  20. -INC SMTABLE
  21. -INC SMLMOTS
  22. -INC SMLENTI
  23. -INC SMELEME
  24.       POINTEUR MELEMC.MELEME
  25. -INC SMCOORD
  26.  
  28.       POINTEUR MAT1.MATRIK,MAT2.MATRIK,MAT3.MATRIK,IMAT1.IMATRI
  29.  
  30.  
  31. *
  32. *      OBJET RIGIDITE
  33. *
  34.       SEGMENT STCOUP
  35.       INTEGER MCOUP(nicd,nicp)
  36.       ENDSEGMENT
  37.  
  38. *         -INC SMRIGID
  39. * Un peu dangereux si le segmet MRIGID evolue ?
  40.       SEGMENT   MRIGID
  41.       CHARACTER*8       MTYMAT
  42.       REAL*8            COERIG(NRIGEL)
  43.       INTEGER           JRIGEL(8,NRIGEL)
  44.       INTEGER           ICHOLE,IMGEO1,IMGEO2,IFORIG
  45.       INTEGER           ISUPEQ,JRCOND,JRDEPP,JRDEPD
  46.       INTEGER           JRELIM,JRGARD,JRTOT,IMLAG
  47.       INTEGER           JRSUP,IVECRI
  48.       INTEGER           MCRCNF       
  49.       ENDSEGMENT
  50. -INC SMCHPOI
  51.  
  52.       DIMENSION XVEC(3),ITINC(100)
  53.       INTEGER JMOTS
  54.       CHARACTER*8 TYPE,TYPC,TYPE1,TYPE2
  55.       PARAMETER (NBOP=32)
  56.       CHARACTER*4 NOMTOT(10)
  57.       CHARACTER*(LOCOMP) MOCOMP,NOMI
  58.       CHARACTER*8 LOPER(NBOP),MTYP,NOM,NOMC,NOMK,LXNM
  59.       CHARACTER*8 NOMKP,NOMKD
  60.       CHARACTER*8 BLAN
  61.       DATA BLAN/'        '/
  62.       DATA LOPER/'MULT    ','DIVI    ','........','........','ET      ',
  63.      &     '*       ','/       ','+       ','-       ','**      ',
  64.      &     '|<      ','>|      ','GRAD    ','ROT     ','CLIM    ',
  65.      &     'INV     ','MATRAK  ','MATRIK  ','VNIMP   ','VTIMP   ',
  66.      &     'MTABX   ','CMCTSPLT','MATIDE  ','RIGIDITE','GRADS   ',
  67.      &     'EXTRCOMP','EXTRMASS','EXTRPREC','CHANINCO','TRANSPOS',
  68.      &     'MATDIAGO','EXTRCOUP'/
  69. C***
  70.       segact mcoord
  71.       JMOTS =0
  72.       NAG   =0
  73.       NBMAT =0
  74.       IKASS =0
  75.       MCHPO1=0
  76.       MCHPO2=0
  77.       MCHPOI=0
  78.       MPOVA1=0
  79.       MPOVA2=0
  80.       XVAL1 =0.
  81.       XVAL2 =0.
  82.       NFLOT =0
  83.       MTABD =0
  84.  
  85. C     ********************************************
  86. C     * La premiere partie de cette routine      *
  87. C     * consiste a recuperer les arguments de    *
  88. C     * l operateur KOPS afin de pouvoir leurs   *
  89. C     * attribuer le traitement correspondant    *
  90. C     ********************************************
  91.  
  92.  10   CONTINUE
  93. C     On saisit le premier objet de la pile
  94. C     *************************************
  95.  
  96.       CALL QUETYP(MTYP,0,IRET)
  97.       IF(IRET.EQ.0)GO TO 9
  98. C      write(6,*)' KOPS nag=',NAG,' MTYP=',MTYP
  99.  
  100. C     ============================================
  101. C     Cas : Objet = MOT
  102. C     ============================================
  103.       IF(MTYP.EQ.'MOT')THEN
  104.          JMOTS=1
  105.  
  106. C?    CALL LIRCHA(MMOP,1,NBC)
  107. C?    CALL OPTLI(KOP,LOPER,MMOP,NBOP)
  108.  
  109.          CALL LIRMOT(LOPER,NBOP,KOP,0)
  110. c*         if (kop.eq.0) write(6,*)' KOPS ',KOP,' pas d operateur'
  111. c*         if (kop.ne.0) write(6,*)' KOPS ',KOP,LOPER(KOP)
  112.          IF(KOP.EQ.0)THEN
  113.             CALL RYO2V(IRET)
  114.             IF(IRET.EQ.0)RETURN
  115.             WRITE(6,*)' Opérateur KOPS :',KOP
  116.             WRITE(6,*)' Operation inconnue '
  117.             RETURN
  118.          ENDIF
  119.  
  120. C Cas tres tres particulier(s)
  121.  
  122. C CAS KOP=17
  123.          IF(KOP.EQ.17)THEN
  124.             NRIGE=8
  125.             NMATRI=0
  126.             NKID =9
  127.             NKMT =7
  128.             SEGINI MATRIK
  129.             SEGDES MATRIK
  130.             CALL ECROBJ('MATRIK',MATRIK)
  131.  
  132.             RETURN
  133.          ENDIF
  134.  
  135. C CAS KOP=18
  136.          IF(KOP.EQ.18)THEN
  137.             NRIGE=7
  138.             NMATRI=0
  139.             NKID =9
  140.             NKMT =7
  141.             SEGINI MATRIK
  142.             SEGDES MATRIK
  143.             CALL ECROBJ('MATRIK',MATRIK)
  144.  
  145.             NAT=2
  146.             NSOUPO=0
  147.             SEGINI MCHPOI
  148.             MTYPOI = '        '
  149.             MOCHDE = '        '
  150.             JATTRI(1)=2
  151.             IFOPOI = IFOUR
  152.             SEGDES MCHPOI
  153.             CALL ECROBJ('CHPOINT',MCHPOI)
  154.  
  155.             RETURN
  156.          ENDIF
  157.  
  158. C CAS KOP=19
  159.          IF(KOP.EQ.19)THEN
  160.  
  161.             CALL VNIMP
  162.  
  163.             RETURN
  164.          ENDIF
  165.  
  166. C CAS KOP=20
  167.          IF(KOP.EQ.20)THEN
  168.  
  169.             CALL VTIMP
  170.  
  171.             RETURN
  172.          ENDIF
  173.  
  174. C CAS KOP=21 MTABX
  175.          IF(KOP.EQ.21)THEN
  176.  
  177.             CALL LIROBJ('TABLE',MTABX,1,IRET)
  178.             IF(IRET.EQ.0)RETURN
  179.             CALL LIRREE(DTR,1,IRET)
  180.             IF(IRET.EQ.0)RETURN
  181.             KKIZG=0
  182.             TYPE=' '
  183.             CALL ACMO(MTABX,'KIZG',TYPE,KIZG)
  184.             IF(KIZG.NE.0)THEN
  185.                TYPE=' '
  186.                CALL ACMO(MTABX,'LISTINCO',TYPE,MLMOTS)
  187.                IF(MLMOTS.EQ.0)RETURN
  188.                SEGACT MLMOTS
  189.                NBMOT=MOTS(/2)
  190.                DO 36476 I=1,NBMOT
  191.                   NOMI=MOTS(I)
  192.                   TYPE=' '
  193.                   CALL ACMO(KIZG,NOMI,TYPE,MCHPOI)
  194.                   IF(TYPE.NE.'CHPOINT')GO TO 36476
  195.                   SEGACT MCHPOI
  196.                   NSOUPO=IPCHP(/1)
  197.                   IF(NSOUPO.NE.1)RETURN
  198.                   MSOUPO=IPCHP(1)
  199.                   SEGACT MSOUPO
  200.                   NC=NOCOMP(/2)
  201.                   DO 36477 J=1,NC
  202.                      IF(NC.NE.1.AND.NC.LT.10)THEN
  203.                         WRITE(MOCOMP,FMT='(I1,A7)')J,NOMI(1:LOCOMP-1)
  204.                      ELSEIF(NC.EQ.1)THEN
  205.                         WRITE(MOCOMP,FMT='(A8)')NOMI
  206.                      ELSE
  207.                         RETURN
  208.                      ENDIF
  209.                      NOCOMP(J)=MOCOMP
  210. 36477             CONTINUE
  211.                   KKIZG=1
  212.                   CALL ECROBJ('CHPOINT ',MCHPOI)
  213.                   CALL ECRREE(-1.D0)
  214.                   CALL OPERMU
  215.                   IF(I.GT.1)CALL OPERAD
  216. 36476          CONTINUE
  217.             ENDIF
  218.  
  219.             IF(KKIZG.NE.0)THEN
  220.                CALL ECRREE(DTR)
  221.                CALL OPERMU
  222.             ENDIF
  223.  
  224.             TYPE=' '
  225.             CALL ACMO(MTABX,'SMBR',TYPE,MCHPOI)
  226.             IF(TYPE.EQ.'CHPOINT')THEN
  227.                CALL ECROBJ('CHPOINT ',MCHPOI)
  228.                IF(KKIZG.NE.0)CALL OPERAD
  229.             ELSE
  230.                IF(KKIZG.EQ.0)CALL ECRREE(1.D0)
  231.             ENDIF
  232.  
  233.             CALL ECME(MTABX,'SMBR',1)
  234.  
  235.             RETURN
  236.          ENDIF
  237.  
  238. C CAS KOP=22
  239.          IF(KOP.EQ.22)THEN
  240.  
  241.             CALL SPLTCC
  242.  
  243.             RETURN
  244.          ENDIF
  245.  
  246. C KAS KOP=23 ('MATIDE')
  247.  
  248.          IF(KOP .EQ. 23)THEN
  249.             CALL KOPSID
  250.             RETURN
  251.          ENDIF
  252.  
  253. C CAS KOP=24
  254.          IF(KOP.EQ.24)THEN
  255.             NRIGE=8
  256.             NRIGEL=0
  257.             SEGINI MRIGID
  258.             MTYMAT='        '
  259.             IFORIG=IFOUR
  260.             SEGDES MRIGID
  261.             CALL ECROBJ('RIGIDITE',MRIGID)
  262.  
  263.             NAT=2
  264.             NSOUPO=0
  265.             SEGINI MCHPOI
  266.             MTYPOI = '        '
  267.             MOCHDE = '        '
  268.             JATTRI(1)=2
  269.             IFOPOI = IFOUR
  270.             SEGDES MCHPOI
  271.             CALL ECROBJ('CHPOINT',MCHPOI)
  272.  
  273.             RETURN
  274.          ENDIF
  275. C
  276. C CAS KOP=25 'GRADS'
  277.          IF(KOP.EQ.25)THEN
  278.             GO TO 10
  279.          ENDIF
  280. C
  281. C CAS KOP=26 'EXTRCOMP'
  282.          IF(KOP.EQ.26)THEN
  283.             CALL LIRCHA(NOMC,1,IRET)
  284.             CALL LIRCHA(NOMK,1,IRET)
  285.             IF(IRET.EQ.0)RETURN
  286.             CALL LIROBJ('MATRIK',MAT1,1,IRET)
  287.             IF(IRET.EQ.0)RETURN
  288.  
  289.             SEGACT MAT1
  290.             NRIGE =MAT1.IRIGEL(/1)
  291.             NMATRI=MAT1.IRIGEL(/2)
  292.             NMATRI=0
  293.             NKID  =MAT1.KIDMAT(/1)
  294.             NKMT  =MAT1.KKMMT(/1)
  295.             SEGINI MATRIK
  296.             CALL RSETI(KIDMAT,MAT1.KIDMAT,NKID)
  297.             CALL RSETI(KKMMT ,MAT1.KKMMT ,NKMT)
  298.             KSYM  = MAT1.KSYM
  299.             mincp= MAT1.KMINC
  300.             if(mincp.ne.0)then
  301.                segact mincp
  302.                nbi= mincp.LISINC(/2)
  303.                npt= mincp.NPOS(/1)-1
  304.                segini minc
  305.                call rseti(npos,mincp.npos,npt+1)
  306.                call rseti(mpos,mincp.mpos,(npt*(nbi+1)))
  307.                lisinc(1)=NOMK
  308.                if(nbi.ne.1)then
  309.                   write(6,*)' Gross Pb NBI=',nbi
  310.                   write(6,*)(mincp.lisinc(ii),ii=1,nbi)
  311.                   call arret (0)
  312.                endif
  313.                KMINC = minc
  314.                KMINCP= minc
  315.                KMINCD= minc
  316.             endif
  317.  
  318.             KIZM  = MAT1.KIZM
  319.  
  320.             KISPGT= MAT1.KISPGT
  321.             KISPGP= MAT1.KISPGP
  322.             KISPGD= MAT1.KISPGD
  323.  
  324.             KNTTT = MAT1.KNTTT
  325.             KNTTP = MAT1.KNTTP
  326.             KNTTD = MAT1.KNTTD
  327.  
  328.             NMATR1=MAT1.IRIGEL(/2)
  329. c         write(6,*)'NMATR1=',NMATR1
  330.             do 6432 lm=1, NMATR1
  331.                IMAT1=MAT1.irigel(4,lm)
  332.                segact imat1
  333.                nbmf=IMAT1.LISPRI(/2)
  334. c          write(6,*)' NBMF=',nbmf
  335.  
  336.             LXNM='LX'//NOMC(1:2)
  337.                do 6433 lmf=1,nbmf
  338.                       NOMKP=NOMK
  339.                       NOMKD=NOMK
  340.                   if(NOMC.eq.IMAT1.LISPRI(lmf)
  341.      &            .OR.LXNM.eq.IMAT1.LISPRI(lmf))then
  342.                    if(LXNM.eq.IMAT1.LISPRI(lmf))NOMKP='LX'//NOMK(1:2)
  343.  
  344.                      if(NOMC.NE.IMAT1.LISDUA(lmf)
  345.      &                .AND.LXNM.NE.IMAT1.LISDUA(lmf))then
  346.             write(6,*)' On a perdu ', nomc,lmf
  347.                         call erreur(153)
  348.                         return
  349.                      endif
  350.                    if(LXNM.eq.IMAT1.LISDUA(lmf))NOMKD='LX'//NOMK(1:2)
  351.                      NMATRI=NMATRI+1
  352.                      segadj MATRIK
  353.                      do 6434 i7=1,7
  354.                         irigel(i7,nmatri)=mat1.irigel(i7,lm)
  355.  6434                continue
  356.  
  357.                      nbme=1
  358.                      nbsous=IMAT1.lizafm(/1)
  359.                      segini IMATRI
  360.                      irigel(4,nmatri)=IMATRI
  361.                      KSPGP=IMAT1.KSPGP
  362.                      KSPGD=IMAT1.KSPGD
  363.                      LISPRI(1)=NOMKP
  364.                      LISDUA(1)=NOMKD
  365.                      do 6435 is=1,nbsous
  366.                         LIZAFM(is,1)=IMAT1. LIZAFM(is,lmf)
  367.  6435                continue
  368.  
  369.  
  370.                   endif
  371.  6433          continue
  372.  6432       continue
  373.  
  374.             SEGDES MATRIK
  375.             CALL ECROBJ('MATRIK',MATRIK)
  376.             RETURN
  377.          ENDIF
  378. C
  379. C
  380. C CAS KOP=32 'EXTRCOUP'
  381.          IF(KOP.EQ.32)THEN
  382.             CALL LIROBJ('MATRIK',MAT1,1,IRET)
  383.             IF(IRET.EQ.0)RETURN
  384.             CALL ECROBJ('MATRIK',MAT1)
  385.             CALL EXTIPD
  386.             CALL LIROBJ('LISTMOTS',MLMOT1,1,IRET)
  387.             CALL LIROBJ('LISTMOTS',MLMOT2,1,IRET)
  388.             SEGACT MLMOT1
  389.             SEGACT MLMOT2
  390.             nicp=MLMOT1.MOTS(/2)
  391.             nicd=MLMOT2.MOTS(/2)
  392.             SEGINI STCOUP
  393.             CALL INITI(MCOUP,(nicp*nicd),0)
  394. *           write(6,*)(MLMOT1.MOTS(ii),ii=1,nicp)
  395. *           write(6,*)(MLMOT2.MOTS(ii),ii=1,nicd)
  396.  
  397.             SEGACT MAT1
  398.  
  399.             NMATR1=MAT1.IRIGEL(/2)
  400.             do 7432 lm=1, NMATR1
  401.                IMAT1=MAT1.irigel(4,lm)
  402.                segact imat1
  403.                nbmf=IMAT1.LISPRI(/2)
  404.  
  405.                do 7433 lmf=1,nbmf
  406.                  NOMKP=IMAT1.LISPRI(lmf)
  407.                  NOMKD=IMAT1.LISDUA(lmf)
  408. c                write(6,*)NOMKP,'----',NOMKD
  409.                  CALL OPTLI4(IP1,MLMOT1.MOTS,NOMKP(1:4),nicp)
  410.                  CALL OPTLI4(IP2,MLMOT2.MOTS,NOMKD(1:4),nicd)
  411.                  MCOUP(IP2,IP1)=1
  412.  7433          continue
  413.  7432       continue
  414.  
  415. c           write(6,*)' MCOUP ',nicp,nicd
  416. c           do 7400 k=1,nicp
  417. c           write(6,*)(MCOUP(k,i),i=1,nicd)
  418. c7400       continue
  419.  
  420.  
  421.             IF(nicp.NE.nicd)THEN
  422.             write(6,*)' ERREUR nicp ne nicd ',nicp,nicd
  423.             return
  424.             ENDIF
  425.  
  426.  
  427.             CALL CRTABL(MTABLE)
  428.             npart=0
  429.  
  430.             do 7401 k=1,nicp
  431.  
  432.             JGN=LOCOMP
  433.             JGM=0
  434.             segini MLMOT3
  435.             I0=MCOUP(k,k)
  436.  
  437.             IF(I0.EQ.0)THEN
  438.             write(6,*)' ERREUR : La diagonale est nule'
  439.             return
  440.             ENDIF
  441.  
  442.             IF(I0.EQ.-1)GO TO 7401
  443.             JGM=JGM+1
  444.             SEGADJ MLMOT3
  445.             MLMOT3.MOTS(JGM)=MLMOT2.MOTS(k)
  446.             MCOUP(k,k)=-1
  447.  
  448.             it=0
  449.             do 7402 m=1,nicd
  450.             I1=MCOUP(k,m)
  451.             IF(I1.EQ.1)THEN
  452.             it=it+1
  453.             itinc(it)=i1
  454.             JGM=JGM+1
  455.             SEGADJ MLMOT3
  456.             MLMOT3.MOTS(JGM)=MLMOT2.MOTS(m)
  457.             MCOUP(k,m)=-1
  458.             MCOUP(m,m)=-1
  459.             ENDIF
  460.  7402 continue
  461.  
  462.  7405 continue
  463.             itp=0
  464.             do      j=1,it
  465.             il=itinc(j)
  466.  
  467.             do      m=1,nicd
  468.             I1=MCOUP(k,m)
  469.             IF(I1.EQ.1)THEN
  470.             itp=itp+1
  471.             itinc(itp)=i1
  472.             JGM=JGM+1
  473.             SEGADJ MLMOT3
  474.             MLMOT3.MOTS(JGM)=MLMOT2.MOTS(m)
  475.             MCOUP(il,m)=-1
  476.             ENDIF
  477.             enddo
  478.             enddo
  479.             do 7404 m=1,itp
  480.             itinc(m)=itinc(m+it)
  481.  7404       continue
  482.             it=itp
  483.             IF(ITP.NE.0)go to 7405
  484.             npart=npart+1
  485.             segdes MLMOT3
  486.       CALL ECCTAB(MTABLE,'ENTIER',npart,0.D0,BLAN,.TRUE.,0,
  487.      1  'LISTMOTS',0,0.D0,BLAN,.TRUE.,MLMOT3)
  488.  
  489.  7401    continue
  490.  
  491.             SEGSUP STCOUP
  492.             SEGDES MTABLE,MLMOT3
  493.             CALL ECROBJ('TABLE',MTABLE)
  494.             RETURN
  495.          ENDIF
  496. C
  497. C
  498. C CAS KOP=27 'EXTRMASS' ou 'EXTRPREC'
  499.          IF(KOP.EQ.27.OR.KOP.EQ.28)THEN
  500.             CALL LIRCHA(NOMC,1,IRET)
  501.             CALL LIRCHA(NOMK,1,IRET)
  502.             IF(IRET.EQ.0)RETURN
  503.             CALL LIROBJ('MATRIK',MAT1,1,IRET)
  504.             IF(IRET.EQ.0)RETURN
  505.  
  506.             SEGACT MAT1
  507.             NRIGE =MAT1.IRIGEL(/1)
  508.             NMATRI=MAT1.IRIGEL(/2)
  509.             NMATRI=0
  510.             NKID  =MAT1.KIDMAT(/1)
  511.             NKMT  =MAT1.KKMMT(/1)
  512.             SEGINI MATRIK
  513.             CALL RSETI(KIDMAT,MAT1.KIDMAT,NKID)
  514.             CALL RSETI(KKMMT ,MAT1.KKMMT ,NKMT)
  515.             KSYM  = MAT1.KSYM
  516.             mincp= MAT1.KMINC
  517.             if(mincp.ne.0)then
  518.                segact mincp
  519.                nbi= mincp.LISINC(/2)
  520.                npt= mincp.NPOS(/1)-1
  521.                segini minc
  522.                call rseti(npos,mincp.npos,npt+1)
  523.                call rseti(mpos,mincp.mpos,(npt*(nbi+1)))
  524.                lisinc(1)=NOMK
  525.                if(nbi.ne.1)then
  526.                   write(6,*)' Gross Pb NBI=',nbi
  527.                   write(6,*)(mincp.lisinc(ii),ii=1,nbi)
  528.                   call arret (0)
  529.                endif
  530.                KMINC = minc
  531.                KMINCP= minc
  532.                KMINCD= minc
  533.             endif
  534.  
  535.             KIZM  = MAT1.KIZM
  536.  
  537.             KISPGT= MAT1.KISPGT
  538.             KISPGP= MAT1.KISPGP
  539.             KISPGD= MAT1.KISPGD
  540.  
  541.             KNTTT = MAT1.KNTTT
  542.             KNTTP = MAT1.KNTTP
  543.             KNTTD = MAT1.KNTTD
  544.  
  545.             NMATR1=MAT1.IRIGEL(/2)
  546. c         write(6,*)'NMATR1=',NMATR1
  547.             do 6532 lm=1, NMATR1
  548.                IMAT1=MAT1.irigel(4,lm)
  549.                segact imat1
  550.                nbmf=IMAT1.LISPRI(/2)
  551. c          write(6,*)' NBMF=',nbmf
  552.  
  553.                do 6533 lmf=1,nbmf
  554.                   if(NOMC.eq.IMAT1.LISPRI(lmf))then
  555.                      if(NOMC.NE.IMAT1.LISDUA(lmf))then
  556. c           write(6,*)' On a perdu ', nomc,lmf
  557.                         call erreur(5)
  558.                         return
  559.                      endif
  560. c           write(6,*)' On a gagne ', nomc,lmf
  561.                      NMATRI=NMATRI+1
  562.                      segadj MATRIK
  563.                      do 6534 i7=1,7
  564.                         irigel(i7,nmatri)=mat1.irigel(i7,lm)
  565.  6534                continue
  566.  
  567.                      nbme=1
  568.                      nbsous=IMAT1.lizafm(/1)
  569.                      segini IMATRI
  570.                      irigel(4,nmatri)=IMATRI
  571.                      KSPGP=IMAT1.KSPGP
  572.                      KSPGD=IMAT1.KSPGD
  573.                      LISPRI(1)=NOMK
  574.                      LISDUA(1)=NOMK
  575.                      do 6535 is=1,nbsous
  576. c?         LIZAFM(is,1)=IMAT1. LIZAFM(is,lmf)
  577.  6535                continue
  578.  
  579.  
  580.                   endif
  581.  6533          continue
  582.  6532       continue
  583.             SEGDES MATRIK
  584.             CALL ECROBJ('MATRIK',MATRIK)
  585.             RETURN
  586.          ENDIF
  587. C
  588. * Option CHANINCO idem opérateur 'CHANGER' 'INCO'
  589. * mais pour les matrik et pour les rigidités y compris les multiplicateurs
  590.          IF (KOP.EQ.29) THEN
  591. * MAtrik CHanger INco
  592.             CALL MACHIN
  593.             RETURN
  594.          ENDIF
  595. C
  596. * Option TRANSPOS transpose une matrice
  597. * (matrik ou rigidité)
  598.          IF (KOP.EQ.30) THEN
  599. * TRanSpose MaTrice
  600.             CALL TRSMAT
  601.             RETURN
  602.          ENDIF
  603. C
  604. * Option MATIAGO pour créer une matrice diagonale
  605.          IF (KOP .EQ. 31) THEN
  606.            CALL KOPDIA
  607.            RETURN
  608.          ENDIF
  609. C
  610.          GO TO 10
  611.  
  612. C     ==============================================
  613. C     Cas : Objet = FLOTTANT ou ENTIER
  614. C     ==============================================
  615.       ELSEIF(MTYP.EQ.'FLOTTANT'.OR.MTYP.EQ.'ENTIER')THEN
  616.          NAG=NAG+1
  617.          NFLOT=NFLOT+1
  618.          IF(NAG.GT.2)GO TO 91
  619.          IF((NAG.EQ.1).OR.(NBMAT.EQ.1)) THEN
  620.             CALL LIRREE(XVAL,1,IRET)
  621.             XVAL1=XVAL
  622.             GO TO 10
  623.          END IF
  624.          IF(NAG.EQ.2)CALL LIRREE(XVAL,1,IRET)
  625.          XVAL2=XVAL
  626.          GO TO 10
  627.  
  628. C     =============================================
  629. C     Cas : Objet = CHPOINT
  630. C     =============================================
  631.       ELSEIF(MTYP.EQ.'CHPOINT')THEN
  632.          NAG=NAG+1
  633.          IF(NAG.GT.2)GO TO 91
  634.          IF ((NAG.EQ.1).OR.(NBMAT.EQ.1))THEN
  635.             CALL LIROBJ('CHPOINT',MCHPO1,1,IRET)
  636.             CALL LICHT(MCHPO1,MPOVA1,TYPE1,IGEOM1)
  637.          ELSE
  638.             CALL LIROBJ('CHPOINT',MCHPO2,1,IRET)
  639.             IF(KOP.NE.15)THEN
  640.                CALL LICHT(MCHPO2,MPOVA2,TYPE2,IGEOM2)
  641.             ELSE
  642.                GO TO 20
  643.             ENDIF
  644.          ENDIF
  645.  
  646. C     ============================================
  647. C     Cas : Objet = TABLE
  648. C     ============================================
  649.       ELSEIF(MTYP.EQ.'TABLE'.OR.MTYP.EQ.'MMODEL')THEN
  650.          NAG=NAG+1
  651.          IF(NAG.GT.2)GO TO 91
  652. C?       CALL LITABS('DOMAINE ',MTABD,1,1,IRET)
  653.          CALL LITDMD(MMODEL,MTABD,IRET)
  654.          IF(IRET.EQ.0)RETURN
  655.          IF(MTABD.EQ.0)CALL LEKMOD(MMODEL,MTABD,INEFMD)
  656. C INEFMD=1 LINE  =2 MACRO  =3 QUADRATIQUE
  657.  
  658. C     ============================================
  659. C     Cas : Objet = POINT
  660. C     ============================================
  661.       ELSEIF(MTYP.EQ.'POINT')THEN
  662.          NAG=NAG+1
  663.          IF(NAG.GT.2)GO TO 91
  664.          CALL LIROBJ('POINT',MPOINT,1,IRET)
  665.          IF(NAG.EQ.1)IKASS=4
  666.          IF(NAG.EQ.2)IKASS=5
  667.          XVEC(1)=XCOOR((MPOINT-1)*(IDIM+1)    +1)
  668.          XVEC(2)=XCOOR((MPOINT-1)*(IDIM+1)    +2)
  669.          IF(IDIM.EQ.3)XVEC(3)=XCOOR((MPOINT-1)*(IDIM+1)+3)
  670. C      Si MPOVA1 n'est pas initialise, il peut poser
  671. C      des problemes dans la partie 'operations'
  672.  
  673.          MPOVA1 = 0
  674. C     ===========================================
  675. C     Cas Objet = MATRIK
  676. C     ===========================================
  677.       ELSEIF(MTYP.EQ.'MATRIK')THEN
  678.          NAG=NAG+1
  679.          IF(NAG.GT.2)GO TO 91
  680.          NBMAT=NBMAT+1
  681.          IF (NBMAT.EQ.1) THEN
  682.             CALL LIROBJ('MATRIK',MAT1,1,IRET)
  683.          ELSEIF (NBMAT.EQ.2) THEN
  684.             CALL LIROBJ('MATRIK',MAT2,1,IRET)
  685.          END IF
  686.          IF (NBMAT.EQ.1) IKASS=6
  687.          IF (NBMAT.EQ.2) IKASS=7
  688.  
  689. C     ===========================================
  690. C     Cas Objet non prevu
  691. C     ===========================================
  692.       ELSE
  693.          MOTERR(1:8)=MTYP
  694.          CALL ERREUR(39)
  695. *         WRITE(6,*)' Opérateur KOPS :'
  696. *         WRITE(6,*)' Type d''objet :',MTYP,' non prevu'
  697.          RETURN
  698.       ENDIF
  699.  
  700.  
  701.       GO TO 10
  702.  
  703. C     *****************************************
  704. C     *  Deuxieme partie                      *
  705. C     * On effectue ici une batterie de tests *
  706. C     * afin de determiner si on fait des     *
  707. C     * operations valides                    *
  708. C     *****************************************
  709.  9    CONTINUE
  710.       IF (JMOTS.EQ.0) THEN
  711.         moterr(1:8)='MOTS   '
  712.         call erreur(37)
  713.         RETURN
  714.       ENDIF
  715.       IKAS=3
  716.       IF(MCHPO1.EQ.0)IKAS=1
  717.       IF(MCHPO2.EQ.0)IKAS=2
  718.       IF((MCHPO1.EQ.0.AND.MCHPO2.EQ.0).AND.NBMAT.EQ.0)THEN
  719.          WRITE(6,*)' Opérateur KOPS :'
  720.          WRITE(6,*)' Il n''y a pas de CHPOINT ?? '
  721.          RETURN
  722.       ENDIF
  723.       IF(IKASS.NE.0)IKAS=IKASS
  724. C     write(6,*)' MCHPO1,MCHPO2=',MCHPO1,MCHPO2,IKAS,IKASS
  725. C    &,' KOP=',KOP
  726.  
  727.       IF(IKAS.EQ.3)THEN
  728.  
  729.          IF(IGEOM1.NE.IGEOM2)THEN
  731.             NBCOMP=-1
  732.             CALL QUEPOI(MCHPO2,IGEOM1,INDIC,NBCOMP,NOMTOT)
  733. C         write(6,*)' indic,nbcom=',indic,nbcom
  734.             CALL LICHT(MCHPO2,MPOVA2,TYPE2,IGEOM2)
  735.             IF(INDIC.LT.0)THEN
  736.                WRITE(6,*)' Opérateur KOPS :'
  737.                WRITE(6,*)' Les deux champs n''ont pas le meme support '
  738.      &              ,'geometrique ou pire '
  739.                WRITE(6,*)' IGEOM1=',IGEOM1,' IGEOM2=',IGEOM2
  740.                RETURN
  741.             ENDIF
  742.          ENDIF
  743.  
  744.          IF(MPOVA1.EQ.0.AND.IGEOM1.EQ.0)THEN
  745. C          WRITE(6,*)'CAS OU LES CHPOINTS SONT VIDE'
  746.             NC1=0
  747.             NC2=0
  748.             NS=0
  749.          ELSE
  750.             NC1=MPOVA1.VPOCHA(/2)
  751.             NC2=MPOVA2.VPOCHA(/2)
  752.             NS =MPOVA1.VPOCHA(/1)
  753.          ENDIF
  754.  
  755.          NC=NC1
  756.          NCK=NC
  757.          IGEOM=IGEOM1
  758.          TYPE=TYPE1
  759.          IF(NC1.NE.NC2)THEN
  760.             IF(NC1.EQ.1.AND.NC2.EQ.IDIM.AND.KOP.EQ.6)THEN
  761.                NC=NC1
  762.                NCK=NC2
  763.             ELSE
  764.                WRITE(6,*)' Opérateur KOPS :'
  765.                WRITE(6,*)' Les deux champs n''ont pas le meme nombre ',
  766.      &              'de composante'
  767.                RETURN
  768.             ENDIF
  769.          ELSE
  770.             IF(KOP.EQ.6)IKAS=6
  771.          ENDIF
  772.  
  773.  
  774.       ENDIF
  775.  
  776.       IF(IKAS.EQ.1)THEN
  777.          IF(MPOVA2.EQ.0.AND.IGEOM2.EQ.0)THEN
  778. C         WRITE(6,*)'CAS OU LE CHPOINT2 EST VIDE'
  779.             NS=0
  780.             NC=0
  781.          ELSE
  782.             NS=MPOVA2.VPOCHA(/1)
  783.             NC=MPOVA2.VPOCHA(/2)
  784.          ENDIF
  785.  
  786.          NC2=NC
  787.          NCK=NC
  788.          IGEOM=IGEOM2
  789.          TYPE=TYPE2
  790.  
  791.       ELSEIF(IKAS.EQ.2)THEN
  792.          IF(MPOVA1.EQ.0.AND.IGEOM1.EQ.0)THEN
  793. C          WRITE(6,*)'CAS OU LE CHPOINT1 EST VIDE'
  794.             NS=0
  795.             NC=0
  796.          ELSE
  797.             NS=MPOVA1.VPOCHA(/1)
  798.             NC=MPOVA1.VPOCHA(/2)
  799.          ENDIF
  800.          NC2=NC
  801.          NCK=NC
  802.          IGEOM=IGEOM1
  803.          TYPE=TYPE1
  804.  
  805.       ELSEIF(IKAS.EQ.4)THEN
  806.          NS=MPOVA2.VPOCHA(/1)
  807.          NC=MPOVA2.VPOCHA(/2)
  808.          IF(NC.NE.1)THEN
  809.             WRITE(6,*)' Opérateur KOPS :'
  810.             WRITE(6,*)' Le champoint doit etre scalaire dans ce cas '
  811.             RETURN
  812.          ENDIF
  813.          NC2=IDIM
  814.          NCK=IDIM
  815.          IGEOM=IGEOM2
  816.          TYPE=TYPE2
  817.       ELSEIF(IKAS.EQ.5)THEN
  818.          NS=MPOVA1.VPOCHA(/1)
  819.          NC=MPOVA1.VPOCHA(/2)
  820.          IF(NC.NE.1)THEN
  821.             WRITE(6,*)' Opérateur KOPS :'
  822.             WRITE(6,*)' Le champoint doit etre scalaire dans ce cas '
  823.             RETURN
  824.          ENDIF
  825.          NC2=IDIM
  826.          NCK=IDIM
  827.          IGEOM=IGEOM1
  828.          TYPE=TYPE1
  829.       ENDIF
  830.  
  831.  20   CONTINUE
  832.       IF(KOP.EQ.25)GO TO 31
  833.       GO TO (21,22,23,24,25,21,22,26,27,28,29,30,31,32,33,34),KOP
  834.  
  835. C     ************************************
  836. C     *  Dans cette partie on effectue   *
  837. C     * les operations                   *
  838. C     ************************************
  839.  
  840. C MULT
  841.  21   CONTINUE
  842.  
  843. C     =======================
  844. C     PRODUIT 2 OBJETS MATRIK
  845. C     =======================
  846.       IF(NBMAT.EQ.2) THEN
  847.          CALL ETOILE(MAT1,MAT2,MAT3,IRET)
  848.  
  849.          IF (IRET.NE.0) THEN
  850.             WRITE(6,*) 'Pb dans ETOILE'
  851.             RETURN
  852.          END IF
  853.  
  854.          CALL ECROBJ('MATRIK',MAT3)
  855.  
  856. C     =============================
  857. C     PRODUIT OBJET MATRIK FLOTTANT
  858. C     =============================
  859.       ELSEIF ((NBMAT.EQ.1).AND.(NFLOT.EQ.1)) THEN
  860.  
  861.          CALL PRDMF(XVAL1,MAT1,MAT2)
  862.          CALL ECROBJ('MATRIK',MAT2)
  863.  
  864. C     =============================
  865. C     PRODUIT OBJET MATRIK CHPOINT
  866. C     =============================
  867.       ELSEIF ((NBMAT.EQ.1).AND.(MCHPO1.NE.0)) THEN
  868.          CALL PRDMCP(MAT1,MCHPO1,MCHPO2)
  869.          CALL ECROBJ('CHPOINT',MCHPO2)
  870. C     =============================
  871.  
  872.       ELSE
  873.          CALL CRCHPT(TYPE,IGEOM,NCK,MCHPOI)
  874.          CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  875. C CB215821 : pour eviter le plantage en compilcd lorsque MPOVA1=0 ...
  876.          IF (MPOVAL .NE. 0) THEN
  877.           IF (MPOVA1 .EQ. 0) MPOVA1 = MPOVAL
  878.           IF(IKAS.EQ.1)THEN
  879.             CALL KOPS1(MPOVAL.VPOCHA,MPOVA2.VPOCHA,MPOVA2.VPOCHA,XVAL1,
  880.      &           XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  881.           ELSEIF(IKAS.EQ.2)THEN
  882.             CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA1.VPOCHA,XVAL1,
  883.      &           XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  884.           ELSE
  885. C     segact mchpoi
  886. C     write(6,*)' segact ok avt kops1 ',kop
  887.             CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA2.VPOCHA,XVAL1,
  888.      &           XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  889.           ENDIF
  890.         ENDIF
  891. C     segact mchpoi
  892. C     write(6,*)' segact ok apr kops1 '
  893. C     write(6,*)' MCHPOI=',mchpoi
  894.          CALL ECROBJ('CHPOINT ',MCHPOI)
  895.       END IF
  896.  
  897.       GO TO 89
  898.  
  899.  
  900. C DIVI
  901.  22   CONTINUE
  902.  
  903.       CALL CRCHPT(TYPE,IGEOM,NC,MCHPOI)
  904.       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  905. C CB215821 : pour eviter le plantage en compilcd lorsque MPOVA1=0 ...
  906.          IF (MPOVAL .NE. 0) THEN
  907.          IF (MPOVA1 .EQ. 0) MPOVA1 = MPOVAL
  908. C     write(6,*)' MCHPOI=',mchpoi,IKAS
  909. C     write(6,*)' NC,NC2,NS=',NC,NC2,NS
  910.       IF(IKAS.EQ.1)THEN
  911.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA2.VPOCHA,MPOVA2.VPOCHA,XVAL1
  912.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  913.       ELSEIF(IKAS.EQ.2)THEN
  914.          segact mchpoi,mchpo1,mpoval,mpova1
  915.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA1.VPOCHA,XVAL1
  916.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  917.          segact mchpoi,mchpo1,mpoval,mpova1
  918.       ELSE
  919.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA2.VPOCHA,XVAL1
  920.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  921.       ENDIF
  922.       ENDIF
  923.       CALL ECROBJ('CHPOINT ',MCHPOI)
  924.       GO TO 89
  925.  
  926. C ........
  927.  23   CONTINUE
  928.       GO TO 89
  929.  
  930. C ........
  931.  24   CONTINUE
  932.       GO TO 89
  933.  
  934. C ET
  935.  25   CONTINUE
  936.       WRITE(6,*)' Opérateur KOPS :'
  937.       WRITE(6,*)' ET : Non operationnel pour l''instant'
  938.       GO TO 89
  939.  
  940. C '+'
  941.  26   CONTINUE
  942.  
  943.       IF (NBMAT.EQ.2) THEN
  944.  
  945. C     On effectue l addition MAT1+MAT2 et on recupere la
  946. C     matrice resultante dans MAT3 en morse
  947.          CALL ADDMAT(MAT1,MAT2,MAT3,IRET)
  948.  
  949.          IF (IRET.NE.0) THEN
  950.             WRITE(6,*) 'Pb dans ADDMAT'
  951.             RETURN
  952.          END IF
  953.  
  954.          CALL ECROBJ('MATRIK',MAT3)
  955.       ELSE
  956.          CALL CRCHPT(TYPE,IGEOM,NC,MCHPOI)
  957.          CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  958. C CB215821 : pour eviter le plantage en compilcd lorsque MPOVA1=0 ...
  959.          IF (MPOVAL .NE. 0) THEN
  960.          IF (MPOVA1 .EQ. 0) MPOVA1 = MPOVAL
  961.          IF(IKAS.EQ.1)THEN
  962.             CALL KOPS1(MPOVAL.VPOCHA,MPOVA2.VPOCHA,MPOVA2.VPOCHA,
  963.      &           XVAL1,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  964.          ELSEIF(IKAS.EQ.2)THEN
  965.             CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA1.VPOCHA,
  966.      &           XVAL1,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  967.          ELSE
  968.             CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA2.VPOCHA,
  969.      &           XVAL1,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  970.          ENDIF
  971.          ENDIF
  972.          CALL ECROBJ('CHPOINT ',MCHPOI)
  973.       END IF
  974.       GO TO 89
  975.  
  976. C '-'
  977.  27   CONTINUE
  978.  
  979.       CALL CRCHPT(TYPE,IGEOM,NC,MCHPOI)
  980.       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  981. C CB215821 : pour eviter le plantage en compilcd lorsque MPOVA1=0 ...
  982.          IF (MPOVAL .NE. 0) THEN
  983.          IF (MPOVA1 .EQ. 0) MPOVA1 = MPOVAL
  984.       IF(IKAS.EQ.1)THEN
  985.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA2.VPOCHA,MPOVA2.VPOCHA,XVAL1
  986.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  987.       ELSEIF(IKAS.EQ.2)THEN
  988.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA1.VPOCHA,XVAL1
  989.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  990.       ELSE
  991.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA2.VPOCHA,XVAL1
  992.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  993.       ENDIF
  994.       ENDIF
  995.       CALL ECROBJ('CHPOINT ',MCHPOI)
  996.       GO TO 89
  997.  
  998. C '**'
  999.  28   CONTINUE
  1000.  
  1001.       CALL CRCHPT(TYPE,IGEOM,NC,MCHPOI)
  1002.       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  1003. C CB215821 : pour eviter le plantage en compilcd lorsque MPOVA1=0 ...
  1004.          IF (MPOVAL .NE. 0) THEN
  1005.          IF (MPOVA1 .EQ. 0) MPOVA1 = MPOVAL
  1006.       IF(IKAS.EQ.1)THEN
  1007.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA2.VPOCHA,MPOVA2.VPOCHA,XVAL1
  1008.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1009.       ELSEIF(IKAS.EQ.2)THEN
  1010.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA1.VPOCHA,XVAL1
  1011.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1012.       ELSE
  1013.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA2.VPOCHA,XVAL1
  1014.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1015.       ENDIF
  1016.       ENDIF
  1017.       CALL ECROBJ('CHPOINT ',MCHPOI)
  1018.       GO TO 89
  1019.  
  1020. C '|<'
  1021.  29   CONTINUE
  1022.  
  1023.       CALL CRCHPT(TYPE,IGEOM,NC,MCHPOI)
  1024.       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  1025. C CB215821 : pour eviter le plantage en compilcd lorsque MPOVA1=0 ...
  1026.          IF (MPOVAL .NE. 0) THEN
  1027.          IF (MPOVA1 .EQ. 0) MPOVA1 = MPOVAL
  1028.       IF(IKAS.EQ.1)THEN
  1029.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA2.VPOCHA,MPOVA2.VPOCHA,XVAL1
  1030.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1031.       ELSEIF(IKAS.EQ.2)THEN
  1032.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA1.VPOCHA,XVAL1
  1033.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1034.       ELSE
  1035.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA2.VPOCHA,XVAL1
  1036.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1037.       ENDIF
  1038.       ENDIF
  1039.       CALL ECROBJ('CHPOINT ',MCHPOI)
  1040.       GO TO 89
  1041.  
  1042. C '>|'
  1043.  30   CONTINUE
  1044.  
  1045.       CALL CRCHPT(TYPE,IGEOM,NC,MCHPOI)
  1046.       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  1047. C CB215821 : pour eviter le plantage en compilcd lorsque MPOVA1=0 ...
  1048.          IF (MPOVAL .NE. 0) THEN
  1049.          IF (MPOVA1 .EQ. 0) MPOVA1 = MPOVAL
  1050.       IF(IKAS.EQ.1)THEN
  1051.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA2.VPOCHA,MPOVA2.VPOCHA,XVAL1
  1052.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1053.       ELSEIF(IKAS.EQ.2)THEN
  1054.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA1.VPOCHA,XVAL1
  1055.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1056.       ELSE
  1057.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA2.VPOCHA,XVAL1
  1058.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1059.       ENDIF
  1060.       ENDIF
  1061.       CALL ECROBJ('CHPOINT ',MCHPOI)
  1062.       GO TO 89
  1063.  
  1064. C 'GRAD'
  1065.  31   CONTINUE
  1066.       IF(MTABD.EQ.0)THEN
  1067.          CALL ERREUR(-182)
  1068.          RETURN
  1069.       ENDIF
  1070.       IF(KOP.EQ.25)THEN
  1071.          CALL KGRAS(MCHPO1,MPOVA1,IGEOM1,MTABD)
  1072.       ELSE
  1073.          CALL KGRA(MCHPO1,MPOVA1,IGEOM1,MTABD)
  1074.       ENDIF
  1075.       GO TO 89
  1076.  
  1077. C 'ROT'
  1078.  32   CONTINUE
  1079.       IF(MTABD.EQ.0)THEN
  1080.          CALL ERREUR(-182)
  1081.          RETURN
  1082.       ENDIF
  1083.       CALL KROT(MCHPO1,MPOVA1,IGEOM1,MTABD)
  1084.       GO TO 89
  1085.  
  1086. C 'CLIM'
  1087.  33   CONTINUE
  1088.       CALL KBOR(MCHPO1,MCHPO2)
  1089.       GO TO 89
  1090.  
  1091.  89   CONTINUE
  1092. C?    IF(KOP.NE.15)THEN
  1093. C?    IF(MCHPOI.NE.0)SEGDES MCHPOI,MPOVAL
  1094. C?    IF(MCHPO1.NE.0)SEGDES MCHPO1,MPOVA1
  1095. C?    IF(MCHPO2.NE.0)SEGDES MCHPO2,MPOVA2
  1096. C?    ENDIF
  1097.       RETURN
  1098.  
  1099. C 'INV'
  1100.  34   CONTINUE
  1101.       IF (NBMAT.EQ.1) THEN
  1102.          NAG=2
  1103.          CALL INVMAT(MAT1,MAT2,IRET)
  1104.          CALL ECROBJ('MATRIK',MAT2)
  1105.       ELSE
  1106.          WRITE(6,*) 'KOPS: On ne peut inverser qu une matrice'
  1107.       END IF
  1108.       RETURN
  1109.  
  1110.  91   CONTINUE
  1111.       WRITE(6,*)' Opérateur KOPS :'
  1112.       WRITE(6,*)' Nombre d''argument superieur a 2 '
  1113.       RETURN
  1114.       END
  1115.  
  1116.  
  1117.  
  1118.  
  1119.  

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