Télécharger modext.eso

Retour à la liste

modext
C MODEXT    SOURCE    OF166741  26/05/06    21:15:06     12537          
C----------------------------------------------------------------------C
C  Subroutine qui acquiert les informations propres aux lois externes  C
C                                                                      C
C  Sortie :                                                            C
C  --------                                                            C
C    MOTPRO : Nom de la loi utilisateur qui apparait dans IMODEL       C
C    LUPARX : Parametres externes  de la loi (PARA_LOI)                C
C    LUCMAT : Composantes materiau de la loi (C_MATERIAU)              C
C    LUCVAR : Variables internes   de la loi (C_VARINTER)              C
C    LUDERI : Derivee associee a la loi (EPSILON)                      C
C    LMOLOI : Numero de loi       (voir LEXTOP)                        C
C    LMOPTR : Pointeur sur la loi (voir LEXTOP)                        C
C    LMOLIB : Nom de la bilbiotheque (LIB_LOI)                         C
C    LMOLGB : Taille du nom LMOLIB                                     C
C    LMOFCT : Nom de la fonction dans la bibliotheque                  C
C    LMOLGT : Taille du nom LMOFCT (FCT_LOI)                           C
C                                                                      C
C----------------------------------------------------------------------C
      SUBROUTINE MODEXT(MOTPRO,LUPARX,LUCMAT,LUCVAR,LUDERI,
     &                  LMOLOI,LMOPTR,LMOLIB,LMOLGB,LMOFCT,LMOLGT) 
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
-INC PPARAM
-INC CCOPTIO
-INC SMLMOTS
C
      SEGMENT LIMODE(0)
C
      EXTERNAL LONG
      PARAMETER (NBEXT=8, NBDER=7)
      CHARACTER*4  MOEXT(NBEXT)
      CHARACTER*8  PAR1
      CHARACTER*16 LMONOM,MOTPRO
      CHARACTER*16 MDERIV(NBDER)
      CHARACTER*(LOCHAI) MOTEMP,LMOLIB,LMOFCT
      DATA MOEXT / 'NUME','NOM_','PARA','C_MA','C_VA','LIB_','FCT_',
     &             'DERI' /
      DATA MDERIV / 'LINEAIRE        ','QUADRATIQUE     ',
     &              'TRUESDELL       ','JAUMANN         ',
     &              'GRADIENT_F      ','FEFP            ',
     &              'UTILISATEUR     ' /
C
      LMONUM = 0
      MOTPRO = ' '
      LUPARX = 0
      LUCMAT = 0
      LUCVAR = 0
      LUDERI = 0
      LMOLOI = 0
      LMOPTR = 0
      LMOLIB = ' '
      LMOLGB = 0
      LMOFCT = ' '
      LMOLGT = 0
      LMONOM = '                '
C     ==================================================================
C     Acquisition des couples mots-cles/valeurs
C     ==================================================================
  10  CONTINUE
      CALL LIRMOT(MOEXT,NBEXT,LEXT,0)
      IF (LEXT.EQ.0) GOTO 11
C
C     Lecture d'un entier sous 'NUME_LOI'
      IF (LEXT.EQ.1) THEN
        CALL LIRENT(LMONUM,1,IRET)
        IF (IERR.NE.0) RETURN
C       Valeur illicite du numero de la loi (superieur ou egal a 1)
        IF (LMONUM.LT.1 .OR. LMONUM.GE.1000000) THEN
          INTERR(1) = LMONUM
          CALL ERREUR(36)
          CALL ERREUR(947)
          RETURN
        ENDIF
C
C     Lecture du nom de la loi sous 'NOM_LOI'
      ELSE IF (LEXT.EQ.2) THEN
        MOTEMP = ' '
        CALL LIRCHA(MOTEMP,1,IRET)
        IF (IERR.NE.0) RETURN
        IRET = LONG(MOTEMP(1:IRET))
        IF (IRET.GT.16) THEN
          INTERR(1) = IRET
          MOTERR = MOTEMP(1:IRET)
          CALL ERREUR(-2)
          CALL ERREUR(21)
          RETURN
        ELSE IF (IRET.LE.0) THEN
          INTERR(1) = 0
          MOTERR = 'NOM_LOI'
          CALL ERREUR(-2)
          CALL ERREUR(6)
          RETURN
        ENDIF
        LMONOM(1:IRET) = MOTEMP(1:IRET)
