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

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