C GRAD      SOURCE    CB215821  22/06/23    21:15:02     11392          

C=======================================================================
C=                              G R A D                                =
C=                              -------                                =
C=                                                                     =
C=  OPERATEUR CAST3M "GRAD" DE CALCUL DU GRADIENT D'UN CHAMP :         =
C=  ----------------------------------------------------------         =
C=   GRA1  =  'GRAD'  MODL1  CHP1 ou CHE1  ( CAR1 )  ;                 =
C=                                                                     =
C=  Cet operateur calcule le gradient d'un champ de temperatures ou    =
C=  de deplacements.                                                   =
C=                                                                     =
C=  ARGUMENTS :                                                        =
C=  -----------                                                        =
C=   MODL1   (MMODEL)   Modele associe a la structure etudiee          =
C=   CHP1    (CHPOINT)  | Champ de deplacements           (NOEUDS)     =
C=   CHE1    (MCHAML)   | ou de temperatures              (ELEMENT)    =
C=   CAR1    (MCHAML)   Caracteristiques geometriques     (facultatif) =
C=                      Sous-type 'CARACTERISTIQUES'                   =
C=                                                                     =
C=  RESULTAT :                                                         =
C=  ----------                                                         =
C=   GRA1    (MCHAML)   Champ de gradients sur la structure            =
C=                                                                     =
C=  SUO X.Z., le 16 novemebre 1986.                                    =
C=  Christian LE BRETON et Denis ROBERT-MOUGIN, le 31 juillet 1989.    =
C=  Modifications aux nouvelles normes par I. MONNIER, le 28 mai 1990. =
C=======================================================================

      SUBROUTINE GRAD

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      INTEGER ZERO


-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC CCHAMP
-INC SMCOORD

      CHARACTER*4 MOCONS(1)
      DATA MOCONS/'CONS'/

      
C     On a besoin du MCOORD plus loin
      SEGACT,MCOORD

C  1 - LECTURE DES ARGUMENTS DE L'OPERATEUR
C ==========================================
C  1.1 - Lecture OBLIGATOIRE du modele (IPMODL)
C =====
      CALL LIROBJ('MMODEL  ',IPMODL,1,IRET)
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
      IF (IERR.NE.0) RETURN
C =====
C  1.2 - Syntaxe 1 : lecture d'un CHPOINT de depl. ou T (IPCHP1)
C        Transformation du CHPOINT en MCHAML aux noeuds (IPCHE2)
C =====
      ZERO=0
      IRET1=0
      CALL LIROBJ('CHPOINT ',IPCHP1,0,IRET1)
      IF (IERR.NE.0) RETURN
      IRET2=0
      IF (IRET1.NE.0) THEN
        CALL ACTOBJ('CHPOINT ',IPCHP1,1)
        IPCHL1=IPCHP1
        CALL CHAME1(0,IPMODL,IPCHP1,' ',IPCHE2,1)
        IF (IERR.NE.0) RETURN
C =====
C  1.3 - Syntaxe 3 : lecture d'un MCHAML de depl. ou T (IPCHE2)
C        ERREUR si le mode de calcul est "generalise"
C =====
      ELSE
        IF (IFOUR.EQ.-3.OR.
     .      (IFOUR.GE.7.AND.IFOUR.LE.11).OR.IFOUR.EQ.14) THEN
          MOTERR(1:8)='CHPOINT '
          CALL ERREUR(37)
          RETURN
        ENDIF
        IPCHL1=0
        CALL LIROBJ('MCHAML  ',IPIN,1,IRET2)
        CALL ACTOBJ('MCHAML  ',IPIN,1)
        IF (IERR.NE.0) RETURN
        CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
        IF (IR.NE.1)  CALL ERREUR(KER)
        IF(IERR.NE.0) RETURN
      ENDIF
C =====
C  1.4 - Lecture FACULTATIVE des caracteristiques geometriques (IPCHE1)
C =====
      IRET3=0
      CALL LIROBJ('MCHAML  ',IPCHE1,0,IRET3)
      IF(IRET3 .EQ. 1) CALL ACTOBJ('MCHAML  ',IPCHE1,1)
      IF (IERR.NE.0) RETURN
      IPCH1=0
      IF (IRET3.NE.0.AND.IRET2.NE.0) THEN
        CALL ACTOBJ('MCHAML  ',IPCHE1,1)
        CALL RNGCHA(IPCHE1,IPCHE2,'CARACTERISTIQUES',
     .              'DEPLACEMENTS',IPCHA1,IPCHA2)
        IF (IPCHA1.EQ.0.OR.IPCHA2.EQ.0) THEN
          CALL ERREUR(805)
          RETURN
        ENDIF
        IPCHE1=IPCHA1
        IPCHE2=IPCHA2
        CALL REDUAF(IPCHE1,IPMODL,IPCH1,0,IR,KER)
        IF (IR.NE.1)  CALL ERREUR(KER)
        IF(IERR.NE.0) RETURN
        IPCHE1 = IPCH1
      ENDIF

C =====
C  1.5 - Lecture FACULTATIVE du mot 'CONS'
C =====
      ISCA=0
      CALL LIRMOT(MOCONS,1,ISCA,0)

      IF (ISCA.EQ.0) THEN
        CALL GRAD1(IPMODL,ZERO,IPCHE2,IPCHE1,IPCHL1,IRET)
        IF(IERR.NE.0) RETURN
      ELSE
        CALL GRAD2(IPMODL,IPCHE2,IPCHE1,IPCHL1,IRET)
        IF(IERR.NE.0) RETURN
      ENDIF

      IF (IRET.EQ.1) THEN
        CALL ACTOBJ('MCHAML  ',IPCHL1,1)
        CALL ECROBJ('MCHAML  ',IPCHL1)
      ENDIF

      END