C
C     Lecture d'un objet LISTMOTS sous 'PARA_LOI'
      ELSE IF (LEXT.EQ.3) THEN
        CALL LIROBJ('LISTMOTS',LUPARX,1,IRET)
        IF (IERR.NE.0) RETURN
C
C     Lecture d'un objet LISTMOTS sous 'C_MATERIAU'
      ELSE IF (LEXT.EQ.4) THEN
        CALL LIROBJ('LISTMOTS',LUCMAT,1,IRET)
        IF (IERR.NE.0) RETURN
C
C     Lecture d'un objet LISTMOTS sous 'C_VARINTER'
      ELSE IF (LEXT.EQ.5) THEN
        CALL LIROBJ('LISTMOTS',LUCVAR,1,IRET)
        IF (IERR.NE.0) RETURN
C
C     Lecture du nom (du fichier) de la bibliotheque de la loi
      ELSE IF (LEXT.EQ.6) THEN
        MOTEMP = ' '
        CALL LIRCHA(MOTEMP,1,IRET)
        IF (IERR.NE.0) RETURN
        IF (IRET.GT.LOCHAI) THEN
          CALL ERREUR(1110)
          RETURN
        ENDIF
        IRET = LONG(MOTEMP(1:IRET))
        IF (IRET.LE.0) THEN
          INTERR(1) = 0
          MOTERR = 'LIB_LOI'
          CALL ERREUR(-2)
          CALL ERREUR(6)
          RETURN
        ENDIF
        LMOLIB(1:IRET) = MOTEMP(1:IRET)
        LMOLGB = IRET
        LMOPTR = IRET
C
C     Lecture du nom de la fonction de la loi
      ELSE IF (LEXT.EQ.7) THEN
        MOTEMP = ' '
        CALL LIRCHA(MOTEMP,1,IRET)
        IF (IERR.NE.0) RETURN
        IF (IRET.GT.LOCHAI) THEN
          CALL ERREUR(1110)
          RETURN
        ENDIF
        IRET = LONG(MOTEMP(1:IRET))
        IF (IRET.LE.0) THEN
          INTERR(1) = 0
          MOTERR = 'FCT_LOI'
          CALL ERREUR(-2)
          CALL ERREUR(6)
          RETURN
        ENDIF
        LMOFCT(1:IRET) = MOTEMP(1:IRET)
        LMOLGT = IRET
C
C     Lecture de la derivee associee a la loi
      ELSE IF (LEXT.EQ.8) THEN
        CALL LIRMOT(MDERIV,NBDER,IRET,1)
        IF (IERR.NE.0) RETURN
        IF (IRET.EQ.7) IRET = 5
        IF (.NOT. (IRET.EQ.1 .OR. IRET.EQ.5)) THEN
          MOTERR = ' '
          CALL ERREUR(963)
          IERR = 0
          MOTERR(1:4) = 'DERI'
          IF (IRET .EQ. 0) THEN
            CALL ERREUR(396)
C          ELSE IF (IRET.NE.1 .AND. IRET.NE.5) THEN
          ELSE
            MOTERR( 5:20) = MDERIV(1)(1:16)
            MOTERR(21:36) = MDERIV(5)(1:16)
            CALL ERREUR(1052)
          ENDIF
          RETURN
        ENDIF
        LUDERI = IRET
 
      ENDIF
C
      GOTO 10
  11  CONTINUE
C     ==================================================================
C     Verification des donnees
C     ==================================================================
C     Il manque 'NUME_LOI' ou 'NOM_LOI' (toujours obligatoire)
      IF (LMONUM.EQ.0 .AND. LMONOM.EQ.'                ') THEN
        IF (LMOLGT.EQ.0) THEN
          CALL ERREUR(641)
          RETURN
        ENDIF
      ENDIF
