Télécharger la plaquette Cast3M


fr en

Télécharger limodl.eso

Retour à la liste

Numérotation des lignes : 

limodl

  1. C LIMODL    SOURCE    OF166741  24/11/18    21:15:08     12081          
  2.  
  3. *--------------------------------------------------------------------*
  4. *                                                                    *
  5. *     LECTURE D'UN NOUVEAU MODELE SUR LE FICHIER IURES.              *
  6. *                                                                    *
  7. *     Parametres:                                                    *
  8. *                                                                    *
  9. *     IURES   Numero du fichier de sortie                            *
  10. *     ITLACC  Pile contenant les nouveaux MODELEs                    *
  11. *     IMAX1   Nombre de MODELEs dans la pile                         *
  12. *     IFORM   Si sauvegarde en format ou non                         *
  13. *                                                                    *
  14. *     APPELE PAR: LIPIL                                              *
  15. *                                                                    *
  16. *     Auteur, date de creation:                                      *
  17. *                                                                    *
  18. *     Denis ROBERT-MOUGIN, le 5 juillet 1989.                        *
  19. *                                                                    *
  20. *--------------------------------------------------------------------*
  21.       SUBROUTINE LIMODL(IURES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU,NBANC)
  22.  
  23.       IMPLICIT INTEGER(I-N)
  24.       IMPLICIT REAL*8 (A-H,O-Z)
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28.  
  29. -INC SMMODEL
  30. -INC SMLMOTS
  31. -INC SMELEME
  32.  
  33.       SEGMENT,ITLACC
  34.         INTEGER ITLAC(0)
  35.       ENDSEGMENT
  36.  
  37.       SEGMENT,MTABE1
  38.         INTEGER ITABE1(NM1)
  39.       ENDSEGMENT
  40.       SEGMENT,MTABE2
  41.         CHARACTER*(8) ITABE2(NM2)
  42.       ENDSEGMENT
  43.       SEGMENT,MTABE3
  44.         CHARACTER*(8) ITABE3(NM3)
  45.       ENDSEGMENT
  46.       SEGMENT,MTABE4
  47.         INTEGER ITABE4(NM4)
  48.       ENDSEGMENT
  49.       SEGMENT,MTABE5
  50.         CHARACTER*(8) ITABE5(NM5)
  51.       ENDSEGMENT
  52.       SEGMENT,MTABE6
  53.         CHARACTER*(8) ITABE6(NM6)
  54.       ENDSEGMENT
  55.       SEGMENT MTAB6B
  56.         CHARACTER*(4) ITAB6B(NM6)
  57.       ENDSEGMENT
  58.       SEGMENT,MTABE7
  59.         CHARACTER*(8) ITABE7(NM7)
  60.       ENDSEGMENT
  61.       SEGMENT,MTABE8
  62.         INTEGER ITABE8(NM7)
  63.       ENDSEGMENT
  64.       SEGMENT MTABE9
  65.         INTEGER ITABE9(NM9)
  66.       ENDSEGMENT
  67.  
  68.       INTEGER IDAN(10)
  69.       CHARACTER*16 MOMODL(10)
  70.       CHARACTER*8  cma
  71.       LOGICAL b_z
  72.  
  73.       iimpil = IIMPI
  74. c-dbg      iimpil = 1972
  75.  
  76.       if (iimpil.eq.1972) write(ioimp,*) 'LIMODEL niveau =',niveau
  77.       if (niveau.lt.4) then
  78.         write(ioimp,*) 'Attention : Niveau tres ancien (< 4) !!!'
  79.         write(ioimp,*) 'Relire puis sauver le fichier avec une ',
  80.      &                 'version de niveau intermediaire'
  81.         call erreur(5)
  82.         return
  83.       endif
  84.  
  85.       NIDAN = 10
  86.       if (niveau.lt.15) NIDAN = 7
  87.       if (niveau.lt.13) NIDAN = 4
  88.  
  89. *  Boucle (10) sur les MODELEs contenus dans la pile :
  90. *  -----------
  91.       DO 10 IEL = 1, IMAX1
  92.  
  93. c*        DO in = 1, NIDAN
  94.         DO in = 1, 10
  95.           IDAN(in) = 0
  96.         ENDDO
  97.  
  98.         mtabe1 = 0
  99.         mtabe2 = 0
  100.         mtabe3 = 0
  101.         mtabe4 = 0
  102.         mtabe5 = 0
  103.         mtabe6 = 0
  104.         mtab6b = 0
  105.         mtabe7 = 0
  106.         mtabe8 = 0
  107.         mtabe9 = 0
  108.  
  109.         IRETOU = 0
  110.  
  111.         CALL LFCDIE(IURES,NIDAN,IDAN,IRETOU,IFORM)
  112.         IF (IRETOU.NE.0) RETURN
  113.  
  114.         N1 = IDAN(1)
  115.         SEGINI,MMODEL
  116.  
  117.         N45 = IDAN(6)
  118.         if (niveau.lt.13) then
  119.           N45 = 6
  120.           if (niveau.lt.12) N45 = 5
  121.         endif
  122.  
  123.         NM1 = N1 * N45
  124.  
  125.         NM2 = IDAN(2)
  126.         NM3 = IDAN(3)
  127.         NM4 = IDAN(4)
  128.  
  129.         NM5 = IDAN(5)
  130.         idecmo = 0
  131.         IF (N1.gt.0) idecmo = NM5 / N1
  132.         if (niveau.lt.13) then
  133.           idecmo = 2
  134.           NM5 = N1 * idecmo
  135.         endif
  136.  
  137.         NM6 = IDAN(7)
  138. c*        if (niveau.ge.13) then : nm6 lu sinon 0
  139.         NM7 = IDAN(8)
  140. c*        if (niveau.ge.15) then : nm7 lu sinon 0
  141.  
  142.         NM9 = N1 * 16
  143.  
  144.       if (iimpil.eq.1972) then
  145.         write(ioimp,*) 'N1, N45 = ',N1,n45
  146.         write(ioimp,*) 'nm1 nm2 nm3 nm4 nm5 nm6 nm7 nm9'
  147.         write(ioimp,*) nm1, nm2 ,nm3, nm4, nm5, nm6, nm7, nm9
  148.       endif
  149.  
  150.         SEGINI,mtabe1,mtabe2,mtabe3,mtabe9
  151.         SEGINI,mtabe4,mtabe5
  152.         if (nm6.gt.0) then
  153.           SEGINI,mtabe6,mtab6b
  154.         endif
  155.         if (nm7.gt.0) then
  156.           SEGINI,mtabe7,mtabe8
  157.         endif
  158.  
  159.         CALL LFCDIE(IURES,NM1,itabe1,IRETOU,IFORM)
  160.         IF (IRETOU.NE.0) RETURN
  161.       if (iimpil.eq.1972) then
  162.         write(ioimp,*) ' itabe1 '
  163.         write(ioimp,fmt='(10i5)') (itabe1(in),in=1,nm1)
  164.       endif
  165.         IF (n45.gt.28) then
  166.           CALL LFCDIE(IURES,NM9,itabe9,IRETOU,IFORM)
  167.           IF (IRETOU.NE.0) RETURN
  168.       if (iimpil.eq.1972) then
  169.         write(ioimp,*) ' itabe9 '
  170.         write(ioimp,fmt='(10i5)') (itabe9(in),in=1,nm9)
  171.       endif
  172.         ENDIF
  173.  
  174.         CALL LFCDIN(IURES,NM5,itabe5,IRETOU,IFORM)
  175.         IF (IRETOU.NE.0) RETURN
  176.         CALL LFCDIN(IURES,NM2,itabe2,IRETOU,IFORM)
  177.         IF (IRETOU.NE.0) RETURN
  178.         CALL LFCDIN(IURES,NM3,itabe3,IRETOU,IFORM)
  179.         IF (IRETOU.NE.0) RETURN
  180.         CALL LFCDIE(IURES,NM4,itabe4,IRETOU,IFORM)
  181.         IF (IRETOU.NE.0) RETURN
  182.         if (nm6.gt.0) then
  183.           if (niveau.ge.14) then
  184.             CALL LFCDIN(iures,nm6,itabe6,iretou,IFORM)
  185.             IF (IRETOU.NE.0) RETURN
  186.           endif
  187.           if (niveau.eq.13) then
  188.             call lfcden(iures,nm6,itab6b,iretou,IFORM)
  189.             if (iretou.ne.0) return
  190.           endif
  191.         endif
  192.         if (nm7.gt.0) then
  193.           if (niveau.ge.15) then
  194.       if (iimpil.eq.1972) write(ioimp,*) 'nm7 ',nm7
  195.             CALL LFCDIN(IURES,NM7,itabe7,IRETOU,IFORM)
  196.       if (iimpil.eq.1972) write(ioimp,*) 'itabe7 ',(itabe7(in),in=1,nm7)
  197.             if (iretou.ne.0) return
  198.             CALL LFCDIE(IURES,NM7,itabe8,IRETOU,IFORM)
  199.       if (iimpil.eq.1972) write(ioimp,*) 'itabe8 ',(itabe8(in),in=1,nm7)
  200.             if (iretou.ne.0) return
  201.           endif
  202.         endif
  203.  
  204. *  BOUCLE (20) SUR LES ZONES ELEMENTAIRES DU MODELE :
  205.         nparmo = 0
  206.         nobmod = 0
  207.  
  208.         jfor   = 0
  209.         jmat   = 0
  210.         jinf   = 0
  211.         jnomid = 0
  212.         jobj   = 0
  213.  
  214.         DO 20 ISOUEL = 1, N1
  215.  
  216.           ISOU = N45 * ( ISOUEL - 1 )
  217.  
  218.           NFOR = itabe1(ISOU+3)
  219.           NMAT = itabe1(ISOU+4)
  220.           if (niveau.ge.13) nparmo = itabe1(isou+10)
  221.           if (niveau.ge.15) nobmod = itabe1(isou+11)
  222.           if (n45.ge.37) nobmod = itabe1(isou+37)
  223.  
  224.           mn3lu = itabe1(ISOU+5)
  225.           MN3 = mn3lu
  226.           if (n45.lt.28) MN3 = 7
  227.           MN3 = MAX(MN3,1)
  228.       if (iimpil.eq.1972) write(ioimp,*) ' nparmo MN3 ',nparmo, MN3
  229.  
  230.           SEGINI,IMODEL
  231.           mmodel.KMODEL(ISOUEL) = IMODEL
  232.  
  233.           imodel.CONMOD = '                '
  234.           imodel.IMAMOD = itabe1(ISOU+1)
  235.           imodel.NEFMOD = itabe1(ISOU+2)
  236.           IF (niveau.GE.20) THEN
  237.             imodel.IPDPGE = itabe1(ISOU+6)
  238.           ELSE
  239.             imodel.IPDPGE = 0
  240.             IF (niveau.GE.12) THEN
  241.               ii_z = itabe1(ISOU+6)
  242.               IF (ii_z.GT.0) THEN
  243.                 ipt1 = ii_z + NBANC
  244.                 CALL CRELEM(ipt1)
  245. C On verifie s'il n'a pas deja ete preconditionne.
  246.                 CALL CRECH1(ipt1,1)
  247.                 segdes,ipt1
  248.                 imodel.IPDPGE = ipt1
  249.               ENDIF
  250.             ENDIF
  251.           ENDIF
  252.  
  253.           if (n45.ge.38) then
  254.             jderiv = itabe1(isou+38)
  255.           else
  256. cbp,2020-12-10 : abandon de MEPSIL (CCOPTIO) et IDERIV (MMODEL)
  257. c            jderiv=mepsil
  258.             jderiv = 0
  259.           endif
  260.           imodel.IDERIV = jderiv
  261.  
  262.           imodel.CONMOD(1:8)  = itabe5(idecmo*(ISOUEL-1)+1)
  263.           imodel.CONMOD(9:16) = itabe5(idecmo*(ISOUEL-1)+2)
  264.           if (niveau.ge.13) then
  265.             imodel.CONMOD(17:24) = itabe5(idecmo*(ISOUEL-1)+3)
  266.           endif
  267.  
  268. c* Lecture de la formulation :
  269.           DO in = 1, NFOR
  270.             jfor = jfor + 1
  271.             imodel.FORMOD(in)(1:8) = itabe2(jfor)
  272.             jfor = jfor + 1
  273.             imodel.FORMOD(in)(9:16) = itabe2(jfor)
  274.           ENDDO
  275.           DO in = 1, NMAT
  276.             jmat = jmat + 1
  277.             imodel.MATMOD(in)(1:8) = itabe3(jmat)
  278.             jmat = jmat + 1
  279.             imodel.MATMOD(in)(9:16) = itabe3(jmat)
  280.           ENDDO
  281.  
  282. c* Cas particuliers :
  283.           inconv = 0
  284.           inraye = 0
  285.           do in = 1, NFOR
  286.             if (imodel.FORMOD(in).eq.'CONVECTION      ' ) then
  287.               if (inconv.eq.0) then
  288.                 inconv = in
  289.                 NMAT = NMAT+1
  290.                 SEGADJ,imodel
  291.                 imodel.FORMOD(in) = 'THERMIQUE       '
  292.                 imodel.MATMOD(NMAT) = 'CONVECTION      '
  293.               else
  294.                 write(ioimp,*) 'CONVECTION lue > 1 !!!'
  295.               endif
  296.             endif
  297.             if (imodel.FORMOD(in).eq.'RAYONNEMENT     ' ) then
  298.               if (inraye.eq.0) then
  299.                 inraye = in
  300.                 NMAT = NMAT+1
  301.                 SEGADJ,imodel
  302.                 imodel.FORMOD(in) = 'THERMIQUE       '
  303.                 DO i = NMAT, 2, -1
  304.                   imodel.MATMOD(i) = imodel.MATMOD(i-1)
  305.                 ENDDO
  306.                 imodel.MATMOD(1) = 'RAYONNEMENT     '
  307.               else
  308.                 write(ioimp,*) 'RAYONNEMENT lu > 1 !!!'
  309.               endif
  310.             endif
  311.           enddo
  312.           if (inconv.ne.0 .and. inraye.ne.0) then
  313.             write(ioimp,*) 'CONVECTION & RAYONNEMENT lus > 1 !!!'
  314.             call erreur(5)
  315.             return
  316.           endif
  317.  
  318. c* Lecture de INFMOD :
  319.           do in = 1, mn3lu
  320.             jinf = jinf + 1
  321.             imodel.INFMOD(in) = itabe4(jinf)
  322.           enddo
  323.       if (iimpil.eq.1972) then
  324.         write(ioimp,*) ' MN3 & mn3lu',MN3,mn3lu
  325.         write(ioimp,*) ' infmod',(infmod(in),in=1,mn3)
  326.       endif
  327.  
  328. C* Cas standard :
  329.           if (niveau.ge.13) then
  330.             if (n45.gt.28) then
  331.               imodel.CMATEE = itabe5(idecmo*(ISOUEL-1)+4)
  332.               imodel.IMATEE = itabe1(ISOU+7)
  333.               imodel.INATUU = itabe1(ISOU+8)
  334. c*              do iou = 1, imodel.infele(/1)
  335.               do in = 1, 16
  336.                 imodel.INFELE(in) = itabe9(in+(ISOUEL-1)*16)
  337.               enddo
  338. c*              do iou = 1, imodel.lnomid(/2)
  339.               do iou = 1, 14
  340.                 nbrobl = itabe1(isou+7+2*iou)
  341.                 nbrfac = itabe1(isou+8+2*iou)
  342.                 if (nbrobl+nbrfac .ne. 0) then
  343.                   SEGINI,nomid
  344.                   do in = 1, nbrobl
  345.                     jnomid = jnomid+1
  346.                     nomid.lesobl(in) = itabe6(jnomid)
  347.                   enddo
  348.                   do in = 1, nbrfac
  349.                     jnomid = jnomid+1
  350.                     nomid.lesfac(in) = itabe6(jnomid)
  351.                   enddo
  352.                   SEGDES,nomid
  353.                   imodel.LNOMID(iou) = nomid
  354.                 endif
  355.               enddo
  356.  
  357. C* Cas particuliers :
  358.             else
  359.               CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,cma,ima,ina)
  360.               if (ierr.ne.0) return
  361.               imodel.CMATEE = cma
  362.               imodel.IMATEE = ima
  363.               imodel.INATUU = ina
  364.               IF (FORMOD(1).eq.'MECANIQUE       ' .or.
  365.      &            FORMOD(1).eq.'POREUX          ' .or.
  366.      &            FORMOD(1).eq.'DIFFUSION       ' .or.
  367.      &            FORMOD(1).eq.'ELECTROSTATIQUE ' .or.
  368.      &            FORMOD(/2).eq.2) then
  369.                 if (MN3.lt.12) then
  370.                   MN3 = 12
  371.                   SEGADJ,imodel
  372.                 endif
  373.                 call prquoi(imodel)
  374.               ENDIF
  375.               lmotva = 0
  376.               lmotma = 0
  377.               lmotmf = 0
  378.               lmotpa = 0
  379.               llmova = itabe1(ISOU+7)
  380.               llmoma = itabe1(ISOU+8)
  381.               llfama = itabe1(ISOU+9)
  382.               jgn = LOCOMP
  383.               if (llmova.ne.0) then
  384.                 jgm = llmova
  385.                 SEGINI,mlmots
  386.                 do in = 1, jgm
  387.                   jnomid=jnomid+1
  388.                   mots(in) = itabe6(jnomid)
  389.                 enddo
  390.                 lmotva = mlmots
  391.               endif
  392.               if (llmoma.ne.0) then
  393.                 jgm = llmoma
  394.                 SEGINI,mlmots
  395.                 do in = 1, jgm
  396.                   jnomid = jnomid+1
  397.                   mots(in) = itabe6(jnomid)
  398.                 enddo
  399.                 lmotma = mlmots
  400.               endif
  401.               if (llfama.ne.0) then
  402.                 jgm = llfama
  403.                 SEGINI,mlmots
  404.                 do in = 1, jgm
  405.                   jnomid = jnomid+1
  406.                   mots(in)=itabe6(jnomid)
  407.                 enddo
  408.                 lmotmf = mlmots
  409.               endif
  410.               if (nparmo.ne.0) then
  411.                 jgm = nparmo
  412.                 SEGINI, mlmots
  413.                 do in = 1, nparmo
  414.                   jnomid=jnomid+1
  415.                   mots(in)=itabe6(jnomid)
  416.                 enddo
  417.                 lmotpa = mlmots
  418.               endif
  419.               CALL INOMID(imodel,lmotva,lmotma,lmotmf,lmotpa)
  420.             endif
  421. C* Anciens niveaux < 13 :
  422.           else
  423.             CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,cma,ima,ina)
  424.             if (ierr.ne.0) return
  425.             imodel.CMATEE = cma
  426.             imodel.IMATEE = ima
  427.             imodel.INATUU = ina
  428.  
  429.             IF (FORMOD(1).eq.'MECANIQUE       ' .or.
  430.      &          FORMOD(1).eq.'POREUX          ' .or.
  431.      &          FORMOD(1).eq.'DIFFUSION       ' .or.
  432.      &          FORMOD(1).eq.'ELECTROSTATIQUE ' .or.
  433.      &          FORMOD(/2).eq.2) then
  434.               IF (MN3.lt.12) then
  435.                 MN3 = 12
  436.                 SEGADJ,imodel
  437.               endif
  438.               call prquoi(imodel)
  439.             ENDIF
  440.             lmotva = 0
  441.             lmotma = 0
  442.             lmotmf = 0
  443.             lmotpa = 0
  444.             CALL INOMID(imodel,lmotva,lmotma,lmotmf,lmotpa)
  445.           endif
  446.  
  447. C* Cas particuliers :
  448.       if (iimpil.eq.1972) write(ioimp,*) FORMOD(1),niveau,MN3
  449.           IF (FORMOD(1).eq.'MAGNETODYNAMIQUE') THEN
  450.             if (niveau.le.24 .and. MN3.lt.12) then
  451.               MN3 = 12
  452.               SEGADJ,imodel
  453.               call prquoi(imodel)
  454.             endif
  455.           ENDIF
  456.           IF (FORMOD(1).eq.'CHANGEMENT_PHASE' .or.
  457.      &        FORMOD(1).eq.'THERMOHYDRIQUE  ') THEN
  458.             if (niveau.le.25 .and. MN3.lt.12) then
  459.               MN3 = 12
  460.               SEGADJ,imodel
  461.               call prquoi(imodel)
  462.             endif
  463.           ENDIF
  464.  
  465.           if (niveau.ge.15) then
  466.             do in = 1, nobmod
  467.               jobj = jobj+1
  468.               imodel.TYMODE(in) = itabe7(jobj)
  469.               imodel.IVAMOD(in) = itabe8(jobj)
  470.             enddo
  471.           endif
  472.  
  473. *Petite modification en cas de modele externe :
  474.           if (imodel.FORMOD(/2).eq.1) then
  475.             if (imodel.FORMOD(1).eq.'MECANIQUE       ' .or.
  476.      &          imodel.FORMOD(1).eq.'POREUX          ') then
  477.               if (imodel.INATUU.GE.0) goto 200
  478.               iumat = 0
  479.               ivisc = 0
  480.               iviex = 0
  481.               do in = 1, nmat
  482.                 if (matmod(in).eq.'NON_LINEAIRE    ') iumat = in
  483.                 if (matmod(in).eq.'VISCO_EXTERNE   ') ivisc = in
  484.               enddo
  485.               if (iumat.ne.0) then
  486.                 if (matmod(iumat+1).ne.'UTILISATEUR     ') then
  487.                   write(ioimp,*) 'maj modele umat incorrect'
  488.                   call erreur(5)
  489.                   return
  490.                 endif
  491.                 imodel.INATUU = -1
  492.               endif
  493.               if (ivisc.ne.0) then
  494.                 if (imodel.INATUU.eq.-2) goto 200
  495. c* mise a jour du modele
  496.                 CALL MODVIX(momodl,nmod)
  497.                 CALL PLACE(momodl,nmod,iviex,matmod(ivisc+1))
  498.                 if (iviex.eq.0) then
  499.                   write(ioimp,*) 'MAJ modele IVIEX incorrect'
  500.                   call erreur(5)
  501.                   return
  502.                 endif
  503.                 imodel.INATUU = -2
  504.                 nobmod = nobmod + 1
  505.                 SEGADJ,imodel
  506.                 imodel.TYMODE(nobmod+1) = 'IVIEX   '
  507.                 imodel.IVAMOD(nobmod+1) = iviex
  508.               endif
  509.  200          continue
  510.             endif
  511.           endif
  512.  
  513. *Petite verification en diffusion
  514.           if (FORMOD(1).eq.'DIFFUSION       ') then
  515.             if (niveau.lt.17) then
  516.               write(ioimp,*) 'Incompatibilite de niveau !'
  517.               call erreur(5)
  518.               return
  519.             endif
  520. *SG: Au-dessus du niveau 18, les noms d'inconnues lnomdd et lnomdu sont sauvegardes
  521.             if (niveau.le.18) then
  522.               call vermdi(tymode(1),tymode(2))
  523.               if (ierr.ne.0) then
  524.                 write(ioimp,*) 'Revoir votre mise en donnees !'
  525.                 call erreur(5)
  526.                 return
  527.               endif
  528.             endif
  529.           endif
  530.  
  531.           SEGDES,IMODEL
  532.  
  533.  20     CONTINUE
  534.  
  535.         SEGSUP,mtabe1,mtabe2,mtabe3
  536.         SEGSUP,mtabe4,mtabe5
  537.         if (nm6.gt.0) then
  538.           SEGSUP,mtabe6,mtab6b
  539.         endif
  540.         if (nm7.gt.0) then
  541.           SEGSUP,mtabe7,mtabe8
  542.         endif
  543.  
  544.         SEGDES,MMODEL
  545.         ITLAC(**) = MMODEL
  546.  
  547.  10   CONTINUE
  548.  
  549. c      RETURN
  550.       END
  551.  
  552.  
  553.  
  554.  
  555.  

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