Télécharger la plaquette Cast3M


fr en

Télécharger kmdmt.eso

Retour à la liste

Numérotation des lignes : 

kmdmt

  1. C KMDMT     SOURCE    CB215821  20/11/25    13:31:31     10792          
  2.       SUBROUTINE KMDMT(MTABP,MCHB,MCHR,IMPR,CBETA,KDPDQ,KPIMP,PIMP,NIMP)
  3. C ***********************************************************************
  4. C                                             -1 T
  5. C     CE SOUS PROGRAMME CALCULE LA MATRICE C D  C   CONNAISSANT C
  6. C
  7. C     POINTEURS :
  8. C
  9. C     IZL      CONTIENT LE PROFIL ET LA RENUMEROTATION (CF PROFCH)
  10. C     MELEME   OBJET MAILLAGE SUR LEQUEL EST FAIT LE CALCUL
  11. C     MATRAK   MATRICES ELEMENTAIRES DE LA DIVERGENCE (ALIAS"C")
  12. C
  13. C     IZDV     DIAGONALE D
  14. C     IZIPAD   CORRESPONDANCE NUMER. GLOBALE --> NUMER. LOCALE
  15. C              (DOMAINE SUR LEQUEL PORTE AP ET NON LA PRESSION)
  16. C
  17. C     EN SORTIE :
  18. C
  19. C     LA DEMI-MATRICE INFERIEUR EST RANGEE PAR LIGNE
  20. C     (UN SEGMENT IZA PAR LIGNE)
  21. C     LA DIAGONALE DE LA MATRICE EST RANGEE A PART DANS IZD
  22. C     KZA CONTIENT TOUT LES POINTEURS IZA
  23. C     IZD=KZA(1)
  24. C
  25. C ***********************************************************************
  26.       IMPLICIT INTEGER(I-N)
  27.       IMPLICIT REAL*8 (A-H,O-Z)
  28.  
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMELEME
  33.       POINTEUR IPTJ.MELEME,IPTK.MELEME,MELEM1.MELEME
  34.       POINTEUR IGEOM.MELEME,IGEOMI.MELEME,IGEOMC.MELEME
  35.       POINTEUR MELEMK.MELEME,MELEMC.MELEME
  36.       POINTEUR MELSTB.MELEME
  37. C?    POINTEUR ELTFA.MELEME,FACEL.MELEME,MELEMC.MELEME
  38. C?    POINTEUR MELEMF.MELEME,MELEMK.MELEME,MELELI.MELEME
  39. -INC SMLENTI
  40.       POINTEUR IZIPAD.MLENTI,MLENTP.MLENTI,IZIPAK.MLENTI
  41. -INC SMCOORD
  42. -INC SMCHPOI
  43.       POINTEUR IZDV.MCHPOI
  44.       POINTEUR IZDP.MCHPOI,IZDDP.MPOVAL
  45.       POINTEUR MCHB.MCHPOI,MCHR.MCHPOI
  46. C?    POINTEUR IZB.MPOVAL,IZR.MPOVAL,IZPOF.MPOVAL,IZPOC.MPOVAL
  47.       POINTEUR IZB.MPOVAL,IZR.MPOVAL,IZPOC.MPOVAL
  48. C?    POINTEUR IZP.MPOVAL,IZF.MPOVAL
  49.       POINTEUR IZP.MPOVAL
  50. C?    POINTEUR IZFAC.MPOVAL,IZVOL.MPOVAL
  51.  
  52. C-INC SMMATRAKANC
  54. C*************************************************************************
  55. C
  56. C    REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES  puis assemblees
  57. C
  58.  
  59. * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
  60. * (points CENTRE ) pour chaque operateur de contrainte
  61. * KGEOC SPG pour la totalite des points CENTRE.
  62. * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
  63. * KLEMC Connectivites de l'ensemble des contraintes
  64. * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones
  65.  
  66.       SEGMENT MATRAK
  67.       INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
  68.       INTEGER LIZAFM(NBSOUS)
  69.       INTEGER IKAM0 (NBSOUS)
  70.       INTEGER IMEM  (NBELC)
  71.       INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
  72.       ENDSEGMENT
  73.  
  74.       SEGMENT IZAFM
  75.       REAL*8  AM(NNELP,NP,IESP),RPGI(NELAX)
  76.       ENDSEGMENT
  77.  
  78.       POINTEUR IPMJ.IZAFM,IPMK.IZAFM
  79.  
  80. C*******************************************************************
  81.       SEGMENT/IZA/(A(LA)*D)
  82.       SEGMENT/IZD/(D(NELP)*D)
  83. -INC SMTABLE
  84.       POINTEUR MTABP.MTABLE
  85. C
  86.       CHARACTER*8 TYPE,TYPC
  87. *      SAVE BETA
  88. C***
  89. C     KDPDQ=0
  90. C     write(6,*)' Entree dans kmdmt KDPDQ=',kdpdq
  91.  
  92.       TYPE=' '
  93.       CALL ACMO(MTABP,'MATC',TYPE,MATRAK)
  94. C     WRITE(6,*)' KMDMT : MATC=',MATRAK
  95.       IF(TYPE.NE.'MATRAK')THEN
  96.       WRITE(6,*)' IL N''Y A PAS D''ENTREE MATC DANS LA TABLE '
  97.       GO TO 90
  98.       ENDIF
  99.  
  100.       SEGACT MATRAK
  101. *  initialisations pour plaire a l'optimiseur IBM
  102.       MELEMK=MATRAK
  103.       IZPOC=MATRAK
  104.       IZIPAK=MATRAK
  105.       MELSTB=MATRAK
  106.       IZA=MATRAK
  107.       IZL=MATRAK
  108.       MLENTI=MATRAK
  109.       IZD=MATRAK
  110.       IDBLK=MATRAK
  111.       IPMJ=MATRAK
  112.       NBELC=IMEM(/1)
  113.       NIMP=NBELC/2
  114.       IF(KPIMP.EQ.2)NIMP=NBELC
  115. C     write(6,*)' CAS KPIMP=',kpimp,' PIMP=',pimp
  116.  
  117.       CALL PROFCH(MATRAK,IMPR,KPIMP,NIMP)
  118.  
  119.       TYPE=' '
  120.       CALL ACMO(MTABP,'DIAGV',TYPE,IZDV)
  121.       IF(TYPE.NE.'CHPOINT ')THEN
  122.       WRITE(6,*)' IL N''Y A PAS D''ENTREE DIAGV DANS LA TABLE '
  123.       GO TO 90
  124.       ENDIF
  125.  
  126.       SEGACT MATRAK*MOD
  127.       IZL=KIZCL
  128. C     write(6,*)' KIZCL=',KIZCL
  129. C     WRITE(6,*)' KDIAG=',KDIAG,' IZDV=',IZDV,' KCAC=',KCAC
  130.       IF(KDIAG.EQ.IZDV.AND.KCAC.EQ.1)THEN
  131.       GO TO 500
  132.       ENDIF
  133.  
  134.  
  135.       IF(KDPDQ.NE.0)THEN
  136. C DPDQ
  137.       TYPE=' '
  138.       CALL ACMO(MTABP,'DOMAINE',TYPE,MTABD)
  139.       IF(TYPE.NE.'TABLE')GO TO 90
  140.       TYPE=' '
  141.       CALL ACMO(MTABD,'MELSTB',TYPE,MELSTB)
  142.       IF(TYPE.NE.'MAILLAGE') GO TO 90
  143.       CALL LEKTAB(MTABD,'CENTRE',MELEMC)
  144.  
  145.       TYPE=' '
  146.       CALL ACMO(MTABD,'MCHPOC',TYPE,MCHPOC)
  147.       IF(TYPE.NE.'CHPOINT') GO TO 90
  148.       CALL LICHT(MCHPOC,IZPOC,TYPC,IGEOMC)
  149.       NBK=IZPOC.VPOCHA(/2)
  150.       SEGACT MELEMC,IGEOMC
  151. C DPDQ
  152.       ENDIF
  153.  
  154.       KDIAG=IZDV
  155.       CALL LICHT(IZDV,MPOVAL,TYPC,IGEOM)
  156.  
  157. C     WRITE(6,*)' DIAGONALE : '
  158. C     LDG=VPOCHA(/1)
  159. C     WRITE(6,*)' SUR X '
  160. C     WRITE(6,1002)(VPOCHA(II,1),II=1,LDG)
  161. C     WRITE(6,*)' SUR Y '
  162. C     WRITE(6,1002)(VPOCHA(II,2),II=1,LDG)
  163.  
  164. C
  165. C   ON COMMENCE PAR ACTIVER
  166. C
  167.       SEGACT IZL
  168.  
  169. C.     NJAN=NUAN(/1)
  170. C.     write(6,*)' NUAN='
  171. C.     write(6,1001)(NUAN(II),II=1,NJAN)
  172. C.     write(6,*)' NUNA='
  173. C.     write(6,1001)(NUNA(II),II=1,NJAN)
  174. C      write(6,*)' IMEL='
  175. C      write(6,1001)(IMEL(II),II=1,NJAN)
  176. C      write(6,*)' IMJ='
  177. C      write(6,1001)(IMJ(II),II=1,NJAN)
  178.  
  179.       MELEM1=KGEOS
  180.       CALL KRIPAD(MELEM1,IZIPAD)
  181.  
  182.       MELEME=KLEMC
  183.       SEGACT MELEME
  184.  
  185.       IKAS=0
  186.       IF(IKAS.EQ.1)THEN
  187.       NIZ=LIZAFM(/1)
  188.       DO 1940 L=1,NIZ
  189.       IZAFM=LIZAFM(L)
  190.       WRITE(6,*)' MATRICE AM  BLOC N° ',L
  191.       SEGACT IZAFM
  192.       NP=AM(/2)
  193.       IES=AM(/3)
  194.       NNELP=AM(/1)
  195.       WRITE(6,*)'NP,IES,NNELP=',NP,IES,NNELP
  196.       DO 1941 K=1,NNELP
  197.       WRITE(6,*)'K=',K
  198.       WRITE(6,1008)((AM(K,I,J),I=1,NP),J=1,IES)
  199.  1941 CONTINUE
  200.  1940 CONTINUE
  201. C     CALL ARRET(0)
  202.  1008 FORMAT(8(1X,1PE11.4))
  203.       ENDIF
  204.  
  205.       IES=VPOCHA(/2)
  206.       NPT=VPOCHA(/1)
  207.       NELP=B(/1)
  208. C
  209.       IDMAT=KZA1
  210.       SEGACT IDMAT*MOD
  211.       NBLK=IDESCR(/1)
  212.       WRITE(6,*) '* NOMBRE DE BLOCS DE LA MATRICE = ',NBLK
  213.       SEGINI IZD
  214.       IDIAG=IZD
  215. C
  216.  
  217.       DO 71 NS=1,LIZAFM(/1)
  218.       IZAFM=LIZAFM(NS)
  219.       SEGACT IZAFM
  220. C
  221. C     NP1=AM(/1)
  222. C     NP2=AM(/3)
  223. C     WRITE(6,*)' NP=',NP1,' NELB=',NP2
  224. C     DO 1834 I=1,NP1
  225. C     WRITE(6,*)' I1=',I
  226. C     WRITE(6,1002)(AM(I,1,KK),KK=1,NP2)
  227. C     WRITE(6,*)' I2=',I
  228. C     WRITE(6,1002)(AM(I,2,KK),KK=1,NP2)
  229. C1834 CONTINUE
  230.  
  231.  71   CONTINUE
  232.  
  233.       NBSOUS=LISOUS(/1)
  234.       IF(NBSOUS.EQ.0)NBSOUS=1
  235.  
  236.       DO 10 JIS=1,NBSOUS
  237.       IF(NBSOUS.EQ.1)IPTJ=MELEME
  238.       IF(NBSOUS.NE.1)IPTJ=LISOUS(JIS)
  239.       SEGACT IPTJ
  240.  10   CONTINUE
  241.  
  242.       IF(KDPDQ.NE.0)THEN
  243. C
  244. C OPERATEUR DPDQ
  245. C
  246.       CALL KRIPAD(IGEOMC,MLENTI)
  247.       SEGACT MELSTB,IGEOMC
  248.       MELEMK=KGEOC
  249.       CALL KRIPAD(MELEMK,IZIPAK)
  250.       SEGACT MELEMK
  251.       ENDIF
  252.  
  253. C Calcul de la diagonale
  254.  
  255.       AD=0.D0
  256.       ADB=1.D0
  257.       NBELP=NUNA(/1)
  258.       DO 7710 KJ=1,NBELP
  259.       KJJ=NUNA(KJ)
  260.  
  261.       IPMJ=LIZAFM(IMEM(NUNA(KJ)))
  262.       JKAM=IKAM0 (IMEM(NUNA(KJ)))
  263.       KJJ=KJJ-JKAM+1
  264.       J=IMJ(KJ)
  265.       IPTJ=IMEL(KJ)
  266.       NPJ=IPTJ.NUM(/1)
  267.       K1=KJ-KZA(KJ)+1
  268.  
  269.       KK=KJ
  270.       KKK=NUNA(KK)
  271.  
  272.       IPMK=LIZAFM(IMEM(NUNA(KK)))
  273.       KKAM=IKAM0 (IMEM(NUNA(KK)))
  274.       KKK=KKK-KKAM+1
  275.       K=IMJ(KK)
  276.       IPTK=IMEL(KK)
  277.       NPK=IPTK.NUM(/1)
  278.       IF(KK.NE.KJ) KA=KA+1
  279.       AUX=0.D0
  280.       DO 7731 I=1,NPJ
  281.       DO 7732 N=1,NPK
  282.       IF(IPTJ.NUM(I,J).NE.IPTK.NUM(N,K))GO TO 7732
  283.       JD=IZIPAD.LECT(IPTK.NUM(N,K))
  284.  
  285.       AUX=AUX+IPMJ.AM(KJJ,I,1)*IPMK.AM(KKK,N,1)/VPOCHA(JD,1)
  286.      &       +IPMJ.AM(KJJ,I,2)*IPMK.AM(KKK,N,2)/VPOCHA(JD,2)
  287.       IF(IES.EQ.3)
  288.      &AUX=AUX+IPMJ.AM(KJJ,I,3)*IPMK.AM(KKK,N,3)/VPOCHA(JD,3)
  289.  
  290.  7732 CONTINUE
  291.  7731 CONTINUE
  292. C
  293.       AD=AD+AUX
  294.       D(KJ)=D(KJ)+AUX
  295.  
  296.  7710 CONTINUE
  297.       AD=AD/FLOAT(NBELP)
  298.  
  299.  
  300.       IF(KDPDQ.NE.0)THEN
  301. C
  302. C OPERATEUR DPDQ
  303. C
  304.       NBELP=NUNA(/1)
  305.       ADB=0.D0
  306.       DO 7711 KJ=1,NBELP
  307.       KC=NUNA(KJ)
  308.       LPC=LECT(MELEMK.NUM(1,KC))
  309.       IF(LPC.NE.0)THEN
  310.       ADB=ADB+ABS(IZPOC.VPOCHA(LPC,1))
  311.       ENDIF
  312.  7711 CONTINUE
  313.       ADB=ADB/FLOAT(NBELP)
  314.  
  315.       BETA0=AD/ADB*5.E-4
  316.       BETA=CBETA*BETA0
  317. C     WRITE(6,7271)AD,ADB,BETA0,CBETA
  318. C7271 FORMAT(1X,' AD=',1PE11.4,' ADB=',1PE11.4,' BETAopt=',1PE11.4,
  319.       WRITE(6,7271)BETA0,CBETA
  320.  7271 FORMAT(1X,' BETAopt=',1PE11.4,' CBETA=',1PE11.4)
  321.  
  322.       KJ=1
  323.       KC=NUNA(KJ)
  324.       LPC=LECT(MELEMK.NUM(1,KC))
  325.       IF(LPC.NE.0)THEN
  326.       P1=BETA*IZPOC.VPOCHA(LPC,1)
  327.       D(KJ)=D(KJ)+ABS(P1)
  328.       ENDIF
  329.  
  330.       ENDIF
  331. C FIN DPDQ
  332.  
  333. C
  334. C CALCUL DES BLOCS
  335. C
  336.       DO 100 IBLK=1,NBLK
  337. C NUMÉROS DES LIGNES DE DÉBUT ET DE FIN DE BLOC KJD,KJF
  338.       KJD=NLDBLK(IBLK)
  339.       KJF=NLDBLK(IBLK+1)-1
  340. C ALLOCATION DE LA MÉMOIRE POUR LE BLOC
  341.       IDBLK=IDESCR(IBLK)
  342.       SEGACT IDBLK*MOD
  343.       LA=ILON
  344.       WRITE(6,*) '* BLOC NUMÉRO : ',IBLK,' TAILLE = ',ILON,' MOTS'
  345.       SEGINI IZA
  346.       IMAT=IZA
  347.       KA=0
  348.       DO 1 KJ=KJD,KJF
  349.       KJJ=NUNA(KJ)
  350.  
  351.       IPMJ=LIZAFM(IMEM(NUNA(KJ)))
  352.       JKAM=IKAM0 (IMEM(NUNA(KJ)))
  353.       KJJ=KJJ-JKAM+1
  354.       J=IMJ(KJ)
  355.       IPTJ=IMEL(KJ)
  356.       NPJ=IPTJ.NUM(/1)
  357.       K1=KJ-KZA(KJ)+1
  358.  
  359.       DO 2 KK=K1,KJ
  360.       KKK=NUNA(KK)
  361.  
  362.       IPMK=LIZAFM(IMEM(NUNA(KK)))
  363.       KKAM=IKAM0 (IMEM(NUNA(KK)))
  364.       KKK=KKK-KKAM+1
  365.       K=IMJ(KK)
  366.       IPTK=IMEL(KK)
  367.       NPK=IPTK.NUM(/1)
  368.       IF(KK.NE.KJ) KA=KA+1
  369.       AUX=0.D0
  370.       DO 31 I=1,NPJ
  371.       DO 32 N=1,NPK
  372.       IF(IPTJ.NUM(I,J).NE.IPTK.NUM(N,K))GO TO 32
  373.       JD=IZIPAD.LECT(IPTK.NUM(N,K))
  374.  
  375.       AUX=AUX+IPMJ.AM(KJJ,I,1)*IPMK.AM(KKK,N,1)/VPOCHA(JD,1)
  376.      &       +IPMJ.AM(KJJ,I,2)*IPMK.AM(KKK,N,2)/VPOCHA(JD,2)
  377.       IF(IES.EQ.3)
  378.      &AUX=AUX+IPMJ.AM(KJJ,I,3)*IPMK.AM(KKK,N,3)/VPOCHA(JD,3)
  379.  
  380.  32   CONTINUE
  381.  31   CONTINUE
  382. C
  383.       IF(KK.EQ.KJ)GO TO 21
  384.       A(KA)=A(KA)+AUX
  385. C
  386.  21   CONTINUE
  387.  2    CONTINUE
  388.  
  389. C?.   ad=ad+aux
  390. C?.   D(KJ)=D(KJ)+AUX
  391.  
  392.       IF(KDPDQ.NE.0)THEN
  393. C OPERATEUR DPDQ
  394. C
  395.       KJJ=NUNA(KJ)
  396.       LPJ=LECT(MELEMK.NUM(1,KJJ))
  397.       IF(LPJ.NE.0)THEN
  398.       P1=BETA*IZPOC.VPOCHA(LPJ,1)
  399.       D(KJ)=D(KJ)+ABS(P1)
  400.  
  401.       DO 3819 JC=2,NBK
  402.       NPC=MELSTB.NUM(JC,LPJ)
  403.       P=BETA*IZPOC.VPOCHA(LPJ,JC)
  404.       KPI=IZIPAK.LECT(NPC)
  405.       KPJN=NUAN(KPI)
  406.       IF(KPJN.GT.KJ)GO TO 3819
  407.       IDECI=IDEBLK(KJ-KJD+1)
  408.       LLI=IDEBLK(KJ-KJD+2)-IDEBLK(KJ-KJD+1)
  409.       KJAA=LLI-KJ+KPJN+IDECI
  410.  
  411.       A(KJAA)=A(KJAA)+P
  412.  
  413.  3819 CONTINUE
  414.       ENDIF
  415.       ENDIF
  416. C FIN DPDQ
  417.  
  418.  1    CONTINUE
  419.       SEGDES IZA
  420.       SEGDES IDBLK
  421.  100  CONTINUE
  422.       SEGDES IDMAT
  423.  
  424.  
  425.       IF(KDPDQ.NE.0)THEN
  426.       SEGSUP IZIPAK,MLENTI
  427.       ENDIF
  428.  
  429.  
  430.       IF(KPIMP.EQ.1)THEN
  431.       D(NIMP)=1.D30
  432.       ELSEIF(KPIMP.EQ.2)THEN
  433.       SEGACT IZA
  434.       NELP=D(/1)
  435.       LGLA=A(/1)
  436.       LGLI=KZA(NIMP)
  437.       CALL INITD(A(LGLA-LGLI+1),LGLI,0.D0)
  438.       D(NELP)=1.D-10
  439.       CALL LEKTAB(MTABD,'XXVOLUM',MCHPOI)
  440.       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  441.       VOLT=0.D0
  442.       DO 482 I=1,NELP
  443.       VOLT=VOLT+VPOCHA(I,1)
  444.  482  CONTINUE
  445.       DO 483 I=1,NELP
  446.       XVOL=VPOCHA(NUNA(I),1)
  447.       A(LGLA-LGLI+I)=-XVOL/VOLT
  448.  483  CONTINUE
  449.       ENDIF
  450.  
  451.       SEGSUP IZIPAD
  452.  
  453.       DO 20 JIS=1,NBSOUS
  454.       IF(NBSOUS.EQ.1)IPTJ=MELEME
  455.       IF(NBSOUS.NE.1)IPTJ=LISOUS(JIS)
  456. C     write(6,*)' On desactive JIS,IPTJ=',JIS,IPTJ
  457.       SEGDES IPTJ
  458.       IPMJ=LIZAFM(JIS)
  459.       JKAM=IKAM0 (JIS)
  460.       SEGDES IPMJ
  461.  20   CONTINUE
  462.  
  463.       SEGDES MPOVAL,IZDV
  464.       KCAC=1
  465.  
  466.       TYPE=' '
  467.       CALL ACMO(MTABP,'DIAGP',TYPE,IZDP)
  468.       IF(TYPE.EQ.'CHPOINT ')THEN
  469.       CALL LICHT(IZDP,IZDDP,TYPE,IGEOMI)
  470.       IGEOM=KGEOC
  471.  
  472.       SEGACT IZD
  473.       SEGACT IGEOM,IGEOMI
  474.  
  475.       NPT=D(/1)
  476.       NPTI=IZDDP.VPOCHA(/1)
  477.  
  478.       DO 51 I=1,NPTI
  479.       XVALI=IZDDP.VPOCHA(I,1)
  480.       IPOI=IGEOMI.NUM(1,I)
  481.       DO 52 J=1,NPT
  482.       IF(IGEOM.NUM(1,J).EQ.IPOI)THEN
  483.       JJ=NUAN(J)
  484.       D(JJ)=D(JJ)+XVALI
  485.       GO TO 53
  486.       ENDIF
  487.  52   CONTINUE
  488.  53   CONTINUE
  489.  51   CONTINUE
  490.       SEGDES IZDP,IZDDP
  491.       SEGDES IGEOM,IGEOMI
  492.       ENDIF
  493.  
  494.       DO 72 NS=1,LIZAFM(/1)
  495.       IZAFM=LIZAFM(NS)
  496.       SEGDES IZAFM
  497.  72   CONTINUE
  498.  
  499.       SEGDES IZD
  500.       SEGDES MATRAK
  501.       SEGDES MELEME
  502. C     WRITE(6,*)' APPEL A TRIAKS'
  503.  
  504.       CALL TRIAKS(IZL)
  505. C     WRITE(6,*)' RETOUR DE TRIAKS'
  506.  500  CONTINUE
  507.       CALL LICHT(MCHB,IZB,TYPC,IGEOM)
  508.       CALL LICHT(MCHR,IZR,TYPC,IGEOM)
  509.  
  510.       CALL KAL2P(MTABP,MCHB)
  511.  
  512. C     write(6,*)' APPEL A RESOCK'
  513.       IF(KPIMP.NE.0)THEN
  514.       SEGACT IZL
  515.       CALL LICHT(MCHB,IZB,TYPC,IGEOM)
  516.       IF(KPIMP.EQ.1)IZB.VPOCHA(NUNA(NIMP),1)=PIMP*1.D30
  517.       IF(KPIMP.EQ.2)IZB.VPOCHA(NUNA(NIMP),1)=-PIMP
  518.       ENDIF
  519.  
  520.       CALL RESOCK(IZB,IZL,IZR)
  521. C     write(6,*)' Retour de resock '
  522.  
  523.       SEGDES MCHB,IZB
  524.       SEGDES MCHR,IZR
  525.       RETURN
  526.  90   CONTINUE
  527.       WRITE(6,*)' ARRET ANORMAL DE KMDMT'
  528.       RETURN
  529.  1002 FORMAT(10(1X,1PE11.4))
  530.  1001 FORMAT(20(1X,I5))
  531.       END
  532.  
  533.  
  534.  
  535.  
  536.  
  537.  
  538.  
  539.  
  540.  
  541.  
  542.  
  543.  

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