Télécharger la plaquette Cast3M


fr en

Télécharger lialin.eso

Retour à la liste

Numérotation des lignes : 

lialin

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

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