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

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