1 : C LIALI1 SOURCE GOUNAND 06/08/04 21:16:59 5520 2 : SUBROUTINE LIALI1(NDDLPR,NDDLDU,NBPOGO, 3 : $ N2FVPR,N2FVDU, 4 : $ NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ, 5 : $ NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ, 6 : $ KDFRPR,KDFRDU, 7 : $ KDERPR,KDERDU, 8 : $ XPOPG, 9 : $ FVPR,FVDU,FCPR,FCDU, 10 : $ JDTJA2,SSFACT,NBELEV,NBELFV,LERF, 11 : $ JMTLIA, 12 : $ IMPR,IRET) 13 : IMPLICIT REAL*8 (A-H,O-Z) 14 : IMPLICIT INTEGER (I-N) 15 : C*********************************************************************** 16 : C NOM : LIALI1 17 : C DESCRIPTION : Calcul de la matrice de moindres carrés pour chaque 18 : C élément réel. 19 : C 20 : C ! Commentaires non à jour ! 21 : C 22 : C LANGAGE : Fortran 77 (sauf E/S) 23 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 24 : C mél : gounand@semt2.smts.cea.fr 25 : C*********************************************************************** 26 : C APPELES : - 27 : C APPELE PAR : LIALIN 28 : C*********************************************************************** 29 : C ENTREES : 30 : C ENTREES/SORTIES : 31 : C SORTIES : - 32 : C TRAVAIL : 33 : C*********************************************************************** 34 : C VERSION : v1, 11/05/04, version initiale 35 : C HISTORIQUE : v1, 11/05/04, création 36 : C HISTORIQUE : 37 : C HISTORIQUE : 38 : C*********************************************************************** 39 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 40 : C en cas de modification de ce sous-programme afin de faciliter 41 : C la maintenance ! 42 : C*********************************************************************** 43 : -INC CCOPTIO 44 : INTEGER NDDLDU,NDDLPR,NBPOGO 45 : INTEGER N2FVPR,N2FVDU 46 : INTEGER NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ 47 : INTEGER NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ 48 : INTEGER KDFRPR,KDFRDU 49 : INTEGER KDERPR,KDERDU 50 : INTEGER NBELEV,NBELFV 51 : REAL*8 XPOPG (NBPOGO) 52 : REAL*8 FVPR(NDDLPR,N2FVPR,NPFVPR,NLFVPR) 53 : REAL*8 FVDU(NDDLDU,N2FVDU,NPFVDU,NLFVDU) 54 : REAL*8 FCPR(NPFCPR,NLFCPR) 55 : REAL*8 FCDU(NPFCDU,NLFCDU) 56 : REAL*8 JDTJA2(NPDTJ,NLDTJ) 57 : LOGICAL SSFACT(NBELFV,NBELEV) 58 : REAL*8 JMTLIA(NDDLDU,NDDLPR,NBELEV) 59 : * 60 : REAL*8 CONTRI,SPOGO,ISPOGO 61 : INTEGER LERF 62 : INTEGER IMPR,IRET 63 : INTEGER IDDLPR,IDDLDU,IPOGO,IBELEV,IBELFV,IBELEF 64 : INTEGER IPFVPR,IPFVDU,IPFCPR,IPFCDU,IPDTJ 65 : INTEGER ILFVPR,ILFVDU,ILFCPR,ILFCDU,ILDTJ 66 : * 67 : * Executable statements 68 : * 69 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans liali1' 70 : IBELEF=0 71 : DO IBELEV=1,NBELEV 72 : DO IBELFV=1,NBELFV 73 : IF (SSFACT(IBELFV,IBELEV)) THEN 74 : IBELEF=IBELEF+1 75 : IF (NLFVPR.EQ.1) THEN 76 : ILFVPR=1 77 : ELSEIF (KDERPR.NE.0) THEN 78 : ILFVPR=IBELEF 79 : ELSE 80 : ILFVPR=IBELFV 81 : ENDIF 82 : * 83 : IF (NLFVDU.EQ.1) THEN 84 : ILFVDU=1 85 : ELSEIF (KDERDU.NE.0) THEN 86 : ILFVDU=IBELEF 87 : ELSE 88 : ILFVDU=IBELFV 89 : ENDIF 90 : * 91 : IF (NLFCPR.EQ.1) THEN 92 : ILFCPR=1 93 : ELSE 94 : ILFCPR=IBELEF 95 : ENDIF 96 : IF (NLFCDU.EQ.1) THEN 97 : ILFCDU=1 98 : ELSE 99 : ILFCDU=IBELEF 100 : ENDIF 101 : * 102 : IF (NLDTJ.EQ.1) THEN 103 : ILDTJ=1 104 : ELSE 105 : ILDTJ=IBELEF 106 : ENDIF 107 : IF (LERF.EQ.2) THEN 108 : SPOGO=0.D0 109 : DO IPOGO=1,NBPOGO 110 : SPOGO=SPOGO+XPOPG(IPOGO) 111 : ENDDO 112 : ISPOGO=1.D0/SPOGO 113 : ENDIF 114 : * 115 : DO IPOGO=1,NBPOGO 116 : IF (NPFVPR.EQ.1) THEN 117 : IPFVPR=1 118 : ELSE 119 : IPFVPR=IPOGO 120 : ENDIF 121 : IF (NPFVDU.EQ.1) THEN 122 : IPFVDU=1 123 : ELSE 124 : IPFVDU=IPOGO 125 : ENDIF 126 : * 127 : IF (NPFCPR.EQ.1) THEN 128 : IPFCPR=1 129 : ELSE 130 : IPFCPR=IPOGO 131 : ENDIF 132 : IF (NPFCDU.EQ.1) THEN 133 : IPFCDU=1 134 : ELSE 135 : IPFCDU=IPOGO 136 : ENDIF 137 : * 138 : IF (NPDTJ.EQ.1) THEN 139 : IPDTJ=1 140 : ELSE 141 : IPDTJ=IPOGO 142 : ENDIF 143 : DO IDDLPR=1,NDDLPR 144 : DO IDDLDU=1,NDDLDU 145 : CONTRI= 146 : C $ XPOPG(IPOGO)* 147 : $ FVDU(IDDLDU,KDFRDU,IPFVDU,ILFVDU) 148 : $ *FCDU(IPFCDU,ILFCDU) 149 : $ *FCPR(IPFCPR,ILFCPR) 150 : $ *FVPR(IDDLPR,KDFRPR,IPFVPR,ILFVPR) 151 : IF (LERF.EQ.0) THEN 152 : CONTRI=CONTRI*ABS(JDTJA2(IPDTJ,ILDTJ)) 153 : $ *XPOPG(IPOGO) 154 : ELSEIF (LERF.EQ.1) THEN 155 : CONTRI=CONTRI*XPOPG(IPOGO) 156 : ELSEIF (LERF.EQ.2) THEN 157 : CONTRI=CONTRI*XPOPG(IPOGO)*ISPOGO 158 : ENDIF 159 : JMTLIA(IDDLDU,IDDLPR,IBELEV)= 160 : $ JMTLIA(IDDLDU,IDDLPR,IBELEV)+ 161 : $ CONTRI 162 : ENDDO 163 : ENDDO 164 : ENDDO 165 : ENDIF 166 : ENDDO 167 : ENDDO 168 : * 169 : * Normal termination 170 : * 171 : IRET=0 172 : RETURN 173 : * 174 : * Format handling 175 : * 176 : * 177 : * Error handling 178 : * 179 : 9999 CONTINUE 180 : IRET=1 181 : WRITE(IOIMP,*) 'An error was detected in subroutine liali1' 182 : RETURN 183 : * 184 : * End of subroutine LIALI1 185 : * 186 : END 187 : 188 : 189 :
© Cast3M 2003 - All rights reserved.
Disclaimer