Télécharger la plaquette Cast3M


fr en

Télécharger cneqp.eso

Retour à la liste

Numérotation des lignes : 

cneqp

  1. C CNEQP     SOURCE    OF166741  25/02/21    21:15:38     12166          
  2.  
  3.       SUBROUTINE CNEQP(IPMODL,IPCHE1,IPCHPO,IPCHE2,IPCHE3,IRET)
  4.  
  5. C_______________________________________________________________________
  6. C
  7. C  Entrees:
  8. C  ________
  9. C
  10. C     IPMODL  Pointeur sur un MMODEL
  11. C     IPCHE1  Pointeur sur un MCHAML de forces volumiques
  12. C     IPCHPO  Pointeur sur un CHPOINT de forces volumiques
  13. C     IPCHE2  Pointeur sur un MCHAML de caracteristiques (FACULTATIF)
  14. C
  15. C  SORTIES:
  16. C  ________
  17. C
  18. C     IPCHE3  Pointeur sur un MCHAML de forces aux noeuds
  19. C     IRET =1  OU  0   suivant succes ou pas (Message d'erreur
  20. C                                         imprime dans ce cas
  21. C
  22. C_______________________________________________________________________
  23. C
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCHAMP
  30.  
  31. -INC SMCHAML
  32. -INC SMCHPOI
  33. -INC SMELEME
  34. -INC SMCOORD
  35. -INC SMMODEL
  36.       POINTEUR NOMID1.NOMID
  37. -INC SMINTE
  38.  
  39. -INC TMPTVAL
  40.  
  41.       SEGMENT INFO
  42.         INTEGER INFELL(JG)
  43.       ENDSEGMENT
  44.  
  45.       SEGMENT NOTYPE
  46.         CHARACTER*16 TYPE(NBTYPE)
  47.       ENDSEGMENT
  48.  
  49.       PARAMETER ( NINF=3 , ISUPC=3)
  50.       INTEGER INFOS(NINF)
  51.       CHARACTER*8 CMATE
  52.       CHARACTER*(NCONCH) CONM
  53.       LOGICAL lsupfo
  54.       INTEGER ISUP1, ISUP2
  55.  
  56.       IRET = 0
  57.       ISUP1 = 0
  58.       ISUP2 = 0
  59.  
  60.       nbtype = 1
  61.       SEGINI,notype
  62.       notype.TYPE(1) = 'REAL*8'
  63.       MOTYR8 = notype
  64.  
  65. * Premieres verifications sur le modele (formulation)
  66.       MMODEL = IPMODL
  67.       NSOUS = KMODEL(/1)
  68.  
  69.       IMECA = 0
  70.       IELEC = 0
  71.       IMAGN = 0
  72.       DO ISOUS = 1, NSOUS
  73.         IMODEL = KMODEL(ISOUS)
  74.         NFOR = FORMOD(/2)
  75.         IF (NFOR.EQ.1) THEN
  76.           IF (FORMOD(1).EQ.'MECANIQUE' .OR. FORMOD(1).EQ.'POREUX') THEN
  77.             IMECA = 1
  78.           ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
  79.             IELEC = 1
  80.           ELSE IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') THEN
  81.             IMAGN = 1
  82.           ELSE
  83.             MOTERR(1:8) = FORMOD(1)
  84.             CALL ERREUR(193)
  85.             GOTO 9991
  86.           ENDIF
  87.         ELSE IF (NFOR.GT.1) THEN
  88.           MOTERR(1:8) = FORMOD(1)
  89.           CALL ERREUR(193)
  90.           GOTO 9991
  91.         ENDIF
  92.       ENDDO
  93.       IF (IMECA+IELEC+IMAGN .NE. 1) THEN
  94. *AV Affiner l'erreur !
  95.         write(ioimp,*) 'Une seule formulation dans le modele !'
  96.         CALL ERREUR(21)
  97.         GOTO 9990
  98.       ENDIF
  99.  
  100. *   PASSAGE DU CHPOINT EN MCHAML
  101.       IF (IPCHE1.EQ.0) THEN
  102.         CALL CHAME1(0,IPMODL,IPCHPO,'VOLUMIQUE',IPCHE1,1)
  103.       ENDIF
  104.  
  105. *   Verification du lieu support du MCHAML de forces volumiques
  106.       CALL QUESUP(IPMODL,IPCHE1,ISUPC,0,ISUP1,IRET1)
  107.       IF (ISUP1.GT.1) THEN
  108.          CALL ERREUR(609)
  109.          GOTO 9990
  110.       ENDIF
  111.  
  112. *     Verification du lieu support du MCHAML de caracteristiques
  113.       IF (IPCHE2.NE.0) THEN
  114.          CALL QUESUP(IPMODL,IPCHE2,ISUPC,1,ISUP2,IRET2)
  115.          IF (ISUP2.GT.1) THEN
  116.             CALL ERREUR(609)
  117.             GOTO 9990
  118.          ENDIF
  119.       ENDIF
  120.  
  121. *_______________________________________________________________________
  122. *     INITIALISATION DU MCHELM DE VALEURS NODALES
  123. *_______________________________________________________________________
  124.       L1=6
  125.       N1=NSOUS
  126.       N3=6
  127.       SEGINI MCHELM
  128.       IPCHE3=MCHELM
  129.       IFOCHE=IFOUR
  130.       TITCHE='FORCES'
  131.  
  132. C  Initialisation de quelques variables (MECANIQUE ou POREUX)
  133.       IF (IMECA.EQ.1) THEN
  134.       IF (IFOUR.EQ.-3) THEN
  135.         NFORDG=3
  136.       ELSE IF (IFOUR.EQ.11) THEN
  137.         NFORDG=2
  138.       ELSE IF ((IFOUR.GE.7.AND.IFOUR.LE.10).OR.IFOUR.EQ.14) THEN
  139.         NFORDG=1
  140.       ELSE
  141.         NFORDG=0
  142.       ENDIF
  143.       ELSE
  144.         NFORDG=0
  145.       ENDIF
  146. C_______________________________________________________________________
  147. C
  148. C     BOUCLE SUR LES SOUS ZONES
  149. C_______________________________________________________________________
  150.  
  151.       DO 200 ISOUS=1,NSOUS
  152. C
  153. C   INITIALISATION
  154. C
  155.       IPMINT = 0
  156.       IVACAR = 0
  157.       IVAFOR = 0
  158.       IVAFVO = 0
  159.       MOCARA = 0
  160.       MOFORC = 0
  161.       MOFOVO = 0
  162.       MCHAML = 0
  163. C
  164. C     TRAITEMENT DU MODELE
  165. C
  166.       IMODEL=KMODEL(ISOUS)
  167.  
  168.       MELE=NEFMOD
  169.       IPMAIL=IMAMOD
  170.       CONM  =CONMOD
  171.       IIPDPG = imodel.IPDPGE
  172.       IIPDPG = IPTPOI(IIPDPG)
  173.  
  174.       CMATE = imodel.CMATEE
  175. C____________________________________________________________________
  176. C
  177. C     ACTIVATION DU MELEME
  178. C
  179.       MELEME=IPMAIL
  180.       NBNN   = meleme.NUM(/1)
  181.       NBELEM = meleme.NUM(/2)
  182. C
  183. C     CREATION DU TABLEAU INFOS
  184. C
  185.       CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  186.       IF (IRTD.EQ.0) GOTO 510
  187. C_______________________________________________________________________
  188. C
  189. C     INFORMATIONS SUR L'ELEMENT FINI
  190. C_______________________________________________________________________
  191. C
  192.        iplaz=3
  193.        IF (IMAGN .EQ. 1) iplaz=2
  194.        if (infmod(/1).lt.2+iplaz) then
  195.         CALL ELQUOI(MELE,0,iplaz,IPINF,IMODEL)
  196.         IF (IERR.NE.0) GOTO 510
  197.         INFO=IPINF
  198.         NBPGAU= INFELL(4)
  199.         NBG   = INFELL(6)
  200.         IPMINT= INFELL(11)
  201.         MFR   = INFELL(13)
  202.         LW    = INFELL(7)
  203.         NDDL  = INFELL(15)
  204.         LRE   = INFELL(9)
  205.         IPORE = INFELL(8)
  206.         IPMIN1=INFELL(12)
  207.         SEGSUP,INFO
  208.       ELSE
  209.         NBPGAU= INFELE(4)
  210.         NBG   = INFELE(6)
  211.         IPMINT= INFMOD(2+iplaz)
  212. **        IPMIN1= INFELE(12)
  213.         IPMIN1= INFMOD(8)
  214.         MFR   = INFELE(13)
  215.         LW    = INFELE(7)
  216.         NDDL  = INFELE(15)
  217.         LRE   = INFELE(9)
  218.         IPORE = INFELE(8)
  219.       ENDIF
  220.       IPPORE=0
  221.       IF(MFR.EQ.33) IPPORE=NBNN
  222.       NHRM   = NIFOUR
  223. C
  224.       MINTE = IPMINT
  225.       NBNO = SHPTOT(/2)
  226. C
  227. C     RECOPIE DU MCHELM
  228. C
  229.       IMACHE(ISOUS)=IPMAIL
  230.       CONCHE(ISOUS)=CONMOD
  231.       INFCHE(ISOUS,1)=0
  232.       INFCHE(ISOUS,2)=0
  233.       INFCHE(ISOUS,3)=NIFOUR
  234.       INFCHE(ISOUS,4)=0
  235.       INFCHE(ISOUS,5)=0
  236.       INFCHE(ISOUS,6)=1
  237. C_______________________________________________________________________
  238. C
  239. C     NOMS DE COMPOSANTES EN SORTIE ( FORCES POUR L'INSTANT ,
  240. C          COMPTE TENU DES FORMULATIONS DISPONIBLES )
  241. C  +    CREATION DU MCHAML
  242. C_______________________________________________________________________
  243. C
  244. C*     IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') THEN
  245.       IF (IMAGN .EQ. 1) THEN
  246.         CALL IDPVIN(MFR,IFOUR,MOFORC,NFOR,NFAC)
  247.         IF ( NFAC.NE.0 ) THEN
  248.            CALL ERREUR(19)
  249.            GO TO 510
  250.         ENDIF
  251.         NOMID1=MOFORC
  252.         lsupfo=.true.
  253.         NCOMP=NFOR
  254.         N2=1
  255.         SEGINI MCHAML
  256.         ICHAML(ISOUS)=MCHAML
  257.         NOMCHE(1)='ED'
  258.         TYPCHE(1)='REAL*8'
  259.       ELSE
  260.         moforc=lnomid(2)
  261.         if (moforc.eq.0) then
  262.           write(ioimp,*) 'CNEQP : MOFORC = lnomid(2) = 0'
  263.           call erreur(5)
  264.         endif
  265.         nomid1=moforc
  266.         nfor =nomid1.lesobl(/2)
  267.         nfac =nomid1.lesfac(/2)
  268.         IF (NFAC.NE.0 .OR. NFOR.NE.NDDL) THEN
  269.           CALL ERREUR(19)
  270.           GO TO 510
  271.         ENDIF
  272.         lsupfo=.false.
  273.         NCOMP=NFOR-NFORDG
  274.         NDDL =NDDL-NFORDG
  275.         N2=NCOMP
  276.         SEGINI,MCHAML
  277.         ICHAML(ISOUS)=MCHAML
  278.         DO 110 ICOMP=1,NCOMP
  279.           NOMCHE(ICOMP)=NOMID1.LESOBL(ICOMP)
  280.           TYPCHE(ICOMP)='REAL*8'
  281.  110    CONTINUE
  282.       ENDIF
  283. *_______________________________________________________________________
  284.  
  285. *     TRAITEMENT DU CHAMP DE VALEURS NODALES EN ENTREE
  286. *_______________________________________________________________________
  287.  
  288. *   ON PREND TOUS LES NOMS DE FORCES COMME COMPOSANTES POSSIBLES
  289. *   MAIS ON LES  MET EN FACULTATIF
  290. *    PUIS ON CREE LE SEGMENT MOFOVO
  291.       NBROBL=0
  292.       NBRFAC=NCOMP
  293.       NFOVO=NBRFAC
  294.       SEGINI NOMID
  295.       MOFOVO=NOMID
  296.       DO 120 ICOMP=1,NCOMP
  297.         LESFAC(ICOMP)=NOMID1.LESOBL(ICOMP)
  298.  120  CONTINUE
  299.  
  300. *     RECUPERATION DES COMPOSANTES PRESENTES
  301.       CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOFOVO,MOTYR8,0,INFOS,3,IVAFVO)
  302.       IF (IERR.NE.0) GOTO 510
  303.  
  304. *   ON VERIFIE A POSTERIORI QU'ON A TROUVE QUELQUE CHOSE
  305.  
  306.        MPTVAL = IVAFVO
  307.        NCOSOR = IVAL(/1)
  308.        NFOVOL = 0
  309.        DO 50 I=1,NCOSOR
  310.          IF (IVAL(I).NE.0) NFOVOL=NFOVOL+1
  311.    50  CONTINUE
  312.        IF(NFOVOL.EQ.0) THEN
  313.            CALL ERREUR(665)
  314.            GO TO 510
  315.        ENDIF
  316.  
  317. *      CHANGEMENT DE SUPPORT SI BESOIN
  318.         IF (ISUP1.EQ.1) THEN
  319.            CALL VALCHE(IVAFVO,NFOVO,IPMINT,IPPORE,MOFOVO,MELE)
  320.         ENDIF
  321. C____________________________________________________________________
  322. C
  323. * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES                   *
  324. C____________________________________________________________________
  325.         NBROBL=0
  326.         NBRFAC=0
  327.         NOMID =0
  328.         NOTYPE = MOTYR8
  329.  
  330. C*        IF (FORMOD(1).NE.'MECANIQUE' .AND.
  331. C*   &        FORMOD(1).NE.'POREUX'    ) GO TO 777
  332.         IF (IMECA .NE. 1) GO TO 777
  333.  
  334. * EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
  335.         IF ((MFR.EQ.1.OR.MFR.EQ.33).AND.IFOUR.EQ.-2.
  336.      +               AND.IPCHE2.NE.0)THEN
  337.           NBRFAC=1
  338.           SEGINI NOMID
  339.           LESFAC(1)='DIM3'
  340.  
  341. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  342.         ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  343.            NBROBL=1
  344.            IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN
  345.              NBRFAC=2
  346.            ELSE
  347.              NBRFAC=1
  348.            ENDIF
  349.            SEGINI NOMID
  350.            LESOBL(1)='EPAI'
  351.            LESFAC(1)='EXCE'
  352.            IF(MFR.EQ.3.AND.IFOUR.EQ.-2)  LESFAC(2)='DIM3'
  353.  
  354. * SECTION POUR LES BARRES
  355.  
  356.         ELSE IF (MFR.EQ.27) THEN
  357.            NBROBL=1
  358.            SEGINI NOMID
  359.            LESOBL(1)='SECT'
  360.  
  361. * CARACTERISTIQUES POUR LES POUTRES
  362.  
  363.          ELSE IF (MFR.EQ.7 ) THEN
  364.            NBROBL=4
  365.            NBRFAC=5
  366.            SEGINI NOMID
  367.            LESOBL(1)='TORS'
  368.            LESOBL(2)='INRY'
  369.            LESOBL(3)='INRZ'
  370.            LESOBL(4)='SECT'
  371.            LESFAC(1)='SECY'
  372.            LESFAC(2)='SECZ'
  373.            LESFAC(3)='VX'
  374.            LESFAC(4)='VY'
  375.            LESFAC(5)='VZ'
  376.  
  377. * CARACTERISTIQUES POUR LES TUYAUX
  378.  
  379.          ELSE IF (MFR.EQ.13) THEN
  380.            NBROBL=2
  381.            NBRFAC=4
  382.            SEGINI NOMID
  383.            LESOBL(1)='EPAI'
  384.            LESOBL(2)='RAYO'
  385.            LESFAC(1)='RACO'
  386.            LESFAC(2)='VX  '
  387.            LESFAC(3)='VY  '
  388.            LESFAC(4)='VZ  '
  389.  
  390. * CARACTERISTIQUES POUR LES LINESPRING
  391.  
  392.          ELSE IF (MFR.EQ.15) THEN
  393.            NBROBL=5
  394.            SEGINI NOMID
  395.            LESOBL(1)='EPAI'
  396.            LESOBL(2)='FISS'
  397.            LESOBL(3)='VX  '
  398.            LESOBL(4)='VY  '
  399.            LESOBL(5)='VZ  '
  400.  
  401. * CARACTERISTIQUES POUR LES TUYAUX FISSURES
  402.  
  403.          ELSE IF (MFR.EQ.17) THEN
  404.            NBROBL=9
  405.            SEGINI NOMID
  406.            LESOBL(1)='RAYO'
  407.            LESOBL(2)='EPAI'
  408.            LESOBL(3)='VX  '
  409.            LESOBL(4)='VY  '
  410.            LESOBL(5)='VZ  '
  411.            LESOBL(6)='VXF '
  412.            LESOBL(7)='VYF '
  413.            LESOBL(8)='VZF '
  414.            LESOBL(9)='ANGL'
  415.  
  416. * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
  417.  
  418.          ELSE IF (MFR.EQ.37) THEN
  419.            IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  420.              NBROBL=4
  421.              SEGINI NOMID
  422.              LESOBL(1)='SCEL'
  423.              LESOBL(2)='SFLU'
  424.              LESOBL(3)='EPS '
  425.              LESOBL(4)='XINE'
  426.            ELSE
  427.              NBROBL=3
  428.              SEGINI NOMID
  429.              LESOBL(1)='SCEL'
  430.              LESOBL(2)='SFLU'
  431.              LESOBL(3)='EPS '
  432.            ENDIF
  433.          ENDIF
  434.  
  435.          NCARA=NBROBL
  436.          NCARF=NBRFAC
  437.          NCARR=NCARA+NCARF
  438.          MOCARA = NOMID
  439.          MOTYPE = NOTYPE
  440.  
  441.          IF (MOCARA.NE.0)  THEN
  442.             IF (IPCHE2.EQ.0)  THEN
  443.                IF (MOTYPE.NE.MOTYR8) SEGSUP NOTYPE
  444.                MOTERR(1:8)='CARACTER'
  445.                MOTERR(9:12)=NOMTP(MELE)
  446.                MOTERR(13:20)='CNEQ   '
  447.                CALL ERREUR(145)
  448.                GOTO 510
  449.             ENDIF
  450.                CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  451.      $                     IVACAR)
  452.                IF (MOTYPE.NE.MOTYR8) SEGSUP NOTYPE
  453.                IF (IERR.NE.0) GOTO 510
  454.  
  455.             IF (ISUP2.EQ.1) THEN
  456.               CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  457.               IF (IERR.NE.0)THEN
  458.                    ISUP2=0
  459.                    GOTO 510
  460.               ENDIF
  461.             ENDIF
  462.          ENDIF
  463. C
  464. C      TAILLES DE MELVAL
  465. C
  466.   777 CONTINUE
  467. C
  468.       N1EL  =NBELEM
  469.       N1PTEL=NBNN
  470.       N2PTEL=0
  471.       N2EL=0
  472.       NBPTEL=NBPGAU
  473.       NEL   =N1EL
  474. C
  475. C     CREATION DU MELVAL DE FORCES NODALES
  476. C
  477.       NSR=1
  478. C*    IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') THEN
  479.       IF (IMAGN .EQ. 1) THEN
  480.         NCOSOR=1
  481.       ELSE
  482.         NCOSOR=NCOMP
  483.       ENDIF
  484.       SEGINI MPTVAL
  485.       IVAFOR=MPTVAL
  486.       DO 100 ICOMP=1,NCOSOR
  487.         SEGINI MELVAL
  488.         IELVAL(ICOMP)=MELVAL
  489.         IVAL(ICOMP)=MELVAL
  490.   100 CONTINUE
  491. C_______________________________________________________________________
  492. C
  493. C     NUMERO DES ETIQUETTES      :
  494. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  495. C     Les elements sont groupes comme suit :
  496. C      - massif, poreux ---------------------------------> CNEQ1
  497. C      - coq3,dkt,coq4,coq8,coq2 ------------------------> CNEQ2
  498. C      - poutre,tuyau,linespring,tuyau fissure,barre ----> CNEQ3
  499. C_______________________________________________________________________
  500. C
  501.       IF(MELE.EQ.128) GO TO 128
  502.       GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99,
  503.      1      99,99, 4, 4, 4, 4,27,27,29,29,99,99,99,99,99,99,99,99,99,99,
  504.      2      27,29,29,27,99,29,99,99,27,29,99,99,99,99,99,27,99,99,99,99,
  505.      3      99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
  506.      4       4, 4, 4,99,99,99,99,99,99,99,99,99,27,99,99,99,99),MELE
  507. C
  508.       IF (MELE.EQ.193.OR.MELE.EQ.194) GOTO 4
  509.    99 CONTINUE
  510.       MOTERR(1:4)=NOMTP(MELE)
  511.       MOTERR(5:8)='CNEQ'
  512.       CALL ERREUR(86)
  513.       GOTO 510
  514. C_______________________________________________________________________
  515. C
  516. C     massifs, poreux
  517. C_______________________________________________________________________
  518. C
  519.    4  CONTINUE
  520.       IF (MFR.EQ.71) THEN
  521.         CALL CNEQEL(IPMAIL,IVAFVO,IPMINT,NBPGAU,IVAFOR,NCOMP)
  522.       ELSE
  523.       CALL CNEQ1(IPMAIL,LRE,NDDL,NBPGAU,MELE,MFR,IVAFVO,IPMINT,IVACAR,
  524.      &            IPORE,NCOMP,IVAFOR,IIPDPG)
  525.       ENDIF
  526.       GOTO 510
  527. C_______________________________________________________________________
  528. C
  529. C     coq3,dkt,coq4,coq8,coq2,dst
  530. C_______________________________________________________________________
  531. C
  532.   27  CONTINUE
  533.       CALL CNEQ2(IPMAIL,LRE,NDDL,IVAFVO,LW,NBPGAU,IVACAR,CMATE,
  534.      & NBPTEL,MELE,IPMINT,IPMIN1,IVAMAT,NMATT,NBGMAT,NELMAT,IMAT,IVAFOR)
  535.       GOTO 510
  536. C_______________________________________________________________________
  537. C
  538. C     poutre,tuyau,linespring,tuyau fissure,barre
  539. C_______________________________________________________________________
  540. C
  541.   29  CONTINUE
  542.       GO TO 99
  543. C_______________________________________________________________________
  544. C
  545. C     Element fini rot3 pour la magnetodynamique
  546. C_______________________________________________________________________
  547. C
  548.   128 CONTINUE
  549.       CALL CNEQMG(IPMAIL,IPMINT,IVAFVO,IVAFOR,MOFOVO,MELE)
  550.       GO TO 510
  551. C_______________________________________________________________________
  552. C
  553. C     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  554. C_______________________________________________________________________
  555. C
  556.   510 CONTINUE
  557.  
  558.       IF(ISUP1.EQ.1)THEN
  559.            CALL DTMVAL(IVAFVO,3)
  560.       ELSE
  561.            CALL DTMVAL(IVAFVO,1)
  562.       ENDIF
  563.  
  564.       IF(ISUP2.EQ.1)THEN
  565.            CALL DTMVAL(IVACAR,3)
  566.       ELSE
  567.            CALL DTMVAL(IVACAR,1)
  568.       ENDIF
  569.  
  570.       NOMID=MOFORC
  571.       if (nomid.NE.0 .AND. lsupfo) SEGSUP NOMID
  572.       NOMID=MOFOVO
  573.       if (nomid.NE.0) SEGSUP NOMID
  574.       NOMID=MOCARA
  575.       if (nomid.NE.0) SEGSUP NOMID
  576.  
  577.       IF (IERR.EQ.0) THEN
  578.         CALL DTMVAL(IVAFOR,1)
  579.       ELSE
  580.         CALL DTMVAL(IVAFOR,3)
  581.         IF (MCHAML.NE.0) SEGSUP MCHAML
  582.         SEGSUP MCHELM
  583.         IRET = 0
  584.         GO TO 9990
  585.       ENDIF
  586.  
  587.   200 CONTINUE
  588.  
  589.       IRET = 1
  590.  
  591. C Desactivation (modele,mchaml) dans tous les cas
  592.  9990 CONTINUE
  593.       notype = MOTYR8
  594.       SEGSUP,notype
  595.  9991 CONTINUE
  596.  
  597. C      RETURN
  598.       END
  599.  
  600.  
  601.  

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