Télécharger la plaquette Cast3M


fr en

Télécharger chisol.eso

Retour à la liste

Numérotation des lignes : 

chisol

  1. C CHISOL    SOURCE    PV        07/11/23    21:15:39     5978
  2. C CHISOL    SOURCE        BOS       97/03/03
  3.       SUBROUTINE CHISOL(NVSOSO,IDSCHI)
  4.       IMPLICIT INTEGER(I-N)
  5.         IMPLICIT REAL*8 (A-H,O-Z)
  6. C-----------------------------------------------------------------
  7. C
  8. C           PRISE EN COMPTE DE NOUVELLES SOLUTIONS SOLIDES
  9. C
  10. C-----------------------------------------------------------------
  11. -INC SMTABLE
  12. -INC SMLENTI
  13. -INC SMLREEL
  14. -INC PPARAM
  15. -INC CCOPTIO
  16.       POINTEUR MLIDEN.MLENTI
  17.       SEGMENT IDSCHI
  18.            REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  19.            INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  20.            INTEGER IDECY(NYDIM),IONZ(NXDIM)
  21.            CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  22.       ENDSEGMENT
  23.       real*8 lf
  24.       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  25.       LOGICAL LOGRE
  26.       INTEGER LINIT
  27. C
  28.       NZDIM=IDZ(/1)
  29.       NYDIM=IDY(/1)
  30.       NXDIM=IDX(/1)
  31.       NPDIM=IDP(/1)
  32.       MTAB1=NVSOSO
  33.       SEGACT MTAB1
  34.       NNSOSO=MTAB1.MLOTAB
  35.       NISOSO=NNSOSO
  36. C   si MTAB1 est une table tous ses indices sont des entiers, mais
  37. C  si MTAB1 est un objet il y a des indices METHODE HERI ... en plus
  38.       IVALI=0
  39.       XVALI=0.D0
  40.       IRETI=0
  41.       IVALR=0
  42.       XVALR=0.D0
  43.       IRETR=0
  44.       MTYPI='MOT     '
  45.       MTYPR='        '
  46.       CHARR='        '
  47.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'CLASSE',.TRUE.,IRETI,
  48.      *        MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  49.       IF(IERR.NE.0)RETURN
  50.       IF(MTYPR.EQ.'MOT     ')THEN
  51. C
  52. C   on a trouvé CLASSE c'est un OBJET on va compter les indices entier
  53. C
  54.       NISOSO= 0
  55.       DO 5 IESP=1,NNSOSO
  56.       IF((MTAB1.MTABTI(IESP)).EQ.'ENTIER') NISOSO= NISOSO+1
  57.     5 CONTINUE
  58.        ENDIF
  59. *     WRITE(6,*)'CHISOL',NNSOSO
  60.       DO 80 ISOSO=1,NISOSO
  61.          IVALI=ISOSO
  62.          XVALI=0.D0
  63.          IRETI=0
  64.          IVALR=0
  65.          XVALR=0.D0
  66.          IRETR=0
  67.          MTYPI='ENTIER  '
  68.          MTYPR='        '
  69.          CHARR='        '
  70.          CHARI='        '
  71.          CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,CHARI,.TRUE.,IRETI,
  72.      *        MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  73.          IF(IERR.NE.0)RETURN
  74.          IF((MTYPR.EQ.'TABLE   ').OR.(MTYPR.EQ.'OBJET   '))THEN
  75.          MTAB2=IRETR
  76. *     WRITE(6,*)'chisol mtab2=',MTAB2
  77.          SEGACT MTAB2
  78.          IVALI=1
  79.          XVALI=0.D0
  80.          IRETI=0
  81.          IVALR=0
  82.          XVALR=0.D0
  83.          IRETR=0
  84.          MTYPI='MOT     '
  85.          MTYPR='ENTIER  '
  86.          CHARR='        '
  87.          CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDEN',.TRUE.,IRETI,
  88.      *        MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  89.          IF(IERR.NE.0)RETURN
  90.          IDSOSO=IVALR
  91. *     WRITE(6,*)'chisol idsoso=',IDSOSO
  92.          IVALI=1
  93.          XVALI=0.D0
  94.          IRETI=0
  95.          IVALR=0
  96.          XVALR=0.D0
  97.          IRETR=0
  98.          MTYPI='MOT     '
  99.          MTYPR='LISTENTI'
  100.          CHARR='        '
  101.          CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SOLID',.TRUE.,IRETI,
  102.      *        MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  103.          IF(IERR.NE.0)RETURN
  104.          MLENTI=IRETR
  105. *     write(6,*)'chisol mlenti= ',MLENTI
  106.          SEGACT MLENTI
  107.          LB=LECT(/1)
  108.          IVALI=1
  109.          XVALI=0.D0
  110.          IRETI=0
  111.          IVALR=0
  112.          XVALR=0.D0
  113.          IRETR=0
  114.          MTYPI='MOT     '
  115.          MTYPR='ENTIER  '
  116.          CHARR='        '
  117.          CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'ITYP',.TRUE.,IRETI,
  118.      *        MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  119.          IF(IERR.NE.0)RETURN
  120.          ITJP=IVALR
  121. *     WRITE(6,*)'CHISOL idsoso,itjp,mlenti',IDSOSO,ITJP,MLENTI
  122.          IVALI=1
  123.          XVALI=0.D0
  124.          IRETI=0
  125.          IVALR=0
  126.          XVALR=0.D0
  127.          IRETR=0
  128.          MTYPI='MOT     '
  129.          MTYPR='        '
  130.          CHARR='        '
  131.          CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'FRACTIO',.TRUE.,IRETI,
  132.      *        MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  133. *     write(6,*)'chisol mtypr=',MTYPR,' iretr=',IRETR
  134.          IF(MTYPR.EQ.'LISTREEL')THEN
  135.  
  136. C SI L UTILISATEUR DONNE LES FRACTIONS MOLAIRES
  137.             MLREEL=IRETR
  138.             SEGACT MLREEL
  139.             LC=PROG(/1)
  140.             IF(LB.NE.LC)THEN
  141.                MOTERR(1:40)='**********NVSOSO.FRACTIO      '
  142.                CALL ERREUR(-301)
  143.                CALL ERREUR(21)
  144.                RETURN
  145.             ENDIF
  146.             DO 20 L=1,LB
  147.                IF(LECT(L).NE.0)THEN
  148.                   IDCK=LECT(L)
  149.                   CALL CHIADY(IDP,NPDIM,IDCK,K)
  150.                   IF(K.EQ.0)THEN
  151. *     WRITE(6,*)' LE POLE ',IDCK,' N A PAS ETE RETENU'
  152. *     WRITE(6,*)' LA SOLSOL ',IDSOSO,' NE PEUT ETRE FORMEE'
  153.                      MOTERR(1:40)='**********NVSOSO.SOLID           '
  154.                      CALL ERREUR(-301)
  155.                      INTERR(1)=IDCK
  156.                      CALL ERREUR(776)
  157.                      RETURN
  158.                   ENDIF
  159.                ELSE
  160.                   GOTO 30
  161.                ENDIF
  162.  20         CONTINUE
  163.  30         CONTINUE
  164.             NN(6)=NN(6)+1
  165.             NYDIM=NYDIM+1
  166.             NZDIM=NZDIM+1
  167.             SEGADJ IDSCHI
  168.             IDY(NYDIM)=IDSOSO
  169.             DO 10 I=1,NPDIM
  170.                FF(NZDIM,I)=0.D0
  171.  10         CONTINUE
  172.  
  173. C PRISE EN COMPTE DES FRACTIONS MOLAIRES DONNEES
  174.             DO 40 IX=1,LB
  175.                IF(LECT(IX).EQ.0) GO TO 50
  176.                IDCK=LECT(IX)
  177.                CALL CHIADY(IDP,NPDIM,IDCK,IK)
  178.                FF(NZDIM,IK)=PROG(IX)
  179.  40         CONTINUE
  180.  
  181. C CALCUL DES COEFFICIENTS STOECHIOMETRIQUES
  182.             DO JC=1,NXDIM
  183.                VF=0
  184.                DO IB=1,NPDIM
  185.                   IF(FF(NZDIM,IB).NE.0.D0)THEN
  186.                      IDPB=IDP(IB)
  187.                      CALL CHIADY(IDY,NYDIM,IDPB,IDPC)
  188.                      VF=VF+AA(IDPC,JC)*FF(NZDIM,IB)
  189.                      AA(NYDIM,JC)=VF
  190.                   ENDIF
  191.                END DO
  192.             END DO
  193.  
  194. C CALCUL DE LA CONSTANTE D EQUILIBRE
  195.             GK(NYDIM)=0
  196.             DO JD=1,NPDIM
  197.                IDPJD=IDP(JD)
  198.                CALL CHIADY(IDY,NYDIM,IDPJD,IDJD)
  199.                IF(FF(NZDIM,JD).NE.0.D0)THEN
  200.                   LF=LOG10(ABS(FF(NZDIM,JD)))
  201.                   GK(NYDIM)=GK(NYDIM)+FF(NZDIM,JD)*(GK(IDJD)-LF)
  202.                ENDIF
  203.             END DO
  204.             SEGDES MLREEL
  205.          ELSE
  206.  
  207. C SI L UTILISATEUR NE DONNE PAS DE FRACTIONS MOLAIRES
  208.             NN(6)=NN(6)+1
  209.             NYDIM=NYDIM+1
  210.             NZDIM=NZDIM+1
  211.             SEGADJ IDSCHI
  212.             IDY(NYDIM)=IDSOSO
  213.             DO 15 I=1,NPDIM
  214.                FF(NZDIM,I)=0.D0
  215.  15         CONTINUE
  216.  
  217. C INITIALISATION DES FRACTIONS MOLAIRES
  218.             DO 60 IIX=1,LB
  219.                IF(LECT(IIX).EQ.0) GOTO 50
  220.                IDCK=LECT(IIX)
  221.                CALL CHIADY(IDP,NPDIM,IDCK,IIK)
  222.                FF(NZDIM,IIK)=1.D0
  223.  60         CONTINUE
  224.          ENDIF
  225.  
  226.  50      CONTINUE
  227.  
  228. C MISE EN TYPE 6 DES POLES DE SOLUTIONS SOLIDES
  229.          NN1=NN(1)+NN(2)+NN(3)
  230.          NN2=NN(1)+NN(2)+NN(3)+NN(4)
  231.          NN3=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)
  232.          NN4=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+1
  233.          DO INN=NN1+1,NN3
  234.             NN4=NN4-1
  235.             IDYN=IDY(NN4)
  236. *     write(6,*)'chisol idyn',idyn,'idy(nn4)',idy(nn4)
  237.             CALL CHIADY(IDP,NPDIM,IDYN,IDN)
  238. *     write(6,*)'chisol idn',idn
  239.             IF(IDN.NE.0)THEN
  240.                IF(FF(NZDIM,IDN).NE.0.D0)THEN
  241. *     write(6,*)'chisol ff(nzdim,idn)',ff(nzdim,idn)
  242.                   IF(NN4.GT.NN1.AND.NN4.LE.NN2)THEN
  243.                      LINIT=4
  244.                      CALL CHIREX(IDSCHI,IDYN,LINIT,6)
  245. *     write(6,*)'chisol 4 ok pour',idyn,'inn',nn4,'idy',idy(nn4)
  246.                   ENDIF
  247.                   IF(NN4.GT.NN2.AND.NN4.LE.NN3)THEN
  248.                      LINIT=5
  249.                      CALL CHIREX(IDSCHI,IDYN,LINIT,6)
  250. *     write(6,*)'chisol 5 ok pour',idyn,'nn4',nn4,'idy',idy(nn4)
  251.                   ENDIF
  252.                ENDIF
  253.             ENDIF
  254.          END DO
  255.  
  256.          LINIT=6
  257.          CALL CHIREX(IDSCHI,IDSOSO,LINIT,ITJP)
  258.          IDZ(NZDIM)=IDSOSO
  259.          SEGDES MLENTI
  260.          SEGDES MTAB2
  261.       ELSE
  262.         MOTERR(1:40)='********         NVSOSO    ???????????  '
  263.         CALL ERREUR(-301)
  264.       CALL ERREUR(21)
  265.       RETURN
  266.       ENDIF
  267.  80   CONTINUE
  268.       SEGDES MTAB1
  269.  
  270. *      write(6,*)'fin chisol'
  271. *     write(6,*)'NXDIM,NYDIM,NPDIM,NZDIM',NXDIM,NYDIM,NPDIM,NZDIM
  272. *     write(6,*)(name(i),i=1,NXDIM)
  273. *     write(6,*)'IDX',(IDX(I),I=1,NXDIM)
  274. *     write(6,*)'IDY',(IDY(I),I=1,NYDIM)
  275. *     WRITE(6,*)'IDZ',(IDZ(I),I=1,NZDIM)
  276. *     write(6,*)'IDP',(IDP(I),i=1,npdim)
  277. *     do 100 i=1,nydim
  278. *     write(6,*)'IDY',idy(i),'AA',(aa(i,j),j=1,nxdim)
  279. *     100 continue
  280. *     do 300 k=1,nzdim
  281. *     write(6,*)'IDZ',idz(k),'FF',(ff(k,i),i=1,npdim)
  282. *     300 continue
  283. *     write(6,*)'GK',(GK(I),I=1,NYDIM)
  284. *     write(6,110)((aa(i,j),i=1,NYDIM),j=1,NXDIM)
  285. *     write(6,110)((ff(k,i),k=1,NZDIM),i=1,NYDIM)
  286.  110  format(2x,(10(1PE10.3)))
  287.  
  288.       RETURN
  289.       END
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  
  297.  

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