Télécharger la plaquette Cast3M


fr en

Télécharger neutre.eso

Retour à la liste

Numérotation des lignes : 

neutre

  1. C NEUTRE    SOURCE    CB215821  20/11/25    13:34:47     10792          
  2.       SUBROUTINE NEUTRE
  3. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  4. C
  5. C               OPERATEUR NEUT
  6. C
  7. C           CALCULE LE BILAN ELECTRIQUE D'UNE SOLUTION CHIMIQUE
  8. C          UTILISE LES RESULTATS DE CHI1
  9. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10.       IMPLICIT INTEGER(I-N)
  11.       IMPLICIT REAL*8(A-H,O-Z)
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC SMLENTI
  16. -INC SMLMOTS
  17. -INC SMCHPOI
  18. -INC SMELEME
  19.       POINTEUR MLAA.MLREEL,MLOGK.MLREEL,MLFF.MLREEL
  20.       POINTEUR MLIDX.MLENTI,MLIDY.MLENTI,MLIDZ.MLENTI,MLIDP.MLENTI
  21.       POINTEUR MLNN.MLENTI,MLDECY.MLENTI
  22.       POINTEUR MLIONZ.MLENTI,MLPREC.MLENTI
  23.       POINTEUR MLNAME.MLMOTS,MLNESP.MLMOTS
  24.       POINTEUR MLSOLU.MLENTI,MMSOLU.MLMOTS
  25.       POINTEUR MCNEUT.MCHPOI,ICNEUT.MPOVAL
  26.       CHARACTER*8 TYPEMA
  27.       SEGMENT IDSCHI
  28.            REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  29.            INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  30.            INTEGER IDECY(NYDIM),IONZ(NXDIM)
  31.            CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  32.       ENDSEGMENT
  33.       SEGMENT SP2
  34.            REAL*8 GX(NXDIM),XX(NXDIM),GS(NZDIM),SS(NZDIM)
  35.            REAL*8 TOT(NXDIM),TOTAQ(NXDIM),TOTFIX(NXDIM),GKS(NZDIM)
  36.            REAL*8 YY(NXDIM),ZZ(NXDIM,NXDIM),CC(NYDIM),GC(NYDIM)
  37.       ENDSEGMENT
  38.       SEGMENT IZBID
  39.             INTEGER IBID(NSOL)
  40.       ENDSEGMENT
  41. C
  42.  
  43. C
  44. C                       LECTURE DE LA TABLE CHIMI1
  45.       CALL CHMDEB(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,MLDECY,
  46.      * MLNAME,MLIONZ,ITIDEN,ITREDO,ITEMPE,MLNESP)
  47.       IF(IERR.NE.0)RETURN
  48. C
  49. C                 LECTURE DE LA TABLE IDEN
  50. C      TOUS LES SEGMENTS REVIENNENT ACTIFS OU AVEC UN POINTEUR NUL
  51. C
  52.       CALL CHMIDE(ITIDEN,MLCOMP,MLSOLU,MMSOLU,MLPREC,MMPREC,MLSURF,
  53.      *     MMSURF,MLTYP3,MMTYP3,MLTYP6,MMTYP6,MLPARF,MLREAC,MLIMMO,
  54.      *     MLPOLE,MMPOLE,MLSOSO,MMSOSO,LIMP3)
  55.        IF(IERR.NE.0)RETURN
  56. C
  57. C       LECTURE DU CHPOIN DES CONCENTRATIONS
  58. C
  59.       CALL LIROBJ('CHPOINT',MCHPOI,0,IRETOU)
  60.       IF(IRETOU.EQ.0)THEN
  61.       CALL ERREUR(21)
  62.       RETURN
  63.       ENDIF
  64.       SEGACT MCHPOI
  65.       NSOUPO=IPCHP(/1)
  66.       IF(NSOUPO.NE.1)THEN
  67.            CALL ERREUR(21)
  68.             RETURN
  69.       ENDIF
  70.       MSOUPO=IPCHP(1)
  71.       SEGACT MSOUPO
  72.       MELEME=IGEOC
  73.       MPOVAL=IPOVAL
  74.       NC=NOCOMP(/2)
  75.       NSOL=MLSOLU.LECT(/1)
  76.       SEGINI IZBID
  77.       DO 20 I=1,NSOL
  78.            DO 25 J=1,NC
  79.            IF(MMSOLU.MOTS(I).EQ.NOCOMP(J))THEN
  80.                IBID(I)=J
  81.                GO TO 22
  82.            ENDIF
  83.    25      CONTINUE
  84.             CALL ERREUR(21)
  85.             RETURN
  86.    22      CONTINUE
  87.    20 CONTINUE
  88.       SEGACT MPOVAL
  89.       NPN=VPOCHA(/1)
  90.  
  91. C
  92. C                         ON ACTIVE LES SEGMENTS
  93. C              ET ON DEFINIT LES TABLEAUX DE TRAVAIL
  94.       SEGACT MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLNN,MLDECY,MLNAME,MLNESP
  95.       SEGACT MLIONZ,MLIDP
  96.       NXDIM=MLIDX.LECT(/1)
  97.       NYDIM=MLIDY.LECT(/1)
  98.       NZDIM=MLIDZ.LECT(/1)
  99.       NPDIM=MLIDP.LECT(/1)
  100.       SEGINI IDSCHI
  101.       SEGINI SP2
  102. C
  103.       JGM=2
  104.       JGN=4
  105.       SEGINI MLMOTS
  106.       MOTS(1)='CATI'
  107.       MOTS(2)='ANIO'
  108.       CALL CHMCRC(MLMOTS,MELEME,NPN,MCNEUT,ICNEUT)
  109.       SEGSUP MLMOTS
  110. C
  111. C                           INITIALISATION
  112.       SEGACT MELEME
  113.  
  114. C
  115. C -------------------------------------------------------------------
  116. C                         BOUCLE SUR LES POINTS
  117. C -------------------------------------------------------------------
  118.       DO 100 II=1,NPN
  119. C                   CHARGEMENT DE IDSCHI
  120.       CALL CHMIDS(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,MLDECY,
  121.      * MLNAME,MLIONZ,IDSCHI,MLNESP)
  122. C     WRITE(6,*)' GK apres CHMIDS '
  123. C     WRITE(6,120)(GK(J),IDY(J),J=1,NYDIM)
  124.   120 FORMAT(6(1X,1PD12.5,I5))
  125. C                   CHARGEMENT DE SP2
  126.       DO 6 J=1,NXDIM
  127.             TOT(J)= 0.D0
  128.             GX(J)= 0.D0
  129.             XX(J)=0.D0
  130.             TOTAQ(J)=0.D0
  131.             TOTFIX(J)=0.D0
  132.             YY(J)=0.D0
  133.     6 CONTINUE
  134.       CALL INITD(GC,NYDIM,0.D0)
  135.       CALL INITD(CC,NYDIM,0.D0)
  136.       DO 30 I=1,NSOL
  137.            CC(I)=VPOCHA(II,IBID(I))
  138.    30 CONTINUE
  139. C
  140. C= CALCUL DES BILANS
  141. C
  142. C
  143.       TC=0.D0
  144.       TA=0.D0
  145.       L1=NN(1)+NN(2)
  146.       DO 60 I=1,L1
  147.       TW=0.D0
  148. C      IF(IDECY(I).EQ.1)GO TO 50
  149.        IF(IDECY(I).NE.0)GO TO 50
  150.       DO 51 J=1,NXDIM
  151.       TW=TW+IONZ(J)*AA(I,J)
  152. 51    CONTINUE
  153.  
  154.       IF (ABS(TW).LT.1.D-10) TW=0.D0
  155.       IF (TW.LT.0.D0) TA=TA+TW*CC(I)
  156.       IF (TW.GT.0.D0) TC=TC+TW*CC(I)
  157. 50    CONTINUE
  158. 60    CONTINUE
  159.          ICNEUT.VPOCHA(II,1)= TC
  160.          ICNEUT.VPOCHA(II,2)= TA
  161.   100 CONTINUE
  162. C   --------------------------------------------------------------
  163. C                      LE MENAGE
  164. C
  165.       SEGSUP IDSCHI
  166.       SEGSUP SP2,IZBID
  167. C
  168. C                   ON DESACTIVE LES DONNEES
  169.       SEGDES MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLNN,MLDECY,MLNAME,MLNESP
  170.        SEGDES MLIONZ,MLIDP
  171.       SEGDES MELEME
  172.        MLENTI=MLCOMP
  173.        SEGDES MLENTI
  174.        IF(MLSOSO.NE.0)THEN
  175.           MLENTI=MLSOSO
  176.           MLMOTS=MMSOSO
  177.           SEGDES MLENTI,MLMOTS
  178.        ENDIF
  179.        IF(MLPOLE.NE.0)THEN
  180.           MLENTI=MLPOLE
  181.           MLMOTS=MMPOLE
  182.           SEGDES MLENTI,MLMOTS
  183.        ENDIF
  184.        IF(MLSOLU.NE.0)THEN
  185.              MLENTI=MLSOLU
  186.              MLMOTS=MMSOLU
  187.              SEGDES MLENTI,MLMOTS
  188.        ENDIF
  189.        IF(MLPREC.NE.0)THEN
  190.              MLENTI=MLPREC
  191.              MLMOTS=MMPREC
  192.              SEGDES MLENTI,MLMOTS
  193.        ENDIF
  194.        IF(MLSURF.NE.0)THEN
  195.              MLENTI=MLSURF
  196.              MLMOTS=MMSURF
  197.              SEGDES MLENTI,MLMOTS
  198.        ENDIF
  199.        IF(MLTYP3.NE.0)THEN
  200.              MLENTI=MLTYP3
  201.              MLMOTS=MMTYP3
  202.              SEGDES MLENTI,MLMOTS
  203.        ENDIF
  204.        IF(MLTYP6.NE.0)THEN
  205.              MLENTI=MLTYP6
  206.              MLMOTS=MMTYP6
  207.              SEGDES MLENTI,MLMOTS
  208.        ENDIF
  209.        IF(MLPARF.NE.0)THEN
  210.              MLENTI=MLPARF
  211.              SEGDES MLENTI
  212.        ENDIF
  213.        IF(MLREAC.NE.0)THEN
  214.              MLENTI=MLREAC
  215.              SEGDES MLENTI
  216.        ENDIF
  217.        IF(MLIMMO.NE.0)THEN
  218.              MLENTI=MLIMMO
  219.              SEGDES MLENTI
  220.        ENDIF
  221.       SEGDES MSOUPO,MPOVAL,MCHPOI
  222. C
  223. C
  224. C                   ON SAUVE LE RESULTAT
  225.       CALL ECROBJ('CHPOINT',MCNEUT)
  226.       MSOUPO=MCNEUT.IPCHP(1)
  227.       SEGDES ICNEUT,MCNEUT,MSOUPO
  228.       RETURN
  229.       END
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  

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