Télécharger liali1.eso

Retour à la liste

liali1
C LIALI1    SOURCE    GOUNAND   06/08/04    21:16:59     5520
      SUBROUTINE LIALI1(NDDLPR,NDDLDU,NBPOGO,
     $     N2FVPR,N2FVDU,
     $     NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ,
     $     NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ,
     $     KDFRPR,KDFRDU,
     $     KDERPR,KDERDU,
     $     XPOPG,
     $     FVPR,FVDU,FCPR,FCDU,
     $     JDTJA2,SSFACT,NBELEV,NBELFV,LERF,
     $     JMTLIA,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : LIALI1
C DESCRIPTION : Calcul de la matrice de moindres carrés pour chaque
C               élément réel.
C
C ! Commentaires non à jour !
C
C LANGAGE     : Fortran 77 (sauf E/S)
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : -
C APPELE PAR       : LIALIN
C***********************************************************************
C ENTREES            :
C ENTREES/SORTIES    :
C SORTIES            : -
C TRAVAIL            :
C***********************************************************************
C VERSION    : v1, 11/05/04, version initiale
C HISTORIQUE : v1, 11/05/04, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
-INC PPARAM
-INC CCOPTIO
      INTEGER NDDLDU,NDDLPR,NBPOGO
      INTEGER N2FVPR,N2FVDU
      INTEGER NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ
      INTEGER NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ
      INTEGER KDFRPR,KDFRDU
      INTEGER KDERPR,KDERDU
      INTEGER NBELEV,NBELFV
      REAL*8 XPOPG (NBPOGO)
      REAL*8 FVPR(NDDLPR,N2FVPR,NPFVPR,NLFVPR)
      REAL*8 FVDU(NDDLDU,N2FVDU,NPFVDU,NLFVDU)
      REAL*8 FCPR(NPFCPR,NLFCPR)
      REAL*8 FCDU(NPFCDU,NLFCDU)
      REAL*8 JDTJA2(NPDTJ,NLDTJ)
      LOGICAL SSFACT(NBELFV,NBELEV)
      REAL*8 JMTLIA(NDDLDU,NDDLPR,NBELEV)
*
      REAL*8 CONTRI,SPOGO,ISPOGO
      INTEGER LERF
      INTEGER IMPR,IRET
      INTEGER IDDLPR,IDDLDU,IPOGO,IBELEV,IBELFV,IBELEF
      INTEGER IPFVPR,IPFVDU,IPFCPR,IPFCDU,IPDTJ
      INTEGER ILFVPR,ILFVDU,ILFCPR,ILFCDU,ILDTJ
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans liali1'
      IBELEF=0
      DO IBELEV=1,NBELEV
         DO IBELFV=1,NBELFV
            IF (SSFACT(IBELFV,IBELEV)) THEN
               IBELEF=IBELEF+1
               IF (NLFVPR.EQ.1) THEN
                  ILFVPR=1
               ELSEIF (KDERPR.NE.0) THEN
                  ILFVPR=IBELEF
               ELSE
                  ILFVPR=IBELFV
               ENDIF
*
               IF (NLFVDU.EQ.1) THEN
                  ILFVDU=1
               ELSEIF (KDERDU.NE.0) THEN
                  ILFVDU=IBELEF
               ELSE
                  ILFVDU=IBELFV
               ENDIF
*
               IF (NLFCPR.EQ.1) THEN
                  ILFCPR=1
               ELSE
                  ILFCPR=IBELEF
               ENDIF
               IF (NLFCDU.EQ.1) THEN
                  ILFCDU=1
               ELSE
                  ILFCDU=IBELEF
               ENDIF
*
               IF (NLDTJ.EQ.1) THEN
                  ILDTJ=1
               ELSE
                  ILDTJ=IBELEF
               ENDIF
               IF (LERF.EQ.2) THEN
                  SPOGO=0.D0
                  DO IPOGO=1,NBPOGO
                     SPOGO=SPOGO+XPOPG(IPOGO)
                  ENDDO
                  ISPOGO=1.D0/SPOGO
               ENDIF
*
               DO IPOGO=1,NBPOGO
                  IF (NPFVPR.EQ.1) THEN
                     IPFVPR=1
                  ELSE
                     IPFVPR=IPOGO
                  ENDIF
                  IF (NPFVDU.EQ.1) THEN
                     IPFVDU=1
                  ELSE
                     IPFVDU=IPOGO
                  ENDIF
*
                  IF (NPFCPR.EQ.1) THEN
                     IPFCPR=1
                  ELSE
                     IPFCPR=IPOGO
                  ENDIF
                  IF (NPFCDU.EQ.1) THEN
                     IPFCDU=1
                  ELSE
                     IPFCDU=IPOGO
                  ENDIF
*
                  IF (NPDTJ.EQ.1) THEN
                     IPDTJ=1
                  ELSE
                     IPDTJ=IPOGO
                  ENDIF
                  DO IDDLPR=1,NDDLPR
                     DO IDDLDU=1,NDDLDU
                        CONTRI=
C     $                       XPOPG(IPOGO)*
     $                       FVDU(IDDLDU,KDFRDU,IPFVDU,ILFVDU)
     $                       *FCDU(IPFCDU,ILFCDU)
     $                       *FCPR(IPFCPR,ILFCPR)
     $                       *FVPR(IDDLPR,KDFRPR,IPFVPR,ILFVPR)
                        IF (LERF.EQ.0) THEN
                           CONTRI=CONTRI*ABS(JDTJA2(IPDTJ,ILDTJ))
     $                          *XPOPG(IPOGO)
                        ELSEIF (LERF.EQ.1) THEN
                           CONTRI=CONTRI*XPOPG(IPOGO)
                        ELSEIF (LERF.EQ.2) THEN
                           CONTRI=CONTRI*XPOPG(IPOGO)*ISPOGO
                        ENDIF
                        JMTLIA(IDDLDU,IDDLPR,IBELEV)=
     $                       JMTLIA(IDDLDU,IDDLPR,IBELEV)+
     $                       CONTRI
                     ENDDO
                  ENDDO
               ENDDO
            ENDIF
         ENDDO
      ENDDO
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine liali1'
      RETURN
*
* End of subroutine LIALI1
*
      END
 
 
 
 

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