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 PPARAM
  37. -INC CCOPTIO
  38. CBEGININCLUDE SMCHAEL
  39. SEGMENT MCHAEL
  40. POINTEUR IMACHE(N1).MELEME
  41. POINTEUR ICHEVA(N1).MCHEVA
  42. ENDSEGMENT
  43. SEGMENT MCHEVA
  44. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  45. ENDSEGMENT
  46. SEGMENT LCHEVA
  47. POINTEUR LISCHE(NBCHE).MCHEVA
  48. ENDSEGMENT
  49. CENDINCLUDE SMCHAEL
  50. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  51. POINTEUR JXPOPG.MCHEVA
  52. POINTEUR FVPR.MCHEVA,FVDU.MCHEVA
  53. POINTEUR FCPR.MCHEVA,FCDU.MCHEVA
  54. POINTEUR JDTJA2.MCHEVA
  55. POINTEUR JMTLIA.MCHEVA
  56. CBEGININCLUDE SFACTIV
  57. SEGMENT FACTIV
  58. POINTEUR IFACTI(NBSOUV).SFACTI
  59. ENDSEGMENT
  60. SEGMENT SFACTI
  61. POINTEUR ISFACT(NBSOFV).SSFACT
  62. ENDSEGMENT
  63. SEGMENT SSFACT
  64. LOGICAL LFACTI(NBELFV,NBELEV)
  65. ENDSEGMENT
  66. CENDINCLUDE SFACTIV
  67. *
  68. INTEGER KDERPR,KDERDU
  69. INTEGER LERF
  70. INTEGER IMPR,IRET
  71. *
  72. INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM
  73. INTEGER NLDTJ,NLMLIA
  74. INTEGER NDDLPR,NDDLDU,IESREL,NBPOGO
  75. *
  76. * Executable statements
  77. *
  78. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans lialin'
  79. *
  80. IF (KDERPR.LT.0.OR.KDERPR.GT.IDIM) THEN
  81. WRITE(IOIMP,*) 'Erreur KDERPR=',KDERPR
  82. GOTO 9999
  83. ENDIF
  84. *
  85. IF (KDERDU.LT.0.OR.KDERDU.GT.IDIM) THEN
  86. WRITE(IOIMP,*) 'Erreur KDERDU=',KDERDU
  87. GOTO 9999
  88. ENDIF
  89. *
  90. IESREL=IDIM
  91. IF (LERF.NE.0) THEN
  92. IESDER=IESREF
  93. ELSE
  94. IESDER=IESREL
  95. ENDIF
  96. *
  97. SEGACT SSFACT
  98. NBELFV=SSFACT.LFACTI(/1)
  99. NBELEV=SSFACT.LFACTI(/2)
  100. *
  101. SEGACT JXPOPG
  102. NDLIG=JXPOPG.VELCHE(/1)
  103. NDCOL=JXPOPG.VELCHE(/2)
  104. N2DLIG=JXPOPG.VELCHE(/3)
  105. N2DCOL=JXPOPG.VELCHE(/4)
  106. NDNOEU=JXPOPG.VELCHE(/5)
  107. NDELM=JXPOPG.VELCHE(/6)
  108. IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1
  109. $ .OR.N2DCOL.NE.1.OR.NDELM.NE.1) THEN
  110. WRITE(IOIMP,*) 'Erreur dims JXPOPG'
  111. GOTO 9999
  112. ENDIF
  113. NBPOGO=NDNOEU
  114. *
  115. SEGACT FVPR
  116. NDLIG=FVPR.VELCHE(/1)
  117. NDCOL=FVPR.VELCHE(/2)
  118. N2DLIG=FVPR.VELCHE(/3)
  119. N2DCOL=FVPR.VELCHE(/4)
  120. NDNOEU=FVPR.VELCHE(/5)
  121. NDELM=FVPR.VELCHE(/6)
  122. IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.
  123. $ ((N2DCOL.NE.1.AND.KDERPR.EQ.0)
  124. $ .OR.(N2DCOL.NE.IESDER.AND.KDERPR.NE.0))
  125. $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  126. $ .OR.(.NOT.(NDELM.EQ.1.OR.(KDERPR.NE.0.AND.NDELM.EQ.NBELEF)
  127. $ .OR.(KDERPR.EQ.0.AND.NDELM.EQ.NBELFV)
  128. $ ))) THEN
  129. WRITE(IOIMP,*) 'FVPR=',FVPR
  130. WRITE(IOIMP,*) 'KDERPR=',KDERPR
  131. WRITE(IOIMP,*) 'IESREL=',IESREL
  132. WRITE(IOIMP,*) 'NBPOGO=',NBPOGO
  133. WRITE(IOIMP,*) 'NBELEF=',NBELEF
  134. WRITE(IOIMP,*) 'NBELFV=',NBELFV
  135. WRITE(IOIMP,*) 'NDLIG=',NDLIG
  136. WRITE(IOIMP,*) 'NDCOL=',NDCOL
  137. WRITE(IOIMP,*) 'N2DLIG=',N2DLIG
  138. WRITE(IOIMP,*) 'N2DCOL=',N2DCOL
  139. WRITE(IOIMP,*) 'NDNOEU=',NDNOEU
  140. WRITE(IOIMP,*) 'NDELM=',NDELM
  141. WRITE(IOIMP,*) 'Erreur dims FVPR'
  142. GOTO 9999
  143. ENDIF
  144. NDDLPR=NDCOL
  145. N2FVPR=N2DCOL
  146. NPFVPR=NDNOEU
  147. NLFVPR=NDELM
  148. *
  149. SEGACT FVDU
  150. NDLIG=FVDU.VELCHE(/1)
  151. NDCOL=FVDU.VELCHE(/2)
  152. N2DLIG=FVDU.VELCHE(/3)
  153. N2DCOL=FVDU.VELCHE(/4)
  154. NDNOEU=FVDU.VELCHE(/5)
  155. NDELM=FVDU.VELCHE(/6)
  156. IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.
  157. $ ((N2DCOL.NE.1.AND.KDERDU.EQ.0)
  158. $ .OR.(N2DCOL.NE.IESDER.AND.KDERDU.NE.0))
  159. $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  160. $ .OR.(.NOT.(NDELM.EQ.1.OR.(KDERDU.NE.0.AND.NDELM.EQ.NBELEF)
  161. $ .OR.(KDERDU.EQ.0.AND.NDELM.EQ.NBELFV)
  162. $ ))) THEN
  163. WRITE(IOIMP,*) 'FVDU=',FVDU
  164. WRITE(IOIMP,*) 'KDERDU=',KDERDU
  165. WRITE(IOIMP,*) 'IESREL=',IESREL
  166. WRITE(IOIMP,*) 'NBPOGO=',NBPOGO
  167. WRITE(IOIMP,*) 'NBELEF=',NBELEF
  168. WRITE(IOIMP,*) 'NBELFV=',NBELFV
  169. WRITE(IOIMP,*) 'NDLIG=',NDLIG
  170. WRITE(IOIMP,*) 'NDCOL=',NDCOL
  171. WRITE(IOIMP,*) 'N2DLIG=',N2DLIG
  172. WRITE(IOIMP,*) 'N2DCOL=',N2DCOL
  173. WRITE(IOIMP,*) 'NDNOEU=',NDNOEU
  174. WRITE(IOIMP,*) 'NDELM=',NDELM
  175. WRITE(IOIMP,*) 'Erreur dims FVDU'
  176. GOTO 9999
  177. ENDIF
  178. NDDLDU=NDCOL
  179. N2FVDU=N2DCOL
  180. NPFVDU=NDNOEU
  181. NLFVDU=NDELM
  182. *
  183. SEGACT FCPR
  184. NDLIG =FCPR.VELCHE(/1)
  185. NDCOL =FCPR.VELCHE(/2)
  186. N2DLIG=FCPR.VELCHE(/3)
  187. N2DCOL=FCPR.VELCHE(/4)
  188. NDNOEU=FCPR.VELCHE(/5)
  189. NDELM =FCPR.VELCHE(/6)
  190. IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
  191. $ N2DCOL.NE.1
  192. $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  193. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEF)) THEN
  194. WRITE(IOIMP,*) 'Erreur dims FCPR'
  195. GOTO 9999
  196. ENDIF
  197. NPFCPR=NDNOEU
  198. NLFCPR=NDELM
  199. *
  200. SEGACT FCDU
  201. NDLIG =FCDU.VELCHE(/1)
  202. NDCOL =FCDU.VELCHE(/2)
  203. N2DLIG=FCDU.VELCHE(/3)
  204. N2DCOL=FCDU.VELCHE(/4)
  205. NDNOEU=FCDU.VELCHE(/5)
  206. NDELM =FCDU.VELCHE(/6)
  207. IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
  208. $ N2DCOL.NE.1.
  209. $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  210. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEF)) THEN
  211. WRITE(IOIMP,*) 'NDLIG=',NDLIG
  212. WRITE(IOIMP,*) 'NDCOL=',NDCOL
  213. WRITE(IOIMP,*) 'N2DLIG=',N2DLIG
  214. WRITE(IOIMP,*) 'N2DCOL=',N2DCOL
  215. WRITE(IOIMP,*) 'NDNOEU=',NDNOEU
  216. WRITE(IOIMP,*) 'NDELM=',NDELM
  217. WRITE(IOIMP,*) 'Erreur dims FCDU'
  218. GOTO 9999
  219. ENDIF
  220. NPFCDU=NDNOEU
  221. NLFCDU=NDELM
  222. *
  223. SEGACT JDTJA2
  224. NDLIG=JDTJA2.VELCHE(/1)
  225. NDCOL=JDTJA2.VELCHE(/2)
  226. N2DLIG=JDTJA2.VELCHE(/3)
  227. N2DCOL=JDTJA2.VELCHE(/4)
  228. NDNOEU=JDTJA2.VELCHE(/5)
  229. NDELM=JDTJA2.VELCHE(/6)
  230. IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1
  231. $ .OR.N2DCOL.NE.1
  232. $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  233. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEF)) THEN
  234. WRITE(IOIMP,*) 'Erreur dims JDTJA2'
  235. GOTO 9999
  236. ENDIF
  237. NPDTJ=NDNOEU
  238. NLDTJ=NDELM
  239. *
  240. IF (JMTLIA.EQ.0) THEN
  241. NBLIG=NDDLDU
  242. NBCOL=NDDLPR
  243. N2LIG=1
  244. N2COL=1
  245. NBPOI=1
  246. NBELM=NBELEV
  247. SEGINI JMTLIA
  248. ELSE
  249. SEGACT JMTLIA*MOD
  250. NDLIG=JMTLIA.VELCHE(/1)
  251. NDCOL=JMTLIA.VELCHE(/2)
  252. N2DLIG=JMTLIA.VELCHE(/3)
  253. N2DCOL=JMTLIA.VELCHE(/4)
  254. NDNOEU=JMTLIA.VELCHE(/5)
  255. NDELM=JMTLIA.VELCHE(/6)
  256. IF (NDLIG.NE.NDDLDU.OR.NDCOL.NE.NDDLPR.OR.N2DLIG.NE.1
  257. $ .OR.N2DCOL.NE.1.OR.NDNOEU.NE.1
  258. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEV)) THEN
  259. WRITE(IOIMP,*) 'Erreur dims JMTLIA'
  260. GOTO 9999
  261. ENDIF
  262. ENDIF
  263. *
  264. KDFRPR=MAX(1,KDERPR)
  265. KDFRDU=MAX(1,KDERDU)
  266. *
  267. * On effectue le calcul de la matrice de moindres carrés
  268. *
  269. CALL LIALI1(NDDLPR,NDDLDU,NBPOGO,
  270. $ N2FVPR,N2FVDU,
  271. $ NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ,
  272. $ NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ,
  273. $ KDFRPR,KDFRDU,
  274. $ KDERPR,KDERDU,
  275. $ JXPOPG.VELCHE,
  276. $ FVPR.VELCHE,FVDU.VELCHE,FCPR.VELCHE,FCDU.VELCHE,
  277. $ JDTJA2.VELCHE,SSFACT.LFACTI,NBELEV,NBELFV,LERF,
  278. $ JMTLIA.VELCHE,
  279. $ IMPR,IRET)
  280. IF (IRET.NE.0) GOTO 9999
  281. * SEGDES JMTLIA
  282. SEGDES JMTLIA
  283. SEGDES JDTJA2
  284. SEGDES FCDU
  285. SEGDES FCPR
  286. SEGDES FVDU
  287. SEGDES FVPR
  288. SEGDES JXPOPG
  289. SEGDES SSFACT
  290. *
  291. * Normal termination
  292. *
  293. IRET=0
  294. RETURN
  295. *
  296. * Format handling
  297. *
  298. *
  299. * Error handling
  300. *
  301. 9999 CONTINUE
  302. IRET=1
  303. WRITE(IOIMP,*) 'An error was detected in subroutine lialin'
  304. RETURN
  305. *
  306. * End of subroutine LIALIN
  307. *
  308. END
  309.  
  310.  
  311.  

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