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

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