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