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    CB215821  24/04/12    21:16:35     11897          
  2.  
  3.       SUBROUTINE LIMODL(IURES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU
  4.      &   ,NBANC)
  5.  
  6.       IMPLICIT INTEGER(I-N)
  7.       IMPLICIT REAL*8(A-H,O-Z)
  8. *--------------------------------------------------------------------*
  9. *                                                                    *
  10. *     LECTURE D'UN NOUVEAU MODELE SUR LE FICHIER IORES.              *
  11. *                                                                    *
  12. *     Param}tres:                                                    *
  13. *                                                                    *
  14. *     IORES   Num{ro du fichier de sortie                            *
  15. *     ITLACC  Pile contenant les nouveaux MODELEs                    *
  16. *     IMAX1   Nombre de MODELEs dans la pile                         *
  17. *     IFORM   Si sauvegarde en format ou non                         *
  18. *                                                                    *
  19. *     APPEL{ PAR: LIPIL                                              *
  20. *                                                                    *
  21. *     Auteur, date de cr{ation:                                      *
  22. *                                                                    *
  23. *     Denis ROBERT-MOUGIN, le 5 juillet 1989.                        *
  24. *                                                                    *
  25. *--------------------------------------------------------------------*
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29.  
  30. -INC SMMODEL
  31. -INC SMLMOTS
  32. -INC SMELEME
  33.  
  34.       SEGMENT,ITLACC
  35.          INTEGER ITLAC(0)
  36.       ENDSEGMENT
  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. * maj modele externe (visco_externe ou utilisateur)
  70.       CHARACTER*16 MOMODL(10)
  71. *
  72. *      write(6,*) ' niveau limodl  ', niveau
  73.       N45=5
  74.       IF(NIVEAU.GE.12) N45=6
  75.       NIDAN=4
  76.       if( niveau.ge.13) nidan = 7
  77.       if(niveau.ge.15)  nidan=10
  78.       IRETOU=0
  79.       MN3=0
  80.       NM7=0
  81. *
  82. *     Boucle sur les MODELEs contenus dans la pile:
  83. *
  84.       DO 10 IEL=1,IMAX1
  85.          DO 110 INI=1,NIDAN
  86.            IDAN(INI) = 0
  87. 110      CONTINUE
  88.          CALL LFCDIE(IURES,NIDAN,IDAN,IRETOU,IFORM)
  89.          IF(IRETOU.NE.0) RETURN
  90.             N1  =IDAN(1)
  91.             NM2 =IDAN(2)
  92.             NM3 =IDAN(3)
  93.             NM4 =IDAN(4)
  94.             idecmo=2
  95.             NM5 = N1 * idecmo
  96.             if(niveau.ge.13) then
  97.               nm5=idan(5)
  98.               idecmo=0
  99.               if (n1.gt.0) idecmo=nm5/n1
  100.               n45=idan(6)
  101.               nm6=idan(7)
  102.               segini mtabe6
  103.               segini mtab6b
  104.              if(niveau.ge.15)  then
  105.                nm7=idan(8)
  106.                segini mtabe7,mtabe8
  107.              endif
  108.             endif
  109. *
  110.             SEGINI MMODEL
  111.             NM1 = N1 * N45
  112.             nm9=n1*16
  113.             segini,mtabe9
  114.             SEGINI,MTABE1
  115.             SEGINI,MTABE2
  116.             SEGINI,MTABE3
  117. *            IF(NIVEAU.GE.4) THEN
  118.               SEGINI,MTABE4
  119.               SEGINI,MTABE5
  120. *            ENDIF
  121. *
  122.             CALL LFCDIE(IURES,NM1,ITABE1,IRETOU,IFORM)
  123.             if(n45.gt.28) call lfcdie(IURES,NM9,ITABE9,IRETOU,IFORM)
  124. *            write(6,*) ' itabe1 '
  125. *            write(6,fmt='(10i5)' ) (itabe1(iau),iau=1,nm1)
  126.             IF(IRETOU.NE.0) RETURN
  127. *            IF(NIVEAU.GE.4) THEN
  128. *             write(6,*) 'nm1 nm2 nm3 nm4 nm5 nm6 nm7 '
  129. *             write(6,*) nm1, nm2 ,nm3, nm4, nm5, nm6, nm7
  130.               CALL LFCDIN(IURES,NM5,ITABE5,IRETOU,IFORM)
  131.               IF(IRETOU.NE.0) RETURN
  132. *            ENDIF
  133.             CALL LFCDIN(IURES,NM2,ITABE2,IRETOU,IFORM)
  134.             IF(IRETOU.NE.0) RETURN
  135.             CALL LFCDIN(IURES,NM3,ITABE3,IRETOU,IFORM)
  136.             IF(IRETOU.NE.0) RETURN
  137. *            IF(NIVEAU.GE.4) THEN
  138.               CALL LFCDIE(IURES,NM4,ITABE4,IRETOU,IFORM)
  139.               IF(IRETOU.NE.0) RETURN
  140. *            ENDIF
  141.             if(niveau.ge.14) then
  142.               call lfcdin(iores,nm6,itabe6,iretou,iform)
  143.               IF(IRETOU.NE.0) RETURN
  144.             ENDIF
  145.             if(niveau.eq.13) then
  146.               call lfcden(iores,nm6,itab6b,iretou,iform)
  147.               if(iretou.ne.0) return
  148.             endif
  149.             if(niveau.ge.15.and.nm7.ne.0) then
  150.                call  LFCDIN(IURES,NM7,ITABE7,IRETOU,IFORM)
  151. *               write(6,*) 'nm7 ' , nm7
  152. *               write(6,*) 'itabe7 ',( itabe7(iou),iou=1,nm7)
  153.                if(iretou.ne.0) return
  154.                CALL LFCDIE(IURES,NM7,ITABE8,IRETOU,IFORM)
  155. *               write(6,*)'itabe8 ', ( itabe8(iou),iou=1,nm7)
  156.                if(iretou.ne.0) return
  157.             endif
  158.  
  159. *        BOUCLES SUR LES ZONES {L{MENTAIRES DU MODELE:
  160. *
  161.             JFOR= 0
  162. *            write(6,*) '  N45 ' , n45
  163.             JMAT= 0
  164.             JINF= 0
  165.             JNOMID=0
  166.             nparmo=0
  167.             jobj=0
  168.             nobmod=0
  169.             jderiv=0
  170.             DO 20 ISOUEL=1,N1
  171.                ISOU = N45 * ( ISOUEL - 1 )
  172.                NFOR   = ITABE1(ISOU+3)
  173.                NMAT   = ITABE1(ISOU+4)
  174.                if(niveau.ge.13) nparmo= itabe1(isou+10)
  175.                if(niveau.ge.15) nobmod = itabe1(isou+11)
  176.                if(n45.ge.37) nobmod=itabe1(isou+37)
  177.                if(n45.ge.38) then
  178.                   jderiv=itabe1(isou+38)
  179.                else
  180. c                   jderiv=mepsil
  181. cbp,2020-12-10 : abandon de MEPSIL (CCOPTIO) et IDERIV (MMODEL)
  182.                     jderiv=0
  183.                endif
  184.                IF(NIVEAU.GE.4) MN33    = ITABE1(ISOU+5)
  185.                mn3=mn33
  186.                if(n45.lt.28) mn3=7
  187. *
  188. *              write(6,*) ' nparmo nm3 ', nparmo ,mn3
  189.                SEGINI IMODEL
  190.                CONMOD='        '
  191.                KMODEL(ISOUEL) = IMODEL
  192.                IMAMOD = ITABE1(ISOU+1)
  193.                NEFMOD = ITABE1(ISOU+2)
  194.                IF (NIVEAU.GE.20) THEN
  195.                  IPDPGE = ITABE1(ISOU+6)
  196.                ELSE
  197. *                 IF (NIVEAU.LE.19) THEN
  198.                  IPDPGE = 0
  199.                  IF (NIVEAU.GE.12) THEN
  200.                    ii_z = ITABE1(ISOU+6)
  201.                    IF (ii_z.GT.0) THEN
  202.                      IPT1 = ii_z + NBANC
  203.                      CALL CRELEM(IPT1)
  204. C On verifie s'il n'a pas deja ete preconditionne.
  205.                      CALL CRECH1(IPT1,1)
  206.                      segdes,ipt1
  207.                      IPDPGE = IPT1
  208.                    ENDIF
  209.                  ENDIF
  210. *                 ENDIF
  211.                ENDIF
  212.                ideriv=jderiv
  213. *               IF(NIVEAU.GE.4) THEN
  214.                CONMOD(1:8) = ITABE5(idecmo*(ISOUEL-1)+1)
  215.                CONMOD(9:16)= ITABE5(idecmo*(ISOUEL-1)+2)
  216.                if(niveau.ge.13) then
  217.                  if(n45.le.28)  then
  218.                    conmod(17:24)= ITABE5(idecmo*(ISOUEL-1)+3)
  219.                    llmova= ITABE1(ISOU+7)
  220.                    llmoma= ITABE1(ISOU+8)
  221.                    llfama= ITABE1(ISOU+9)
  222. *                   write(6,*)'llmova llmoma llfama',llmova,llmoma,llfama
  223.                  else
  224.                    conmod(17:24)= ITABE5(idecmo*(ISOUEL-1)+3)
  225.                    cmatee=ITABE5(idecmo*(ISOUEL-1)+4)
  226.                    imatee=itabe1(isou+7)
  227.                    inatuu=itabe1(isou+8)
  228.                    do iyu=1,16
  229.                      infele(iyu)=itabe9( iyu+(isouel-1)*16)
  230.                    enddo
  231.                  endif
  232.                endif
  233. *
  234.                DO 30 IFOR=1,NFOR
  235.                   JFOR = JFOR + 1
  236.                   FORMOD(IFOR)(1:8) = ITABE2(JFOR)
  237.                   JFOR = JFOR + 1
  238.                   FORMOD(IFOR)(9:16) = ITABE2(JFOR)
  239.  30            CONTINUE
  240. *
  241.                iplu=0
  242.                do ioy=1,nfor
  243.                  if(formod(ioy).eq.'CONVECTION      ' ) then
  244.                    iplu=1
  245.                    formod(ioy)='THERMIQUE'
  246.                  endif
  247.                enddo
  248.                DO 40 IMAT=1,NMAT
  249.                   JMAT = JMAT + 1
  250.                   MATMOD(IMAT)(1:8) = ITABE3(JMAT)
  251.                   JMAT = JMAT + 1
  252.                   MATMOD(IMAT)(9:16) = ITABE3(JMAT)
  253.  40            CONTINUE
  254.                if(iplu.eq.1) then
  255.                  nmat=nmat+1
  256.                  segadj imodel
  257.                  matmod(nmat)='CONVECTION      '
  258.                endif
  259. *
  260. *               IF(NIVEAU.GE.4) THEN
  261.                  DO 50 IMN3=1,MN33
  262.                     JINF = JINF + 1
  263.                     INFMOD(IMN3) = ITABE4(JINF)
  264.  50              CONTINUE
  265. *                write(6,*) ' nm3infmod', mn3,(infmod(iou),iou=1,mn3)
  266. *               ENDIF
  267.                if ( niveau.ge.13) then
  268.                if(n45.le.28) then
  269.                   lmotva=0
  270.                   lmotma=0
  271.                   lmotmf=0
  272.                   lmotpa=0
  273.                   jgn=4
  274.                   jgm=llmova
  275.                   nbrobl=llmova
  276.                   nbrfac=0
  277.                   if(nbrobl.ne.0) then
  278.                     segini mlmots
  279.                     lmotva=mlmots
  280.                     do inm6=1,nbrobl
  281.                      jnomid=jnomid+1
  282. *                     write(6,*) ' jnomid1' , jnomid
  283.                      mots(inm6)=itabe6(jnomid)
  284.                    enddo
  285.                   endif
  286.                   nbrobl=llmoma
  287.                   nbrfac=llfama
  288.                   if(nbrobl.ne.0) then
  289.                     jgm=nbrobl
  290.                     segini mlmots
  291.                     lmotma=mlmots
  292.                     do inm6=1,nbrobl
  293.                      jnomid=jnomid+1
  294. *                     write(6,*) ' jnomid2  ' , jnomid
  295.                      mots(inm6)=itabe6(jnomid)
  296.                     enddo
  297.                   endif
  298.                   if(nbrfac.ne.0) then
  299.                     jgm=nbrfac
  300.                     segini mlmots
  301.                     lmotmf=mlmots
  302.                     do inm6=1,nbrfac
  303.                      jnomid=jnomid+1
  304. *                     write(6,*) ' jnomid3  ' , jnomid
  305.                      mots(inm6)=itabe6(jnomid)
  306.                     enddo
  307.                   endif
  308.                   if(nparmo.ne.0) then
  309.                     jgm=nparmo
  310.                     segini mlmots
  311.                     lmotpa=mlmots
  312.                     do inm6=1,nparmo
  313.                     jnomid=jnomid+1
  314.                      mots(inm6)=itabe6(jnomid)
  315.                     enddo
  316.                   endif
  317.       IF (FORMOD(1).NE.'NAVIER_STOKES'.AND.FORMOD(1).NE.'EULER') THEN
  318.                   call inomid(imodel,'        ',iret,lmotva,lmotma,
  319.      $            lmotmf,lmotpa)
  320.       ENDIF
  321.       IF(FORMOD(1).EQ.'MECANIQUE'.or.formod(1).eq.'POREUX'.or.
  322.      $   FORMOD(1).EQ.'DIFFUSION'.or.formod(1).eq.'ELECTROSTATIQUE'.or.
  323.      $        formod(/2).eq.2) then
  324.                   call prquoi(imodel)
  325.       ENDIF
  326.               else
  327.                 do iou=1,14
  328.                   nbrobl=itabe1(isou+7+2*iou)
  329.                   nbrfac=itabe1(isou+8+2*iou)
  330.                   if(nbrobl+nbrfac.ne.0) then
  331.                     segini nomid
  332.                     lnomid(iou)=nomid
  333.                     do iyto=1,nbrobl
  334.                        jnomid=jnomid+1
  335.                        lesobl(iyto)=itabe6(jnomid)
  336.                     enddo
  337.                     do iyto=1,nbrfac
  338.                        jnomid=jnomid+1
  339.                        lesfac(iyto)=itabe6(jnomid)
  340.                     enddo
  341.                     segdes nomid
  342.                   endif
  343.                 enddo
  344.               endif
  345.              endif
  346.              if(niveau.ge.15) then
  347. *             write(6,*) ' nobmod job' , nobmod,jobj
  348.                do 15 ihy = 1, nobmod
  349.                jobj=jobj+1
  350.                tymode(ihy)=itabe7(jobj)
  351.                ivamod(ihy)=itabe8(jobj)
  352.    15          continue
  353.              endif
  354. *Petite modification en cas de modele externe :
  355.          if (formod(/2).eq.1) then
  356.            if (formod(1).EQ.'MECANIQUE' .OR.
  357.      &         formod(1).EQ.'POREUX') then
  358.              if (inatuu.ge.0) goto 200
  359.              iumat = 0
  360.              ivisc = 0
  361.              iviex = 0
  362.              do i = 1, nmat
  363.                if (matmod(i).EQ.'NON_LINEAIRE')  iumat = i
  364.                if (matmod(i).EQ.'VISCO_EXTERNE') ivisc = i
  365.              enddo
  366.              if (iumat.ne.0) then
  367.                if (matmod(iumat+1).ne.'UTILISATEUR') then
  368.                  write(ioimp,*) 'maj modele umat incorrect'
  369.                  call erreur(5)
  370.                  return
  371.                endif
  372.                inatuu = -1
  373.              endif
  374.              if (ivisc.ne.0) then
  375.                if (inatuu.eq.-2) goto 200
  376. c* mise a jour du modele
  377.                call modvix(momodl,nmod)
  378.                call place(momodl,nmod,iviex,matmod(ivisc+1))
  379.                if (iviex.eq.0) then
  380.                  write(ioimp,*) 'MAJ modele iviex incorrect'
  381.                  call erreur(5)
  382.                  return
  383.                endif
  384.                inatuu = -2
  385.                nobmod = nobmod + 1
  386.                segadj,imodel
  387.                tymode(nobmod+1)='IVIEX   '
  388.                ivamod(nobmod+1)=iviex
  389.              endif
  390.  200         continue
  391.            endif
  392.          endif
  393. *Petite verification en diffusion
  394.          if (formod(1).eq.'DIFFUSION') then
  395.            if (niveau.lt.17) then
  396.              write(ioimp,*) 'Incompatibilite de niveau !'
  397.              call erreur(5)
  398.            endif
  399. *gounand: au-dessus du niveau 18, les noms d'inconnues lnomdd et lnomdu
  400. *         sont sauvegardes
  401.            if (niveau.le.18) call vermdi(tymode(1),tymode(2))
  402.            if (ierr.ne.0) then
  403.              write(ioimp,*) 'Revoir votre mise en donnees !'
  404.              call erreur(5)
  405.            endif
  406.          endif
  407. *
  408.                SEGDES IMODEL
  409.   20       CONTINUE
  410. *
  411.             SEGSUP,MTABE1,MTABE2,MTABE3
  412.             IF(NIVEAU.GE.4) THEN
  413.                SEGSUP,MTABE4,MTABE5
  414.             ENDIF
  415.             if(niveau.ge.14)segsup mtabe6
  416.             if(niveau.ge.13) segsup mtab6b
  417.             if(niveau.ge.15) segsup mtabe7,mtabe8
  418.             SEGDES MMODEL
  419.             ITLAC(**) = MMODEL
  420. *
  421.  10      CONTINUE
  422. *
  423.       RETURN
  424.       END
  425.  
  426.  
  427.  
  428.  
  429.  
  430.  

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