Télécharger adchfl.eso

Retour à la liste

adchfl
C ADCHFL    SOURCE    CB215821  20/11/04    21:15:07     10766          
 
      SUBROUTINE ADCHFL(IPCHE1,XFLO1,IPLMO1,CHA8b,CHA8c,IPCHE2,IEPS)
 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C BUT: Faire '+' ou '-' entre un CHAMELEM et un FLOTTANT
C      Lorsqu'il n'y a qu'une composante on effectue l'operation sur la
C      seule composante. Sinon le LISTMOT devient necessaire pour savoir
C      sur quelle composante on effectue l'operation
C
C Entree : IPCHE1  : CHAMELEM
C          XFLO1   : FLOTTANT
C          IPLMO1  : LISTMOT des composantes sur lesquelles on fait l'operation
C          CHA8b   : Nom de IPCHE1 s'il en a un
C          CHA8c   : Nom de IPLMO1 s'il en a un
C          IEPS    : 0 ==> Soustraction IPCHE1 - XFLO1
C                    1 ==> Addition     IPCHE1 + XFLO1 ou XFLO1 + IPCHE1
C                    2 ==> Soustraction XFLO1  - IPCHE1
C
C Auteur : Clement BERTHINIER
C          Mars 2016
C
C Liste des Corrections :
C
C Appele par : OPERAD, OPERSO
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMCOORD
-INC SMLMOTS
-INC SMLENTI
 
      CHARACTER*(LOCOMP) CHAR_A
      CHARACTER*8        CHA8b,CHA8c
      LOGICAL            BMO
 
      BMO    = .FALSE.
      MOTERR='                                        '
 
      MCHEL1 = IPCHE1
      SEGACT,MCHEL1
      SEGINI,MCHELM=MCHEL1
      IPCHE2=MCHELM
      N1 = MCHEL1.ICHAML(/1)
      IF (ICHAML .EQ. 0) THEN
        RETURN
      ENDIF
 
      IF (IPLMO1 .NE. 0) THEN
        MLMOTS = IPLMO1
        SEGACT,MLMOTS
        JGM = MOTS(/2)
        JG  = JGM
        SEGINI,MLENTI
      ENDIF
 
      DO 100 IA=1,N1
        MCHAM1= MCHEL1.ICHAML(IA)
        SEGACT,MCHAM1
        SEGINI,MCHAML=MCHAM1
        ICHAML(IA)=MCHAML
        N2   =MCHAM1.IELVAL(/1)
 
        IF (N2 .GE. 1) THEN
          DO 101 ICOMP=1,N2
 
 
            CHAR_A=MCHAM1.NOMCHE(ICOMP)
 
C           LISTMOTS obligatoire si N2 > 1
            IF (N2 .GE. 2) THEN
              IF ((IPLMO1 .EQ. 0) .OR. (JGM .EQ. 0)) THEN
                MOTERR(1:8)='LISTMOTS'
                CALL ERREUR(37)
              ELSE
C               Recherche de la COMPOSANTE du meme nom dans le LISTMOTS
                BMO = .FALSE.
                IPLAC=0
                DO IMO = 1,JGM
                  IF (MOTS(IMO) .EQ. CHAR_A) THEN
C                    PRINT *,'COMPOSANTE TROUVEE :',MOTS(IMO)
                    LECT(IMO)  =LECT(IMO  )+1
                    IF (.NOT. BMO) THEN
                      IPLAC = IMO
                    ELSE
                      LECT(IPLAC)=LECT(IPLAC)+1
                    ENDIF
                    BMO = .TRUE.
                  ENDIF
                ENDDO
                IF (BMO) GOTO 102
                GOTO 101
              ENDIF
            ENDIF
 
 102        CONTINUE
 
            MELVA1=MCHAM1.IELVAL(ICOMP)
            SEGACT,MELVA1
            N1PTEL=MELVA1.VELCHE(/1)
            N1EL  =MELVA1.VELCHE(/2)
            N2PTEL=0
            N2EL  =0
            SEGINI,MELVAL
            IELVAL(ICOMP)=MELVAL
 
            IF     (N1PTEL .NE. 0) THEN
              IF     (IEPS .EQ. 0) THEN
                DO IGAU=1,N1PTEL
                  DO IB=1,N1EL
                    VELCHE(IGAU,IB)= MELVA1.VELCHE(IGAU,IB) - XFLO1
                  ENDDO
                ENDDO
 
              ELSEIF (IEPS .EQ. 1) THEN
                DO IGAU=1,N1PTEL
                  DO IB=1,N1EL
                    VELCHE(IGAU,IB)= MELVA1.VELCHE(IGAU,IB) + XFLO1
                  ENDDO
                ENDDO
 
              ELSEIF (IEPS .EQ. 2) THEN
                DO IGAU=1,N1PTEL
                  DO IB=1,N1EL
                    VELCHE(IGAU,IB)=-MELVA1.VELCHE(IGAU,IB) + XFLO1
                  ENDDO
                ENDDO
 
              ELSE
                CALL ERREUR(21)
                RETURN
              ENDIF
 
            ELSE
              CALL ERREUR(21)
              RETURN
            ENDIF
 
            SEGDES,MELVA1,MELVAL
 101      CONTINUE
        ENDIF
 
        SEGDES,MCHAM1,MCHAML
 100  CONTINUE
 
      IF (IPLMO1 .NE. 0) THEN
C       Verification que toutes les composantes demandees ont ete trouvees
        DO IMO = 1,JGM
          IF     (LECT(IMO) .EQ. 0) THEN
            CHAR_A = MOTS(IMO)
            MOTERR(1:4 )=CHAR_A(1:4)
            MOTERR(5:12)=CHA8b
            CALL ERREUR(77)
            SEGSUP,MLENTI
            SEGDES,MCHEL1,MCHELM,MLMOTS
            RETURN
 
          ELSEIF (LECT(IMO) .GT. 1) THEN
            CHAR_A = MOTS(IMO)
            MOTERR(1:4 )=CHAR_A(1:4)
            MOTERR(5:12)=CHA8c
            CALL ERREUR(1051)
            SEGSUP,MLENTI
            SEGDES,MCHEL1,MCHELM,MLMOTS
            RETURN
          ENDIF
        ENDDO
 
        SEGDES,MLMOTS
        SEGSUP,MLENTI
      ENDIF
      SEGDES,MCHEL1,MCHELM
 
      RETURN
      END
 
 
 
 

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