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

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