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    GOUNAND   25/11/12    21:15:32     12399          
  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. *     SG 2025/10/30 : pour bien mettre en evidence tous les couplages
  426. *     possibles entre inconnues, on ajoute les produits tensoriels de
  427. *     chaque ligne avec elle-meme
  428.             do ilig=1,nicp
  429.                do icol1=1,nicp
  430.                   do icol2=1,nicp
  431.                      i12=MCOUP(ilig,icol1)*MCOUP(ilig,icol2)
  432.                      MCOUP(icol1,icol2)=max(MCOUP(icol1,icol2),i12)
  433.                   enddo
  434.                enddo
  435.             enddo
  436. * Pareil pour les colonnes
  437.             do icol=1,nicp
  438.                do ilig1=1,nicp
  439.                   do ilig2=1,nicp
  440.                      i12=MCOUP(ilig1,icol)*MCOUP(ilig2,icol)
  441.                      MCOUP(ilig1,ilig2)=max(MCOUP(ilig1,ilig2),i12)
  442.                   enddo
  443.                enddo
  444.             enddo
  445.  
  446.  
  447.             CALL CRTABL(MTABLE)
  448.             npart=0
  449.  
  450.             do 7401 k=1,nicp
  451.  
  452.             JGN=LOCOMP
  453.             JGM=0
  454.             segini MLMOT3
  455.             I0=MCOUP(k,k)
  456.  
  457.             IF(I0.EQ.0)THEN
  458.             write(6,*)' ERREUR : La diagonale est nulle'
  459.             return
  460.             ENDIF
  461.  
  462.             IF(I0.EQ.-1)GO TO 7401
  463.             JGM=JGM+1
  464.             SEGADJ MLMOT3
  465.             MLMOT3.MOTS(JGM)=MLMOT2.MOTS(k)
  466.             MCOUP(k,k)=-1
  467.  
  468.             it=0
  469.             do 7402 m=1,nicd
  470.             I1=MCOUP(k,m)
  471.             IF(I1.EQ.1)THEN
  472.             it=it+1
  473.             itinc(it)=i1
  474.             JGM=JGM+1
  475.             SEGADJ MLMOT3
  476.             MLMOT3.MOTS(JGM)=MLMOT2.MOTS(m)
  477.             MCOUP(k,m)=-1
  478.             MCOUP(m,m)=-1
  479.             ENDIF
  480.  7402 continue
  481.  
  482.  7405 continue
  483.             itp=0
  484.             do      j=1,it
  485.             il=itinc(j)
  486.  
  487.             do      m=1,nicd
  488.             I1=MCOUP(k,m)
  489.             IF(I1.EQ.1)THEN
  490.             itp=itp+1
  491.             itinc(itp)=i1
  492.             JGM=JGM+1
  493.             SEGADJ MLMOT3
  494.             MLMOT3.MOTS(JGM)=MLMOT2.MOTS(m)
  495.             MCOUP(il,m)=-1
  496.             ENDIF
  497.             enddo
  498.             enddo
  499.             do 7404 m=1,itp
  500.             itinc(m)=itinc(m+it)
  501.  7404       continue
  502.             it=itp
  503.             IF(ITP.NE.0)go to 7405
  504.             npart=npart+1
  505.             segdes MLMOT3
  506.       CALL ECCTAB(MTABLE,'ENTIER',npart,0.D0,BLAN,.TRUE.,0,
  507.      1  'LISTMOTS',0,0.D0,BLAN,.TRUE.,MLMOT3)
  508.  
  509.  7401    continue
  510.  
  511.             SEGSUP STCOUP
  512.             SEGDES MTABLE,MLMOT3
  513.             CALL ECROBJ('TABLE',MTABLE)
  514.             RETURN
  515.          ENDIF
  516. C
  517. C
  518. C CAS KOP=27 'EXTRMASS' ou 'EXTRPREC'
  519.          IF(KOP.EQ.27.OR.KOP.EQ.28)THEN
  520.             CALL LIRCHA(NOMC,1,IRET)
  521.             CALL LIRCHA(NOMK,1,IRET)
  522.             IF(IRET.EQ.0)RETURN
  523.             CALL LIROBJ('MATRIK',MAT1,1,IRET)
  524.             IF(IRET.EQ.0)RETURN
  525.  
  526.             SEGACT MAT1
  527.             NRIGE =MAT1.IRIGEL(/1)
  528.             NMATRI=MAT1.IRIGEL(/2)
  529.             NMATRI=0
  530.             NKID  =MAT1.KIDMAT(/1)
  531.             NKMT  =MAT1.KKMMT(/1)
  532.             SEGINI MATRIK
  533.             CALL RSETI(KIDMAT,MAT1.KIDMAT,NKID)
  534.             CALL RSETI(KKMMT ,MAT1.KKMMT ,NKMT)
  535.             KSYM  = MAT1.KSYM
  536.             mincp= MAT1.KMINC
  537.             if(mincp.ne.0)then
  538.                segact mincp
  539.                nbi= mincp.LISINC(/2)
  540.                npt= mincp.NPOS(/1)-1
  541.                segini minc
  542.                call rseti(npos,mincp.npos,npt+1)
  543.                call rseti(mpos,mincp.mpos,(npt*(nbi+1)))
  544.                lisinc(1)=NOMK
  545.                if(nbi.ne.1)then
  546.                   write(6,*)' Gross Pb NBI=',nbi
  547.                   write(6,*)(mincp.lisinc(ii),ii=1,nbi)
  548.                   call arret (0)
  549.                endif
  550.                KMINC = minc
  551.                KMINCP= minc
  552.                KMINCD= minc
  553.             endif
  554.  
  555.             KIZM  = MAT1.KIZM
  556.  
  557.             KISPGT= MAT1.KISPGT
  558.             KISPGP= MAT1.KISPGP
  559.             KISPGD= MAT1.KISPGD
  560.  
  561.             KNTTT = MAT1.KNTTT
  562.             KNTTP = MAT1.KNTTP
  563.             KNTTD = MAT1.KNTTD
  564.  
  565.             NMATR1=MAT1.IRIGEL(/2)
  566. c         write(6,*)'NMATR1=',NMATR1
  567.             do 6532 lm=1, NMATR1
  568.                IMAT1=MAT1.irigel(4,lm)
  569.                segact imat1
  570.                nbmf=IMAT1.LISPRI(/2)
  571. c          write(6,*)' NBMF=',nbmf
  572.  
  573.                do 6533 lmf=1,nbmf
  574.                   if(NOMC.eq.IMAT1.LISPRI(lmf))then
  575.                      if(NOMC.NE.IMAT1.LISDUA(lmf))then
  576. c           write(6,*)' On a perdu ', nomc,lmf
  577.                         call erreur(5)
  578.                         return
  579.                      endif
  580. c           write(6,*)' On a gagne ', nomc,lmf
  581.                      NMATRI=NMATRI+1
  582.                      segadj MATRIK
  583.                      do 6534 i7=1,7
  584.                         irigel(i7,nmatri)=mat1.irigel(i7,lm)
  585.  6534                continue
  586.  
  587.                      nbme=1
  588.                      nbsous=IMAT1.lizafm(/1)
  589.                      segini IMATRI
  590.                      irigel(4,nmatri)=IMATRI
  591.                      KSPGP=IMAT1.KSPGP
  592.                      KSPGD=IMAT1.KSPGD
  593.                      LISPRI(1)=NOMK
  594.                      LISDUA(1)=NOMK
  595.                      do 6535 is=1,nbsous
  596. c?         LIZAFM(is,1)=IMAT1. LIZAFM(is,lmf)
  597.  6535                continue
  598.  
  599.  
  600.                   endif
  601.  6533          continue
  602.  6532       continue
  603.             SEGDES MATRIK
  604.             CALL ECROBJ('MATRIK',MATRIK)
  605.             RETURN
  606.          ENDIF
  607. C
  608. * Option CHANINCO idem opérateur 'CHANGER' 'INCO'
  609. * mais pour les matrik et pour les rigidités y compris les multiplicateurs
  610.          IF (KOP.EQ.29) THEN
  611. * MAtrik CHanger INco
  612.             CALL MACHIN
  613.             RETURN
  614.          ENDIF
  615. C
  616. * Option TRANSPOS transpose une matrice
  617. * (matrik ou rigidité)
  618.          IF (KOP.EQ.30) THEN
  619. * TRanSpose MaTrice
  620.             CALL TRSMAT
  621.             RETURN
  622.          ENDIF
  623. C
  624. * Option MATIAGO pour créer une matrice diagonale
  625.          IF (KOP .EQ. 31) THEN
  626.            CALL KOPDIA
  627.            RETURN
  628.          ENDIF
  629. C
  630.          GO TO 10
  631.  
  632. C     ==============================================
  633. C     Cas : Objet = FLOTTANT ou ENTIER
  634. C     ==============================================
  635.       ELSEIF(MTYP.EQ.'FLOTTANT'.OR.MTYP.EQ.'ENTIER')THEN
  636.          NAG=NAG+1
  637.          NFLOT=NFLOT+1
  638.          IF(NAG.GT.2)GO TO 91
  639.          IF((NAG.EQ.1).OR.(NBMAT.EQ.1)) THEN
  640.             CALL LIRREE(XVAL,1,IRET)
  641.             XVAL1=XVAL
  642.             GO TO 10
  643.          END IF
  644.          IF(NAG.EQ.2)CALL LIRREE(XVAL,1,IRET)
  645.          XVAL2=XVAL
  646.          GO TO 10
  647.  
  648. C     =============================================
  649. C     Cas : Objet = CHPOINT
  650. C     =============================================
  651.       ELSEIF(MTYP.EQ.'CHPOINT')THEN
  652.          NAG=NAG+1
  653.          IF(NAG.GT.2)GO TO 91
  654.          IF ((NAG.EQ.1).OR.(NBMAT.EQ.1))THEN
  655.             CALL LIROBJ('CHPOINT',MCHPO1,1,IRET)
  656.             CALL LICHT(MCHPO1,MPOVA1,TYPE1,IGEOM1)
  657.          ELSE
  658.             CALL LIROBJ('CHPOINT',MCHPO2,1,IRET)
  659.             IF(KOP.NE.15)THEN
  660.                CALL LICHT(MCHPO2,MPOVA2,TYPE2,IGEOM2)
  661.             ELSE
  662.                GO TO 20
  663.             ENDIF
  664.          ENDIF
  665.  
  666. C     ============================================
  667. C     Cas : Objet = TABLE
  668. C     ============================================
  669.       ELSEIF(MTYP.EQ.'TABLE'.OR.MTYP.EQ.'MMODEL')THEN
  670.          NAG=NAG+1
  671.          IF(NAG.GT.2)GO TO 91
  672. C?       CALL LITABS('DOMAINE ',MTABD,1,1,IRET)
  673.          CALL LITDMD(MMODEL,MTABD,IRET)
  674.          IF(IRET.EQ.0)RETURN
  675.          IF(MTABD.EQ.0)CALL LEKMOD(MMODEL,MTABD,INEFMD)
  676. C INEFMD=1 LINE  =2 MACRO  =3 QUADRATIQUE
  677.  
  678. C     ============================================
  679. C     Cas : Objet = POINT
  680. C     ============================================
  681.       ELSEIF(MTYP.EQ.'POINT')THEN
  682.          NAG=NAG+1
  683.          IF(NAG.GT.2)GO TO 91
  684.          CALL LIROBJ('POINT',MPOINT,1,IRET)
  685.          IF(NAG.EQ.1)IKASS=4
  686.          IF(NAG.EQ.2)IKASS=5
  687.          XVEC(1)=XCOOR((MPOINT-1)*(IDIM+1)    +1)
  688.          XVEC(2)=XCOOR((MPOINT-1)*(IDIM+1)    +2)
  689.          IF(IDIM.EQ.3)XVEC(3)=XCOOR((MPOINT-1)*(IDIM+1)+3)
  690. C      Si MPOVA1 n'est pas initialise, il peut poser
  691. C      des problemes dans la partie 'operations'
  692.  
  693.          MPOVA1 = 0
  694. C     ===========================================
  695. C     Cas Objet = MATRIK
  696. C     ===========================================
  697.       ELSEIF(MTYP.EQ.'MATRIK')THEN
  698.          NAG=NAG+1
  699.          IF(NAG.GT.2)GO TO 91
  700.          NBMAT=NBMAT+1
  701.          IF (NBMAT.EQ.1) THEN
  702.             CALL LIROBJ('MATRIK',MAT1,1,IRET)
  703.          ELSEIF (NBMAT.EQ.2) THEN
  704.             CALL LIROBJ('MATRIK',MAT2,1,IRET)
  705.          END IF
  706.          IF (NBMAT.EQ.1) IKASS=6
  707.          IF (NBMAT.EQ.2) IKASS=7
  708.  
  709. C     ===========================================
  710. C     Cas Objet non prevu
  711. C     ===========================================
  712.       ELSE
  713.          MOTERR(1:8)=MTYP
  714.          CALL ERREUR(39)
  715. *         WRITE(6,*)' Opérateur KOPS :'
  716. *         WRITE(6,*)' Type d''objet :',MTYP,' non prevu'
  717.          RETURN
  718.       ENDIF
  719.  
  720.  
  721.       GO TO 10
  722.  
  723. C     *****************************************
  724. C     *  Deuxieme partie                      *
  725. C     * On effectue ici une batterie de tests *
  726. C     * afin de determiner si on fait des     *
  727. C     * operations valides                    *
  728. C     *****************************************
  729.  9    CONTINUE
  730.       IF (JMOTS.EQ.0) THEN
  731.         moterr(1:8)='MOTS   '
  732.         call erreur(37)
  733.         RETURN
  734.       ENDIF
  735.       IKAS=3
  736.       IF(MCHPO1.EQ.0)IKAS=1
  737.       IF(MCHPO2.EQ.0)IKAS=2
  738.       IF((MCHPO1.EQ.0.AND.MCHPO2.EQ.0).AND.NBMAT.EQ.0)THEN
  739.          WRITE(6,*)' Opérateur KOPS :'
  740.          WRITE(6,*)' Il n''y a pas de CHPOINT ?? '
  741.          RETURN
  742.       ENDIF
  743.       IF(IKASS.NE.0)IKAS=IKASS
  744. *
  745.       CALL COMBNA(MCHPO1,MCHPO2,INAT,IATTR)
  746.  
  747. *      write(6,*)' MCHPO1,MCHPO2=',MCHPO1,MCHPO2,IKAS,IKASS
  748. *     &,' KOP=',KOP
  749. *      write(6,*)' INAT,IATTR=',INAT,IATTR
  750.  
  751.       IF(IKAS.EQ.3)THEN
  752.  
  753.          IF(IGEOM1.NE.IGEOM2)THEN
  755.             NBCOMP=-1
  756.             CALL QUEPOI(MCHPO2,IGEOM1,INDIC,NBCOMP,NOMTOT)
  757. C         write(6,*)' indic,nbcom=',indic,nbcom
  758.             CALL LICHT(MCHPO2,MPOVA2,TYPE2,IGEOM2)
  759.             IF(INDIC.LT.0)THEN
  760.                WRITE(6,*)' Opérateur KOPS :'
  761.                WRITE(6,*)' Les deux champs n''ont pas le meme support '
  762.      &              ,'geometrique ou pire '
  763.                WRITE(6,*)' IGEOM1=',IGEOM1,' IGEOM2=',IGEOM2
  764.                RETURN
  765.             ENDIF
  766.          ENDIF
  767.  
  768.          IF(MPOVA1.EQ.0.AND.IGEOM1.EQ.0)THEN
  769. C          WRITE(6,*)'CAS OU LES CHPOINTS SONT VIDE'
  770.             NC1=0
  771.             NC2=0
  772.             NS=0
  773.          ELSE
  774.             NC1=MPOVA1.VPOCHA(/2)
  775.             NC2=MPOVA2.VPOCHA(/2)
  776.             NS =MPOVA1.VPOCHA(/1)
  777.          ENDIF
  778.  
  779.          NC=NC1
  780.          NCK=NC
  781.          IGEOM=IGEOM1
  782.          TYPE=TYPE1
  783.          IF(NC1.NE.NC2)THEN
  784.             IF(NC1.EQ.1.AND.NC2.EQ.IDIM.AND.KOP.EQ.6)THEN
  785.                NC=NC1
  786.                NCK=NC2
  787.             ELSE
  788.                WRITE(6,*)' Opérateur KOPS :'
  789.                WRITE(6,*)' Les deux champs n''ont pas le meme nombre ',
  790.      &              'de composante'
  791.                RETURN
  792.             ENDIF
  793.          ELSE
  794.             IF(KOP.EQ.6)IKAS=6
  795.          ENDIF
  796.  
  797.  
  798.       ENDIF
  799.  
  800.       IF(IKAS.EQ.1)THEN
  801.          IF(MPOVA2.EQ.0.AND.IGEOM2.EQ.0)THEN
  802. C         WRITE(6,*)'CAS OU LE CHPOINT2 EST VIDE'
  803.             NS=0
  804.             NC=0
  805.          ELSE
  806.             NS=MPOVA2.VPOCHA(/1)
  807.             NC=MPOVA2.VPOCHA(/2)
  808.          ENDIF
  809.  
  810.          NC2=NC
  811.          NCK=NC
  812.          IGEOM=IGEOM2
  813.          TYPE=TYPE2
  814.  
  815.       ELSEIF(IKAS.EQ.2)THEN
  816.          IF(MPOVA1.EQ.0.AND.IGEOM1.EQ.0)THEN
  817. C          WRITE(6,*)'CAS OU LE CHPOINT1 EST VIDE'
  818.             NS=0
  819.             NC=0
  820.          ELSE
  821.             NS=MPOVA1.VPOCHA(/1)
  822.             NC=MPOVA1.VPOCHA(/2)
  823.          ENDIF
  824.          NC2=NC
  825.          NCK=NC
  826.          IGEOM=IGEOM1
  827.          TYPE=TYPE1
  828.  
  829.       ELSEIF(IKAS.EQ.4)THEN
  830.          NS=MPOVA2.VPOCHA(/1)
  831.          NC=MPOVA2.VPOCHA(/2)
  832.          IF(NC.NE.1)THEN
  833.             WRITE(6,*)' Opérateur KOPS :'
  834.             WRITE(6,*)' Le champoint doit etre scalaire dans ce cas '
  835.             RETURN
  836.          ENDIF
  837.          NC2=IDIM
  838.          NCK=IDIM
  839.          IGEOM=IGEOM2
  840.          TYPE=TYPE2
  841.       ELSEIF(IKAS.EQ.5)THEN
  842.          NS=MPOVA1.VPOCHA(/1)
  843.          NC=MPOVA1.VPOCHA(/2)
  844.          IF(NC.NE.1)THEN
  845.             WRITE(6,*)' Opérateur KOPS :'
  846.             WRITE(6,*)' Le champoint doit etre scalaire dans ce cas '
  847.             RETURN
  848.          ENDIF
  849.          NC2=IDIM
  850.          NCK=IDIM
  851.          IGEOM=IGEOM1
  852.          TYPE=TYPE1
  853.       ENDIF
  854.  
  855.  20   CONTINUE
  856.       IF(KOP.EQ.25)GO TO 31
  857.       GO TO (21,22,23,24,25,21,22,26,27,28,29,30,31,32,33,34),KOP
  858.  
  859. C     ************************************
  860. C     *  Dans cette partie on effectue   *
  861. C     * les operations                   *
  862. C     ************************************
  863.  
  864. C MULT
  865.  21   CONTINUE
  866.  
  867. C     =======================
  868. C     PRODUIT 2 OBJETS MATRIK
  869. C     =======================
  870.       IF(NBMAT.EQ.2) THEN
  871.          CALL ETOILE(MAT1,MAT2,MAT3,IRET)
  872.  
  873.          IF (IRET.NE.0) THEN
  874.             WRITE(6,*) 'Pb dans ETOILE'
  875.             RETURN
  876.          END IF
  877.  
  878.          CALL ECROBJ('MATRIK',MAT3)
  879.  
  880. C     =============================
  881. C     PRODUIT OBJET MATRIK FLOTTANT
  882. C     =============================
  883.       ELSEIF ((NBMAT.EQ.1).AND.(NFLOT.EQ.1)) THEN
  884.  
  885.          CALL PRDMF(XVAL1,MAT1,MAT2)
  886.          CALL ECROBJ('MATRIK',MAT2)
  887.  
  888. C     =============================
  889. C     PRODUIT OBJET MATRIK CHPOINT
  890. C     =============================
  891.       ELSEIF ((NBMAT.EQ.1).AND.(MCHPO1.NE.0)) THEN
  892.          CALL PRDMCP(MAT1,MCHPO1,MCHPO2)
  893.          CALL ECROBJ('CHPOINT',MCHPO2)
  894. C     =============================
  895.  
  896.       ELSE
  897.          CALL CRCHPT(TYPE,IGEOM,NCK,IATTR,MCHPOI)
  898.          CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  899. C CB215821 : pour eviter le plantage en compilcd lorsque MPOVA1=0 ...
  900.          IF (MPOVAL .NE. 0) THEN
  901.           IF (MPOVA1 .EQ. 0) MPOVA1 = MPOVAL
  902.           IF(IKAS.EQ.1)THEN
  903.             CALL KOPS1(MPOVAL.VPOCHA,MPOVA2.VPOCHA,MPOVA2.VPOCHA,XVAL1,
  904.      &           XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  905.           ELSEIF(IKAS.EQ.2)THEN
  906.             CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA1.VPOCHA,XVAL1,
  907.      &           XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  908.           ELSE
  909. C     segact mchpoi
  910. C     write(6,*)' segact ok avt kops1 ',kop
  911.             CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA2.VPOCHA,XVAL1,
  912.      &           XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  913.           ENDIF
  914.         ENDIF
  915. C     segact mchpoi
  916. C     write(6,*)' segact ok apr kops1 '
  917. C     write(6,*)' MCHPOI=',mchpoi
  918.          CALL ECROBJ('CHPOINT ',MCHPOI)
  919.       END IF
  920.  
  921.       GO TO 89
  922.  
  923.  
  924. C DIVI
  925.  22   CONTINUE
  926.  
  927.       CALL CRCHPT(TYPE,IGEOM,NC,IATTR,MCHPOI)
  928.       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  929. C CB215821 : pour eviter le plantage en compilcd lorsque MPOVA1=0 ...
  930.          IF (MPOVAL .NE. 0) THEN
  931.          IF (MPOVA1 .EQ. 0) MPOVA1 = MPOVAL
  932. C     write(6,*)' MCHPOI=',mchpoi,IKAS
  933. C     write(6,*)' NC,NC2,NS=',NC,NC2,NS
  934.       IF(IKAS.EQ.1)THEN
  935.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA2.VPOCHA,MPOVA2.VPOCHA,XVAL1
  936.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  937.       ELSEIF(IKAS.EQ.2)THEN
  938.          segact mchpoi,mchpo1,mpoval,mpova1
  939.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA1.VPOCHA,XVAL1
  940.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  941.          segact mchpoi,mchpo1,mpoval,mpova1
  942.       ELSE
  943.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA2.VPOCHA,XVAL1
  944.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  945.       ENDIF
  946.       ENDIF
  947.       CALL ECROBJ('CHPOINT ',MCHPOI)
  948.       GO TO 89
  949.  
  950. C ........
  951.  23   CONTINUE
  952.       GO TO 89
  953.  
  954. C ........
  955.  24   CONTINUE
  956.       GO TO 89
  957.  
  958. C ET
  959.  25   CONTINUE
  960.       WRITE(6,*)' Opérateur KOPS :'
  961.       WRITE(6,*)' ET : Non operationnel pour l''instant'
  962.       GO TO 89
  963.  
  964. C '+'
  965.  26   CONTINUE
  966.  
  967.       IF (NBMAT.EQ.2) THEN
  968.  
  969. C     On effectue l addition MAT1+MAT2 et on recupere la
  970. C     matrice resultante dans MAT3 en morse
  971.          CALL ADDMAT(MAT1,MAT2,MAT3,IRET)
  972.  
  973.          IF (IRET.NE.0) THEN
  974.             WRITE(6,*) 'Pb dans ADDMAT'
  975.             RETURN
  976.          END IF
  977.  
  978.          CALL ECROBJ('MATRIK',MAT3)
  979.       ELSE
  980.          CALL CRCHPT(TYPE,IGEOM,NC,IATTR,MCHPOI)
  981.          CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  982. C CB215821 : pour eviter le plantage en compilcd lorsque MPOVA1=0 ...
  983.          IF (MPOVAL .NE. 0) THEN
  984.          IF (MPOVA1 .EQ. 0) MPOVA1 = MPOVAL
  985.          IF(IKAS.EQ.1)THEN
  986.             CALL KOPS1(MPOVAL.VPOCHA,MPOVA2.VPOCHA,MPOVA2.VPOCHA,
  987.      &           XVAL1,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  988.          ELSEIF(IKAS.EQ.2)THEN
  989.             CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA1.VPOCHA,
  990.      &           XVAL1,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  991.          ELSE
  992.             CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA2.VPOCHA,
  993.      &           XVAL1,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  994.          ENDIF
  995.          ENDIF
  996.          CALL ECROBJ('CHPOINT ',MCHPOI)
  997.       END IF
  998.       GO TO 89
  999.  
  1000. C '-'
  1001.  27   CONTINUE
  1002.  
  1003.       CALL CRCHPT(TYPE,IGEOM,NC,IATTR,MCHPOI)
  1004.       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  1005. C CB215821 : pour eviter le plantage en compilcd lorsque MPOVA1=0 ...
  1006.          IF (MPOVAL .NE. 0) THEN
  1007.          IF (MPOVA1 .EQ. 0) MPOVA1 = MPOVAL
  1008.       IF(IKAS.EQ.1)THEN
  1009.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA2.VPOCHA,MPOVA2.VPOCHA,XVAL1
  1010.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1011.       ELSEIF(IKAS.EQ.2)THEN
  1012.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA1.VPOCHA,XVAL1
  1013.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1014.       ELSE
  1015.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA2.VPOCHA,XVAL1
  1016.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1017.       ENDIF
  1018.       ENDIF
  1019.       CALL ECROBJ('CHPOINT ',MCHPOI)
  1020.       GO TO 89
  1021.  
  1022. C '**'
  1023.  28   CONTINUE
  1024.  
  1025.       CALL CRCHPT(TYPE,IGEOM,NC,IATTR,MCHPOI)
  1026.       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  1027. C CB215821 : pour eviter le plantage en compilcd lorsque MPOVA1=0 ...
  1028.          IF (MPOVAL .NE. 0) THEN
  1029.          IF (MPOVA1 .EQ. 0) MPOVA1 = MPOVAL
  1030.       IF(IKAS.EQ.1)THEN
  1031.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA2.VPOCHA,MPOVA2.VPOCHA,XVAL1
  1032.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1033.       ELSEIF(IKAS.EQ.2)THEN
  1034.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA1.VPOCHA,XVAL1
  1035.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1036.       ELSE
  1037.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA2.VPOCHA,XVAL1
  1038.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1039.       ENDIF
  1040.       ENDIF
  1041.       CALL ECROBJ('CHPOINT ',MCHPOI)
  1042.       GO TO 89
  1043.  
  1044. C '|<'
  1045.  29   CONTINUE
  1046.  
  1047.       CALL CRCHPT(TYPE,IGEOM,NC,IATTR,MCHPOI)
  1048.       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  1049. C CB215821 : pour eviter le plantage en compilcd lorsque MPOVA1=0 ...
  1050.          IF (MPOVAL .NE. 0) THEN
  1051.          IF (MPOVA1 .EQ. 0) MPOVA1 = MPOVAL
  1052.       IF(IKAS.EQ.1)THEN
  1053.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA2.VPOCHA,MPOVA2.VPOCHA,XVAL1
  1054.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1055.       ELSEIF(IKAS.EQ.2)THEN
  1056.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA1.VPOCHA,XVAL1
  1057.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1058.       ELSE
  1059.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA2.VPOCHA,XVAL1
  1060.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1061.       ENDIF
  1062.       ENDIF
  1063.       CALL ECROBJ('CHPOINT ',MCHPOI)
  1064.       GO TO 89
  1065.  
  1066. C '>|'
  1067.  30   CONTINUE
  1068.  
  1069.       CALL CRCHPT(TYPE,IGEOM,NC,IATTR,MCHPOI)
  1070.       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  1071. C CB215821 : pour eviter le plantage en compilcd lorsque MPOVA1=0 ...
  1072.          IF (MPOVAL .NE. 0) THEN
  1073.          IF (MPOVA1 .EQ. 0) MPOVA1 = MPOVAL
  1074.       IF(IKAS.EQ.1)THEN
  1075.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA2.VPOCHA,MPOVA2.VPOCHA,XVAL1
  1076.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1077.       ELSEIF(IKAS.EQ.2)THEN
  1078.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA1.VPOCHA,XVAL1
  1079.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1080.       ELSE
  1081.          CALL KOPS1(MPOVAL.VPOCHA,MPOVA1.VPOCHA,MPOVA2.VPOCHA,XVAL1
  1082.      $        ,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  1083.       ENDIF
  1084.       ENDIF
  1085.       CALL ECROBJ('CHPOINT ',MCHPOI)
  1086.       GO TO 89
  1087.  
  1088. C 'GRAD'
  1089.  31   CONTINUE
  1090.       IF(MTABD.EQ.0)THEN
  1091.          CALL ERREUR(-182)
  1092.          RETURN
  1093.       ENDIF
  1094.       IF(KOP.EQ.25)THEN
  1095.          CALL KGRAS(MCHPO1,MPOVA1,IGEOM1,MTABD)
  1096.       ELSE
  1097.          CALL KGRA(MCHPO1,MPOVA1,IGEOM1,MTABD)
  1098.       ENDIF
  1099.       GO TO 89
  1100.  
  1101. C 'ROT'
  1102.  32   CONTINUE
  1103.       IF(MTABD.EQ.0)THEN
  1104.          CALL ERREUR(-182)
  1105.          RETURN
  1106.       ENDIF
  1107.       CALL KROT(MCHPO1,MPOVA1,IGEOM1,MTABD)
  1108.       GO TO 89
  1109.  
  1110. C 'CLIM'
  1111.  33   CONTINUE
  1112.       CALL KBOR(MCHPO1,MCHPO2)
  1113.       GO TO 89
  1114.  
  1115.  89   CONTINUE
  1116. C?    IF(KOP.NE.15)THEN
  1117. C?    IF(MCHPOI.NE.0)SEGDES MCHPOI,MPOVAL
  1118. C?    IF(MCHPO1.NE.0)SEGDES MCHPO1,MPOVA1
  1119. C?    IF(MCHPO2.NE.0)SEGDES MCHPO2,MPOVA2
  1120. C?    ENDIF
  1121.       RETURN
  1122.  
  1123. C 'INV'
  1124.  34   CONTINUE
  1125.       IF (NBMAT.EQ.1) THEN
  1126.          NAG=2
  1127.          CALL INVMAT(MAT1,MAT2,IRET)
  1128.          CALL ECROBJ('MATRIK',MAT2)
  1129.       ELSE
  1130.          WRITE(6,*) 'KOPS: On ne peut inverser qu une matrice'
  1131.       END IF
  1132.       RETURN
  1133.  
  1134.  91   CONTINUE
  1135.       WRITE(6,*)' Opérateur KOPS :'
  1136.       WRITE(6,*)' Nombre d''argument superieur a 2 '
  1137.       RETURN
  1138.       END
  1139.  
  1140.  

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