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 PPARAM
  44. -INC CCOPTIO
  45. INTEGER NDDLDU,NDDLPR,NBPOGO
  46. INTEGER N2FVPR,N2FVDU
  47. INTEGER NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ
  48. INTEGER NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ
  49. INTEGER KDFRPR,KDFRDU
  50. INTEGER KDERPR,KDERDU
  51. INTEGER NBELEV,NBELFV
  52. REAL*8 XPOPG (NBPOGO)
  53. REAL*8 FVPR(NDDLPR,N2FVPR,NPFVPR,NLFVPR)
  54. REAL*8 FVDU(NDDLDU,N2FVDU,NPFVDU,NLFVDU)
  55. REAL*8 FCPR(NPFCPR,NLFCPR)
  56. REAL*8 FCDU(NPFCDU,NLFCDU)
  57. REAL*8 JDTJA2(NPDTJ,NLDTJ)
  58. LOGICAL SSFACT(NBELFV,NBELEV)
  59. REAL*8 JMTLIA(NDDLDU,NDDLPR,NBELEV)
  60. *
  61. REAL*8 CONTRI,SPOGO,ISPOGO
  62. INTEGER LERF
  63. INTEGER IMPR,IRET
  64. INTEGER IDDLPR,IDDLDU,IPOGO,IBELEV,IBELFV,IBELEF
  65. INTEGER IPFVPR,IPFVDU,IPFCPR,IPFCDU,IPDTJ
  66. INTEGER ILFVPR,ILFVDU,ILFCPR,ILFCDU,ILDTJ
  67. *
  68. * Executable statements
  69. *
  70. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans liali1'
  71. IBELEF=0
  72. DO IBELEV=1,NBELEV
  73. DO IBELFV=1,NBELFV
  74. IF (SSFACT(IBELFV,IBELEV)) THEN
  75. IBELEF=IBELEF+1
  76. IF (NLFVPR.EQ.1) THEN
  77. ILFVPR=1
  78. ELSEIF (KDERPR.NE.0) THEN
  79. ILFVPR=IBELEF
  80. ELSE
  81. ILFVPR=IBELFV
  82. ENDIF
  83. *
  84. IF (NLFVDU.EQ.1) THEN
  85. ILFVDU=1
  86. ELSEIF (KDERDU.NE.0) THEN
  87. ILFVDU=IBELEF
  88. ELSE
  89. ILFVDU=IBELFV
  90. ENDIF
  91. *
  92. IF (NLFCPR.EQ.1) THEN
  93. ILFCPR=1
  94. ELSE
  95. ILFCPR=IBELEF
  96. ENDIF
  97. IF (NLFCDU.EQ.1) THEN
  98. ILFCDU=1
  99. ELSE
  100. ILFCDU=IBELEF
  101. ENDIF
  102. *
  103. IF (NLDTJ.EQ.1) THEN
  104. ILDTJ=1
  105. ELSE
  106. ILDTJ=IBELEF
  107. ENDIF
  108. IF (LERF.EQ.2) THEN
  109. SPOGO=0.D0
  110. DO IPOGO=1,NBPOGO
  111. SPOGO=SPOGO+XPOPG(IPOGO)
  112. ENDDO
  113. ISPOGO=1.D0/SPOGO
  114. ENDIF
  115. *
  116. DO IPOGO=1,NBPOGO
  117. IF (NPFVPR.EQ.1) THEN
  118. IPFVPR=1
  119. ELSE
  120. IPFVPR=IPOGO
  121. ENDIF
  122. IF (NPFVDU.EQ.1) THEN
  123. IPFVDU=1
  124. ELSE
  125. IPFVDU=IPOGO
  126. ENDIF
  127. *
  128. IF (NPFCPR.EQ.1) THEN
  129. IPFCPR=1
  130. ELSE
  131. IPFCPR=IPOGO
  132. ENDIF
  133. IF (NPFCDU.EQ.1) THEN
  134. IPFCDU=1
  135. ELSE
  136. IPFCDU=IPOGO
  137. ENDIF
  138. *
  139. IF (NPDTJ.EQ.1) THEN
  140. IPDTJ=1
  141. ELSE
  142. IPDTJ=IPOGO
  143. ENDIF
  144. DO IDDLPR=1,NDDLPR
  145. DO IDDLDU=1,NDDLDU
  146. CONTRI=
  147. C $ XPOPG(IPOGO)*
  148. $ FVDU(IDDLDU,KDFRDU,IPFVDU,ILFVDU)
  149. $ *FCDU(IPFCDU,ILFCDU)
  150. $ *FCPR(IPFCPR,ILFCPR)
  151. $ *FVPR(IDDLPR,KDFRPR,IPFVPR,ILFVPR)
  152. IF (LERF.EQ.0) THEN
  153. CONTRI=CONTRI*ABS(JDTJA2(IPDTJ,ILDTJ))
  154. $ *XPOPG(IPOGO)
  155. ELSEIF (LERF.EQ.1) THEN
  156. CONTRI=CONTRI*XPOPG(IPOGO)
  157. ELSEIF (LERF.EQ.2) THEN
  158. CONTRI=CONTRI*XPOPG(IPOGO)*ISPOGO
  159. ENDIF
  160. JMTLIA(IDDLDU,IDDLPR,IBELEV)=
  161. $ JMTLIA(IDDLDU,IDDLPR,IBELEV)+
  162. $ CONTRI
  163. ENDDO
  164. ENDDO
  165. ENDDO
  166. ENDIF
  167. ENDDO
  168. ENDDO
  169. *
  170. * Normal termination
  171. *
  172. IRET=0
  173. RETURN
  174. *
  175. * Format handling
  176. *
  177. *
  178. * Error handling
  179. *
  180. 9999 CONTINUE
  181. IRET=1
  182. WRITE(IOIMP,*) 'An error was detected in subroutine liali1'
  183. RETURN
  184. *
  185. * End of subroutine LIALI1
  186. *
  187. END
  188.  
  189.  
  190.  
  191.  

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