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    CB215821  24/04/12    21:17:30     11897          
  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. -INC SMMODEL
  28.  
  29.       SEGMENT,ITLACC
  30.          INTEGER ITLAC(0)
  31.       ENDSEGMENT
  32.       SEGMENT,MTABE1
  33.          INTEGER ITABE1(NM1)
  34.       ENDSEGMENT
  35.       SEGMENT,MTABE2
  36.          CHARACTER*(8) ITABE2(NM2)
  37.       ENDSEGMENT
  38.       SEGMENT,MTABE3
  39.          CHARACTER*(8) ITABE3(NM3)
  40.       ENDSEGMENT
  41.       SEGMENT,MTABE4
  42.          INTEGER ITABE4(NM4)
  43.       ENDSEGMENT
  44.       SEGMENT,MTABE5
  45.          CHARACTER*(8) ITABE5(NM5)
  46.       ENDSEGMENT
  47.       SEGMENT,MTABE6
  48.          CHARACTER*(8) ITABE6(NM6)
  49.       ENDSEGMENT
  50. *      SEGMENT,MTAB6B
  51. *         CHARACTER*(4) ITAB6B(NM6)
  52. *      ENDSEGMENT
  53.       SEGMENT,MTABE7
  54.          CHARACTER*(8) ITABE7(NM7)
  55.       ENDSEGMENT
  56.       SEGMENT,MTABE8
  57.          integer       itabe8(nm7)
  58.       ENDSEGMENT
  59.       SEGMENT MTABE9
  60.          integer   itabe9(nm9)
  61.       endsegment
  62.  
  63.       INTEGER IDAN(10)
  64.  
  65.       MN3=0
  66.       N45=38
  67.       NIDAN=10
  68. *  pour l'instant idan(9 et 10) sont libres
  69.  
  70. *
  71. *     BOUCLE SUR LES MODELES CONTENUS DANS LA PILE:
  72. *
  73.       DO 10 IEL=IDEB,IMAX1
  74.          MMODEL  = ITLAC(IEL)
  75.          IF (MMODEL.eq.0) GO TO 10
  76. *
  77.          DO 110 INI=1,NIDAN
  78.             IDAN(INI) = 0
  79.  110     CONTINUE
  80. *
  81.             SEGACT,MMODEL
  82.             N1  = KMODEL(/1)
  83. *
  84. *           Boucles sur les zones élémentaires du MODELE:
  85. *
  86.             NM1 = N1 * N45
  87.             NM2 = 0
  88.             NM3 = 0
  89.             NM4 = 0
  90.             NM6 = 0
  91.             nm7= 0
  92.             nm9=n1*16
  93.             segini mtabe9
  94.             SEGINI,MTABE1
  95. *            IF(IONIVE.GE.4) THEN
  96. * a partir du niveau 13 on stocke aussi PHAMOD
  97.                IDECMO=4
  98.                NM5 = N1 * idecmo
  99.                SEGINI,MTABE5
  100. *            ENDIF
  101. *
  102.             DO 21 ISOUEL=1,N1
  103.                ISOU = N45 * (ISOUEL - 1)
  104.                IMODEL = KMODEL(ISOUEL)
  105.                SEGACT IMODEL
  106.                NFOR = FORMOD(/2)
  107.                NMAT = MATMOD(/2)
  108.                MN3  = INFMOD(/1)
  109.                nobmod=tymode(/2)
  110.                NM2 = NM2 + NFOR
  111.                NM3 = NM3 + NMAT
  112.                NM4 = NM4 + MN3
  113.                nm7=nm7+nobmod
  114.                llmova=0
  115.                llmoma=0
  116.                llfama=0
  117.                ITABE1(ISOU+1)  = IMAMOD
  118.                ITABE1(ISOU+2)  = NEFMOD
  119.                ITABE1(ISOU+3)  = NFOR
  120.                ITABE1(ISOU+4)  = NMAT
  121. *               ITABE1(ISOU+5)  = IPDPGE
  122. *               IF(IONIVE.GE.4) THEN
  123.                ITABE1(ISOU+5)  = MN3
  124.                ITABE5(idecmo*(ISOUEL-1) +1)=CONMOD(1:8)
  125.                ITABE5(idecmo*(ISOUEL-1) +2)=CONMOD(9:16)
  126.                ITABE5(idecmo*(ISOUEL-1) +3)=CONMOD(17:24)
  127.                ITABE5(idecmo*(ISOUEL-1) +4)=CMATEE
  128. *               ENDIF
  129.                ITABE1(ISOU+6)  = IPDPGE
  130.                ITABE1(ISOU+7)= IMATEE
  131.                ITABE1(ISOU+8)=INATUU
  132.                DO iou=1,14
  133.                  nomid=lnomid(iou)
  134.                  nbrobl=0
  135.                  nbrfac=0
  136.                  if(nomid.ne.0) then
  137.                    segact nomid
  138.                    nbrobl=lesobl(/2)
  139.                    nbrfac=lesfac(/2)
  140.                  endif
  141.                  nm6=nm6+nbrobl+nbrfac
  142.                  itabe1(isou+7+2*IOU)=nbrobl
  143.                  itabe1(isou+8+2*IOU)=nbrfac
  144.                ENDDO
  145.                ITABE1(ISOU+37)=nobmod
  146.                ITABE1(ISOU+38)=ideriv
  147.                do iyu=1,16
  148.                   itabe9(iyu+(isouel-1)*16)=infele(iyu)
  149.                enddo
  150.   21        CONTINUE
  151. *
  152. *           PASSAGE MATMOD ET FORMOD DE CHARACTER*8 EN CHARACTER*16
  153. *           ON DECOMPOSE LE CHARACTER*16 EN DEUX CHARACTER*8
  154. *           IDEM POUR CONMOD
  155. *
  156.             NM2=NM2*2
  157.             NM3=NM3*2
  158. *
  159.             IDAN(1) = N1
  160.             IDAN(2)= NM2
  161.             IDAN(3)= NM3
  162.             IDAN(4)= NM4
  163.             idan(5)= NM5
  164.             idan(6)= N45
  165.             idan(7)= nm6
  166.             idan(8)= nm7
  167.             CALL ECDIFE(IOSAU,NIDAN,IDAN,IFORM)
  168.             CALL ECDIFE(IOSAU,NM1,ITABE1,IFORM)
  169.             CALL ECDIFE(IOSAU,NM9,ITABE9,IFORM)
  170.             SEGSUP MTABE1
  171. *            IF(IONIVE.GE.4) THEN
  172.                CALL ECDIFN(IOSAU,NM5,MTABE5,IFORM)
  173.                SEGSUP MTABE5
  174.                SEGINI,MTABE4
  175. *            ENDIF
  176. *
  177.             SEGINI,MTABE2
  178.             SEGINI,MTABE3
  179.             segini,mtabe6
  180. *            segini,mtab6b
  181.             segini mtabe7,mtabe8
  182.             JFOR= 0
  183.             JMAT= 0
  184.             JINF= 0
  185.             JNOMID=0
  186.             Jobj=0
  187.             DO 20 ISOUEL=1,N1
  188.                IMODEL = KMODEL(ISOUEL)
  189.                NFOR   = FORMOD(/2)
  190.                NMAT   = MATMOD(/2)
  191.                nobmod=tymode(/2)
  192. *
  193.                DO 30 IFOR=1,NFOR
  194.                   JFOR = JFOR + 1
  195.                   ITABE2(JFOR) = FORMOD(IFOR)(1:8)
  196.                   JFOR = JFOR + 1
  197.                   ITABE2(JFOR) = FORMOD(IFOR)(9:16)
  198.  30            CONTINUE
  199. *
  200.                DO 40 IMAT=1,NMAT
  201.                   JMAT = JMAT + 1
  202.                   ITABE3(JMAT) = MATMOD(IMAT)(1:8)
  203.                   JMAT = JMAT + 1
  204.                   ITABE3(JMAT) = MATMOD(IMAT)(9:16)
  205.  40            CONTINUE
  206. *
  207. *               IF(IONIVE.GE.4) THEN
  208.                   MN3    = INFMOD(/1)
  209.                   DO 50 IMN3=1,MN3
  210.                      JINF = JINF + 1
  211.                      ITABE4(JINF) = INFMOD(IMN3)
  212.  50               CONTINUE
  213. *               ENDIF
  214.                do iou=1,14
  215.                  nomid = lnomid(iou)
  216.                  if(nomid.ne.0) then
  217.                     segact nomid
  218.                     nbrobl=lesobl(/2)
  219.                     if(nbrobl.ne.0)then
  220.                       do ityo=1,nbrobl
  221.                         jnomid=jnomid+1
  222.                         itabe6(jnomid)=lesobl (ityo)
  223.                       enddo
  224.                     endif
  225.                     nbrfac=lesfac(/2)
  226.                     if(nbrfac.ne.0)then
  227.                       do ityo=1,nbrfac
  228.                         jnomid=jnomid+1
  229.                         itabe6(jnomid)=lesfac (ityo)
  230.                       enddo
  231.                     endif
  232.                     segdes nomid
  233.                  endif
  234.                enddo
  235.               if(nobmod.ne.0) then
  236.                 do 51 ihy=1,nobmod
  237.                   jobj=jobj+1
  238.                    itabe7(jobj)=tymode(ihy)
  239.                    itabe8(jobj)=ivamod(ihy)
  240.   51            continue
  241.               endif
  242. *
  243.                SEGDES,IMODEL
  244.  20         CONTINUE
  245. *
  246.             CALL ECDIFN(IOSAU,NM2,MTABE2,IFORM)
  247.             CALL ECDIFN(IOSAU,NM3,MTABE3,IFORM)
  248. *            IF(IONIVE.GE.4) THEN
  249.                CALL ECDIFE(IOSAU,NM4,ITABE4,IFORM)
  250.                SEGSUP MTABE4
  251. *            ENDIF
  252. *            if(ionive.eq.13)call ecdien(iosau,nm6,mtab6b,iform)
  253.             if(ionive.ge.14)call ecdifn(iosau,nm6,mtabe6,iform)
  254.             segsup mtabe6
  255.              if(nm7.ne.0) then
  256.                 call  ECDIFN(IOSAU,NM7,MTABE7,IFORM)
  257.                 CALL ECDIFE(IOSAU,NM7,ITABE8,IFORM)
  258.              endif
  259.  
  260.             SEGSUP MTABE2,MTABE3
  261.             SEGDES,MMODEL
  262. *
  263.  10   CONTINUE
  264.  
  265.       END
  266.  
  267.  
  268.  

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