Télécharger la plaquette Cast3M


fr en

Télécharger modsta.eso

Retour à la liste

Numérotation des lignes : 

modsta

  1. C MODSTA    SOURCE    JK148537  24/10/29    21:15:07     12056          
  2.       SUBROUTINE MODSTA(IPMOD,IPTABM,ipmod1)
  3. C
  4.       implicit real*8(a-h,o-z) 
  5. -INC PPARAM      
  6. -INC CCOPTIO
  7. -INC SMMODEL
  8.       POINTEUR IMODE3.IMODEL
  9. -INC SMTABLE
  10. -INC SMELEME
  11. -INC SMLENTI
  12.  
  13.       logical login,lobre,lexmod,dupli2
  14.       character*8 charin,charre,tapind,typobj
  15.  
  16. * ipmod1 initialise dans modeli
  17.       if (ipmod1.gt.0) then
  18.         call pimodl(ipmod1,ipmod2,iptz,1)
  19.         mmodel = ipmod2
  20.       endif
  21. *      write(6,*) 'modsta',ipmod,iptabm,mmodel
  22.       is0 = kmodel(/1)
  23.       isa = 1
  24.       isb = is0
  25.       IVOUT = 0
  26.       IVALI0 = 0
  27.  
  28. *
  29.       n1 = kmodel(/1)
  30.       isk = n1
  31.       segini,mmode2=mmodel
  32.       call dimen7(iptabm,idimen)
  33.       n1 = n1 * idimen
  34.       segadj,mmode2
  35.       n21 = n1
  36.  
  37. * dupliquer modele elementaire
  38.       do 100 is = 1,is0
  39.             imode2 = kmodel(is)
  40.             dupli2 = .true.
  41.             ivok = 0
  42.             lexmod = .false.
  43.             do jma=1,imode2.matmod(/2)
  44.               if(imode2.matmod(jma).eq.'STATIONNAIRE') then
  45.                 nobmod = imode2.ivamod(/1)
  46.                 if (imode2.tymode(nobmod).ne.'IMODEL') then
  47. *       write(6,*) 'verifier sous-zone ',is,imode2,' pour stationnaire'
  48.                   call erreur(21)
  49.                   return
  50.                 endif       
  51.                 lexmod = .true.
  52.                 goto 6
  53.               endif
  54.             enddo
  55. c            goto 100
  56.   6         continue
  57.             ipt2 = imode2.imamod
  58.             ityp2 = ipt2.itypel
  59.             nbn2 = ipt2.num(/1)
  60.             nbele2 = ipt2.num(/2)
  61.  
  62.         IVALIN = IVALI0
  63.  10     CONTINUE
  64. * tranche suivante            
  65.         IVALIN=IVALIN + 1
  66.         XVALIN=REAL(0.D0)
  67.         LOGIN=.TRUE.
  68.         IOBIN=0
  69.         TAPIND='ENTIER  '
  70.         CHARIN='        '
  71.         TYPOBJ='        '
  72.         CALL ACCTAB(IPTABM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  73.      .                     TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  74. c        write(6,*)'bsta',ivalin,iobre,typobj,ierr
  75.         IF (IERR.NE.0) RETURN
  76.         if (typobj.eq.'        '.AND.IVALIN.EQ.1) GOTO 10
  77.         if (typobj.ne.'MAILLAGE') then
  78.           if (ivout.eq.0) then
  79.             ivout = ivok
  80.           elseif (ivout.ne.ivok) then
  81. c            write(6,*) 'duplication non homogène', is
  82.             call erreur(21)
  83.             return
  84.           endif
  85.           goto 100
  86.         endif    
  87.  
  88. * traiter les maillages elementaires      
  89.         MELEME = IOBRE
  90.         segact meleme*nomod
  91.         NSOU  = MELEME.LISOUS(/1)
  92.         NSOU1 = MAX(1,NSOU)
  93.         DO 80 IM=1,NSOU1
  94.           IF (NSOU.EQ.0) THEN
  95.             IPT1  =MELEME
  96.           ELSE
  97.             IPT1  =MELEME.LISOUS(IM)
  98.             SEGACT,IPT1
  99.           ENDIF
  100.           ITYP1 =IPT1.ITYPEL
  101.           NBNN  =IPT1.NUM(/1)
  102.           NBELEM  = IPT1.NUM(/2) 
  103.  
  104.         if (ipt1.eq.ipt2) goto 10
  105.         if (ityp2.eq.ityp1.and.nbn2.eq.nbnn.and.nbele2.eq.nbelem) then
  106.             goto 60
  107.         endif
  108.  80     CONTINUE       
  109. *         write(6,*) 'la tranche ', ivalin,' n est pas homeomorphe'
  110.         call erreur(21)
  111.         return
  112.  
  113.  60     CONTINUE
  114. * dupliquer modele elementaire
  115.           segini,imodel=imode2
  116.           ivok = ivok + 1
  117.           isk = isk + 1
  118.       if (isk.ge.n21) then
  119.         n1 = n21 + is0
  120.         segadj mmode2
  121.         n21 = n1
  122.       endif
  123.           mmode2.kmodel(isk) = imodel
  124. *        segact imodel*mod
  125.           imamod = ipt1
  126. C ... modif constituant ?
  127.  
  128.         nobmod = ivamod(/1)
  129.         if (lexmod) then
  130. * surcharge indice nobmod 
  131.         else
  132.           mn3 = infmod(/1)
  133.           nfor = formod(/2)
  134.           nmat = matmod(/2)
  135.           nmat = nmat + 1
  136. c      write(6,*) 'modsta',imodel,mn3,nfor,nmat,nobmod
  137.           nobmod = nobmod + 1
  138.           segadj imodel
  139.           matmod(nmat) = 'STATIONNAIRE'
  140.           tymode(nobmod) = 'IMODEL'
  141.         endif
  142.         IF (dupli2) THEN
  143. * stationnaire : pointe la sous-zone dupliquee
  144.           ivamod(nobmod) = imode2
  145.           dupli2 = .false.
  146.         ELSE
  147. * ou bien la tranche anterieure (en s epargnant de tester le contenu)        
  148.           ivamod(nobmod) = mmode2.kmodel(isk - 1)
  149.         ENDIF
  150.         goto 10
  151. CCCC
  152.  100  continue
  153.           if (IVOUT.gt.0) then
  154. c            write(6,*) ' ',ivout,' tranches dupliquees stationnaires'
  155.           else
  156.             call erreur(21)
  157.             return
  158.           endif
  159.  
  160. * fin duplication
  161.       n1 = isk
  162.       segadj mmode2
  163. c      ipmod = mmode2
  164.  
  165.       jg = 0
  166.       segini mlenti,mlent1,mlent2
  167. * reaffecte modeles parallele
  168.       do 200 is = 1,is0
  169.         imode2 = kmodel(is)
  170.         if (imode2.cmatee.eq.'PARALLEL') then
  171.           nobmod = imode2.ivamod(/1)
  172.           nmat = imode2.matmod(/2)
  173.           if (imode2.matmod(nmat).eq.'STATIONNAIRE') then
  174.             if (imode2.tymode(nobmod).ne.'IMODEL') then
  175. *jk18537 conventionnel 
  176. *             write(6,*) 'sous-zone', is, imode2, ' PARALLEL mal defini'
  177.              call erreur(21)
  178.              return
  179.             endif
  180.             jg = nobmod
  181.           else          
  182.             jg = nobmod + 1
  183.           endif
  184.           if (jg.ne.lect(/1)) then
  185.             segadj mlenti,mlent1,mlent2
  186.           endif
  187.           do jj = 1,jg
  188.             lect(jj) = 0
  189.             mlent1.lect(jj) = 0
  190.           enddo
  191.           do iv=1,nobmod
  192.       if (imode2.tymode(iv).eq.'IMODEL') lect(iv) = imode2.ivamod(iv)
  193.             mlent2.lect(iv) = lect(iv) 
  194.           enddo 
  195.           mlent2.lect(jg) = imode2
  196.           nobjg = jg        
  197.  
  198. * debut de recherche
  199.           isa = is0 + (is-1)*IVOUT
  200.           do jt = 1,ivout
  201.             isk = isa + jt 
  202.             imodel = mmode2.kmodel(isk)
  203.  
  204.             if (cmatee.eq.'PARALLEL') then
  205.               nobmod = ivamod(/1)
  206.               if (tymode(nobmod).ne.'IMODEL'.or.nobmod.ne.nobjg) then
  207. c                 write(6,*) 'erreur duplication'
  208.                  call erreur(5)
  209.                  return
  210.               endif
  211.               if (ivamod(nobmod).ne.mlent2.lect(nobmod)) then
  212. c                write(6,*) 'erreur de suivi'
  213.                 call erreur(5)
  214.                 return
  215.               endif
  216.               mlent2.lect(nobmod) = imodel
  217.                do iv = 1,nobjg-1
  218.                 if (tymode(iv).eq.'IMODEL') then
  219.                  if (ivamod(iv).eq.lect(iv)) then
  220.                    if (mlent1.lect(iv).eq.0) then 
  221.                     do lu = 1,is0
  222.                      if (mmode2.kmodel(lu).eq.lect(iv)) then
  223.                        isb = is0 + (lu - 1)*ivout + 1
  224.                        mlent1.lect(iv) = isb
  225.                      endif
  226.                     enddo
  227.                    endif
  228. *
  229.                    isu = mlent1.lect(iv)
  230.                    imode1 = mmode2.kmodel(isu)
  231.                    nobmod = imode1.ivamod(/1)
  232.                    nmat = imode1.matmod(/2)
  233.                    if (imode1.matmod(nmat).ne.'STATIONNAIRE'.OR.
  234.      &  imode1.tymode(nobmod).ne.'IMODEL'.OR.
  235.      &  imode1.ivamod(nobmod).ne.mlent2.lect(iv) ) then
  236. *                     write(6,*) 'erreur 3 duplication',is,isk,isu
  237. *                 write(6,*) imode1.matmod(nmat).ne.'STATIONNAIRE'
  238. *                 write(6,*) imode1.tymode(nobmod).ne.'IMODEL'
  239. *                 write(6,*) imode1.ivamod(nobmod),mlent2.lect(iv) 
  240.                      call erreur(21)
  241.                      return
  242.                    endif
  243. * petit test
  244.                    if (imode1.imamod.ne.imamod) then
  245. c        write(6,*) imodel,' erreur affectation parallele ',imode1
  246.                     call erreur(21)
  247.                     return
  248.                    endif                  
  249.                    ivamod(iv) = imode1
  250.                    mlent1.lect(iv) = isu + 1
  251.                    mlent2.lect(iv) = imode1
  252.  
  253.                  else
  254. c                   write(6,*) 'erreur 2 duplication'
  255.                    call erreur(21)
  256.                    return
  257.                  endif
  258.                 endif
  259.                enddo
  260.             else
  261. c              write(6,*) 'mal gere les indices' 
  262.                 call erreur(5)
  263.                 return
  264.             endif
  265.           enddo     
  266.  
  267.         endif      
  268.  200  continue     
  269.  
  270. * 
  271.           segsup mlenti,mlent1,mlent2
  272.  
  273. * condense mmode2
  274.       mmodel = mmode2          
  275.       n1 = kmodel(/1)
  276.       segini mmode1
  277.       n10 = n1
  278.       mmode2 = ipmod1
  279.       n21 = mmode2.kmodel(/1)
  280.       isk1 = n21
  281.       jtk0 = 0
  282.       do 300 is = 1,n21
  283.          imode1 = mmode2.kmodel(is)
  284.            imodu = imode1
  285.          mmode1.kmodel(is) = imode1
  286.          nmat1 = imode1.matmod(/2)
  287.            jtk = 0
  288.            do 350 jt = n21, n10
  289.              imodel = kmodel(jt)
  290.              if (imodel.eq.0) goto 350
  291.              nobmod = ivamod(/1)
  292.              nmat = matmod(/2)
  293.              if (matmod(nmat).eq.'STATIONNAIRE') then
  294.                if (tymode(nobmod).ne.'IMODEL') then
  295. c                   write(6,*) 'erreur 3 duplication'
  296.                  call erreur(21)
  297.                  return
  298.                endif
  299.  
  300.                if (ivamod(nobmod).ne.imodu) goto 350
  301.                isk1 = isk1 + 1
  302.                jtk = jtk + 1
  303.                mmode1.kmodel(isk1) = imodel
  304.                imodu = imodel
  305.                kmodel(jt) = 0           
  306.              endif
  307.  
  308.   350      continue
  309.            if (jtk0.eq.0) then
  310.              jtk0 = jtk
  311.            else
  312.              if (jtk.ne.jtk0) then
  313. c                  write(6,*) 'erreur 4 duplication'
  314.                  call erreur(21)
  315.                  return
  316.              endif
  317.            endif  
  318.  
  319.   300 continue
  320.  
  321.       n1 = isk1
  322.       segadj mmode1
  323.       ipmod = mmode1
  324.       segsup mmodel
  325. c      write(6,*) 'modsta-f-',ipmod,n1,iptabm
  326.  
  327.  
  328.       RETURN
  329.       END
  330.  
  331.  
  332.  
  333.  
  334.  

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