Télécharger lialin.eso

Retour à la liste

Numérotation des lignes :

  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. *
  268. CALL LIALI1(NDDLPR,NDDLDU,NBPOGO,
  269. $ N2FVPR,N2FVDU,
  270. $ NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ,
  271. $ NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ,
  272. $ KDFRPR,KDFRDU,
  273. $ KDERPR,KDERDU,
  274. $ JXPOPG.VELCHE,
  275. $ FVPR.VELCHE,FVDU.VELCHE,FCPR.VELCHE,FCDU.VELCHE,
  276. $ JDTJA2.VELCHE,SSFACT.LFACTI,NBELEV,NBELFV,LERF,
  277. $ JMTLIA.VELCHE,
  278. $ IMPR,IRET)
  279. IF (IRET.NE.0) GOTO 9999
  280. * SEGDES JMTLIA
  281. SEGDES JMTLIA
  282. SEGDES JDTJA2
  283. SEGDES FCDU
  284. SEGDES FCPR
  285. SEGDES FVDU
  286. SEGDES FVPR
  287. SEGDES JXPOPG
  288. SEGDES SSFACT
  289. *
  290. * Normal termination
  291. *
  292. IRET=0
  293. RETURN
  294. *
  295. * Format handling
  296. *
  297. *
  298. * Error handling
  299. *
  300. 9999 CONTINUE
  301. IRET=1
  302. WRITE(IOIMP,*) 'An error was detected in subroutine lialin'
  303. RETURN
  304. *
  305. * End of subroutine LIALIN
  306. *
  307. END
  308.  
  309.  
  310.  

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