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  24/10/03    21:15:19     12022          
  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=6
  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.       INFCHE(ISOUS,6)=1
  215. C_______________________________________________________________________
  216. C
  217. C     NOMS DE COMPOSANTES EN SORTIE
  218. C_______________________________________________________________________
  219. C
  220.       if(lnomid(2).ne.0) then
  221.         lsupfo=.false.
  222.         moforc=lnomid(2)
  223.         nomid=moforc
  224.         segact nomid
  225.         NFORC=lesobl(/2)
  226.         nfac=lesfac(/2)
  227.       else
  228.         lsupfo=.true.
  229.         CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,NFAC)
  230.         NOMID=MOFORC
  231.         SEGACT NOMID
  232.       endif
  233.         NCOMP=IDECAP
  234. C
  235. C       CREATION DU MCHAML
  236. C
  237.         N2=NCOMP
  238.         SEGINI MCHAML
  239.         ICHAML(ISOUS)=MCHAML
  240.         DO 110 ICOMP=1,NCOMP
  241.           IPRDEC=NFORC-IDECAP+ICOMP
  242.           NOMCHE(ICOMP)=LESOBL(IPRDEC)
  243.           TYPCHE(ICOMP)='REAL*8'
  244.  110    CONTINUE
  245. *_______________________________________________________________________
  246. *
  247. *     TRAITEMENT DU CHAMP DE VALEURS EN ENTREE
  248. *_______________________________________________________________________
  249. *
  250. *   ON PREND TOUS LES NOMS DE FORCES COMME COMPOSANTES POSSIBLES
  251. *   MAIS ON LES  MET EN FACULTATIF
  252. *
  253. *     CAS JOINTS
  254. *
  255.        IF((MELE.GE.108.AND.MELE.LE.110).OR.
  256.      .    (MELE.GE.185.AND.MELE.LE.190)) THEN
  257.  
  258.          IF(IFOUR.LE.0) THEN
  259. *             CAS PLAN
  260.             NCOVEC=3
  261.          ELSE IF (IFOUR.EQ.2) THEN
  262. *              3D
  263.             NCOVEC=4
  264.          ENDIF
  265.       ELSE
  266.  
  267.         IF(IFOUR.LE.0) THEN
  268. *            CONTRAINTES PLANES - DEFORMATIONS PLANES
  269. *            DEFO PLAN GENE
  270. *            AXISYMETRIQUE
  271.            NCOVEC=2
  272.  
  273.         ELSE IF (IFOUR.GT.0) THEN
  274. *            FOURIER
  275. *             3D
  276.            NCOVEC=3
  277.         ENDIF
  278.       ENDIF
  279. *
  280. *    PUIS ON CREE LE SEGMENT MOVECO
  281. *
  282.       NBROBL=0
  283.       NBRFAC=NCOVEC*IDECAP
  284. *
  285.       NVECO=NBRFAC
  286.       SEGINI NOMID
  287.       MOVECO=NOMID
  288.  
  289.       IF((MELE.GE.108.AND.MELE.LE.110).OR.
  290.      .   (MELE.GE.185.AND.MELE.LE.190)) THEN
  291.  
  292.         DO 121 IPR=1,IDECAP
  293.         IPRDEC = (IPR-1)*NCOVEC
  294.         IF(IPR.EQ.1) THEN
  295.           LESFAC(IPRDEC+1)='VCPH'
  296.           LESFAC(IPRDEC+2)='VCPB'
  297.           LESFAC(IPRDEC+3)='VCP1'
  298.           IF(NCOVEC.EQ.4) LESFAC(IPRDEC+4)='VCP2'
  299.         ELSE IF(IPR.EQ.2) THEN
  300.           LESFAC(IPRDEC+1)='VCQH'
  301.           LESFAC(IPRDEC+2)='VCQB'
  302.           LESFAC(IPRDEC+3)='VCQ1'
  303.           IF(NCOVEC.EQ.4) LESFAC(IPRDEC+4)='VCQ2'
  304.         ELSE IF(IPR.EQ.3) THEN
  305.           LESFAC(IPRDEC+1)='VCTH'
  306.           LESFAC(IPRDEC+2)='VCTB'
  307.           LESFAC(IPRDEC+3)='VCT1'
  308.           IF(NCOVEC.EQ.4) LESFAC(IPRDEC+4)='VCT2'
  309.         ENDIF
  310.  121    CONTINUE
  311.  
  312.       ELSE
  313.         DO 120 IPR=1,IDECAP
  314.         IPRDEC = (IPR-1)*NCOVEC
  315.         IF(IPR.EQ.1) THEN
  316.           LESFAC(IPRDEC+1)='VCP1'
  317.           LESFAC(IPRDEC+2)='VCP2'
  318.           IF(NCOVEC.EQ.3) LESFAC(IPRDEC+3)='VCP3'
  319.         ELSE IF(IPR.EQ.2) THEN
  320.           LESFAC(IPRDEC+1)='VCQ1'
  321.           LESFAC(IPRDEC+2)='VCQ2'
  322.           IF(NCOVEC.EQ.3) LESFAC(IPRDEC+3)='VCQ3'
  323.         ELSE IF(IPR.EQ.3) THEN
  324.           LESFAC(IPRDEC+1)='VCT1'
  325.           LESFAC(IPRDEC+2)='VCT2'
  326.           IF(NCOVEC.EQ.3) LESFAC(IPRDEC+3)='VCT3'
  327.         ENDIF
  328.  120    CONTINUE
  329.  
  330.       ENDIF
  331. *
  332. *     RECUPERATION DES COMPOSANTES PRESENTES
  333. *
  334.       NBTYPE=1
  335.       SEGINI NOTYPE
  336.       MOTYPE=NOTYPE
  337.       TYPE(1)='REAL*8'
  338.       CALL KOMCHA(IPCHM1,IPMAIL,CONM,MOVECO,MOTYPE,0,INFOS,3,IVAVCO)
  339.       SEGSUP NOTYPE
  340.       IF (IERR.NE.0) GOTO 9991
  341. *
  342. *   ON VERIFIE A POSTERIORI QU'ON A TROUVE QUELQUE CHOSE
  343. *
  344.        MPTVAL = IVAVCO
  345.        NCOSOU = IVAL(/1)
  346.        DO 50 I=1,NCOSOU
  347.          IF (IVAL(I).NE.0) GOTO 501
  348.    50  CONTINUE
  349.        MOTERR(1:8)='VEC. COU'
  350.        MOTERR(9:12)=NOMTP(MELE)
  351.        MOTERR(13:20)='GNFL    '
  352.        CALL ERREUR(145)
  353.        GO TO 9991
  354.   501  CONTINUE
  355. *
  356. *      CHANGEMENT DE SUPPORT SI BESOIN
  357. *
  358.         IF (ISUP1.EQ.1) THEN
  359.            CALL VALCHE(IVAVCO,NVECO,IPMINT,IPPORE,MOVECO,MELE)
  360.            IF (IERR.NE.0) THEN
  361.              ISUP1 = 0
  362.              GOTO 9991
  363.            ENDIF
  364.         ENDIF
  365. C____________________________________________________________________
  366. C
  367. * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES                   *
  368. C____________________________________________________________________
  369. *
  370.          NCARA=0
  371.          NCARF=0
  372.  
  373.          IF (IPCHE2.NE.0)  THEN
  374.            NBROBL=0
  375.            NBRFAC=0
  376. *
  377. * EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
  378. *
  379.            IF((MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59)
  380.      +      .AND.IFOUR.EQ.-2)THEN
  381.            NBROBL=0
  382.            NBRFAC=1
  383.            SEGINI NOMID
  384.            MOCARA=NOMID
  385.            LESFAC(1)='DIM3'
  386. *
  387.            NBTYPE=1
  388.            SEGINI NOTYPE
  389.            TYPE(1)='REAL*8'
  390.            ENDIF
  391.            NCARA=NBROBL
  392.            NCARF=NBRFAC
  393.            NCARR=NCARA+NCARF
  394. *
  395.            IF (MOCARA.NE.0)  THEN
  396.              MOTYPE=NOTYPE
  397.                CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  398.      $                     IVACAR)
  399.             SEGSUP NOTYPE
  400.             IF (IERR.NE.0) GOTO 9991
  401. *
  402.             IF (ISUP2.EQ.1) THEN
  403.               CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  404.               IF (IERR.NE.0) THEN
  405.                    ISUP2=0
  406.                    GOTO 9991
  407.               ENDIF
  408.             ENDIF
  409.            ENDIF
  410.          ENDIF
  411. C
  412. C      TAILLES DE MELVAL
  413. C
  414.       N1EL  =NBELEM
  415.       N1PTEL=NBNN
  416.       N2PTEL=0
  417.       N2EL=0
  418.       NBPTEL=NBPGAU
  419.       NEL   =N1EL
  420. C
  421. C     CREATION DU MELVAL DE FORCES NODALES
  422. C
  423.       NS=1
  424.       NCOSOU=NCOMP
  425.       SEGINI MPTVAL
  426.       IVAFOR=MPTVAL
  427.       DO 100 ICOMP=1,NCOSOU
  428.         SEGINI MELVAL
  429.         IELVAL(ICOMP)=MELVAL
  430.         IVAL(ICOMP)=MELVAL
  431.   100 CONTINUE
  432. C
  433.        IF(MELE.GE.79.AND.MELE.LE.83) GO TO 4
  434.        IF(MELE.GE.173.AND.MELE.LE.182) GO TO 4
  435.        IF(MELE.GE.108.AND.MELE.LE.110) GO TO 4
  436.        IF(MELE.GE.185.AND.MELE.LE.190) GO TO 4
  437. C
  438.    99 CONTINUE
  439.       MOTERR(1:4)=NOMTP(MELE)
  440.       MOTERR(5:8)='GNFL'
  441.       CALL ERREUR(86)
  442.       GOTO 9991
  443. C_______________________________________________________________________
  444. C
  445. C      poreux
  446. C_______________________________________________________________________
  447. C
  448.    4  CONTINUE
  449.       CALL GNFL1(IPMAIL,NVECO,NBPGAU,MELE,MFR,IVAVCO,IPMINT,IVACAR,
  450.      &            IPORE,NCOMP,IVAFOR,IIPDPG,IDECAP)
  451.       GOTO 510
  452. C_______________________________________________________________________
  453. C
  454. C     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  455. C_______________________________________________________________________
  456.   510 CONTINUE
  457. C
  458.  9991 CONTINUE
  459.  9990 CONTINUE
  460. C
  461.       IF (ISUP1.EQ.1)THEN
  462.            CALL DTMVAL(IVAVCO,3)
  463.       ELSE
  464.            CALL DTMVAL(IVAVCO,1)
  465.       ENDIF
  466.       IF (MOVECO.NE.0) THEN
  467.         NOMID=MOVECO
  468.         SEGSUP NOMID
  469.       ENDIF
  470. C
  471.       CALL DTMVAL(IVAFOR,1)
  472.       IF (MOFORC.NE.0) THEN
  473.         NOMID=MOFORC
  474.         if (lsupfo) SEGSUP NOMID
  475.       ENDIF
  476. C
  477.       IF (IPCHE2.NE.0) THEN
  478.         IF (ISUP2.EQ.1) THEN
  479.           CALL DTMVAL(IVACAR,3)
  480.         ELSE
  481.           CALL DTMVAL(IVACAR,1)
  482.         ENDIF
  483.         IF (MOCARA.NE.0) THEN
  484.           NOMID=MOCARA
  485.           SEGSUP NOMID
  486.         ENDIF
  487.       ENDIF
  488. C
  489.       IF (IERR.NE.0) GO TO 9999
  490. C
  491.   200 CONTINUE
  492.  
  493. C_______________________________________________________________________
  494. C
  495. C     TRANSFORMATION DU CHAMELEM EN CHPOINT
  496. C_______________________________________________________________________
  497. C
  498.       CALL CHAMPO(IPCHE5,0,IPCHP4,IRET)
  499.       IF (IERR.NE.0) GOTO 9999
  500.       CALL DTCHAM(IPCHE5)
  501. C
  502.       IRET = 1
  503.       GOTO 9900
  504. C
  505. C     ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  506.  9999 CONTINUE
  507.       IRET = 0
  508.       IPCHP4 = 0
  509.       IF (IPCHE5.NE.0) SEGSUP,MCHELM
  510.  
  511. C- Fin du sous-programme : gestion des segments
  512.  9900 CONTINUE
  513. C  Destructions de segments si necessaire
  514.  
  515.       END
  516.  
  517.  
  518.  

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