Télécharger la plaquette Cast3M


fr en

Télécharger prolis.eso

Retour à la liste

Numérotation des lignes : 

prolis

  1. C PROLIS    SOURCE    GOUNAND   06/04/26    21:16:21     5414
  2.       SUBROUTINE PROLIS(JCDUAB,JCPRIB,JCPRIC,JCDUAC,
  3.      $     LIPNMC,       KRIPRI,
  4.      $     LMDUAB,LMPRIB,LMPRIC,LMDUAC,
  5.      $            LILBLC,KRMPRI,
  6.      $     LCHPOD,LMATRB,LMATRC,
  7.      $     ICPCDB,ICDCDB,NIUNIQ,
  8.      $     LMPCDB,LMDCDB,NTOTPO,
  9.      $     LMACDB,
  10.      $     IMPR,IRET)
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8 (A-H,O-Z)
  13. C***********************************************************************
  14. C NOM         : PROLIS
  15. C DESCRIPTION : Produit des matrices stockées sous forme de listes
  16. C               indexées (1 : Initialisation des tableaux de travail et
  17. C               boucle sur les noms d'inconnues)
  18. C
  19. C
  20. C LANGAGE     : ESOPE
  21. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  22. C               mél : gounand@semt2.smts.cea.fr
  23. C***********************************************************************
  24. C APPELES          : INLMAP, RSETEE, PROLI2
  25. C APPELE PAR       : PROMAT
  26. C***********************************************************************
  27. C ENTREES            : tout sauf LMACDB
  28. C SORTIES            : LMACDB
  29. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  30. C***********************************************************************
  31. C VERSION    : v1, 10/02/2000, version initiale
  32. C HISTORIQUE : v1, 10/02/2000, création
  33. C HISTORIQUE :
  34. C HISTORIQUE :
  35. C***********************************************************************
  36. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  37. C en cas de modification de ce sous-programme afin de faciliter
  38. C la maintenance !
  39. C***********************************************************************
  40.  
  41. -INC PPARAM
  42. -INC CCOPTIO
  43. -INC SMLENTI
  44.       POINTEUR JCPRIB.MLENTI
  45.       POINTEUR JCDUAB.MLENTI
  46.       POINTEUR JCPRIC.MLENTI
  47.       POINTEUR JCDUAC.MLENTI
  48.       POINTEUR KRIPRI.MLENTI
  49.       POINTEUR ICPCDB.MLENTI
  50.       INTEGER JG
  51.       POINTEUR KRMPRI.MLENTI
  52.       POINTEUR KIPCDB.MLENTI
  53.       POINTEUR KIDCDB.MLENTI
  54.       POINTEUR KMPRBP.MLENTI
  55.       POINTEUR KMDCDB.MLENTI
  56. * Includes persos
  57. *     Segment LSTIND (liste séquentielle indexée)
  58.       SEGMENT LSTIND
  59.       INTEGER IDX(NBM+1)
  60.       INTEGER IVAL(NBTVAL)
  61.       ENDSEGMENT
  62.       POINTEUR LIPNMC.LSTIND
  63.       POINTEUR ICDCDB.LSTIND
  64.       POINTEUR LMDUAB.LSTIND
  65.       POINTEUR LMPRIB.LSTIND
  66.       POINTEUR LMPRIC.LSTIND
  67.       POINTEUR LMDUAC.LSTIND
  68.       POINTEUR LILBLC.LSTIND
  69.       POINTEUR LMPCDB.LSTIND
  70.       POINTEUR LMDCDB.LSTIND
  71.       SEGMENT LSRIND
  72.       INTEGER IDXX(NBM+1)
  73.       REAL*8 XVAL(NBTVAL)
  74.       ENDSEGMENT
  75.       SEGMENT LLI
  76.       POINTEUR LISLI(NBME).LSRIND
  77.       ENDSEGMENT
  78.       POINTEUR LMATRB.LLI
  79.       POINTEUR LMATRC.LLI
  80.       POINTEUR LMACDB.LLI
  81.       POINTEUR SLMATB.LSRIND
  82.       POINTEUR SLMATC.LSRIND
  83.       POINTEUR SLMCDB.LSRIND
  84. -INC SMLREEL
  85.       SEGMENT LLR
  86.       POINTEUR LISLR(NBME).MLREEL
  87.       ENDSEGMENT
  88.       POINTEUR LCHPOD.LLR
  89.       POINTEUR SLCHPD.MLREEL
  90. *
  91.       INTEGER IMPR,IRET
  92. *
  93.       INTEGER NIUNIQ
  94.       INTEGER NTOTPO
  95.       INTEGER NBMEB,NMPCDB,NELCDB
  96.       INTEGER IBMEB,IMPCDB,IBMEC,IBMCDB,INMLPB,NUIDP
  97.       INTEGER IVDCDB,IVSTRT,IVSTOP
  98.       INTEGER JVBMEC,JVSTRT,JVSTOP
  99.  
  100. *
  101. * Executable statements
  102. *
  103.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prolis.eso'
  104. * Initialisation de LMACDB
  105.       CALL INLMAP(ICDCDB,LMPCDB,LMDCDB,
  106.      $     LMACDB,
  107.      $     IMPR,IRET)
  108.       IF (IRET.NE.0) GOTO 9999
  109. *
  110. * Bouclage sur les inconnues
  111. *
  112. * Repérage dans ICPCDB
  113.       JG=NIUNIQ
  114.       SEGINI KIPCDB
  115.       SEGACT ICPCDB
  116.       NMPCDB=ICPCDB.LECT(/1)
  117.       CALL RSETEE(ICPCDB.LECT,NMPCDB,
  118.      $     KIPCDB.LECT,NIUNIQ,
  119.      $     IMPR,IRET)
  120.       IF (IRET.NE.0) GOTO 9999
  121.       SEGDES ICPCDB
  122. * Repérage dans ICDCDB
  123.       JG=NIUNIQ
  124.       SEGINI KIDCDB
  125.       SEGACT ICDCDB
  126. * Repérage dans MAIPRI
  127.       JG=NTOTPO
  128.       SEGINI KMPRBP
  129. * Repérage dans LMDCDB
  130.       JG=NTOTPO
  131.       SEGINI KMDCDB
  132.       SEGACT JCDUAB
  133.       SEGACT JCPRIB
  134.       NBMEB=JCPRIB.LECT(/1)
  135.       SEGACT JCPRIC
  136.       SEGACT JCDUAC
  137.       SEGACT KRIPRI
  138.       SEGACT LIPNMC
  139.       SEGACT LMDUAB
  140.       SEGACT LMPRIB
  141.       SEGACT LMPRIC
  142.       SEGACT LMDUAC
  143.       SEGACT KRMPRI
  144.       SEGACT LILBLC
  145.       SEGACT LMPCDB
  146.       NELCDB=LMPCDB.IDX(/1)-1
  147.       SEGACT LMDCDB
  148.       SEGACT LMATRB
  149.       SEGACT LMATRC
  150.       IF (LCHPOD.NE.0) THEN
  151.          SEGACT LCHPOD
  152.       ENDIF
  153.       SEGACT LMACDB
  154. *
  155. * Boucle sur les inconnues de B
  156. *
  157.       DO 1 IBMEB=1,NBMEB
  158.          IMPCDB=KIPCDB.LECT(JCDUAB.LECT(IBMEB))
  159.          IVSTRT=ICDCDB.IDX(IMPCDB)
  160.          IVSTOP=ICDCDB.IDX(IMPCDB+1)-1
  161.          DO 12 IVDCDB=IVSTRT,IVSTOP
  162.             NUIDP=ICDCDB.IVAL(IVDCDB)
  163.             KIDCDB.LECT(NUIDP)=IVDCDB
  164.  12      CONTINUE
  165.          INMLPB=KRIPRI.LECT(JCPRIB.LECT(IBMEB))
  166.          JVSTRT=LIPNMC.IDX(INMLPB)
  167.          JVSTOP=LIPNMC.IDX(INMLPB+1)-1
  168. *
  169. * Boucle sur les inconnues C associées à chaque inconnue B
  170. *
  171.          DO 14 JVBMEC=JVSTRT,JVSTOP
  172.             IBMEC=LIPNMC.IVAL(JVBMEC)
  173.             IBMCDB=KIDCDB.LECT(JCDUAC.LECT(IBMEC))
  174.             SLMATB=LMATRB.LISLI(IBMEB)
  175.             SLMATC=LMATRC.LISLI(IBMEC)
  176.             IF (LCHPOD.NE.0) THEN
  177.                SLCHPD=LCHPOD.LISLR(INMLPB)
  178.                SEGACT SLCHPD
  179.             ELSE
  180.                SLCHPD=0
  181.             ENDIF
  182.             SLMCDB=LMACDB.LISLI(IBMCDB)
  183.             SEGACT SLMATB
  184.             SEGACT SLMATC
  185.             SEGACT SLMCDB*MOD
  186.             CALL PROLI2(LMDUAB,LMPRIB,LMPRIC,LMDUAC,
  187.      $           LILBLC,KRMPRI,KMDCDB,KMPRBP,
  188.      $           SLCHPD,SLMATB,SLMATC,
  189.      $           LMPCDB,LMDCDB,NELCDB,
  190.      $           SLMCDB,
  191.      $           IMPR,IRET)
  192.             IF (IRET.NE.0) GOTO 9999
  193.             SEGDES SLMCDB
  194.             IF (SLCHPD.NE.0) THEN
  195.                SEGDES SLCHPD
  196.             ENDIF
  197.             SEGDES SLMATC
  198.             SEGDES SLMATB
  199.  14      CONTINUE
  200.          DO 16 IVDCDB=IVSTRT,IVSTOP
  201.             NUIDP=ICDCDB.IVAL(IVDCDB)
  202.             KIDCDB.LECT(NUIDP)=0
  203.  16      CONTINUE
  204.  1    CONTINUE
  205.       SEGDES LMACDB
  206.       IF (LCHPOD.NE.0) THEN
  207.          SEGDES LCHPOD
  208.       ENDIF
  209.       SEGDES LMATRC
  210.       SEGDES LMATRB
  211.       SEGDES LMDCDB
  212.       SEGDES LMPCDB
  213.       SEGDES LILBLC
  214.       SEGDES KRMPRI
  215.       SEGDES LMDUAC
  216.       SEGDES LMPRIC
  217.       SEGDES LMPRIB
  218.       SEGDES LMDUAB
  219.       SEGDES LIPNMC
  220.       SEGDES KRIPRI
  221.       SEGDES JCDUAC
  222.       SEGDES JCPRIC
  223.       SEGDES JCPRIB
  224.       SEGDES JCDUAB
  225.       SEGSUP KMDCDB
  226.       SEGSUP KMPRBP
  227.       SEGDES ICDCDB
  228.       SEGSUP KIDCDB
  229.       SEGSUP KIPCDB
  230. *
  231. * Normal termination
  232. *
  233.       IRET=0
  234.       RETURN
  235. *
  236. * Format handling
  237. *
  238. *
  239. * Error handling
  240. *
  241.  9999 CONTINUE
  242.       IRET=1
  243.       WRITE(IOIMP,*) 'An error was detected in subroutine prolis'
  244.       RETURN
  245. *
  246. * End of subroutine PROLIS
  247. *
  248.       END
  249.  
  250.  
  251.  
  252.  
  253.  

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