Télécharger la plaquette Cast3M


fr en

Télécharger wrmodl.eso

Retour à la liste

Numérotation des lignes : 

wrmodl

  1. C WRMODL    SOURCE    OF166741  24/05/06    21:15:27     11082          
  2.  
  3.       SUBROUTINE WRMODL(IOSAU,ITLACC,IMAX1,IFORM,IONIVE,IDEB)
  4.  
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *     Ecriture d'un nouveau MODELE sur le fichier IOSAU.             *
  8. *                                                                    *
  9. *     Paramètres:                                                    *
  10. *                                                                    *
  11. *     IOSAU   Numéro du fichier de sortie                            *
  12. *     ITLACC  Pile contenant les nouveaux MODELEs                    *
  13. *     IMAX1   Nombre de MODELEs dans la pile                         *
  14. *     IFORM   Si sauvegarde en format ou non                         *
  15. *                                                                    *
  16. *     Appelé par: WRPIL                                              *
  17. *                                                                    *
  18. *     Auteur, date de création:                                      *
  19. *                                                                    *
  20. *     Denis ROBERT-MOUGIN, le 5 juillet 1989.                        *
  21. *                                                                    *
  22. *--------------------------------------------------------------------*
  23.       IMPLICIT INTEGER(I-N)
  24.       IMPLICIT REAL*8(A-H,O-Z)
  25.  
  26. -INC PPARAM
  27. C==DEB= FORMULATION HHO == INCLUDE =====================================
  28. -INC CCHHOPA
  29. -INC CCHHORS
  30. C==FIN= FORMULATION HHO ================================================
  31.  
  32. -INC SMMODEL
  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.       segment mtahho
  69.          integer itahho(nmh)
  70.       end segment
  71.  
  72. *  pour l'instant idan(9 et 10) sont libres
  73.       INTEGER IDAN(10)
  74.  
  75.       MN3=0
  76.       N45=38
  77.  
  78.       NIDAN=10
  79. *
  80. *     BOUCLE SUR LES MODELES CONTENUS DANS LA PILE:
  81. *
  82.       DO 10 IEL=IDEB,IMAX1
  83.          MMODEL  = ITLAC(IEL)
  84.          IF (MMODEL.eq.0) GO TO 10
  85. *
  86.          DO 110 INI=1,NIDAN
  87.             IDAN(INI) = 0
  88.  110     CONTINUE
  89. *
  90.             SEGACT,MMODEL
  91.             N1  = KMODEL(/1)
  92. *
  93. *           Boucles sur les zones élémentaires du MODELE:
  94. *
  95.             NM1 = N1 * N45
  96.             NM2 = 0
  97.             NM3 = 0
  98.             NM4 = 0
  99.             NM6 = 0
  100.             nm7= 0
  101.             nm9=n1*16
  102.             SEGINI,MTABE1
  103.             segini mtabe9
  104. *            IF(IONIVE.GE.4) THEN
  105. * a partir du niveau 13 on stocke aussi PHAMOD
  106.                IDECMO=4
  107.                NM5 = N1 * idecmo
  108.                SEGINI,MTABE5
  109. *            ENDIF
  110. *
  111.             DO 21 ISOUEL=1,N1
  112.                ISOU = N45 * (ISOUEL - 1)
  113.                IMODEL = KMODEL(ISOUEL)
  114.                SEGACT IMODEL
  115.                NFOR = FORMOD(/2)
  116.                NMAT = MATMOD(/2)
  117.                MN3  = INFMOD(/1)
  118.                nobmod=tymode(/2)
  119.                NM2 = NM2 + NFOR
  120.                NM3 = NM3 + NMAT
  121.                NM4 = NM4 + MN3
  122.                nm7=nm7+nobmod
  123. c*               llmova=0
  124. c*               llmoma=0
  125. c*               llfama=0
  126.                ITABE1(ISOU+1)  = IMAMOD
  127.                ITABE1(ISOU+2)  = NEFMOD
  128.                ITABE1(ISOU+3)  = NFOR
  129.                ITABE1(ISOU+4)  = NMAT
  130. *               ITABE1(ISOU+5)  = IPDPGE
  131. *               IF(IONIVE.GE.4) THEN
  132.                ITABE1(ISOU+5)  = MN3
  133.                ITABE5(idecmo*(ISOUEL-1) +1)=CONMOD(1:8)
  134.                ITABE5(idecmo*(ISOUEL-1) +2)=CONMOD(9:16)
  135.                ITABE5(idecmo*(ISOUEL-1) +3)=CONMOD(17:24)
  136.                ITABE5(idecmo*(ISOUEL-1) +4)=CMATEE
  137. *               ENDIF
  138.                ITABE1(ISOU+6)  = IPDPGE
  139.                ITABE1(ISOU+7)= IMATEE
  140.                ITABE1(ISOU+8)=INATUU
  141.                DO iou=1,14
  142.                  nomid=lnomid(iou)
  143.                  nbrobl=0
  144.                  nbrfac=0
  145.                  if(nomid.ne.0) then
  146.                    segact nomid
  147.                    nbrobl=lesobl(/2)
  148.                    nbrfac=lesfac(/2)
  149.                  endif
  150.                  nm6=nm6+nbrobl+nbrfac
  151.                  itabe1(isou+7+2*IOU)=nbrobl
  152.                  itabe1(isou+8+2*IOU)=nbrfac
  153.                ENDDO
  154.                ITABE1(ISOU+37)=nobmod
  155.                ITABE1(ISOU+38)=ideriv
  156.                do iyu=1,16
  157.                   itabe9(iyu+(isouel-1)*16)=infele(iyu)
  158.                enddo
  159.   21        CONTINUE
  160. *
  161. *           PASSAGE MATMOD ET FORMOD DE CHARACTER*8 EN CHARACTER*16
  162. *           ON DECOMPOSE LE CHARACTER*16 EN DEUX CHARACTER*8
  163. *           IDEM POUR CONMOD
  164. *
  165.             NM2=NM2*2
  166.             NM3=NM3*2
  167. *
  168.             IDAN(1) = N1
  169.             IDAN(2) = NM2
  170.             IDAN(3) = NM3
  171.             IDAN(4) = NM4
  172.             idan(5) = NM5
  173.             idan(6) = N45
  174.             idan(7) = nm6
  175.             idan(8) = nm7
  176.             idan(9) = 0
  177.             idan(10)= 0
  178.  
  179. C==DEB= FORMULATION HHO ================================================
  180. C= On utilise idan(9) pour sauver une seule fois les maillages globaux !
  181.             nmh = 0
  182.             IF (ISAUHO.EQ.1) THEN
  183.               iHHO = 0
  184.               DO ISOUEL = 1, N1
  185.                 imodel = KMODEL(ISOUEL)
  186.                 IF (imodel.NEFMOD .EQ. HHO_NUM_ELEMENT) iHHO = iHHO + 1
  187.               END DO
  188.               IF (iHHO.GT.0) nmh = 4
  189.             END IF
  190.             idan(9) = nmh
  191. C==FIN= FORMULATION HHO ================================================
  192.  
  193.             CALL ECDIFE(IOSAU,NIDAN,IDAN,IFORM)
  194.             CALL ECDIFE(IOSAU,NM1,ITABE1,IFORM)
  195.             CALL ECDIFE(IOSAU,NM9,ITABE9,IFORM)
  196.             SEGSUP MTABE1
  197. *            IF(IONIVE.GE.4) THEN
  198.                CALL ECDIFN(IOSAU,NM5,MTABE5,IFORM)
  199.                SEGSUP MTABE5
  200.                SEGINI,MTABE4
  201. *            ENDIF
  202. *
  203.             SEGINI,MTABE2
  204.             SEGINI,MTABE3
  205.             segini,mtabe6
  206. *            segini,mtab6b
  207.             IF (nm7 .gt. 0) then
  208.               segini mtabe7,mtabe8
  209.             END IF
  210.             JFOR= 0
  211.             JMAT= 0
  212.             JINF= 0
  213.             JNOMID=0
  214.             Jobj=0
  215.             DO 20 ISOUEL=1,N1
  216.                IMODEL = KMODEL(ISOUEL)
  217.                NFOR   = FORMOD(/2)
  218.                NMAT   = MATMOD(/2)
  219.                nobmod=tymode(/2)
  220. *
  221.                DO 30 IFOR=1,NFOR
  222.                   JFOR = JFOR + 1
  223.                   ITABE2(JFOR) = FORMOD(IFOR)(1:8)
  224.                   JFOR = JFOR + 1
  225.                   ITABE2(JFOR) = FORMOD(IFOR)(9:16)
  226.  30            CONTINUE
  227. *
  228.                DO 40 IMAT=1,NMAT
  229.                   JMAT = JMAT + 1
  230.                   ITABE3(JMAT) = MATMOD(IMAT)(1:8)
  231.                   JMAT = JMAT + 1
  232.                   ITABE3(JMAT) = MATMOD(IMAT)(9:16)
  233.  40            CONTINUE
  234. *
  235. *               IF(IONIVE.GE.4) THEN
  236.                   MN3    = INFMOD(/1)
  237.                   DO 50 IMN3=1,MN3
  238.                      JINF = JINF + 1
  239.                      ITABE4(JINF) = INFMOD(IMN3)
  240.  50               CONTINUE
  241. *               ENDIF
  242.                do iou=1,14
  243.                  nomid = lnomid(iou)
  244.                  if(nomid.ne.0) then
  245.                     segact nomid
  246.                     nbrobl=lesobl(/2)
  247.                     if(nbrobl.ne.0)then
  248.                       do ityo=1,nbrobl
  249.                         jnomid=jnomid+1
  250.                         itabe6(jnomid)=lesobl (ityo)
  251.                       enddo
  252.                     endif
  253.                     nbrfac=lesfac(/2)
  254.                     if(nbrfac.ne.0)then
  255.                       do ityo=1,nbrfac
  256.                         jnomid=jnomid+1
  257.                         itabe6(jnomid)=lesfac (ityo)
  258.                       enddo
  259.                     endif
  260.                     segdes nomid
  261.                  endif
  262.                enddo
  263.               if(nobmod.ne.0) then
  264.                 do 51 ihy=1,nobmod
  265.                   jobj=jobj+1
  266.                    itabe7(jobj)=tymode(ihy)
  267.                    itabe8(jobj)=ivamod(ihy)
  268.   51            continue
  269.               endif
  270. *
  271.                SEGDES,IMODEL
  272.  20         CONTINUE
  273. *
  274.             CALL ECDIFN(IOSAU,NM2,MTABE2,IFORM)
  275.             CALL ECDIFN(IOSAU,NM3,MTABE3,IFORM)
  276.             SEGSUP MTABE2,MTABE3
  277. *               if(ionive.ge.4) then
  278.             CALL ECDIFE(IOSAU,NM4,ITABE4,IFORM)
  279.             SEGSUP MTABE4
  280. *               endif
  281. *               if(ionive.eq.13)call ecdien(iosau,nm6,mtab6b,iform)
  282. *               if(ionive.ge.14) then
  283.             call ecdifn(iosau,nm6,mtabe6,iform)
  284.             segsup mtabe6
  285. *               endif
  286.              IF (NM7.NE.0) THEN
  287.                 call ECDIFN(IOSAU,NM7,MTABE7,IFORM)
  288.                 CALL ECDIFE(IOSAU,NM7,ITABE8,IFORM)
  289.                 SEGSUP,MTABE7,MTABE8
  290.              END IF
  291.  
  292. C==DEB= FORMULATION HHO ================================================
  293.              IF (ISAUHO.EQ.1 .AND. nmh.NE.0) THEN
  294. **Mettre "les pointeurs sur les maillages" contenus dans le common...
  295.                 SEGINI,mtahho
  296.                 mtahho.itahho(1) = ISSQHO
  297.                 mtahho.itahho(2) = ISCEHO
  298.                 mtahho.itahho(3) = ISPFHO
  299.                 mtahho.itahho(4) = ISPCHO
  300.                 CALL ECDIFE(IOSAU,nmh,itahho,IFORM)
  301.                 SEGSUP,mtahho
  302. * Plus besoin de faire la sauvegarde !
  303.                 ISAUHO = 0
  304.              END IF
  305. C==FIN= FORMULATION HHO ================================================
  306.  
  307.             SEGDES,MMODEL
  308. *
  309.  10   CONTINUE
  310.  
  311.       END
  312.  
  313.  
  314.  

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