Sources Esope | Cast3M

xnuage
C XNUAGE    SOURCE    CHAT      05/01/13    04:14:49     5004
 
      SUBROUTINE XNUAGE(WRK0,JC,WR11,NTABO3,NTABO4,KERRE)
C
C  CE PROGRAMME RANGE DANS 2 TABLEAUX LES INFOS RELATIVES A UNE
C  COMPOSANTE DE MATERIAU DE TYPE NUAGE
C  IL EST UTILISE POUR LES MATR. ENDOMMAGEABLES DE LEMAITRE (26 OU 29)
C
C  ENTREES:
C  -------
C  WRK0    = POINTEUR SUR LE SEGMENT CONTENANT LE TABLEAU XMAT DU MATR.
C       JC = NUMERO DE COMPOSANTE REPRESENTANT LA COURBE DE TRACTION
C            OU LA COURBE k(X) RESPECTIVEMENT POUR MATR. 26 OU 29
C  XMAT(JC) = POINTEUR SUR UN OBJET DE TYPE NUAGE REPRESENTANT :
C             -LA COURBE DE TRACTION EN FONCTION DE LA TEMPERATURE T
C              POUR MATR. 26
C             -LA COURBE k(X) EN FONCTION DE LA TEMPERATURE T
C              POUR MATR. 29  (k=PARAMETRE X=CONTR.)
C  NTABO3 = 0
C  NTABO4 = 0
C
C  SORTIES:
C  -------
C  NTABO3 = NBR. DE COURBES
C  IABLO3 = TABLEAU CONTENANT POUR CHAQUE COURBE LE NBR. DE PTS. QUI LA
C           DEFINIT
C  NTABO4 = DIMENSION DU TABLEAU TABLO4
C  TABLO4 = TABLEAU CONTENANT :
C           T1 EPS11 SIG11 EPS12 SIG12 ... T2 EPS21 SIG21 EPS22 SIG22 ...
C           T3 ....       POUR MATR. 26
C           T1 X11 k11 X12 k12 ... T2 X21 k21 X22 k22 ... T3 ...
C                         POUR MATR. 29
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMNUAGE
-INC SMEVOLL
-INC SMLREEL
      SEGMENT WRK0
       REAL*8 XMAT(NCXMAT)
      ENDSEGMENT
*
      SEGMENT WR11
        INTEGER IABLO3(NTABO3)
        REAL*8  TABLO4(NTABO4)
      ENDSEGMENT
*
      KERRE=0
      MNUAGE=XMAT(JC)
      SEGACT MNUAGE
         IF(MNUAGE.EQ.0) THEN
           MOTERR(1:8)='NUAGE   '
           CALL ERREUR(37)
           KERRE=37
           RETURN
         ENDIF
      NVAR=NUANOM(/2)
         IF(NVAR.LE.1) THEN
           SEGDES MNUAGE
           INTERR(1)=MNUAGE
           INTERR(2)=2
           INTERR(3)=2
           CALL ERREUR(628)
           KERRE=628
           RETURN
         ENDIF
      DO 203 IA=1,NVAR
         IF (NUATYP(IA).EQ.'FLOTTANT') GOTO 204
 203  CONTINUE
      SEGDES MNUAGE
      INTERR(1)=MNUAGE
      MOTERR(1:8)='FLOTTANT'
      CALL ERREUR(629)
      KERRE=629
      RETURN
 204  CONTINUE
      DO 205 IB=1,NVAR
         IF (NUATYP(IB).EQ.'EVOLUTIO') GOTO 206
 205  CONTINUE
      SEGDES MNUAGE
      INTERR(1)=MNUAGE
      MOTERR(1:8)='EVOLUTIO'
      CALL ERREUR(629)
      KERRE=629
      RETURN
 206  CONTINUE
      NUAVFL=NUAPOI(IA)
      NUAVIN=NUAPOI(IB)
      SEGACT NUAVFL
      SEGACT NUAVIN
      NBC1=NUAFLO(/1)
      NBC2=NUAINT(/1)
         IF (NBC1.NE.NBC2) THEN
           SEGDES MNUAGE,NUAVFL,NUAVIN
           CALL ERREUR(625)
           KERRE=625
           RETURN
         ENDIF
         IF (NBC1.LE.1) THEN
           SEGDES MNUAGE,NUAVFL,NUAVIN
           INTERR(1)=MNUAGE
           INTERR(2)=2
           INTERR(3)=2
           CALL ERREUR(628)
           KERRE=628
           RETURN
         ENDIF
      NTABO3=NBC1
      J0=1
      NTABO4=J0
      SEGADJ WR11
      DO 301 I=1,NBC1
            MEVOLL=NUAINT(I)
            IF(MEVOLL.EQ.0) THEN
              MOTERR(1:8)='EVOLUTIO'
              CALL ERREUR(37)
              KERRE=37
              RETURN
            ENDIF
            SEGACT MEVOLL
            KEVOLL=IEVOLL(1)
            SEGACT KEVOLL
            MLREEL=IPROGX
            MLREE1=IPROGY
            SEGDES KEVOLL
            SEGACT MLREEL,MLREE1
            NBPOIX=PROG(/1)
            IABLO3(I)=NBPOIX
            TABLO4(J0)=NUAFLO(I)
            DO 298 J=1,NBPOIX
                   NTABO4=J0+(2*J)
                   SEGADJ WR11
                   TABLO4(J0+(2*J-1))=PROG(J)
                   TABLO4(J0+2*J)=MLREE1.PROG(J)
 298        CONTINUE
            IF (I.LT.NBC1) THEN
            J0=J0+1+(2*NBPOIX)
            NTABO4=J0
            SEGADJ WR11
            ENDIF
            SEGDES MLREEL,MLREE1
            SEGDES MEVOLL
 301  CONTINUE
      SEGDES NUAVFL
      SEGDES NUAVIN
      SEGDES MNUAGE
      RETURN
      END