Télécharger la plaquette Cast3M


fr en

Télécharger extrsk.eso

Retour à la liste

Numérotation des lignes : 

extrsk

  1. C EXTRSK    SOURCE    OF166741  25/02/21    21:16:18     12166          
  2.       SUBROUTINE EXTRSK(IPCHE1,IPMOD1,NS,IPCHS1,IENT4,IERR1)
  3. C-----------------------------------------------------------
  4. C
  5. C                     EXTRSK
  6. C                     ------
  7. C FONCTION:
  8. C SUBROUTINE APPELEE PAR CALP1 OU CALP2 POUR LE CAS DES COQUES MINCES
  9. C AVEC INTEGRATION DANS L'EPAISSEUR
  10. C
  11. C-----------------------------------------------------------
  12. C MODULES UTILISES
  13. C ----------------
  14. C
  15.       IMPLICIT INTEGER(I-N)
  16.       IMPLICIT REAL*8 (A-H,O-Z)
  17.  
  18. -INC PPARAM
  19. -INC CCOPTIO
  20.  
  21. -INC SMCHAML
  22. -INC SMMODEL
  23. -INC SMELEME
  24.  
  25. C
  26. C PARAMETRES:    (E)=ENTREE    (S)=SORTIE
  27. C ----------
  28. C
  29. C     IPCHE1  (E) POINTEUR SUR UN MCHAML
  30. C     IPMOD1  (E) POINTEUR SUR UN IMODEL (ACTIF)
  31. C     NS      (E) NUMERO DE LA ZONE
  32. C     IPCHS1  (E) ET (S) POINTEUR SUR LE MCHAML A REMPLIR (ACTIF)
  33. C     IENT4   (E) ENTIER = NUMERO DE LA COUCHE
  34. C     IERR1   (E,S) PARAMETRE D'ERREUR
  35. C-----------------------------------------------------------
  36.  
  37. -INC TMPTVAL
  38.  
  39.       SEGMENT NOTYPE
  40.         CHARACTER*16 TYPE(NBTYPE)
  41.       ENDSEGMENT
  42.  
  43.       INTEGER INFOS(3)
  44.       CHARACTER*(NCONCH) CONM
  45.       logical lsupde
  46. *
  47.       MCHELM = IPCHE1
  48.       SEGACT,MCHELM
  49.       IMODEL=IPMOD1
  50.       MCHEL1=IPCHS1
  51. *
  52.       IPMAIL=IMAMOD
  53.       CONM=CONMOD
  54. *
  55. *......INFORMATION SUR L'ELEMENT FINI..........
  56.       MELE=NEFMOD
  57.       NBG=INFELE(4)/INFMOD(1)
  58. *
  59. *......CREATION DU TABLEAU INFOS.......
  60.             CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE1,INFOS,IRTD)
  61.             IF (IRTD.EQ.0) THEN
  62.                SEGDES MCHELM
  63.                IERR1=1
  64.                RETURN
  65.             ENDIF
  66. *
  67.             MCHEL1.INFCHE(NS,1)=1
  68.             MCHEL1.INFCHE(NS,2)=0
  69.             MCHEL1.INFCHE(NS,3)=NIFOUR
  70.             MCHEL1.INFCHE(NS,4)=INFELE(11)
  71.             MCHEL1.INFCHE(NS,5)=0
  72.             MCHEL1.INFCHE(NS,6)=5
  73.             MCHEL1.IMACHE(NS)=IMAMOD
  74.             MCHEL1.CONCHE(NS)=CONMOD
  75. *
  76. *...........RECHERCHE DES NOMS COMPOSANTES...........
  77.             lsupde=.false.
  78.             IF (TITCHE(1:4).EQ.'DEFO') THEN
  79.                if(lnomid(5).ne.0) then
  80.                  nomid=lnomid(5)
  81.                  segact nomid
  82.                  mocomp=nomid
  83.                else
  84.                 lsupde=.true.
  85.                 CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NCOMP,NFAC)
  86.                endif
  87.             ELSE
  88.               if(lnomid(4).ne.0) then
  89.                 nomid=lnomid(4)
  90.                 segact nomid
  91.                 mocomp=nomid
  92.                 ncomp=lesobl(/2)
  93.                 nfac=lesfac(/2)
  94.               else
  95.                 lsupde=.true.
  96.                CALL IDCONT(IMODEL,IFOUR,MOCOMP,NCOMP,NFAC)
  97.              endif
  98.             ENDIF
  99. *
  100. *...........VERIFICATION DE LEUR PRESENCE............
  101.             NBTYPE=1
  102.             SEGINI NOTYPE
  103.             MOTYPE=NOTYPE
  104.             TYPE(1)='REAL*8'
  105.             CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCOMP,MOTYPE,
  106.      $           1,INFOS,3,IVACOM)
  107.             IF (IERR.NE.0) THEN
  108.                SEGDES MCHELM
  109.                IERR1=1
  110.                RETURN
  111.             ENDIF
  112. *
  113. *...........CREATION DU MCHAM DE LA SOUS ZONE...........
  114.             N2=NCOMP
  115.             SEGINI MCHAM1
  116.             MCHEL1.ICHAML(NS)=MCHAM1
  117. *
  118. *...........RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER.....
  119.             N1PTEL=0
  120.             N1EL=0
  121.             MPTVAL=IVACOM
  122.             DO 110 ICOMP=1,NCOMP
  123.                MELVAL=IVAL(ICOMP)
  124.                M=MAX(N1PTEL,VELCHE(/1))
  125.                IF (M.GT.1) THEN
  126.                   N1PTEL=M/INFMOD(1)
  127.                ELSE
  128.                   N1PTEL=M
  129.                ENDIF
  130.                N1EL=MAX(N1EL,VELCHE(/2))
  131.                N2PTEL=0
  132.                N2EL=0
  133.                SEGINI MELVA1
  134.                MCHAM1.IELVAL(ICOMP)=MELVA1
  135. 110         CONTINUE
  136. *
  137.             NOMID=MOCOMP
  138.             SEGACT NOMID
  139.             MPTVAL=IVACOM
  140. *...........BOUCLE SUR LES ELEMENTS.......
  141.             DO 20 IB=1,N1EL
  142. *
  143.             DO 20 IGAU=1,N1PTEL
  144. *
  145.                DO 40 ICOMP=1,NCOMP
  146.                   MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP)
  147.                   MCHAM1.TYPCHE(ICOMP)=TYPE(1)
  148.                   MELVAL=IVAL(ICOMP)
  149.                   SEGACT MELVAL
  150.                   MELVA1=MCHAM1.IELVAL(ICOMP)
  151.                   SEGACT MELVA1*MOD
  152.                   IGMN=MIN(IGAU,VELCHE(/1))
  153.                   IBMN=MIN(IB,VELCHE(/2))
  154.                   IF (IGMN.EQ.VELCHE(/1)) THEN
  155.                      MELVA1.VELCHE(IGAU,IB)=VELCHE(IGMN,IBMN)
  156.                   ELSE
  157.                      MELVA1.VELCHE(IGAU,IB)=VELCHE(IGAU+NBG*
  158.      $                     (IENT4-1),IBMN)
  159.                   ENDIF
  160.                   SEGDES MELVAL,MELVA1
  161. 40             CONTINUE
  162. 20          CONTINUE
  163.             SEGDES MCHAM1,nomid
  164.             SEGSUP MPTVAL,NOTYPE
  165.             if(lsupde)segsup nomid
  166. *
  167.       IPCHS1=MCHEL1
  168. *
  169.       SEGDES IMODEL,MCHELM
  170.  
  171.       RETURN
  172.       END
  173.  
  174.  
  175.  

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