Télécharger la plaquette Cast3M


fr en

Télécharger gnflp.eso

Retour à la liste

Numérotation des lignes : 

gnflp

  1. C GNFLP     SOURCE    MB234859  25/09/08    21:15:32     12358          
  2.       SUBROUTINE GNFLP(IPMODL,IPCHE1,IPCHP1,IPCHE2,IPCHP4,IRET)
  3. C_______________________________________________________________________
  4. C
  5. C      IPMODL  MMODEL
  6. C      IPCHE1  MCHAML
  7. C      IPCHE2  MCHAML de caract{ristiques (facultatif)
  8. C      IPCHP4  CHPOINT resultat
  9. C      IRET =1  OU  0   suivant succes ou pas (Message d'erreur)
  10. C_______________________________________________________________________
  11. C
  12.       IMPLICIT INTEGER(I-N)
  13.       IMPLICIT REAL*8(A-H,O-Z)
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. -INC CCHAMP
  18.  
  19. -INC SMCHAML
  20. -INC SMCHPOI
  21. -INC SMELEME
  22. -INC SMCOORD
  23. -INC SMMODEL
  24. -INC SMINTE
  25.  
  26. -INC TMPTVAL
  27.  
  28.       SEGMENT NOTYPE
  29.         CHARACTER*16 TYPE(NBTYPE)
  30.       ENDSEGMENT
  31.  
  32.       CHARACTER*8 CMATE
  33.       CHARACTER*(NCONCH) CONM
  34.       PARAMETER ( NINF=3 )
  35.       INTEGER INFOS(NINF)
  36.       LoGICAL lsupfo
  37.  
  38.       lsupfo=.false.
  39.       IRET = 0
  40.       IPCHP4 = 0
  41.       IPCHE5 = 0
  42. *
  43. *       Verification du lieu support du MCHAML
  44. *
  45.       IF (IPCHE1.NE.0) THEN
  46.         CALL QUESUP(IPMODL,IPCHE1,3,0,ISUP1,IRET1)
  47.         IF (ISUP1.GT.1) THEN
  48.            CALL ERREUR(609)
  49.            RETURN
  50.         ENDIF
  51.         IPCHM1 = IPCHE1
  52. *
  53. *       PASSAGE DU CHPOINT EN MCHAML
  54. *
  55.       ELSE
  56.         CALL CHAME1(0,IPMODL,IPCHP1,'VOLUMIQUE',IPCHM1,1)
  57.         IF (IERR.NE.0) RETURN
  58.         ISUP1 = 1
  59.       ENDIF
  60. *
  61. *     Verification du lieu support du MCHAML de caracteristiques
  62. *
  63.       IF (IPCHE2.NE.0) THEN
  64.          CALL QUESUP(IPMODL,IPCHE2,3,1,ISUP2,IRET2)
  65.          IF (ISUP2.GT.1) THEN
  66.             CALL ERREUR(609)
  67.             RETURN
  68.          ENDIF
  69.       ENDIF
  70. *_______________________________________________________________________
  71. *
  72. *     ACTIVATION DU MODELE
  73. *_______________________________________________________________________
  74. *
  75.       MMODEL=IPMODL
  76.       SEGACT MMODEL
  77.       NSOUS=KMODEL(/1)
  78. C Petite verification sur le MODELE : uniquement FORMULATION POREUX
  79.       DO ISOUS = 1, NSOUS
  80.         IMODEL=KMODEL(ISOUS)
  81.         SEGACT,IMODEL
  82.         NFOR=FORMOD(/2)
  83.         IF (NFOR.EQ.1) THEN
  84.           IF (FORMOD(1).NE.'POREUX') THEN
  85.             MOTERR(1:8)=FORMOD(1)
  86.             CALL ERREUR(193)
  87.             GOTO 9900
  88.           ENDIF
  89. C*      ELSE IF (NFOR.GT.1) THEN
  90.         ELSE
  91.           MOTERR(1:8)=FORMOD(1)
  92.           CALL ERREUR(193)
  93.           GOTO 9900
  94.         ENDIF
  95.       ENDDO
  96. C
  97. C     ACTIVATION DU CHAMP EN ENTREE
  98. C
  99.       MCHEL1=IPCHM1
  100.       SEGACT,MCHEL1
  101. C
  102. C     INITIALISATION DU MCHELM DE VALEURS NODALES
  103. C
  104.       L1=6
  105.       N1=NSOUS
  106.       N3=6
  107.       SEGINI,MCHELM
  108.       IPCHE5=MCHELM
  109.       IFOCHE=IFOUR
  110.       TITCHE='FORCES'
  111. C_______________________________________________________________________
  112. C
  113. C     BOUCLE SUR LES SOUS ZONES
  114. C_______________________________________________________________________
  115. C
  116.       DO 200 ISOUS=1,NSOUS
  117. C
  118. C   INITIALISATION
  119. C
  120.         IVACAR=0
  121.         IVAFOR=0
  122.         IVAVCO=0
  123.         MOCARA=0
  124.         MOFORC=0
  125.         MOVECO=0
  126. C
  127. C     TRAITEMENT DU MODELE
  128. C
  129.       IMODEL=KMODEL(ISOUS)
  130.       IIPDPG = imodel.IPDPGE
  131.       IIPDPG = IPTPOI(IIPDPG)
  132.       MELE=NEFMOD
  133.       IPMAIL=IMAMOD
  134.       CONM  =CONMOD
  135. C____________________________________________________________________
  136. C
  137. C     ACTIVATION DU MELEME
  138. C
  139.       MELEME=IPMAIL
  140.       SEGACT MELEME
  141.       NBNN=NUM(/1)
  142.       NBELEM=NUM(/2)
  143. C
  144. C     CREATION DU TABLEAU INFOS
  145. C
  146.       CALL IDENT(IPMAIL,CONM,IPCHM1,IPCHE2,INFOS,IRTD)
  147.       IF (IRTD.EQ.0) GOTO 9990
  148. C_______________________________________________________________________
  149. C
  150. C     INFORMATIONS SUR L'ELEMENT FINI
  151. C_______________________________________________________________________
  152. C
  153.       NBPGAU = INFELE(4)
  154.       NBG    = INFELE(6)
  155.       MINTE  = INFMOD(5)
  156.       MINTE1 = INFMOD(3)
  157.       IPMINT = MINTE
  158.       IPMIN1 = MINTE1
  159.       MFR    = INFELE(13)
  160.       LW     = INFELE(7)
  161.       IELE   = INFELE(14)
  162.       IPORE  = INFELE(8)
  163.       IPPORE = 0
  164.       IF(MFR.EQ.33)  THEN
  165.          IPPORE=NBNN
  166.          IDECAP=1
  167.        ELSE IF(MFR.EQ.57) THEN
  168.          IPPORE=NBNN
  169.          IDECAP=2
  170.        ELSE IF(MFR.EQ.59) THEN
  171.          IPPORE=NBNN
  172.          IDECAP=3
  173.       ENDIF
  174.       NHRM   = NIFOUR
  175. C
  176.       SEGACT MINTE
  177.       NBNO=SHPTOT(/2)
  178. C
  179. C     RECOPIE DU MCHELM
  180. C
  181.       IMACHE(ISOUS)=IPMAIL
  182.       CONCHE(ISOUS)=CONMOD
  183.       INFCHE(ISOUS,1)=0
  184.       INFCHE(ISOUS,2)=0
  185.       INFCHE(ISOUS,3)=NIFOUR
  186.       INFCHE(ISOUS,4)=0
  187.       INFCHE(ISOUS,5)=0
  188.       INFCHE(ISOUS,6)=1
  189. C_______________________________________________________________________
  190. C
  191. C     NOMS DE COMPOSANTES EN SORTIE
  192. C_______________________________________________________________________
  193. C
  194.       if(lnomid(2).ne.0) then
  195.         lsupfo=.false.
  196.         moforc=lnomid(2)
  197.         nomid=moforc
  198.         segact nomid
  199.         NFORC=lesobl(/2)
  200.         nfac=lesfac(/2)
  201.       else
  202.         lsupfo=.true.
  203.         CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,NFAC)
  204.         NOMID=MOFORC
  205.         SEGACT NOMID
  206.       endif
  207.         NCOMP=IDECAP
  208. C
  209. C       CREATION DU MCHAML
  210. C
  211.         N2=NCOMP
  212.         SEGINI MCHAML
  213.         ICHAML(ISOUS)=MCHAML
  214.         DO 110 ICOMP=1,NCOMP
  215.           IPRDEC=NFORC-IDECAP+ICOMP
  216.           NOMCHE(ICOMP)=LESOBL(IPRDEC)
  217.           TYPCHE(ICOMP)='REAL*8'
  218.  110    CONTINUE
  219. *_______________________________________________________________________
  220. *
  221. *     TRAITEMENT DU CHAMP DE VALEURS EN ENTREE
  222. *_______________________________________________________________________
  223. *
  224. *   ON PREND TOUS LES NOMS DE FORCES COMME COMPOSANTES POSSIBLES
  225. *   MAIS ON LES  MET EN FACULTATIF
  226. *
  227. *     CAS JOINTS
  228. *
  229.        IF((MELE.GE.108.AND.MELE.LE.110).OR.
  230.      .    (MELE.GE.185.AND.MELE.LE.190)) THEN
  231.  
  232.          IF(IFOUR.LE.0) THEN
  233. *             CAS PLAN
  234.             NCOVEC=3
  235.          ELSE IF (IFOUR.EQ.2) THEN
  236. *              3D
  237.             NCOVEC=4
  238.          ENDIF
  239.       ELSE
  240.  
  241.         IF(IFOUR.LE.0) THEN
  242. *            CONTRAINTES PLANES - DEFORMATIONS PLANES
  243. *            DEFO PLAN GENE
  244. *            AXISYMETRIQUE
  245.            NCOVEC=2
  246.  
  247.         ELSE IF (IFOUR.GT.0) THEN
  248. *            FOURIER
  249. *             3D
  250.            NCOVEC=3
  251.         ENDIF
  252.       ENDIF
  253. *
  254. *    PUIS ON CREE LE SEGMENT MOVECO
  255. *
  256.       NBROBL=0
  257.       NBRFAC=NCOVEC*IDECAP
  258. *
  259.       NVECO=NBRFAC
  260.       SEGINI NOMID
  261.       MOVECO=NOMID
  262.  
  263.       IF((MELE.GE.108.AND.MELE.LE.110).OR.
  264.      .   (MELE.GE.185.AND.MELE.LE.190)) THEN
  265.  
  266.         DO 121 IPR=1,IDECAP
  267.         IPRDEC = (IPR-1)*NCOVEC
  268.         IF(IPR.EQ.1) THEN
  269.           LESFAC(IPRDEC+1)='VCPH'
  270.           LESFAC(IPRDEC+2)='VCPB'
  271.           LESFAC(IPRDEC+3)='VCP1'
  272.           IF(NCOVEC.EQ.4) LESFAC(IPRDEC+4)='VCP2'
  273.         ELSE IF(IPR.EQ.2) THEN
  274.           LESFAC(IPRDEC+1)='VCQH'
  275.           LESFAC(IPRDEC+2)='VCQB'
  276.           LESFAC(IPRDEC+3)='VCQ1'
  277.           IF(NCOVEC.EQ.4) LESFAC(IPRDEC+4)='VCQ2'
  278.         ELSE IF(IPR.EQ.3) THEN
  279.           LESFAC(IPRDEC+1)='VCTH'
  280.           LESFAC(IPRDEC+2)='VCTB'
  281.           LESFAC(IPRDEC+3)='VCT1'
  282.           IF(NCOVEC.EQ.4) LESFAC(IPRDEC+4)='VCT2'
  283.         ENDIF
  284.  121    CONTINUE
  285.  
  286.       ELSE
  287.         DO 120 IPR=1,IDECAP
  288.         IPRDEC = (IPR-1)*NCOVEC
  289.         IF(IPR.EQ.1) THEN
  290.           LESFAC(IPRDEC+1)='VCP1'
  291.           LESFAC(IPRDEC+2)='VCP2'
  292.           IF(NCOVEC.EQ.3) LESFAC(IPRDEC+3)='VCP3'
  293.         ELSE IF(IPR.EQ.2) THEN
  294.           LESFAC(IPRDEC+1)='VCQ1'
  295.           LESFAC(IPRDEC+2)='VCQ2'
  296.           IF(NCOVEC.EQ.3) LESFAC(IPRDEC+3)='VCQ3'
  297.         ELSE IF(IPR.EQ.3) THEN
  298.           LESFAC(IPRDEC+1)='VCT1'
  299.           LESFAC(IPRDEC+2)='VCT2'
  300.           IF(NCOVEC.EQ.3) LESFAC(IPRDEC+3)='VCT3'
  301.         ENDIF
  302.  120    CONTINUE
  303.  
  304.       ENDIF
  305. *
  306. *     RECUPERATION DES COMPOSANTES PRESENTES
  307. *
  308.       NBTYPE=1
  309.       SEGINI NOTYPE
  310.       MOTYPE=NOTYPE
  311.       TYPE(1)='REAL*8'
  312.       CALL KOMCHA(IPCHM1,IPMAIL,CONM,MOVECO,MOTYPE,0,INFOS,3,IVAVCO)
  313.       SEGSUP NOTYPE
  314.       IF (IERR.NE.0) GOTO 9991
  315. *
  316. *   ON VERIFIE A POSTERIORI QU'ON A TROUVE QUELQUE CHOSE
  317. *
  318.        MPTVAL = IVAVCO
  319.        NCOSOU = IVAL(/1)
  320.        DO 50 I=1,NCOSOU
  321.          IF (IVAL(I).NE.0) GOTO 501
  322.    50  CONTINUE
  323.        MOTERR(1:8)='VEC. COU'
  324.        MOTERR(9:12)=NOMTP(MELE)
  325.        MOTERR(13:20)='GNFL    '
  326.        CALL ERREUR(145)
  327.        GO TO 9991
  328.   501  CONTINUE
  329. *
  330. *      CHANGEMENT DE SUPPORT SI BESOIN
  331. *
  332.         IF (ISUP1.EQ.1) THEN
  333.            CALL VALCHE(IVAVCO,NVECO,IPMINT,IPPORE,MOVECO,MELE)
  334.            IF (IERR.NE.0) THEN
  335.              ISUP1 = 0
  336.              GOTO 9991
  337.            ENDIF
  338.         ENDIF
  339. C____________________________________________________________________
  340. C
  341. * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES                   *
  342. C____________________________________________________________________
  343. *
  344.          NCARA=0
  345.          NCARF=0
  346.  
  347.          IF (IPCHE2.NE.0)  THEN
  348.            NBROBL=0
  349.            NBRFAC=0
  350. *
  351. * EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
  352. *
  353.            IF((MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59)
  354.      +      .AND.IFOUR.EQ.-2)THEN
  355.            NBROBL=0
  356.            NBRFAC=1
  357.            SEGINI NOMID
  358.            MOCARA=NOMID
  359.            LESFAC(1)='DIM3'
  360. *
  361.            NBTYPE=1
  362.            SEGINI NOTYPE
  363.            TYPE(1)='REAL*8'
  364.            ENDIF
  365.            NCARA=NBROBL
  366.            NCARF=NBRFAC
  367.            NCARR=NCARA+NCARF
  368. *
  369.            IF (MOCARA.NE.0)  THEN
  370.              MOTYPE=NOTYPE
  371.                CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  372.      $                     IVACAR)
  373.             SEGSUP NOTYPE
  374.             IF (IERR.NE.0) GOTO 9991
  375. *
  376.             IF (ISUP2.EQ.1) THEN
  377.               CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  378.               IF (IERR.NE.0) THEN
  379.                    ISUP2=0
  380.                    GOTO 9991
  381.               ENDIF
  382.             ENDIF
  383.            ENDIF
  384.          ENDIF
  385. C
  386. C      TAILLES DE MELVAL
  387. C
  388.       N1EL  =NBELEM
  389.       N1PTEL=NBNN
  390.       N2PTEL=0
  391.       N2EL=0
  392.       NBPTEL=NBPGAU
  393.       NEL   =N1EL
  394. C
  395. C     CREATION DU MELVAL DE FORCES NODALES
  396. C
  397.       NSR=1
  398.       NCOSOR=NCOMP
  399.       SEGINI MPTVAL
  400.       IVAFOR=MPTVAL
  401.       DO 100 ICOMP=1,NCOMP
  402.         SEGINI MELVAL
  403.         IELVAL(ICOMP)=MELVAL
  404.         IVAL(ICOMP)=MELVAL
  405.   100 CONTINUE
  406. C
  407.        IF(MELE.GE.79.AND.MELE.LE.83) GO TO 4
  408.        IF(MELE.GE.173.AND.MELE.LE.182) GO TO 4
  409.        IF(MELE.GE.108.AND.MELE.LE.110) GO TO 4
  410.        IF(MELE.GE.185.AND.MELE.LE.190) GO TO 4
  411. C
  412.    99 CONTINUE
  413.       MOTERR(1:4)=NOMTP(MELE)
  414.       MOTERR(5:8)='GNFL'
  415.       CALL ERREUR(86)
  416.       GOTO 9991
  417. C_______________________________________________________________________
  418. C
  419. C      poreux
  420. C_______________________________________________________________________
  421. C
  422.    4  CONTINUE
  423.       CALL GNFL1(IPMAIL,NVECO,NBPGAU,MELE,MFR,IVAVCO,IPMINT,IVACAR,
  424.      &            IPORE,NCOMP,IVAFOR,IIPDPG,IDECAP)
  425.       GOTO 510
  426. C_______________________________________________________________________
  427. C
  428. C     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  429. C_______________________________________________________________________
  430.   510 CONTINUE
  431. C
  432.  9991 CONTINUE
  433.  9990 CONTINUE
  434. C
  435.       IF (ISUP1.EQ.1)THEN
  436.            CALL DTMVAL(IVAVCO,3)
  437.       ELSE
  438.            CALL DTMVAL(IVAVCO,1)
  439.       ENDIF
  440.       IF (MOVECO.NE.0) THEN
  441.         NOMID=MOVECO
  442.         SEGSUP NOMID
  443.       ENDIF
  444. C
  445.       CALL DTMVAL(IVAFOR,1)
  446.       IF (MOFORC.NE.0) THEN
  447.         NOMID=MOFORC
  448.         if (lsupfo) SEGSUP NOMID
  449.       ENDIF
  450. C
  451.       IF (IPCHE2.NE.0) THEN
  452.         IF (ISUP2.EQ.1) THEN
  453.           CALL DTMVAL(IVACAR,3)
  454.         ELSE
  455.           CALL DTMVAL(IVACAR,1)
  456.         ENDIF
  457.         IF (MOCARA.NE.0) THEN
  458.           NOMID=MOCARA
  459.           SEGSUP NOMID
  460.         ENDIF
  461.       ENDIF
  462. C
  463.       IF (IERR.NE.0) GO TO 9999
  464. C
  465.   200 CONTINUE
  466.  
  467. C_______________________________________________________________________
  468. C
  469. C     TRANSFORMATION DU CHAMELEM EN CHPOINT
  470. C_______________________________________________________________________
  471. C
  472.       CALL CHAMPO(IPCHE5,0,IPCHP4,IRET)
  473.       IF (IERR.NE.0) GOTO 9999
  474.       CALL DTCHAM(IPCHE5)
  475. C
  476.       IRET = 1
  477.       GOTO 9900
  478. C
  479. C     ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  480.  9999 CONTINUE
  481.       IRET = 0
  482.       IPCHP4 = 0
  483.       IF (IPCHE5.NE.0) SEGSUP,MCHELM
  484.  
  485. C- Fin du sous-programme : gestion des segments
  486.  9900 CONTINUE
  487. C  Destructions de segments si necessaire
  488.  
  489.       RETURN
  490.       END
  491.  
  492.  
  493.  
  494.  

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