Télécharger la plaquette Cast3M


fr en

Télécharger proli2.eso

Retour à la liste

Numérotation des lignes : 

proli2

  1. C PROLI2    SOURCE    CHAT      05/01/13    02:32:40     5004
  2.       SUBROUTINE PROLI2(LMDUAB,LMPRIB,LMPRIC,LMDUAC,
  3.      $     LILBLC,KRMPRI,KMDCDB,KMPRBP,
  4.      $     SLCHPD,SLMATB,SLMATC,
  5.      $     LMPCDB,LMDCDB,NELCDB,
  6.      $     SLMCDB,
  7.      $     IMPR,IRET)
  8.       IMPLICIT INTEGER(I-N)
  9.       IMPLICIT REAL*8 (A-H,O-Z)
  10. C***********************************************************************
  11. C NOM         : PROLI2
  12. C DESCRIPTION : Produit des matrices stockées sous forme de listes
  13. C               indexées (2 : Boucles sur les éléments)
  14. C
  15. C
  16. C
  17. C LANGAGE     : ESOPE
  18. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  19. C               mél : gounand@semt2.smts.cea.fr
  20. C***********************************************************************
  21. C APPELES          : -
  22. C APPELE PAR       : PROLIS
  23. C***********************************************************************
  24. C ENTREES            : tout sauf SLMCDB
  25. C SORTIES            : SLMCDB
  26. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27. C***********************************************************************
  28. C VERSION    : v1, 14/02/2000, version initiale
  29. C HISTORIQUE : v1, 14/02/2000, création
  30. C HISTORIQUE :
  31. C HISTORIQUE :
  32. C***********************************************************************
  33. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34. C en cas de modification de ce sous-programme afin de faciliter
  35. C la maintenance !
  36. C***********************************************************************
  37.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. -INC SMLENTI
  41.       POINTEUR KRMPRI.MLENTI
  42.       POINTEUR KMPRBP.MLENTI
  43.       POINTEUR KMDCDB.MLENTI
  44. * Includes persos
  45. *     Segment LSTIND (liste séquentielle indexée)
  46.       SEGMENT LSTIND
  47.       INTEGER IDX(NBM+1)
  48.       INTEGER IVAL(NBTVAL)
  49.       ENDSEGMENT
  50.       POINTEUR LMDUAB.LSTIND
  51.       POINTEUR LMPRIB.LSTIND
  52.       POINTEUR LMPRIC.LSTIND
  53.       POINTEUR LMDUAC.LSTIND
  54.       POINTEUR LILBLC.LSTIND
  55.       POINTEUR LMPCDB.LSTIND
  56.       POINTEUR LMDCDB.LSTIND
  57.       SEGMENT LSRIND
  58.       INTEGER IDXX(NBM+1)
  59.       REAL*8 XVAL(NBTVAL)
  60.       ENDSEGMENT
  61.       POINTEUR SLMATB.LSRIND
  62.       POINTEUR SLMATC.LSRIND
  63.       POINTEUR SLMCDB.LSRIND
  64. -INC SMLREEL
  65.       POINTEUR SLCHPD.MLREEL
  66. *
  67.       INTEGER NELCDB
  68.       INTEGER IMPR,IRET
  69. *
  70.       INTEGER IELCDB
  71.       INTEGER KVDCDB,KVSTRT,KVSTOP,IPDCDB
  72.       INTEGER LVMPBP,LVSTRT,LVSTOP
  73.       INTEGER MVLBLC,MVSTRT,MVSTOP
  74.       INTEGER NVPRIC,NVSTRT,NVSTOP
  75.       INTEGER OVDUAC,OVSTRT,OVSTOP
  76.       INTEGER PVDUAB,PVSTRT,PVSTOP
  77.       INTEGER QVMATC,QVSTRT
  78.       INTEGER RVMATB,RVSTRT
  79.       INTEGER SVMCDB,SVSTRT
  80.       INTEGER NPPB,NPPC,NPPCDB
  81.       INTEGER NLOCPB,NUELC,NUMPC,NUPBP,NUPDP
  82.       REAL*8 BIJ,CIK,COEFD
  83. *
  84. * Executable statements
  85. *
  86.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans proli2.eso'
  87. *
  88. * Boucle sur les éléments de CD-1Bt
  89. *
  90. *COMM      SEGPRT,LMDCDB
  91.       DO 1 IELCDB=1,NELCDB
  92. * On construit KRDCDB
  93.          KVSTRT=LMDCDB.IDX(IELCDB)
  94.          KVSTOP=LMDCDB.IDX(IELCDB+1)-1
  95.          DO 11 KVDCDB=KVSTRT,KVSTOP
  96.             NUPDP=LMDCDB.IVAL(KVDCDB)
  97.             KMDCDB.LECT(NUPDP)=KVDCDB-KVSTRT
  98.  11      CONTINUE
  99. *COMM         WRITE(IOIMP,*) 'Repérage dans LMDCDB'
  100. *COMM         SEGPRT,KMDCDB
  101. * On construit KRMPBP
  102.          LVSTRT=LMPRIB.IDX(IELCDB)
  103.          LVSTOP=LMPRIB.IDX(IELCDB+1)-1
  104.          DO 12 LVMPBP=LVSTRT,LVSTOP
  105.             NUPBP=LMPRIB.IVAL(LVMPBP)
  106.             IF (KRMPRI.LECT(NUPBP).NE.0) THEN
  107.                KMPRBP.LECT(NUPBP)=LVMPBP-LVSTRT+1
  108.             ENDIF
  109.  12      CONTINUE
  110. *COMM         WRITE(IOIMP,*) 'Repérage dans LMPRIB'
  111. *COMM         SEGPRT,KMPRBP
  112. *COMM         WRITE(IOIMP,*) 'Numéro d''élément de CD-1Bt (ouB)=',IELCDB
  113.          NPPCDB=LMPCDB.IDX(IELCDB+1)-LMPCDB.IDX(IELCDB)
  114.          NPPB  =LMPRIB.IDX(IELCDB+1)-LMPRIB.IDX(IELCDB)
  115.          RVSTRT=SLMATB.IDXX(IELCDB)
  116.          SVSTRT=SLMCDB.IDXX(IELCDB)
  117. * On parcourt les éléments de la matrice C de ayant au moins un point
  118. * commmun avec un élément de la matrice B courante
  119.          MVSTRT=LILBLC.IDX(IELCDB)
  120.          MVSTOP=LILBLC.IDX(IELCDB+1)-1
  121.          DO 13 MVLBLC=MVSTRT,MVSTOP
  122.             NUELC=LILBLC.IVAL(MVLBLC)
  123. *COMM            WRITE(IOIMP,*) '  Numéro d''élément C',NUELC
  124.             NPPC=LMPRIC.IDX(NUELC+1)-LMPRIC.IDX(NUELC)
  125.             QVSTRT=SLMATC.IDXX(NUELC)
  126. *  Parcourons les points de l'élément NUELC de MPRIC
  127.             NVSTRT=LMPRIC.IDX(NUELC)
  128.             NVSTOP=LMPRIC.IDX(NUELC+1)-1
  129.             DO 132 NVPRIC=NVSTRT,NVSTOP
  130.                NUMPC=LMPRIC.IVAL(NVPRIC)
  131. *COMM               WRITE(IOIMP,*) '    Point du primal de C :',NUMPC
  132.                NLOCPB=KMPRBP.LECT(NUMPC)
  133. *COMM               WRITE(IOIMP,*) '    NLOCPB=',NLOCPB
  134.                IF (NLOCPB.NE.0) THEN
  135. *  On a trouvé un point de MPRIB qui correspond donc
  136. *  on parcourt les points de l'élément NUELC de MDUAC
  137. *  et les points de l'élément IELCDB de MDUAB
  138.                   OVSTRT=LMDUAC.IDX(NUELC)
  139.                   OVSTOP=LMDUAC.IDX(NUELC+1)-1
  140.                   PVSTRT=LMDUAB.IDX(IELCDB)
  141.                   PVSTOP=LMDUAB.IDX(IELCDB+1)-1
  142.                   IF (SLCHPD.NE.0) THEN
  143.                      COEFD=SLCHPD.PROG(KRMPRI.LECT(NUMPC))
  144. *COMM                     WRITE(IOIMP,*) '    COEFD=',COEFD
  145.                   ENDIF
  146.                   DO 1322 OVDUAC=OVSTRT,OVSTOP
  147. *COMM                     write(ioimp,*) '      po. dua. C=',
  148. *COMM     $                    LMDUAC.IVAL(OVDUAC)
  149.                      QVMATC=QVSTRT+
  150.      $                    (NPPC*(OVDUAC-OVSTRT)+(NVPRIC-NVSTRT))
  151.                      CIK=SLMATC.XVAL(QVMATC)
  152. *COMM                     WRITE(IOIMP,*) '      CIK=',CIK
  153.                      IPDCDB=KMDCDB.LECT(LMDUAC.IVAL(OVDUAC))
  154.                      DO 13222 PVDUAB=PVSTRT,PVSTOP
  155. *COMM                     write(ioimp,*) '        po. dua. B=',
  156. *COMM     $                    LMDUAB.IVAL(PVDUAB)
  157.                         RVMATB=RVSTRT+
  158.      $                       (NPPB*(PVDUAB-PVSTRT)+(NLOCPB-1))
  159.                         BIJ=SLMATB.XVAL(RVMATB)
  160. *COMM                        WRITE(IOIMP,*) '        BIJ=',BIJ
  161.                         SVMCDB=SVSTRT+
  162.      $                       (IPDCDB*NPPCDB+(PVDUAB-PVSTRT))
  163. *COMM                        WRITE(IOIMP,*) '        SVMCDB=',SVMCDB
  164.                         IF (SLCHPD.NE.0) THEN
  165.                            SLMCDB.XVAL(SVMCDB)=SLMCDB.XVAL(SVMCDB)
  166.      $                          +(BIJ*COEFD*CIK)
  167.                         ELSE
  168.                            SLMCDB.XVAL(SVMCDB)=SLMCDB.XVAL(SVMCDB)
  169.      $                          +(BIJ*CIK)
  170.                         ENDIF
  171. 13222                CONTINUE
  172.  1322             CONTINUE
  173.                ENDIF
  174.  132        CONTINUE
  175.  13      CONTINUE
  176. * On remet KRMPBP à 0
  177.          DO 15 LVMPBP=LVSTRT,LVSTOP
  178.             NUPBP=LMPRIB.IVAL(LVMPBP)
  179.             IF (KRMPRI.LECT(NUPBP).NE.0) THEN
  180.                KMPRBP.LECT(NUPBP)=0
  181.             ENDIF
  182.  15      CONTINUE
  183. * On remet KRDCDB à 0
  184.          DO 17 KVDCDB=KVSTRT,KVSTOP
  185.             NUPDP=LMDCDB.IVAL(IELCDB)
  186.             KMDCDB.LECT(NUPDP)=0
  187.  17      CONTINUE
  188.  1    CONTINUE
  189.  
  190. *
  191. * Normal termination
  192. *
  193.       IRET=0
  194.       RETURN
  195. *
  196. * Format handling
  197. *
  198. *
  199. * Error handling
  200. *
  201.  9999 CONTINUE
  202.       IRET=1
  203.       WRITE(IOIMP,*) 'An error was detected in subroutine proli2'
  204.       RETURN
  205. *
  206. * End of subroutine PROLI2
  207. *
  208.       END
  209.  
  210.  
  211.  
  212.  
  213.  

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