Télécharger la plaquette Cast3M


fr en

Télécharger thetap.eso

Retour à la liste

Numérotation des lignes : 

thetap

  1. C THETAP    SOURCE    CB215821  24/04/12    21:17:21     11897          
  2.       SUBROUTINE THETAP(IPMODL,IPCHE1,IPCHE2,IPSTRS,IRET)
  3. *_______________________________________________________________________
  4. *
  5. *  OPERATEUR DE CALCUL DE CONTRAINTES DUES A UN CHAMP DE TEMPERATURE
  6. *  APPELE PAR THETA
  7. *
  8. *  ENTREES :
  9. *  ---------
  10. *
  11. *     IPMODL   POINTEUR SUR UN MMODEL
  12. *     IPCHE1   MCHAML DE SOUS TYPE CARACTERISTIQUE
  13. *     IPCHE2   MCHAML DE SOUS TYPE TEMPERATURE
  14. *
  15. *  SORTIES :
  16. *  ---------
  17. *
  18. *     IPSTRS   MCHAML DE SOUS TYPE CONTRAINTE (DUE @ LA TEMP{RATURE)
  19. *     IRET     1 OU 0 SUIVANT SUCCES OU PAS
  20. *
  21. * PASSAGE AUX NOUVEAUX CHAMELEMS PAR S.RAMAHANDRY LE 05/09/90
  22. *
  23. * VARIATION PARABOLIQUE DE TEMPERATURE DANS LES COQUES,OPTION ORTHOTROPE
  24. * ET ANISOTROPE POUR LES MASSIFS PAR P.DOWLATYARI LE 15/03/91
  25. *_______________________________________________________________________
  26. *
  27.       IMPLICIT INTEGER(I-N)
  28.       IMPLICIT REAL*8(A-H,O-Z)
  29. *
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMCHAML
  33. -INC SMELEME
  34. -INC SMINTE
  35. -INC SMMODEL
  36. -INC CCHAMP
  37. -INC SMCOORD
  38. *
  39.       SEGMENT NOTYPE
  40.         CHARACTER*16 TYPE(NBTYPE)
  41.       ENDSEGMENT
  42. *
  43.       SEGMENT MPTVAL
  44.         INTEGER IPOS(NS)    ,NSOF(NS)
  45.         INTEGER      IVAL(NCOSOU)
  46.         CHARACTER*16 TYVAL(NCOSOU)
  47.       ENDSEGMENT
  48. *
  49.       SEGMENT WRK1
  50.         REAL*8 WORK(LW)
  51.       ENDSEGMENT
  52. *
  53.       SEGMENT WRK2
  54.         REAL*8 XE(3,NBNN),TXR(IDIM,IDIM)
  55.         REAL*8 XLOC(3,3),XGLOB(3,3)
  56.         REAL*8 ROTS(NSTRS,NSTRS),DHOOK(LHOOK,LHOOK)
  57.       ENDSEGMENT
  58. *
  59.       SEGMENT WRK3
  60.         REAL*8 RES(NSTRS)
  61.       ENDSEGMENT
  62. *
  63.       SEGMENT MVELCH
  64.         REAL*8 VALMAT(NV1)
  65.       ENDSEGMENT
  66. *
  67.       CHARACTER*8        CMATE
  68.       CHARACTER*(NCONCH) CONM
  69.       PARAMETER (NINF=3)
  70.       INTEGER            INFOS(NINF)
  71.       DIMENSION          CRIGI(12)
  72.       LOGICAL            lsupco,lsupma,lsupte
  73. *
  74.       IRET   = 0
  75.       IPSTRS = 0
  76. *
  77.       NHRM=NIFOUR
  78.       THM    = 0.D0
  79.       THIF   = 0.D0
  80.       THSU   = 0.D0
  81.       TEMP   = 0.D0
  82. *
  83. *    VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  84. *
  85.       CALL QUESUP(IPMODL,IPCHE1,5,0,ISUPMA,IRETMA)
  86.       IF(ISUPMA.GT.1) RETURN
  87. *
  88. *    VERIFICATION DU LIEU SUPPORT DU MCHAML DE TEMPERATURE
  89. *
  90.       CALL QUESUP(IPMODL,IPCHE2,5,0,ISUPTE,IRETTE)
  91.       IF(ISUPTE.GT.1) RETURN
  92. C=============================================
  93. *     CREATION DU MCHELM resultat (decompte des SOUS-ZONES)
  94. C=============================================
  95. *
  96.       MMODEL=IPMODL
  97.       NSOUS =KMODEL(/1)
  98.       N1=0
  99.       DO 200 ISOUS=1,NSOUS
  100.         IMODEL=KMODEL(ISOUS)
  101.         IF (NEFMOD.EQ.22 ) GOTO 200
  102.         IF (NEFMOD.EQ.259) GOTO 200
  103.         IF (IMODEL.FORMOD(1) .EQ. 'MELANGE         ') GOTO 200
  104.         N1 = N1 + 1
  105.  200  CONTINUE
  106.       L1=11
  107.       N3=6
  108.       SEGINI,MCHELM
  109.       TITCHE='CONTRAINTES'
  110.       IFOCHE=IFOUR
  111. C=============================================
  112. *____________________________________________________________________
  113. *
  114. *     DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  115. *____________________________________________________________________
  116. *
  117.       ISOUS=0
  118.       DO 500 KISOUS=1,NSOUS
  119. *
  120. *     INITIALISATION
  121. *
  122.          MOCARA=0
  123.          MOMATR=0
  124.          MOSTRS=0
  125.          MOTEMP=0
  126.          IVAMAT=0
  127.          IVACAR=0
  128.          IVATEM=0
  129.          IVASTR=0
  130.          NCARA =0
  131.          NCARF =0
  132. *
  133.  
  134.          IMODEL=KMODEL(KISOUS)
  135.          MELE=NEFMOD
  136.          if(mele.eq.22) GOTO 999
  137.          if(mele.eq.259) GOTO 999
  138.          IF (IMODEL.FORMOD(1) .EQ. 'MELANGE         ') GOTO 500
  139.          ISOUS=ISOUS+1
  140. *
  141. *        TRAITEMENT DU MODELE
  142. *
  143.          IPMAIL=IMAMOD
  144.          CONM  =CONMOD
  145.  
  146.          IMACHE(ISOUS)=IPMAIL
  147.          CONCHE(ISOUS)=CONMOD
  148. *
  149. *        CREATION DU TABLEAU INFOS
  150. *
  151.          CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  152.          IF (IRTD.EQ.0) GOTO 999
  153. *
  154. *        NATURE DU MATERIAU
  155. *
  156. C         NFOR=FORMOD(/2)
  157. C         NMAT=MATMOD(/2)
  158. C         CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT)
  159.          CMATE = CMATEE
  160.          MATE  = IMATEE
  161.          INAT  = INATUU
  162. C         IF (CMATE.EQ.' ') THEN
  163. C            CALL ERREUR(251)
  164. C            GOTO 999
  165. C         ENDIF
  166. C
  167. C   COQUE INTEGREE OU PAS ?
  168. C
  169.       IF(INFMOD(/1).NE.0)THEN
  170.           NPINT=INFMOD(1)
  171.       ELSE
  172.           NPINT = 0
  173.       ENDIF
  174. *
  175. *        INFORMATION SUR L'ELEMENT FINI
  176. *
  177. *         CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  178. *         IF (IERR.NE.0) GOTO 999
  179. *         INFO=IPINF
  180.          MELE =INFELE(1)
  181.          ICARA=INFELE(5)
  182.          IPORE=INFELE(8)
  183.          MFR  =INFELE(13)
  184.          LHOOK=INFELE(10)
  185.          NBGS =INFELE(4)
  186.          NSTRS=INFELE(16)
  187.          LW   =INFELE(7)
  188. *         MINTE=INFELE(11)
  189.          MINTE=INFMOD(7)
  190.          IPMINT=MINTE
  191. *         SEGSUP INFO
  192. *
  193.          INFCHE(ISOUS,1)=0
  194.          INFCHE(ISOUS,2)=0
  195.          INFCHE(ISOUS,3)=NHRM
  196.          INFCHE(ISOUS,4)=MINTE
  197.          INFCHE(ISOUS,5)=0
  198.          INFCHE(ISOUS,6)=5
  199. *
  200. *        INITIALISATION DE MINTE
  201. *
  202.          NBPGAU=POIGAU(/1)
  203. *
  204. *        ACTIVATION DU MELEME
  205. *
  206.          MELEME=IPMAIL
  207.          NBNN  =NUM(/1)
  208.          NBELEM=NUM(/2)
  209.          NBNO=NBNN
  210.          IF(MFR.EQ.33) NBNO=IPORE
  211.          IELE = NUMGEO(MELE)
  212.          IPPORE=0
  213.          IF(MFR.EQ.33) IPPORE=NBNN
  214. *
  215. *
  216. *        RECUPERATION DES NOMS DE COMPOSANTES DES STRESSES
  217.          if(lnomid(4).ne.0) then
  218.            nomid =lnomid(4)
  219.            mostrs=nomid
  220.            nstr  =lesobl(/2)
  221.            nfac  =lesfac(/2)
  222.            lsupco=.false.
  223.          else
  224.            lsupco=.true.
  225.            CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  226.          endif
  227.  
  228. *
  229. *        RECUPERATION DES NOMS DE COMPOSANTES DE LA TEMPERATURE
  230.          if(lnomid(8).ne.0) then
  231.            nomid =lnomid(8)
  232.            motemp=nomid
  233.            ntem  =lesobl(/2)
  234.            nfac  =lesfac(/2)
  235.            lsupte=.false.
  236.          else
  237.            lsupte=.true.
  238.            CALL IDTEMP(MFR,IFOUR,NPINT,MOTEMP,NTEM,NFAC)
  239.          endif
  240.  
  241. *
  242.          NBTYPE=1
  243.          SEGINI NOTYPE
  244.          MOTYPE=NOTYPE
  245.          TYPE(1)='REAL*8'
  246. *
  247. *        RECUPERATION DES COMPOSANTES DE LA TEMPERATURE DANS IPCHE2
  248.          CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOTEMP,
  249.      1                        MOTYPE,1,INFOS,3,IVATEM)
  250.          IF (IERR.NE.0) GOTO 9990         
  251. *
  252. *        CHANGEMENT DE SUPPORT DES MELVAL DANS IVATEM ==> Passage au STRESSES
  253.          IF(ISUPTE.EQ.1)THEN
  254.             CALL VALCHE(IVATEM,NTEM,IPMINT,IPPORE,MOTEMP,MELE)
  255.             IF(IERR.NE.0)THEN
  256.               ISUPTE=0
  257.               GOTO 9990
  258.             ENDIF
  259.          ENDIF
  260.  
  261. *        Introduction en 2020 : T_ALPHA_REFERENCE dans le MATERIAU
  262.          NBROBL=1
  263.          NBRFAC=0
  264.          SEGINI,NOMID
  265.          MOTTAL=NOMID
  266.          LESOBL(1)='TALP'
  267.  
  268. *        RECUPERATION DES COMPOSANTES DE T_ALPHA_REFERENCE DANS IPCHE1
  269.          CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOTTAL,
  270.      1                        MOTYPE,1,INFOS,3,IVATAL)
  271.          IF (IERR.NE.0) GOTO 9990
  272. *
  273. *        CHANGEMENT DE SUPPORT DES MELVAL DANS IVATAL ==> Passage au STRESSES
  274.          IF(ISUPTE.EQ.1)THEN
  275.             NCOMP=1
  276.             CALL VALCHE(IVATAL,NCOMP,IPMINT,IPPORE,MOTTAL,MELE)
  277.             IF(IERR.NE.0)THEN
  278.               ISUPTE=0
  279.               GOTO 9990
  280.             ENDIF
  281.          ENDIF
  282.  
  283.          SEGSUP NOTYPE
  284. *
  285. *        RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
  286. *
  287.          N1PTEL=NBGS
  288.          N1EL=NBELEM
  289. *
  290. *        CREATION DU MCHAML DE LA SOUS ZONE
  291. *
  292.          N2=NSTRS
  293.          SEGINI MCHAML
  294.          ICHAML(ISOUS)=MCHAML
  295.          NS=1
  296.          NCOSOU=NSTRS
  297.          SEGINI MPTVAL
  298.          IVASTR=MPTVAL
  299.          NOMID =MOSTRS
  300.          N2PTEL=0
  301.          N2EL  =0
  302. *
  303.          IF(MELE.EQ.30.OR.MELE.EQ.43) THEN
  304.             N1PTEL=1
  305.             N1EL=1
  306.          ENDIF
  307.          DO 100 ICOMP=1,NSTRS
  308.             NOMCHE(ICOMP)=LESOBL(ICOMP)
  309.             TYPCHE(ICOMP)='REAL*8'
  310.             SEGINI MELVAL
  311.             IELVAL(ICOMP)=MELVAL
  312.             IVAL(ICOMP)=MELVAL
  313.  100     CONTINUE
  314. *
  315. *        TRAITEMENT DES CHAMPS DE MATERIAU
  316. *
  317.          NBROBL=0
  318.          NBRFAC=0
  319.          MOMATR=0
  320.          lsupma=.true.
  321. *
  322.          IF (MELE.EQ.29.OR.MELE.EQ.42.OR.MELE.EQ.45.OR.MELE.EQ.46
  323.      &   .OR.MELE.EQ.95.OR.MELE.EQ.123.OR.MELE.EQ.124
  324.      &   .OR.MELE.EQ.84) THEN
  325.             NBROBL=2
  326.             SEGINI NOMID
  327.             MOMATR=NOMID
  328.             LESOBL(1)='YOUN'
  329.             LESOBL(2)='ALPH'
  330. *
  331. *   materiau isotrope
  332. *
  333.          ELSE IF (CMATE.EQ.'ISOTROPE') THEN
  334.            IF (MFR.EQ.35) THEN
  335.              NBROBL=3
  336.              SEGINI NOMID
  337.              MOMATR=NOMID
  338.              LESOBL(1)='KS  '
  339.              LESOBL(2)='KN  '
  340.              LESOBL(3)='ALPN'
  341.            ELSE
  342.              NBROBL=3
  343.              SEGINI NOMID
  344.              MOMATR=NOMID
  345.              LESOBL(1)='YOUN'
  346.              LESOBL(2)='NU  '
  347.              LESOBL(3)='ALPH'
  348.            ENDIF
  349. *
  350. *  materiau orthotrope
  351. *
  352.          ELSE IF(CMATE.EQ.'ORTHOTRO') THEN
  353.            IF(MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9)THEN
  354.               NBROBL=7
  355.               SEGINI NOMID
  356.               MOMATR=NOMID
  357.               LESOBL(1)='YG1 '
  358.               LESOBL(2)='YG2 '
  359.               LESOBL(3)='NU12'
  360.               LESOBL(4)='ALP1'
  361.               LESOBL(5)='ALP2'
  362.               LESOBL(6)='V1X '
  363.               LESOBL(7)='V1Y '
  364.            ELSE IF (MFR.EQ.35) THEN
  365.               NBROBL=6
  366.               SEGINI NOMID
  367.               MOMATR=NOMID
  368.               LESOBL(1)='KS1 '
  369.               LESOBL(2)='KS2 '
  370.               LESOBL(3)='KN  '
  371.               LESOBL(4)='ALPN'
  372.               LESOBL(5)='V1X'
  373.               LESOBL(6)='V1Y '
  374.            ELSE IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN
  375.               IF(IFOUR.EQ.-2) THEN
  376.                 NBROBL =10
  377.                 SEGINI NOMID
  378.                 MOMATR=NOMID
  379.                 LESOBL(1)='YG1 '
  380.                 LESOBL(2)='YG2 '
  381.                 LESOBL(3)='NU12'
  382.                 LESOBL(4)='ALP1'
  383.                 LESOBL(5)='ALP2'
  384.                 LESOBL(6)='V1X '
  385.                 LESOBL(7)='V1Y '
  386.                 LESOBL(8)='YG3 '
  387.                 LESOBL(9)='NU23'
  388.                 LESOBL(10)='NU13'
  389.  
  390.               ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0
  391.      1            .OR.IFOUR.EQ.1.OR.IFOUR.EQ.-3)THEN
  392.                 NBROBL = 11
  393.                 SEGINI NOMID
  394.                 MOMATR=NOMID
  395.                 LESOBL(1)='YG1 '
  396.                 LESOBL(2)='YG2 '
  397.                 LESOBL(3)='YG3 '
  398.                 LESOBL(4)='NU12'
  399.                 LESOBL(5)='NU23'
  400.                 LESOBL(6)='NU13'
  401.                 LESOBL(7)='ALP1'
  402.                 LESOBL(8)='ALP2'
  403.                 LESOBL(9)='ALP3'
  404.                 LESOBL(10)='V1X '
  405.                 LESOBL(11)='V1Y '
  406.               ELSEIF(IFOUR.EQ.2)THEN
  407.                 NBROBL = 15
  408.                 SEGINI NOMID
  409.                 MOMATR=NOMID
  410.                 LESOBL(1)='YG1 '
  411.                 LESOBL(2)='YG2 '
  412.                 LESOBL(3)='YG3 '
  413.                 LESOBL(4)='NU12'
  414.                 LESOBL(5)='NU23'
  415.                 LESOBL(6)='NU13'
  416.                 LESOBL(7)='ALP1'
  417.                 LESOBL(8)='ALP2'
  418.                 LESOBL(9)='ALP3'
  419.                 LESOBL(10)='V1X '
  420.                 LESOBL(11)='V1Y '
  421.                 LESOBL(12)='V1Z '
  422.                 LESOBL(13)='V2X '
  423.                 LESOBL(14)='V2Y '
  424.                 LESOBL(15)='V2Z '
  425. C= Modes de calcul UNIDIMENSIONNELS (1D)
  426.               ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  427. C= Mode 1D UNID PLAN CYCZ
  428.                 IF (IFOUR.EQ.6) THEN
  429.                   NBROBL=7
  430.                   SEGINI,NOMID
  431.                   LESOBL(1)='YG1 '
  432.                   LESOBL(2)='YG2 '
  433.                   LESOBL(3)='YG3 '
  434.                   LESOBL(4)='NU12'
  435.                   LESOBL(5)='NU23'
  436.                   LESOBL(6)='NU13'
  437.                   LESOBL(7)='ALP1'
  438. C= Modes 1D UNID PLAN CYDZ et CYGZ
  439.                 ELSE IF (IFOUR.EQ.5.OR.IFOUR.EQ.10) THEN
  440.                   NBROBL=8
  441.                   SEGINI,NOMID
  442.                   LESOBL(1)='YG1 '
  443.                   LESOBL(2)='YG2 '
  444.                   LESOBL(3)='YG3 '
  445.                   LESOBL(4)='NU12'
  446.                   LESOBL(5)='NU23'
  447.                   LESOBL(6)='NU13'
  448.                   LESOBL(7)='ALP1'
  449.                   LESOBL(8)='ALP3'
  450.                 ELSE IF (IFOUR.EQ.4.OR.IFOUR.EQ.8.OR.IFOUR.EQ.13) THEN
  451. C= Modes 1D UNID PLAN DYCZ et GYCZ, et mode 1D UNID AXIS AXCZ
  452.                   NBROBL=8
  453.                   SEGINI,NOMID
  454.                   LESOBL(1)='YG1 '
  455.                   LESOBL(2)='YG2 '
  456.                   LESOBL(3)='YG3 '
  457.                   LESOBL(4)='NU12'
  458.                   LESOBL(5)='NU23'
  459.                   LESOBL(6)='NU13'
  460.                   LESOBL(7)='ALP1'
  461.                   LESOBL(8)='ALP2'
  462.                 ELSE
  463. C= Autres modes de calcul 1D UNID
  464. C= Mode 1D UNID SPHErique : on suppose que YG2=YG3  NU12=NU13  ALP2=ALP3
  465.                   NBROBL=9
  466.                   SEGINI,NOMID
  467.                   LESOBL(1)='YG1 '
  468.                   LESOBL(2)='YG2 '
  469.                   LESOBL(3)='YG3 '
  470.                   LESOBL(4)='NU12'
  471.                   LESOBL(5)='NU23'
  472.                   LESOBL(6)='NU13'
  473.                   LESOBL(7)='ALP1'
  474.                   LESOBL(8)='ALP2'
  475.                   LESOBL(9)='ALP3'
  476.                 ENDIF
  477.                 MOMATR=NOMID
  478.               ENDIF
  479.            ENDIF
  480. *
  481. *  materiau anisotrope
  482. *
  483.          ELSE IF(CMATE.EQ.'ANISOTRO') THEN
  484.            IF(MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33)THEN
  485.              IF(IFOUR.EQ.-2) THEN
  486.                NBROBL=15
  487.                SEGINI NOMID
  488.                MOMATR=NOMID
  489.                LESOBL(1)='D11 '
  490.                LESOBL(2)='D21 '
  491.                LESOBL(3)='D22 '
  492.                LESOBL(4)='D41 '
  493.                LESOBL(5)='D42 '
  494.                LESOBL(6)='D44 '
  495.                LESOBL(7)='ALP1'
  496.                LESOBL(8)='ALP2'
  497.                LESOBL(9)='AL12'
  498.                LESOBL(10)='V1X '
  499.                LESOBL(11)='V1Y '
  500.                LESOBL(12)='D31 '
  501.                LESOBL(13)='D32 '
  502.                LESOBL(14)='D33 '
  503.                LESOBL(15)='D43 '
  504.              ELSE IF(IFOUR.EQ.-3.OR.IFOUR.
  505.      1        EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.1)THEN
  506.                NBROBL=16
  507.                SEGINI NOMID
  508.                MOMATR=NOMID
  509.                LESOBL(1)='D11 '
  510.                LESOBL(2)='D21 '
  511.                LESOBL(3)='D22 '
  512.                LESOBL(4)='D31 '
  513.                LESOBL(5)='D32 '
  514.                LESOBL(6)='D33 '
  515.                LESOBL(7)='D41 '
  516.                LESOBL(8)='D42 '
  517.                LESOBL(9)='D43 '
  518.                LESOBL(10)='D44 '
  519.                LESOBL(11)='ALP1'
  520.                LESOBL(12)='ALP2'
  521.                LESOBL(13)='AL12'
  522.                LESOBL(14)='ALP3'
  523.                LESOBL(15)='V1X '
  524.                LESOBL(16)='V1Y '
  525.              ELSEIF(IFOUR.EQ.2)THEN
  526.                NBROBL=33
  527.                SEGINI NOMID
  528.                MOMATR=NOMID
  529.                LESOBL(1)='D11 '
  530.                LESOBL(2)='D21 '
  531.                LESOBL(3)='D22 '
  532.                LESOBL(4)='D31 '
  533.                LESOBL(5)='D32 '
  534.                LESOBL(6)='D33 '
  535.                LESOBL(7)='D41 '
  536.                LESOBL(8)='D42 '
  537.                LESOBL(9)='D43 '
  538.                LESOBL(10)='D44 '
  539.                LESOBL(11)='D51 '
  540.                LESOBL(12)='D52 '
  541.                LESOBL(13)='D53 '
  542.                LESOBL(14)='D54 '
  543.                LESOBL(15)='D55 '
  544.                LESOBL(16)='D61 '
  545.                LESOBL(17)='D62 '
  546.                LESOBL(18)='D63 '
  547.                LESOBL(19)='D64 '
  548.                LESOBL(20)='D65 '
  549.                LESOBL(21)='D66 '
  550.                LESOBL(22)='ALP1'
  551.                LESOBL(23)='ALP2'
  552.                LESOBL(24)='ALP3'
  553.                LESOBL(25)='AL12'
  554.                LESOBL(26)='AL13'
  555.                LESOBL(27)='AL23'
  556.                LESOBL(28)='V1X '
  557.                LESOBL(29)='V1Y '
  558.                LESOBL(30)='V1Z '
  559.                LESOBL(31)='V2X '
  560.                LESOBL(32)='V2Y '
  561.                LESOBL(33)='V2Z '
  562.              ENDIF
  563.            ENDIF
  564. *
  565. *  materiau unidirectionnel
  566. *
  567.          ELSE IF(CMATE.EQ.'UNIDIREC') THEN
  568. *  MLR 31/1/97      IF(IFOUR.EQ.2)THEN
  569.           IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
  570.               NBROBL=8
  571.               SEGINI NOMID
  572.               MOMATR=NOMID
  573.               LESOBL(1)='YOUN'
  574.               LESOBL(2)='ALPH'
  575.               LESOBL(3)='V1X '
  576.               LESOBL(4)='V1Y '
  577.               LESOBL(5)='V1Z '
  578.               LESOBL(6)='V2X '
  579.               LESOBL(7)='V2Y '
  580.               LESOBL(8)='V2Z '
  581.             ELSE
  582.               NBROBL=4
  583.               SEGINI NOMID
  584.               MOMATR=NOMID
  585.               LESOBL(1)='YOUN'
  586.               LESOBL(2)='ALPH'
  587.               LESOBL(3)='V1X '
  588.               LESOBL(4)='V1Y '
  589.             ENDIF
  590. C         ENDIF
  591.          ELSE
  592.            CALL ERREUR(5)
  593.          ENDIF
  594.          IF(MOMATR.EQ.0) CALL ERREUR(5)
  595.          NMATT=NBROBL+NBRFAC
  596.  
  597. *        Types attendus des composantes
  598.          IF (CMATE.EQ.'SECTION') THEN
  599.            NBTYPE=3
  600.            SEGINI NOTYPE
  601.            MOTYPE=NOTYPE
  602.            TYPE(1)='POINTEURMMODEL'
  603.            TYPE(2)='POINTEURMCHAML'
  604.            TYPE(3)='POINTEURLISTREEL'
  605.          ELSE
  606.            NBTYPE=1
  607.            SEGINI NOTYPE
  608.            MOTYPE=NOTYPE
  609.            TYPE(1)='REAL*8'
  610.          ENDIF
  611.  
  612. *        Recuperation des COMPOSANTES des NOMID
  613.          CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,
  614.      1                          MOTYPE,1,INFOS,3,IVAMAT)
  615.          SEGSUP NOTYPE
  616.          IF (IERR.NE.0) GOTO 9990
  617.  
  618. *        CHANGEMENT DE SUPPORT DES MELVAL DANS IVAMAT ==> Passage au STRESSES
  619.          IF(ISUPMA.EQ.1)THEN
  620.           CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  621.           IF(IERR.NE.0)THEN
  622.             ISUPMA=0
  623.             GOTO 9990
  624.           ENDIF
  625.          ENDIF
  626.          MPTVAL=IVAMAT
  627. *         MELVAL=IVAL(1)
  628.          NBGMAT = 0
  629.          NELMAT = 0
  630.          DO 1108 IM=1,NMATT
  631.            IF(IVAL(IM).NE.0)THEN
  632.             MELVAL=IVAL(IM)
  633.             IF (CMATE.EQ.'SECTION') THEN
  634.               NBGMAT=MAX(NBGMAT,MELVAL.IELCHE(/1))
  635.               NELMAT=MAX(NELMAT,MELVAL.IELCHE(/2))
  636.             ELSE
  637.               NBGMAT=MAX(NBGMAT,MELVAL.VELCHE(/1))
  638.               NELMAT=MAX(NELMAT,MELVAL.VELCHE(/2))
  639.             ENDIF
  640.            ENDIF
  641.  1108    CONTINUE
  642. *
  643. *        TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
  644. *
  645.          NBROBL=0
  646.          NBRFAC=0
  647.          IVECT=0
  648. *
  649. *        EPAISSEUR DANS LE CAS DES COQUES
  650. *
  651.          IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  652.             NBROBL=1
  653.             SEGINI NOMID
  654.             MOCARA=NOMID
  655.             LESOBL(1)='EPAI'
  656. *
  657.            NBTYPE=1
  658.            SEGINI NOTYPE
  659.            MOTYPE=NOTYPE
  660.            TYPE(1)='REAL*8'
  661. *
  662. *        SECTION POUR LES BARRES ET LES CERCES
  663. *
  664.          ELSE IF (MFR.EQ.27) THEN
  665.             NBROBL=1
  666.             NBRFAC=0
  667.             SEGINI NOMID
  668.             MOCARA=NOMID
  669.             LESOBL(1)='SECT'
  670. *
  671.            NBTYPE=1
  672.            SEGINI NOTYPE
  673.            MOTYPE=NOTYPE
  674.            TYPE(1)='REAL*8'
  675. *
  676. * section, excentrements et orientation pour les barres excentrees
  677. *
  678.          ELSE IF (MFR.EQ.49) THEN
  679.              NBROBL=6
  680.              SEGINI NOMID
  681.              MOCARA=NOMID
  682.              LESOBL(1)='SECT'
  683.              LESOBL(2)='EXCZ'
  684.              LESOBL(3)='EXCY'
  685.              LESOBL(4)='VX  '
  686.              LESOBL(5)='VY  '
  687.              LESOBL(6)='VZ  '
  688. *
  689.              NBTYPE=1
  690.              SEGINI NOTYPE
  691.              MOTYPE=NOTYPE
  692.              TYPE(1)='REAL*8'
  693. *
  694. *        CARACTERISTIQUES POUR LES POUTRES
  695. *
  696.          ELSE IF (MFR.EQ.7 ) THEN
  697.            IF (CMATE.NE.'SECTION') THEN
  698.             NBROBL=1
  699.             NBRFAC=0
  700.             SEGINI NOMID
  701.             MOCARA=NOMID
  702.             LESOBL(1)='SECT'
  703. *
  704.             NBTYPE=1
  705.             SEGINI NOTYPE
  706.             MOTYPE=NOTYPE
  707.             TYPE(1)='REAL*8'
  708.            ENDIF
  709. *
  710. *        CARACTERISTIQUES POUR LES TUYAUX
  711. *
  712.          ELSE IF (MFR.EQ.13) THEN
  713.             NBROBL=2
  714.             NBRFAC=5
  715.             SEGINI NOMID
  716.             MOCARA=NOMID
  717.             LESOBL(1)='EPAI'
  718.             LESOBL(2)='RAYO'
  719.             LESFAC(1)='RACO'
  720.             LESFAC(2)='CISA'
  721.             LESFAC(3)='VX'
  722.             LESFAC(4)='VY'
  723.             LESFAC(5)='VZ'
  724.             IVECT=1
  725. *
  726.            NBTYPE=7
  727.            SEGINI NOTYPE
  728.            MOTYPE=NOTYPE
  729.            TYPE(1)='REAL*8'
  730.            TYPE(2)='REAL*8'
  731.            TYPE(3)='REAL*8'
  732.            TYPE(4)='REAL*8'
  733.            TYPE(5)='REAL*8'
  734.            TYPE(6)='REAL*8'
  735.            TYPE(7)='REAL*8'
  736.          ENDIF
  737. *
  738.          NCARA=NBROBL
  739.          NCARF=NBRFAC
  740.          NCARR=NCARA+NCARF
  741.          IF (MOCARA.NE.0) THEN
  742.             IF (IPCHE1.EQ.0) THEN
  743.                SEGSUP NOTYPE
  744.                MOTERR(1:4)='CARA'
  745.                MOTERR(5:8)='CARA'
  746.                MOTERR(9:12)=NOMTP(MELE)
  747.                MOTERR(13:20)='THETA'
  748.                CALL ERREUR(145)
  749.                GOTO 9990
  750.             ENDIF
  751.             CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,
  752.      1                                      1,INFOS,3,IVACAR)
  753.             SEGSUP NOTYPE
  754.             IF (IERR.NE.0) GOTO 9990
  755.  
  756. *           CHANGEMENT DE SUPPORT DES MELVAL DANS IVACAR ==> Passage au STRESSES
  757.             IF (ISUPMA.EQ.1) THEN
  758.               CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  759.               IF (IERR.NE.0) THEN
  760.                 ISUPMA=0
  761.                 GOTO 9990
  762.               ENDIF
  763.             ENDIF
  764.          ENDIF
  765. *
  766.         NV1=NMATT
  767.         SEGINI,MVELCH
  768.         SEGINI, WRK3
  769. *
  770.         IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  771.      1     CMATE.EQ.'UNIDIREC')) THEN
  772. C                RENSEIGNEMENTS SUR LE MAILLAGE
  773.            MELEME=IPMAIL
  774.            NBNN=NUM(/1)
  775.            SEGINI WRK2
  776. *
  777. *  RECUPERATION DES FONCTIONS DE FORME ET LEURS DERIVEES AU CENTRE DE
  778. *  L'ELEMENT POUR LE CALCUL DES AXES LOCAUX
  779.            IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN
  780.              CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPT1,IRT1)
  781.              IF (IERR.NE.0) THEN
  782.                SEGSUP MVELCH,WRK2,WRK3
  783.                GOTO 9990
  784.              ENDIF
  785.              MINTE2=IPT1
  786.            ENDIF
  787.         ENDIF
  788. *
  789. * BOUCLE SUR LES ELEMENTS
  790. *
  791.        DO 1000 IB=1,NBELEM
  792. C
  793.         IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  794.      1       CMATE.EQ.'UNIDIREC').AND.
  795.      2      (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33)) THEN
  796. C
  797. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  798. C
  799.           CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  800. C
  801. C     CALCUL DES AXES LOCAUX
  802. C
  803.           NBSH=MINTE2.SHPTOT(/2)
  804.           CALL RLOCAL (XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  805.         if (nbsh.eq.-1) then
  806.          call erreur(525)
  807.          return
  808.         endif
  809.         ENDIF
  810. C
  811.         IF(CMATE.EQ.'SECTION') THEN
  812. *
  813. *  CAS DE LA POUTRE TIMO - MODELE SECTION
  814. *
  815.             MPTVAL=IVAMAT
  816.             MELVAL=IVAL(1)
  817.             IBMN=MIN(IB,IELCHE(/2))
  818.             IPMODL=IELCHE(1,IBMN)
  819.             MELVAL=IVAL(2)
  820.             IBMN=MIN(IB,IELCHE(/2))
  821.             IPMAT=IELCHE(1,IBMN)
  822.             CALL FRIGTH(IPMODL,IPMAT,CRIGI,0,1)
  823.         ENDIF
  824. C
  825. * BOUCLE SUR LES POINTS
  826. *
  827.          DO 2000 IGAU=1,NBPGAU
  828. *
  829. * initialisations
  830. *
  831.            EPAIST=0.D0
  832.            SD    =0.D0
  833.            TEMP  =0.D0
  834.            THIF  =0.D0
  835.            THM   =0.D0
  836.            THSU  =0.D0
  837.            E3    =0.D0
  838. *
  839. * remplissage du tableau des caracteristiques du materiau
  840. *
  841.         IF(CMATE.NE.'SECTION') THEN
  842.           MPTVAL=IVAMAT
  843.           NOMID=MOMATR
  844.           DO 1100 IO = 1,NMATT
  845.              MELVAL = IVAL(IO)
  846.              IF(MELVAL .EQ. 0)GOTO 1100
  847.              IBMN=MIN(IB,VELCHE(/2))
  848.              IGMN=MIN(IGAU,VELCHE(/1))
  849.              VALMAT(IO) = VELCHE( IGMN,IBMN)
  850.  1100     CONTINUE
  851.         ENDIF
  852. *
  853. C  Prise en compte de l'epaisseur et de l'excentrement
  854. C  dans le cas des coques minces avec ou sans cisaillement
  855. C  transverse
  856. C
  857.         IF ((CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.
  858.      1         OR.CMATE.EQ.'UNIDIREC').AND.
  859.      2                       (MFR.EQ.3.OR.MFR.EQ.9)) THEN
  860.          MPTVAL=IVACAR
  861.          MELVAL=IVAL(1)
  862.          IF (MELVAL.NE.0) THEN
  863.            IBMN=MIN(IB  ,VELCHE(/2))
  864.            IGMN=MIN(IGAU,VELCHE(/1))
  865.            EPAIST=VELCHE(IGMN,IBMN)
  866.          ELSE
  867.            CALL ERREUR(527)
  868.            GOTO 9990
  869.          ENDIF
  870.         ENDIF
  871. *
  872. * remplissage du tableau des caracteristiques geometriques
  873. *
  874.  
  875.         IF (MELE.EQ.29.OR.MELE.EQ.42.OR.MELE.EQ.45.OR.MELE.EQ.123
  876.      1       .OR.MELE.EQ.124.OR.MELE.EQ.46.OR.MELE.EQ.95
  877.      1       .OR.MELE.EQ.84) THEN
  878.         SEGINI WRK1
  879.          IF(MELE.EQ.42) THEN
  880.             MPTVAL=IVACAR
  881.             DO 1200 IC=1,NCARR
  882.                IF (IVAL(IC).NE.0) THEN
  883.                   MELVAL=IVAL(IC)
  884.                   IBMN=MIN(IB,VELCHE(/2))
  885.                  IF (IBMN.NE.0)  THEN
  886.                    WORK(IC)=VELCHE(1,IBMN)
  887.                  ELSE
  888.                    WORK(IC)=0.D0
  889.                  ENDIF
  890.                ELSE
  891.                   WORK(IC)=0.D0
  892.                ENDIF
  893.  1200       CONTINUE
  894. *
  895. *  CAS DES TUYAUX - ON CALCULE LES CARACTERISTIQUES DE LA POUTRE  EQUIVA
  896. *
  897.             CISA=WORK(4)
  898.             VX=WORK(5)
  899.             VY=WORK(6)
  900.             VZ=WORK(7)
  901.             CALL TUYCAR(WORK,CISA,VX,VY,VZ,KERRE,1)
  902.             SD=WORK(4)
  903.          ELSE
  904.             MPTVAL=IVACAR
  905.             MELVAL=IVAL(1)
  906.             IBMN=MIN(IB,VELCHE(/2))
  907.             SD=0.D0
  908.             DO 1201 IAUX=1,NBPGAU
  909.               IGMN=MIN(IAUX,VELCHE(/1))
  910.               SD=SD+VELCHE(IGMN,IBMN)
  911.               IF(IAUX.EQ.NBPGAU)  SD=SD/NBPGAU
  912.  1201       CONTINUE
  913.          ENDIF
  914.         ENDIF
  915.         IF(CMATE.EQ.'SECTION') SD=CRIGI(1)
  916.  
  917.  
  918. *      'T_ALPHA_REFERENCE'
  919.         MPTVAL=IVATAL
  920.         MELVAL=IVAL(1)
  921.         IGMN  =MIN(IGAU,VELCHE(/1))
  922.         IBMN  =MIN(IB  ,VELCHE(/2))
  923.         TALP  =VELCHE(IGMN,IBMN)
  924.  
  925.         IF (((MFR.EQ.3.OR.MFR.EQ.9).AND.(CMATE.EQ.'ISOTROPE'.
  926.      +       OR.CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'UNIDIREC')).
  927.      +       OR.(MFR.EQ.5.AND.(CMATE.EQ.'ISOTROPE'.OR.CMATE.
  928.      +       EQ.'ORTHOTRO')))   THEN
  929. *
  930.             IF(NPINT.EQ.0) THEN
  931.                MPTVAL=IVATEM
  932. *             'TINF' - 'T_ALPHA_REFERENCE'
  933.                MELVAL=IVAL(1)
  934.                IGMN=MIN(IGAU,VELCHE(/1))
  935.                IBMN=MIN(IB  ,VELCHE(/2))
  936.                THIF=VELCHE(IGMN,IBMN) - TALP
  937.  
  938. *             'T' - 'T_ALPHA_REFERENCE'
  939.                MELVAL=IVAL(2)
  940.                IGMN=MIN(IGAU,VELCHE(/1))
  941.                IBMN=MIN(IB  ,VELCHE(/2))
  942.                THM=VELCHE(IGMN,IBMN) - TALP
  943.  
  944. *             'TSUP' - 'T_ALPHA_REFERENCE'
  945.                MELVAL=IVAL(3)
  946.                IGMN=MIN(IGAU,VELCHE(/1))
  947.                IBMN=MIN(IB  ,VELCHE(/2))
  948.                THSU=VELCHE(IGMN,IBMN) - TALP
  949.             ELSE
  950. *             'T' - 'T_ALPHA_REFERENCE'
  951.                MPTVAL=IVATEM
  952.                MELVAL=IVAL(1)
  953.                IGMN=MIN(IGAU,VELCHE(/1))
  954.                IBMN=MIN(IB  ,VELCHE(/2))
  955.                TEMP=VELCHE(IGMN,IBMN) - TALP
  956.             ENDIF
  957. *
  958.             E3 = DZEGAU(IGAU)
  959. *
  960.          ELSEIF((MFR.EQ.7.OR.MFR.EQ.13.OR.MFR.EQ.27.OR.MELE.EQ.85.OR.
  961.      +       MELE.EQ.86.OR.MELE.EQ.87.OR.MELE.EQ.88.OR.MFR.EQ.49.OR.
  962.      +       MELE.EQ.84.OR.MFR.EQ.51).OR.((MFR.EQ.1.OR.MFR.EQ.33.OR.
  963.      +       MFR.EQ.31).AND.(CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'
  964.      +       .OR.CMATE.EQ.'ANISOTRO'.OR.CMATE.EQ.'UNIDIREC'))) THEN
  965.  
  966. *          'T' - 'T_ALPHA_REFERENCE'
  967.             MPTVAL=IVATEM
  968.             MELVAL=IVAL(1)
  969.             IGMN  =MIN(IGAU,VELCHE(/1))
  970.             IBMN  =MIN(IB  ,VELCHE(/2))
  971.             TEMP  =VELCHE(IGMN,IBMN) - TALP
  972.          ENDIF
  973. *--------------------------------------------------------------
  974. *                      CAS ISOTROPE
  975. *--------------------------------------------------------------
  976. *
  977.       IF(CMATE.EQ.'ISOTROPE') THEN
  978. *
  979.             CALL THETIS(MFR,MELE,VALMAT,NSTRS,NPINT,TEMP,THIF,
  980.      1                  THM,THSU,E3,SD,EPAIST,RES,KERRE)
  981. *
  982. *--------------------------------------------------------------
  983. *                      CAS ORTHOTROPE
  984. *--------------------------------------------------------------
  985.       ELSEIF(CMATE.EQ.'ORTHOTRO') THEN
  986.             CALL THETOR(MFR,MELE,VALMAT,LHOOK,NSTRS,TEMP,THIF,
  987.      1                  THM,THSU,E3,SD,EPAIST,TXR,XLOC,XGLOB,
  988.      2                                  ROTS,DHOOK,RES,KERRE)
  989. *
  990. *--------------------------------------------------------------
  991. *                      CAS ANISOTROPE
  992. *--------------------------------------------------------------
  993.       ELSEIF(CMATE.EQ.'ANISOTRO') THEN
  994.             CALL THETAN(MFR,MELE,VALMAT,LHOOK,NSTRS,TEMP,
  995.      1            SD,TXR,XLOC,XGLOB,ROTS,DHOOK,RES,KERRE)
  996.  
  997. *--------------------------------------------------------------
  998. *                      CAS UNIDIRECTIONNEL
  999. *--------------------------------------------------------------
  1000.       ELSEIF(CMATE.EQ.'UNIDIREC') THEN
  1001.             CALL THETUN(MFR,MELE,VALMAT,LHOOK,NSTRS,TEMP,THIF,
  1002.      1                      THM,THSU,SD,EPAIST,TXR,XLOC,XGLOB,
  1003.      2                                   ROTS,DHOOK,RES,KERRE)
  1004. *
  1005. *--------------------------------------------------------------
  1006. *                      CAS HOMOGENEISE ET SECTION
  1007. *--------------------------------------------------------------
  1008.       ELSEIF(CMATE.EQ.'HOMOGENE'.OR.CMATE.EQ.'SECTION') THEN
  1009.             CALL THETHS(MELE,VALMAT,NSTRS,TEMP,SD,RES,KERRE)
  1010. *
  1011. *--------------------------------------------------------------
  1012. *
  1013.       ELSE
  1014.          CALL ERREUR(19)
  1015.          GOTO 9900
  1016.       ENDIF
  1017. *
  1018.       IF (KERRE.EQ.19) THEN
  1019.          CALL ERREUR(19)
  1020.          GOTO 9900
  1021.       ELSEIF (KERRE.EQ.86) THEN
  1022.          MOTERR(1:4) =NOMTP(MELE)
  1023.          MOTERR(5:12)='THET'
  1024.          CALL ERREUR(86)
  1025.          GOTO 9900
  1026.       ENDIF
  1027. *
  1028.       MPTVAL=IVASTR
  1029.       DO 1600 I=1,NSTRS
  1030.         MELVAL=IVAL(I)
  1031.         VELCHE(IGAU,IB)=RES(I)
  1032.  1600   CONTINUE
  1033. *
  1034.  2000   CONTINUE
  1035.  1000  CONTINUE
  1036. *
  1037. *____________________________________________________________________
  1038. *
  1039. *    DESACTIVATION DES SEGMENTS DE TRAVAIL
  1040. *____________________________________________________________________
  1041. *
  1042.  9900 CONTINUE
  1043. *
  1044.         IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  1045.      1     CMATE.EQ.'UNIDIREC')) SEGSUP WRK2
  1046.         IF (MELE.EQ.29.OR.MELE.EQ.42)  SEGSUP WRK1
  1047. *
  1048.       SEGSUP MVELCH,WRK3
  1049. *
  1050.  9990  CONTINUE
  1051. *____________________________________________________________________
  1052. *
  1053. *    DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  1054. *____________________________________________________________________
  1055. *
  1056.       IF(IERR.NE.0)RETURN
  1057.       IF(IVAMAT .GT. 0)THEN
  1058.         MPTVAL=IVAMAT
  1059.         SEGSUP,MPTVAL
  1060.       ENDIF
  1061.       IF(IVACAR .GT. 0)THEN
  1062.         MPTVAL=IVACAR
  1063.         SEGSUP,MPTVAL
  1064.       ENDIF
  1065.       IF(IVASTR .GT. 0)THEN
  1066.         MPTVAL=IVASTR
  1067.         SEGSUP,MPTVAL
  1068.       ENDIF
  1069.       IF(IVATEM .GT. 0)THEN
  1070.         MPTVAL=IVATEM
  1071.         SEGSUP,MPTVAL
  1072.       ENDIF
  1073.       IF(IVATAL .GT. 0)THEN
  1074.         MPTVAL=IVATAL
  1075.         SEGSUP,MPTVAL
  1076.       ENDIF
  1077. *
  1078.       IF(MOMATR.NE.0)THEN
  1079.          NOMID=MOMATR
  1080.          if(lsupma)SEGSUP NOMID
  1081.       ENDIF
  1082.       IF(MOCARA.NE.0)THEN
  1083.          NOMID=MOCARA
  1084.          SEGSUP NOMID
  1085.       ENDIF
  1086.       IF(MOSTRS.NE.0)THEN
  1087.          NOMID=MOSTRS
  1088.          if(lsupco)SEGSUP NOMID
  1089.       ENDIF
  1090.       IF(MOTEMP.NE.0)THEN
  1091.          NOMID=MOTEMP
  1092.          if(lsupte)SEGSUP NOMID
  1093.       ENDIF
  1094.       IF(MOTTAL.NE.0)THEN
  1095.          NOMID=MOTTAL
  1096.          SEGSUP NOMID
  1097.       ENDIF
  1098. *
  1099.  999  CONTINUE
  1100.       IF (IERR.NE.0) GOTO 888
  1101. *
  1102.   500 CONTINUE
  1103.  
  1104.  
  1105.  888  CONTINUE
  1106.       IF(IERR.NE.0)THEN
  1107.          IRET   = 0
  1108.          SEGSUP MCHELM
  1109.          IPSTRS = 0
  1110.       ELSE
  1111.          IRET   = 1
  1112.          IPSTRS = MCHELM
  1113.       ENDIF
  1114.  
  1115.       END
  1116.  
  1117.  
  1118.  
  1119.  
  1120.  
  1121.  

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