Télécharger la plaquette Cast3M


fr en

Télécharger feqpr.eso

Retour à la liste

Numérotation des lignes : 

feqpr

  1. C FEQPR     SOURCE    OF166741  25/02/21    21:16:28     12166          
  2.  
  3. C_______________________________________________________________________
  4. C
  5. C  ENTREES:
  6. C  ________
  7. C
  8. C     IPMODL  Pointeur sur un MMODEL
  9. C     IPCHM1  Pointeur sur un MCHAML de CONTRAINTES
  10. C     IPCHM2  Pointeur sur un MCHAML de CARACTERISTIQUES
  11. C
  12. C  SORTIES:
  13. C  ________
  14. C
  15. C     IPCHP4  Pointeur sur un CHPOINT de forces aux noeuds
  16. C     IRET =  1  OU  0   suivant succes ou pas (Message d'erreur
  17. C                                               imprime dans ce cas)
  18. C_______________________________________________________________________
  19.  
  20.       SUBROUTINE FEQPR(IPMODL,IPCHM1,IPCHM2,IPCHP4,IRET)
  21.  
  22.       IMPLICIT INTEGER(I-N)
  23.       IMPLICIT REAL*8(A-H,O-Z)
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC CCHAMP
  28.  
  29. -INC SMCOORD
  30. -INC SMMODEL
  31. -INC SMCHAML
  32. -INC SMCHPOI
  33. -INC SMELEME
  34. -INC SMINTE
  35. -INC SMLENTI
  36.  
  37. -INC TMPTVAL
  38.  
  39.       SEGMENT NOTYPE
  40.         CHARACTER*16 TYPE(NBTYPE)
  41.       ENDSEGMENT
  42.  
  43.       SEGMENT LIMODL(0)
  44.  
  45.       PARAMETER ( NINF=3 )
  46.       INTEGER INFOS(NINF)
  47.       CHARACTER*(NCONCH) CONM
  48.  
  49.       IRET   = 0
  50.       IPCHP4 = 0
  51.  
  52.       SEGACT,MCOORD*NOMOD
  53. C_______________________________________________________________________
  54. C
  55. C     A T-ON BIEN UN MMODEL CHARGEMENT PRESSION ?
  56. C_______________________________________________________________________
  57.       MMODEL = IPMODL
  58. c*      SEGACT,MMODEL                              <- Actif en E/S
  59.       NSOUS = MMODEL.KMODEL(/1)
  60.  
  61.       IPMOD0 = 0
  62.       SEGINI,LIMODL
  63.       DO ISOUS = 1,NSOUS
  64.         IMODEL = MMODEL.KMODEL(ISOUS)
  65. c*        SEGACT,IMODEL                            <- Actif en E/S
  66.         IF (FORMOD(1).EQ.'CHARGEMENT') THEN
  67.           LIMODL(**) = IMODEL
  68.         ENDIF
  69.       ENDDO
  70.  
  71.       NSOUS = LIMODL(/1)
  72.       IF (NSOUS.EQ.0) THEN
  73.         MOTERR(1:10)='un MMODEL '
  74.         MOTERR(11:20)='CHARGEMENT'
  75.         MOTERR(21:30)=' PRESSION '
  76.         CALL ERREUR(881)
  77.         GOTO 9100
  78.       ENDIF
  79. C
  80. C     TEST DE NON REDONDANCES DES SOUS-MODELES
  81. C
  82.       N1 = 1
  83.       DO I = NSOUS,2,-1
  84.         IMODE1 = LIMODL(I)
  85.         DO J = (I-1),1,-1
  86.           IMODE2 = LIMODL(J)
  87.           IF (IMODE1.EQ.IMODE2) THEN
  88.             LIMODL(I) = 0
  89.             GOTO 10
  90.           ELSE IF (IMODE1.IMAMOD.EQ.IMODE2.IMAMOD .AND.
  91.      &             IMODE1.CONMOD.EQ.IMODE2.CONMOD) THEN
  92.             LIMODL(I) = 0
  93.             GOTO 10
  94.           ENDIF
  95.         ENDDO
  96.         N1 = N1 + 1
  97.  10     CONTINUE
  98.       ENDDO
  99. C
  100. C     CREATION DU MMODEL IPMOD0
  101. C
  102.       SEGINI,MMODE1
  103.       j = 0
  104.       DO i = 1, NSOUS
  105.         IF (LIMODL(i).GT.0) THEN
  106.           j = j + 1
  107.           MMODE1.KMODEL(j) = LIMODL(i)
  108.         ENDIF
  109.       ENDDO
  110.       IPMOD0 = MMODE1
  111. C_______________________________________________________________________
  112. C
  113. C     REDUCTION DES MCHAML EN ENTREE SUR LE MODELE
  114. C     VERIFICATION DES LIEUX SUPPORT DES MCHAML
  115. C_______________________________________________________________________
  116. C     REDUAF DEJA FAIT DANS BSIGMA SUR IPMODL
  117. C
  118.       IPCHE1 = 0
  119.       ISUP1  = 0
  120.       IPCHE2 = 0
  121.       ISUP2  = 0
  122.       IF (IPCHM1.NE.0) THEN
  123.         CALL REDUAF(IPCHM1,IPMOD0,IPCHE1,0,IR,KER)
  124.         IF (IR.NE.1) CALL ERREUR(KER)
  125.         IF (IERR.NE.0) GOTO 9100
  126.         CALL QUESUP(IPMOD0,IPCHE1,3,0,ISUP1,IR1C)
  127.         IF (ISUP1.GT.1) GOTO 9100
  128.       ENDIF
  129.       IF (IPCHM2.NE.0) THEN
  130.         CALL REDUAF(IPCHM2,IPMOD0,IPCHE2,0,IR,KER)
  131.         IF (IR.NE.1) CALL ERREUR(KER)
  132.         IF (IERR.NE.0) GOTO 9100
  133.         CALL QUESUP(IPMOD0,IPCHE2,3,0,ISUP2,IR2C)
  134.         IF (ISUP2.GT.1) GOTO 9100
  135.       ENDIF
  136. C
  137. C  MODELE
  138. C
  139.       MMODEL = IPMOD0
  140. C
  141. C  MCHELM CONTENANT 'PRES'
  142. C
  143.       IF (IPCHE1.NE.0) THEN
  144.         MCHEL1 = IPCHE1
  145.       ELSE
  146.         MCHEL1 = IPCHE2
  147.       ENDIF
  148. C
  149. C  INITIALISATION DU MCHELM DE FORCES
  150. C
  151.       N1 = NSOUS
  152.       L1 = 6
  153.       N3 = 6
  154.       SEGINI,MCHELM
  155.       IPCHE5 = MCHELM
  156.       MCHELM.IFOCHE = IFOUR
  157.       MCHELM.TITCHE = 'FORCES'
  158.  
  159.       NBTYPE=1
  160.       SEGINI,NOTYPE
  161.       TYPE(1)='REAL*8'
  162.       MOTYR8 = NOTYPE
  163. C
  164. C=======================================================================
  165. C
  166. C     BOUCLE SUR LES MODELES ELEMENTAIRES
  167. C
  168. C=======================================================================
  169. C
  170.       ISOUS = 0
  171. C
  172.       DO 200 KISOUS = 1, NSOUS
  173. C
  174. C       INITIALISATION
  175. C
  176.         IVAMAT=0
  177.         IVACAR=0
  178.         IVASTR=0
  179.         IVAFOR=0
  180.         MOMATR=0
  181.         MOCARA=0
  182.         MOSTRS=0
  183.         MOFORC=0
  184.         IPMINT=0
  185.         IPMIN1=0
  186.         MCHAML = 0
  187. C
  188. C       TRAITEMENT DU MODELE
  189. C
  190.         IMODEL = MMODEL.KMODEL(KISOUS)
  191.         ISOUS  = ISOUS+1
  192.         MELE   = IMODEL.NEFMOD
  193. C
  194. C       PETITE VERIFICATION SUR LE TYPE D'ELEMENT
  195. C
  196.         IF (MELE.EQ.0) THEN
  197. C
  198. C         ERREUR : IMPOSSIBLE D UTILISER L OPERATEUR PRESSI POUR
  199. C                  LES ELEMENTS DE FORMULATION MELE
  200. C
  201.           MOTERR(1:8)=NOMTP(MELE)
  202.           CALL ERREUR(193)
  203.           GOTO 9992
  204.         ENDIF
  205.         IPMAIL = IMODEL.IMAMOD
  206.         CONM   = IMODEL.CONMOD
  207. C
  208. C       CREATION DU TABLEAU INFOS
  209. C
  210.         CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  211.         IF (IRTD.EQ.0) GOTO 9992
  212. C_______________________________________________________________________
  213. C
  214. C       ACTIVATION DU MELEME
  215. C_______________________________________________________________________
  216. C
  217.         MELEME = IPMAIL
  218. c*        SEGACT, MELEME                           <- ACTIF EN E/S
  219.         NBNN   = MELEME.NUM(/1)
  220.         NBELEM = MELEME.NUM(/2)
  221. C_______________________________________________________________________
  222. C
  223. C       INFORMATIONS SUR L'ELEMENT FINI
  224. C_______________________________________________________________________
  225. C
  226.         NBPGAU= INFELE(4)
  227.         MINTE = INFMOD(5)
  228.         MINTE1= INFMOD(8)
  229.         MFR   = INFELE(13)
  230.         MFR2  = NUMMFR(MELE)
  231.         NSTRS = INFELE(16)
  232. C
  233.         IPMINT= MINTE
  234.         IPMIN1= MINTE1
  235. c*        SEGACT,MINTE                             <- ACTIF EN E/S
  236.         IPPORE= 0
  237.         IF (MFR2.EQ.33.OR.MFR2.EQ.57.OR.MFR2.EQ.59) IPPORE = NBNN
  238.  
  239.         IMACHE(ISOUS) = IPMAIL
  240.         INFCHE(ISOUS,1)=0
  241.         INFCHE(ISOUS,2)=0
  242.         INFCHE(ISOUS,3)=NIFOUR
  243.         INFCHE(ISOUS,4)=0
  244.         INFCHE(ISOUS,5)=0
  245.         INFCHE(ISOUS,6)=1
  246. C_______________________________________________________________________
  247. C
  248. C       NOMS DE COMPOSANTES DE CONTRAINTES
  249. C_______________________________________________________________________
  250. C
  251.         IF (IPCHE1.NE.0) THEN
  252.           MOSTRS=LNOMID(4)
  253.           NOMID=MOSTRS
  254.           NSTR=LESOBL(/2)
  255.           NFAC=LESFAC(/2)
  256. C
  257. C         VERIFICATION DE LEUR PRESENCE
  258. C
  259.           CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYR8,1,INFOS,3,IVASTR)
  260.           IF (IERR.NE.0) GOTO 9991
  261. C
  262.           IF (ISUP1.EQ.1) THEN
  263.             NSTRS = 1
  264.             CALL VALCHE(IVASTR,NSTRS,IPMINT,IPPORE,MOSTRS,MELE)
  265.           ENDIF
  266.         ELSE
  267.           MOMATR=LNOMID(6)
  268.           NOMID=MOMATR
  269.           NMATR=LESOBL(/2)
  270.           NMATF=LESFAC(/2)
  271. C
  272. C         VERIFICATION DE LEUR PRESENCE
  273. C
  274.           CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOMATR,MOTYR8,1,INFOS,3,IVAMAT)
  275.           IF (IERR.NE.0) GOTO 9991
  276. C
  277.           IF (ISUP2.EQ.1) THEN
  278.             CALL VALCHE(IVAMAT,NMATR,IPMINT,IPPORE,MOMATR,MELE)
  279.           ENDIF
  280.         ENDIF
  281. C_______________________________________________________________________
  282. C
  283. C       NOMS DE COMPOSANTES DE FORCES ET CREATION DU MCHAML DE FORCE
  284. C       (CE MCHAML SERA TRANSFORME EN FIN DE SUBROUTINE EN CHPOINT)
  285. C_______________________________________________________________________
  286. C
  287.         MOFORC = LNOMID(2)
  288.         NOMID=MOFORC
  289.         NFORC=LESOBL(/2)
  290.         NFACF=LESFAC(/2)
  291. C
  292.         N2=NFORC+NFACF
  293.         SEGINI,MCHAML
  294.         ICHAML(ISOUS)=MCHAML
  295. C
  296.         DO ICOMP=1,NFORC
  297.           NOMCHE(ICOMP)=LESOBL(ICOMP)
  298.           TYPCHE(ICOMP)='REAL*8'
  299.         ENDDO
  300. C
  301.         IF (NFACF.NE.0) THEN
  302.           IFAC = 0
  303.           DO ICOMP=(NFORC+1),N2
  304.             IFAC = IFAC + 1
  305.             NOMCHE(ICOMP)=LESFAC(IFAC)
  306.             TYPCHE(ICOMP)='REAL*8'
  307.           ENDDO
  308.         ENDIF
  309. C
  310. C       TAILLES DE MELVAL
  311. C
  312.         NBPTEL = NBPGAU
  313.         NEL    = N1EL
  314.         N1PTEL = NBNN
  315.         N1EL   = NBELEM
  316.         N2PTEL = 0
  317.         N2EL   = 0
  318. C
  319. C       CREATION DU MELVAL DE FORCES
  320. C
  321.         NSR=1
  322.         NCOSOR=NFORC+NFACF
  323.         SEGINI,MPTVAL
  324.         IVAFOR=MPTVAL
  325.         DO ICOMP=1,NCOSOR
  326.           SEGINI,MELVAL
  327.           IELVAL(ICOMP)=MELVAL
  328.           IVAL(ICOMP)=MELVAL
  329.         ENDDO
  330. C_______________________________________________________________________
  331. C
  332. C       NOMS DE COMPOSANTES DE CARACTERISTIQUES (FACULTATIF)
  333. C_______________________________________________________________________
  334. C
  335.         NBROBL=0
  336.         NBRFAC=0
  337.         NOMID=0
  338.         NOTYPE = MOTYR8
  339. C
  340. C       EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
  341. C
  342.         IF(MFR.EQ.72.AND.IFOUR.EQ.-2)THEN
  343. C
  344.           NBRFAC=1
  345.           SEGINI,NOMID
  346.           LESFAC(1)='DIM3'
  347. C
  348. C       EPAISSEUR DANS LE CAS DES COQUES 2D COQ2
  349. C
  350.         ELSEIF(MFR.EQ.74.AND.MELE.EQ.44.AND.IFOUR.EQ.-2)THEN
  351. C
  352.           NBRFAC=1
  353.           SEGINI,NOMID
  354.           LESFAC(1)='DIM3'
  355. C
  356. C       EPAISSEUR DANS LE CAS DES COQUES EPAISSES
  357. C
  358.         ELSEIF (MFR.EQ.74.AND.MFR2.EQ.5) THEN
  359.           NBROBL=1
  360.           SEGINI,NOMID
  361.           LESOBL(1)='EPAI'
  362. C
  363. C       EPAISSEUR ET RAYON EXTERNE DANS LE CAS DES TUYAUX
  364. C
  365.         ELSEIF (MFR.EQ.74.AND.MFR2.EQ.13) THEN
  366.           NBROBL=2
  367.           NBRFAC=4
  368.           SEGINI,NOMID
  369.           LESOBL(1)='EPAI'
  370.           LESOBL(2)='RAYO'
  371.           LESFAC(1)='RACO'
  372.           LESFAC(2)='VX'
  373.           LESFAC(3)='VY'
  374.           LESFAC(4)='VZ'
  375.         ENDIF
  376.         MOCARA=NOMID
  377.         MOTYPE=NOTYPE
  378. C
  379.         NCARA=NBROBL
  380.         NCARF=NBRFAC
  381.         NCARR=NCARA+NCARF
  382. C
  383.         IF (IPCHE2.NE.0) THEN
  384.           IF (MOCARA.NE.0) THEN
  385.             CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  386.      +                      IVACAR)
  387.             IF (MOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  388.             SEGSUP,NOMID
  389.             IF (IERR.NE.0) GOTO 9990
  390.             IF (ISUP2.EQ.1) THEN
  391.               CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  392.               IF (IERR.NE.0)THEN
  393.                 ISUP2=0
  394.                 GOTO 9990
  395.               ENDIF
  396.             ENDIF
  397.           ELSE
  398.             IF (MOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  399.             SEGSUP,NOMID
  400.           ENDIF
  401.         ELSE IF (NCARA.GT.0) THEN
  402.           IF (MOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  403.           SEGSUP,NOMID
  404.           MOTERR(1:8)='CARACTER'
  405.           MOTERR(9:12)=NOMTP(MELE)
  406.           MOTERR(13:20)='FEQPR'
  407.           CALL ERREUR(145)
  408.           GOTO 9990
  409.         ENDIF
  410. C_______________________________________________________________________
  411. C
  412. C       CALCUL DES FORCES EQUIVALENTES
  413. C_______________________________________________________________________
  414. C
  415.         IF (IPCHE1.NE.0) THEN
  416.           MPTVAL=IVASTR
  417.         ELSE
  418.           MPTVAL=IVAMAT
  419.         ENDIF
  420.         IVAPRE = IVAL(1)
  421. C
  422. C       - ELEMENTS DE FORMULATION MASSIF
  423. C
  424.         IF (MFR2.EQ.1) THEN
  425.           XP=0.D0
  426.           IF (MELE.EQ.2.OR.MELE.EQ.3.OR.MELE.EQ.79.OR.MELE.EQ.80) THEN
  427.             CALL FPMA2D(IVAPRE,IPMAIL,0,IPMINT,IVAFOR,IVACAR,XP,0,0)
  428.           ELSE IF(MELE.EQ.4.OR.MELE.EQ.6.OR.MELE.EQ.8.OR.
  429.      +            MELE.EQ.10.OR.MELE.EQ.81.OR.MELE.EQ.82.OR.
  430.      +            MELE.EQ.83) THEN
  431.             IF (IDIM.EQ.3) THEN
  432.               CALL FPMA3D(IVAPRE,IPMAIL,0,IPMINT,IVAFOR,XP,0,0)
  433.             ELSE
  434. C             ERREUR, APPLICATION PRESSION SUR SURFACE DANS UN PB 2D
  435.               CALL ERREUR(820)
  436.               GOTO 9990
  437.             ENDIF
  438.           ELSE IF (MELE.EQ.45) THEN
  439.             CALL FPMA1D(IVAPRE,IPMAIL,0,IPMINT,IVAFOR,XP,0,0)
  440.           ELSE
  441. C           ERREUR, ELEMENT NON IMPLEMENTE
  442.             MOTERR(1:4)=NOMTP(MELE)
  443.             MOTERR(5:12)='FEQPR '
  444.             CALL ERREUR(86)
  445.             GOTO 9990
  446.           ENDIF
  447. C
  448. C       - ELEMENTS DE FORMULATION COQUES
  449. C
  450.         ELSE IF (MFR2.EQ.3.OR.MFR2.EQ.5.OR.MFR2.EQ.9) THEN
  451. C
  452.           IF (MELE.EQ.27.OR.MELE.EQ.28.OR.MELE.EQ.45.OR.
  453.      +        MELE.EQ.93.OR.MELE.EQ.44.OR.MELE.EQ.49.OR.
  454.      +        MELE.EQ.41.OR.MELE.EQ.56) THEN
  455. C           VERIFICATION DE L ORIENTATION DU IPMAIL
  456.             CALL ECROBJ('MAILLAGE',IPMAIL)
  457.             CALL VERSEN
  458.             CALL LIROBJ('MAILLAGE',IPMAIL,1,iretou)
  459.             IF (IERR.NE.0) GOTO 9990
  460.             IPT1 = IPMAIL
  461.             SEGACT,IPT1
  462.             IF (MELE.EQ.27.OR.MELE.EQ.28.OR.MELE.EQ.45
  463.      +                                  .OR.MELE.EQ.93) THEN
  464.               CALL FPCO3D(IVAPRE,IPMAIL,IVAFOR)
  465.             ELSE IF (MELE.EQ.44) THEN
  466.               CALL FPCO2D(IVAPRE,IPMAIL,IVAFOR,IVACAR)
  467.             ELSE IF (MELE.EQ.49) THEN
  468.               CALL FPCOQ4(IVAPRE,IPMAIL,IPMINT,IVAFOR)
  469.             ELSE IF (MELE.EQ.41.OR.MELE.EQ.56) THEN
  470.               CALL FPCOQ8(IVAPRE,IPMAIL,IPMINT,IVACAR,IPMIN1,IVAFOR)
  471.             ENDIF
  472.           ELSE
  473. C           ERREUR, ELEMENT NON IMPLEMENTE
  474.             MOTERR(1:4)=NOMTP(MELE)
  475.             MOTERR(5:12)='FEQPR '
  476.             CALL ERREUR(86)
  477.             GOTO 9990
  478.           ENDIF
  479. C
  480.         ELSE IF (MFR2.EQ.13) THEN
  481. C
  482. C       - ELEMENTS TUYAU
  483. C
  484.            CALL FPELTU(IVAPRE,IVACAR,IPMAIL,I,IVAFOR)
  485. C
  486. C       - SINON TENTATIVE D'UTILISATION D'UNE OPTION NON IMPLEMENTEE
  487. C
  488.         ELSE
  489.           CALL ERREUR(251)
  490.           GOTO 9990
  491.         ENDIF
  492. C
  493. C       DESACTIVATION AVANT DE PASSER A LA SOUS ZONE SUIVANTE
  494. C
  495.         IF(ISUP1.EQ.1)THEN
  496.           CALL DTMVAL(IVASTR,3)
  497.         ELSE
  498.           CALL DTMVAL(IVASTR,1)
  499.         ENDIF
  500. C
  501.         CALL DTMVAL(IVAFOR,1)
  502. C
  503.         IF(ISUP2.EQ.1)THEN
  504.           CALL DTMVAL(IVAMAT,3)
  505.           CALL DTMVAL(IVACAR,3)
  506.         ELSE
  507.           CALL DTMVAL(IVAMAT,1)
  508.           CALL DTMVAL(IVACAR,1)
  509.         ENDIF
  510. C
  511.         IF (IERR.NE.0) GO TO 9990
  512. C
  513. C=======================================================================
  514. C
  515. C       FIN DE BOUCLE SUR LES MODELES ELEMENTAIRES
  516. C
  517. C=======================================================================
  518.   200 CONTINUE
  519. C_______________________________________________________________________
  520. C
  521. C     TRANSFORMATION DU CHAMELEM EN CHPOINT
  522. C_______________________________________________________________________
  523. C
  524.       CALL CHAMPO(IPCHE5,0,IPCHP4,iretou)
  525.       CALL DTCHAM(IPCHE5)
  526.       IF (iretou.EQ.0) GOTO 9000
  527. C
  528. C     FIN NORMALE
  529. C
  530.       IRET = 1
  531.       GOTO 9000
  532. C_______________________________________________________________________
  533. C
  534. C     ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  535. C_______________________________________________________________________
  536. C
  537.  9990 CONTINUE
  538.       IF (MCHAML.NE.0) SEGSUP,MCHAML
  539.       CALL DTMVAL(IVAFOR,3)
  540. C
  541.  9991 CONTINUE
  542. C
  543.  9992 CONTINUE
  544.       IF (MCHELM.NE.0) SEGSUP,MCHELM
  545. C_______________________________________________________________________
  546. C
  547. C     DERNIERES DESACTIVATIONS AVANT DE QUITTER
  548. C_______________________________________________________________________
  549. C
  550.  9000 CONTINUE
  551.       NOTYPE = MOTYR8
  552.       SEGSUP,NOTYPE
  553.  9100 CONTINUE
  554.       MMODE1 = IPMOD0
  555.       IF (IPMOD0.GT.0) SEGSUP,MMODE1
  556.       SEGSUP,LIMODL
  557.  
  558. C      RETURN
  559.       END
  560.  
  561.  
  562.  

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