1 : C LIALIN SOURCE GOUNAND 06/08/04 21:17:04 5520 2 : SUBROUTINE LIALIN(JXPOPG, 3 : $ FVPR,FVDU,FCPR,FCDU, 4 : $ KDERPR,KDERDU, 5 : $ JDTJA2,SSFACT,NBELEF,LERF,IESREF, 6 : $ JMTLIA, 7 : $ IMPR,IRET) 8 : IMPLICIT REAL*8 (A-H,O-Z) 9 : IMPLICIT INTEGER (I-N) 10 : C*********************************************************************** 11 : C NOM : LIALIN 12 : C DESCRIPTION : 13 : C 14 : C 15 : C LANGAGE : ESOPE 16 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 17 : C mél : gounand@semt2.smts.cea.fr 18 : C*********************************************************************** 19 : C APPELES : LIALI1 (calcul de JMTLIA (fortran 77)) 20 : C APPELE PAR : NLIA 21 : C*********************************************************************** 22 : C ENTREES : 23 : C ENTREES/SORTIES : 24 : C SORTIES : - 25 : C TRAVAIL : 26 : C*********************************************************************** 27 : C VERSION : v1, 11/05/04, version initiale 28 : C HISTORIQUE : v1, 11/05/04, création 29 : C HISTORIQUE : 30 : C HISTORIQUE : 31 : C*********************************************************************** 32 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 33 : C en cas de modification de ce sous-programme afin de faciliter 34 : C la maintenance ! 35 : C*********************************************************************** 36 : -INC CCOPTIO 37 : CBEGININCLUDE SMCHAEL 38 : SEGMENT MCHAEL 39 : POINTEUR IMACHE(N1).MELEME 40 : POINTEUR ICHEVA(N1).MCHEVA 41 : ENDSEGMENT 42 : SEGMENT MCHEVA 43 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) 44 : ENDSEGMENT 45 : SEGMENT LCHEVA 46 : POINTEUR LISCHE(NBCHE).MCHEVA 47 : ENDSEGMENT 48 : CENDINCLUDE SMCHAEL 49 : INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM 50 : POINTEUR JXPOPG.MCHEVA 51 : POINTEUR FVPR.MCHEVA,FVDU.MCHEVA 52 : POINTEUR FCPR.MCHEVA,FCDU.MCHEVA 53 : POINTEUR JDTJA2.MCHEVA 54 : POINTEUR JMTLIA.MCHEVA 55 : CBEGININCLUDE SFACTIV 56 : SEGMENT FACTIV 57 : POINTEUR IFACTI(NBSOUV).SFACTI 58 : ENDSEGMENT 59 : SEGMENT SFACTI 60 : POINTEUR ISFACT(NBSOFV).SSFACT 61 : ENDSEGMENT 62 : SEGMENT SSFACT 63 : LOGICAL LFACTI(NBELFV,NBELEV) 64 : ENDSEGMENT 65 : CENDINCLUDE SFACTIV 66 : * 67 : INTEGER KDERPR,KDERDU 68 : INTEGER LERF 69 : INTEGER IMPR,IRET 70 : * 71 : INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM 72 : INTEGER NLDTJ,NLMLIA 73 : INTEGER NDDLPR,NDDLDU,IESREL,NBPOGO 74 : * 75 : * Executable statements 76 : * 77 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans lialin' 78 : * 79 : IF (KDERPR.LT.0.OR.KDERPR.GT.IDIM) THEN 80 : WRITE(IOIMP,*) 'Erreur KDERPR=',KDERPR 81 : GOTO 9999 82 : ENDIF 83 : * 84 : IF (KDERDU.LT.0.OR.KDERDU.GT.IDIM) THEN 85 : WRITE(IOIMP,*) 'Erreur KDERDU=',KDERDU 86 : GOTO 9999 87 : ENDIF 88 : * 89 : IESREL=IDIM 90 : IF (LERF.NE.0) THEN 91 : IESDER=IESREF 92 : ELSE 93 : IESDER=IESREL 94 : ENDIF 95 : * 96 : SEGACT SSFACT 97 : NBELFV=SSFACT.LFACTI(/1) 98 : NBELEV=SSFACT.LFACTI(/2) 99 : * 100 : SEGACT JXPOPG 101 : NDLIG=JXPOPG.VELCHE(/1) 102 : NDCOL=JXPOPG.VELCHE(/2) 103 : N2DLIG=JXPOPG.VELCHE(/3) 104 : N2DCOL=JXPOPG.VELCHE(/4) 105 : NDNOEU=JXPOPG.VELCHE(/5) 106 : NDELM=JXPOPG.VELCHE(/6) 107 : IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1 108 : $ .OR.N2DCOL.NE.1.OR.NDELM.NE.1) THEN 109 : WRITE(IOIMP,*) 'Erreur dims JXPOPG' 110 : GOTO 9999 111 : ENDIF 112 : NBPOGO=NDNOEU 113 : * 114 : SEGACT FVPR 115 : NDLIG=FVPR.VELCHE(/1) 116 : NDCOL=FVPR.VELCHE(/2) 117 : N2DLIG=FVPR.VELCHE(/3) 118 : N2DCOL=FVPR.VELCHE(/4) 119 : NDNOEU=FVPR.VELCHE(/5) 120 : NDELM=FVPR.VELCHE(/6) 121 : IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR. 122 : $ ((N2DCOL.NE.1.AND.KDERPR.EQ.0) 123 : $ .OR.(N2DCOL.NE.IESDER.AND.KDERPR.NE.0)) 124 : $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO) 125 : $ .OR.(.NOT.(NDELM.EQ.1.OR.(KDERPR.NE.0.AND.NDELM.EQ.NBELEF) 126 : $ .OR.(KDERPR.EQ.0.AND.NDELM.EQ.NBELFV) 127 : $ ))) THEN 128 : WRITE(IOIMP,*) 'FVPR=',FVPR 129 : WRITE(IOIMP,*) 'KDERPR=',KDERPR 130 : WRITE(IOIMP,*) 'IESREL=',IESREL 131 : WRITE(IOIMP,*) 'NBPOGO=',NBPOGO 132 : WRITE(IOIMP,*) 'NBELEF=',NBELEF 133 : WRITE(IOIMP,*) 'NBELFV=',NBELFV 134 : WRITE(IOIMP,*) 'NDLIG=',NDLIG 135 : WRITE(IOIMP,*) 'NDCOL=',NDCOL 136 : WRITE(IOIMP,*) 'N2DLIG=',N2DLIG 137 : WRITE(IOIMP,*) 'N2DCOL=',N2DCOL 138 : WRITE(IOIMP,*) 'NDNOEU=',NDNOEU 139 : WRITE(IOIMP,*) 'NDELM=',NDELM 140 : WRITE(IOIMP,*) 'Erreur dims FVPR' 141 : GOTO 9999 142 : ENDIF 143 : NDDLPR=NDCOL 144 : N2FVPR=N2DCOL 145 : NPFVPR=NDNOEU 146 : NLFVPR=NDELM 147 : * 148 : SEGACT FVDU 149 : NDLIG=FVDU.VELCHE(/1) 150 : NDCOL=FVDU.VELCHE(/2) 151 : N2DLIG=FVDU.VELCHE(/3) 152 : N2DCOL=FVDU.VELCHE(/4) 153 : NDNOEU=FVDU.VELCHE(/5) 154 : NDELM=FVDU.VELCHE(/6) 155 : IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR. 156 : $ ((N2DCOL.NE.1.AND.KDERDU.EQ.0) 157 : $ .OR.(N2DCOL.NE.IESDER.AND.KDERDU.NE.0)) 158 : $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO) 159 : $ .OR.(.NOT.(NDELM.EQ.1.OR.(KDERDU.NE.0.AND.NDELM.EQ.NBELEF) 160 : $ .OR.(KDERDU.EQ.0.AND.NDELM.EQ.NBELFV) 161 : $ ))) THEN 162 : WRITE(IOIMP,*) 'FVDU=',FVDU 163 : WRITE(IOIMP,*) 'KDERDU=',KDERDU 164 : WRITE(IOIMP,*) 'IESREL=',IESREL 165 : WRITE(IOIMP,*) 'NBPOGO=',NBPOGO 166 : WRITE(IOIMP,*) 'NBELEF=',NBELEF 167 : WRITE(IOIMP,*) 'NBELFV=',NBELFV 168 : WRITE(IOIMP,*) 'NDLIG=',NDLIG 169 : WRITE(IOIMP,*) 'NDCOL=',NDCOL 170 : WRITE(IOIMP,*) 'N2DLIG=',N2DLIG 171 : WRITE(IOIMP,*) 'N2DCOL=',N2DCOL 172 : WRITE(IOIMP,*) 'NDNOEU=',NDNOEU 173 : WRITE(IOIMP,*) 'NDELM=',NDELM 174 : WRITE(IOIMP,*) 'Erreur dims FVDU' 175 : GOTO 9999 176 : ENDIF 177 : NDDLDU=NDCOL 178 : N2FVDU=N2DCOL 179 : NPFVDU=NDNOEU 180 : NLFVDU=NDELM 181 : * 182 : SEGACT FCPR 183 : NDLIG =FCPR.VELCHE(/1) 184 : NDCOL =FCPR.VELCHE(/2) 185 : N2DLIG=FCPR.VELCHE(/3) 186 : N2DCOL=FCPR.VELCHE(/4) 187 : NDNOEU=FCPR.VELCHE(/5) 188 : NDELM =FCPR.VELCHE(/6) 189 : IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR. 190 : $ N2DCOL.NE.1 191 : $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO) 192 : $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEF)) THEN 193 : WRITE(IOIMP,*) 'Erreur dims FCPR' 194 : GOTO 9999 195 : ENDIF 196 : NPFCPR=NDNOEU 197 : NLFCPR=NDELM 198 : * 199 : SEGACT FCDU 200 : NDLIG =FCDU.VELCHE(/1) 201 : NDCOL =FCDU.VELCHE(/2) 202 : N2DLIG=FCDU.VELCHE(/3) 203 : N2DCOL=FCDU.VELCHE(/4) 204 : NDNOEU=FCDU.VELCHE(/5) 205 : NDELM =FCDU.VELCHE(/6) 206 : IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR. 207 : $ N2DCOL.NE.1. 208 : $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO) 209 : $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEF)) THEN 210 : WRITE(IOIMP,*) 'NDLIG=',NDLIG 211 : WRITE(IOIMP,*) 'NDCOL=',NDCOL 212 : WRITE(IOIMP,*) 'N2DLIG=',N2DLIG 213 : WRITE(IOIMP,*) 'N2DCOL=',N2DCOL 214 : WRITE(IOIMP,*) 'NDNOEU=',NDNOEU 215 : WRITE(IOIMP,*) 'NDELM=',NDELM 216 : WRITE(IOIMP,*) 'Erreur dims FCDU' 217 : GOTO 9999 218 : ENDIF 219 : NPFCDU=NDNOEU 220 : NLFCDU=NDELM 221 : * 222 : SEGACT JDTJA2 223 : NDLIG=JDTJA2.VELCHE(/1) 224 : NDCOL=JDTJA2.VELCHE(/2) 225 : N2DLIG=JDTJA2.VELCHE(/3) 226 : N2DCOL=JDTJA2.VELCHE(/4) 227 : NDNOEU=JDTJA2.VELCHE(/5) 228 : NDELM=JDTJA2.VELCHE(/6) 229 : IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1 230 : $ .OR.N2DCOL.NE.1 231 : $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO) 232 : $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEF)) THEN 233 : WRITE(IOIMP,*) 'Erreur dims JDTJA2' 234 : GOTO 9999 235 : ENDIF 236 : NPDTJ=NDNOEU 237 : NLDTJ=NDELM 238 : * 239 : IF (JMTLIA.EQ.0) THEN 240 : NBLIG=NDDLDU 241 : NBCOL=NDDLPR 242 : N2LIG=1 243 : N2COL=1 244 : NBPOI=1 245 : NBELM=NBELEV 246 : SEGINI JMTLIA 247 : ELSE 248 : SEGACT JMTLIA*MOD 249 : NDLIG=JMTLIA.VELCHE(/1) 250 : NDCOL=JMTLIA.VELCHE(/2) 251 : N2DLIG=JMTLIA.VELCHE(/3) 252 : N2DCOL=JMTLIA.VELCHE(/4) 253 : NDNOEU=JMTLIA.VELCHE(/5) 254 : NDELM=JMTLIA.VELCHE(/6) 255 : IF (NDLIG.NE.NDDLDU.OR.NDCOL.NE.NDDLPR.OR.N2DLIG.NE.1 256 : $ .OR.N2DCOL.NE.1.OR.NDNOEU.NE.1 257 : $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEV)) THEN 258 : WRITE(IOIMP,*) 'Erreur dims JMTLIA' 259 : GOTO 9999 260 : ENDIF 261 : ENDIF 262 : * 263 : KDFRPR=MAX(1,KDERPR) 264 : KDFRDU=MAX(1,KDERDU) 265 : * 266 : * On effectue le calcul de la matrice de moindres carrés 267 : * 267 : CALL LIALI1(NDDLPR,NDDLDU,NBPOGO, 268 : $ N2FVPR,N2FVDU, 269 : $ NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ, 270 : $ NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ, 271 : $ KDFRPR,KDFRDU, 272 : $ KDERPR,KDERDU, 273 : $ JXPOPG.VELCHE, 274 : $ FVPR.VELCHE,FVDU.VELCHE,FCPR.VELCHE,FCDU.VELCHE, 275 : $ JDTJA2.VELCHE,SSFACT.LFACTI,NBELEV,NBELFV,LERF, 276 : $ JMTLIA.VELCHE, 277 : $ IMPR,IRET) 278 : IF (IRET.NE.0) GOTO 9999 279 : * SEGDES JMTLIA 280 : SEGDES JMTLIA 281 : SEGDES JDTJA2 282 : SEGDES FCDU 283 : SEGDES FCPR 284 : SEGDES FVDU 285 : SEGDES FVPR 286 : SEGDES JXPOPG 287 : SEGDES SSFACT 288 : * 289 : * Normal termination 290 : * 291 : IRET=0 292 : RETURN 293 : * 294 : * Format handling 295 : * 296 : * 297 : * Error handling 298 : * 299 : 9999 CONTINUE 300 : IRET=1 301 : WRITE(IOIMP,*) 'An error was detected in subroutine lialin' 302 : RETURN 303 : * 304 : * End of subroutine LIALIN 305 : * 306 : END 307 : 308 :
© Cast3M 2003 - All rights reserved.
Disclaimer