C
      IF (LMONUM.NE.0 .AND. LMONOM.NE.'                ') THEN
        MOTERR(1:16) = 'NUME_LOINOM_LOI '
        CALL ERREUR(135)
        RETURN
      ENDIF
C
C     Verifier que les listes de composantes :
C     1/ Ne sont pas vides
C     2/ Ne contiennent pas de redondance
C     3/ La temperature est en tete dans les parametres
      DO I =1,3
        IF (I.EQ.1) MLMOTS = LUPARX
        IF (I.EQ.2) MLMOTS = LUCMAT
        IF (I.EQ.3) MLMOTS = LUCVAR
C
        IF (MLMOTS.NE.0) THEN
          SEGACT,MLMOTS
          NBCOMP = MLMOTS.MOTS(/2)
          IF (NBCOMP.EQ.0) THEN
            CALL ERREUR(964)
            RETURN
          ENDIF
C
          IF (I.GT.1) THEN
C
            DO IP = 1, NBCOMP
              IF (MOTS(IP).EQ.'T   ') THEN
                IF (IP.GT.1) THEN
                  CALL ERREUR(948)
                  RETURN
                ENDIF
                GOTO 221
              ENDIF
            ENDDO
 221        CONTINUE
C
            DO 230 IP1 =1,NBCOMP-1
              PAR1 = MOTS(IP1)
              DO 231 IP2 =IP1+1,NBCOMP
                IF (MOTS(IP2).EQ.PAR1) THEN
                  CALL ERREUR(949)
                  RETURN
                ENDIF
 231          CONTINUE
 230        CONTINUE
C
          ENDIF
        ENDIF
      ENDDO
C
C     Ajouter le numero ou le nom de la loi utilisateur
      IF (LMONUM.EQ.0) THEN
        MOTPRO = LMONOM
        IF (LMOLGT.GT.0 .AND. LMONOM.EQ.'                ') THEN
          SEGINI,limode
          WRITE(MOTPRO(1:16),'(I16)') limode
          SEGSUP,limode
        ENDIF
      ELSE
        WRITE(MOTPRO(1:16),'(I16)') LMONUM
      ENDIF
C
C     Bibliotheque externe : pointeur de la fonction externe
      IF (LMOPTR.GT.0) THEN
C Si le nom de la fonction n'a pas ete fourni avec le mot-cle 'FCT_LOI',
C on le construit a partir de 'NOM_LOI' ou 'NUME_LOI'.
        IF (LMOLGT.EQ.0) THEN
          LMOFCT = ' '
          IF (LMONUM.EQ.0) THEN
            IRET = LONG(LMONOM)
            LMOFCT(1:IRET) = LMONOM(1:IRET)
            LMOLGT = IRET
          ELSE
            IRET = 0
            DO i = 1, 16
              IRET = IRET + 1
              IF (MOTPRO(i:i).NE.' ') GOTO 20
            ENDDO
  20        CONTINUE
            LMOFCT = 'umat_'//MOTPRO(IRET:16)
            LMOLGT = 22-IRET
          ENDIF
        ENDIF
        ip = -1
        CALL LEXTOP(LMOLIB,LMOFCT,ip,LMOLOI,LMOPTR)
***     IF (IERR.NE.0) RETURN
*si pas d'erreur LMOLOI > 0 et LMOPTR >0 pointe sur une fonction
*dbg    IF (LMOLOI.LE.0) CALL ERREUR(5)
*dbg    IF (LMOPTR.LE.0) CALL ERREUR(5)
        LMOLGB = LONG(LMOLIB)
        LMOLGT = LONG(LMOFCT)
*dbg    write(ioimp,*) 'LMOLOI =',LMOLOI,LMOPTR,LMOLGB,LMOLGT,
*dbg   &                     LMOLIB(1:LMOLGB),'=',LMOFCT(1:LMOLGT)
      ENDIF
C
C      RETURN
      END
 
 
 

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