Télécharger liali1.eso

Retour à la liste

Numérotation des lignes :

  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.  
  190.  

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