Télécharger la plaquette Cast3M


fr en

Télécharger chiclm.eso

Retour à la liste

Numérotation des lignes : 

chiclm

  1. C CHICLM    SOURCE    CHAT      05/01/12    21:56:55     5004
  2.       SUBROUTINE CHICLM(ICLIM,IDSCHI,IZIADR,MLENT3,LIMP3)
  3.       IMPLICIT INTEGER(I-N)
  4.         IMPLICIT REAL*8 (A-H,O-Z)
  5. C------------------------------------------------------------------
  6. C
  7. C            PRISE EN COMPTE DES CONDITIONS AUX LIMITES
  8. C     IZIADR POINTEUR DE LA LISTE DES ESPECES SIMPLES DE TYPE 3
  9. C     MLENT3 POINTEUR DE LA LISTE DES ESPECES SIMPLES A RETENIR
  10. C            (CONTENU DE CLIM.COMP3 )
  11. C     LIMP3 POINTEUR DE LA LISTE DES ESPECES IMPOSES EN 3
  12. C            (ON A BESOIN DE CETTE INFORMATION DANS CHIMI2)
  13. C
  14. C------------------------------------------------------------------
  15. -INC SMTABLE
  16. -INC SMLENTI
  17.  
  18. -INC PPARAM
  19. -INC CCOPTIO
  20.       POINTEUR MLIDEN.MLENTI
  21.       SEGMENT IDSCHI
  22.            REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  23.            INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  24.            INTEGER IDECY(NYDIM),IONZ(NXDIM)
  25.            CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  26.       ENDSEGMENT
  27.       SEGMENT IZIADR
  28.             INTEGER IADR(NCR)
  29.       ENDSEGMENT
  30.       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  31.       LOGICAL LOGRE
  32. C
  33.       NCR=0
  34.       NYDIM=IDY(/1)
  35.       NXDIM=IDX(/1)
  36.       NZDIM=IDZ(/1)
  37.       NPDIM=IDP(/1)
  38.       MTAB1=ICLIM
  39.       SEGACT MTAB1
  40.       IF(IZIADR.EQ.0) SEGINI IZIADR
  41.       NCR=IADR(/1)
  42.       LIMP3=0
  43.       NL=0
  44.       IVALI=1
  45.       XVALI=0.D0
  46.       IRETI=0
  47.       IVALR=0
  48.       XVALR=0.D0
  49.       IRETR=0
  50.       MTYPI='MOT     '
  51.       MTYPR='        '
  52.       CHARR='        '
  53.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP3',.TRUE.,
  54.      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  55.       IF(MTYPR.NE.'        ')THEN
  56.             IF(MTYPR.EQ.'LISTENTI')THEN
  57.                   MLENT1=IRETR
  58.                   SEGACT MLENT1
  59.                   LIMP3=MLENT1
  60.                   NL=MLENT1.LECT(/1)
  61.                   LTYPE=3
  62.                   DO 40 J=1,NL
  63.                         IDYT=MLENT1.LECT(J)
  64.                         II=0
  65. C        ON RECHERCHE LE TYPE INITIAL POUR LE CHANGER EN TYPE 3
  66.                         DO 20 L=1,6
  67.                               LL=L
  68.                               IF(NN(L).NE.0)THEN
  69.                                     I0=II+1
  70.                                     II=II+NN(L)
  71.                                     DO 10 I=I0,II
  72.                                     IF(IDY(I).EQ.IDYT)GO TO 30
  73.    10                               CONTINUE
  74.                               ENDIF
  75.    20                   CONTINUE
  76. C           WRITE(6,*) IDYT,' N EST PAS UNE ESPECE CONNUE '
  77.                         INTERR(1)=IDYT
  78.                         CALL ERREUR(772)
  79.                         RETURN
  80.    30                   CONTINUE
  81. C                  write(6,*)' idyt ll ltype ',IDYT,LL,LTYPE
  82.                         CALL CHIREX(IDSCHI,IDYT,LL,LTYPE)
  83.    40             CONTINUE
  84.             ELSE
  85.                   MOTERR(1:11)='CLIM TYP3  '
  86.                   MOTERR(12:20)='LISTENTI'
  87.                   CALL ERREUR(627)
  88.                   RETURN
  89.             ENDIF
  90.       ENDIF
  91.       MLENT3=0
  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='        '
  100.       CHARR='        '
  101.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'COMP3',.TRUE.,
  102.      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  103.       IF(MTYPR.NE.'        ')THEN
  104.             IF(MTYPR.EQ.'LISTENTI')THEN
  105.                   MLENT3=IRETR
  106.                   SEGACT MLENT3
  107.                   NLC=MLENT3.LECT(/1)
  108.                   IF(NLC.NE.NL)THEN
  109. C          WRITE(6,*)' COMP3 NE CORRESPOND PAS A TYP3 '
  110.                         MOTERR(1:8)='COMP3   '
  111.                         MOTERR(9:16)='TYP3    '
  112.                         CALL ERREUR(773)
  113.                         RETURN
  114.                   ENDIF
  115.                   DO 50 J=1,NLC
  116.                   IDXT= MLENT3.LECT(J)
  117.                   IDYT= MLENT1.LECT(J)
  118.                   IF(IDXT.NE.IDYT)THEN
  119.                         CALL CHIADY(IDX,NXDIM,IDXT,NDX)
  120.                         IF(NDX.EQ.0)THEN
  121. C      WRITE(6,*)  IDXT,' N EST PAS UN  COMPOSANT  DE', IDYT
  122.                               INTERR(1)=IDXT
  123.                               INTERR(2)=IDYT
  124.                               CALL ERREUR(774)
  125.                               RETURN
  126.                         ENDIF
  127.                         CALL CHIADY(IDY,NYDIM,IDYT,NDY)
  128. C                   write(6,*)' ndx ndy aa',ndx,ndy,aa(ndy,ndx)
  129.                         IF(AA(NDY,NDX).EQ.0.D0)THEN
  130. C       IDXT N EST PAS UNE COMPOSANTE DE IDYT
  131. C      WRITE(6,*)  IDXT,' N EST PAS UN COMPOSANT  DE', IDYT
  132.                               INTERR(1)=IDXT
  133.                               INTERR(2)=IDYT
  134.                               CALL ERREUR(774)
  135.                               RETURN
  136.                         ENDIF
  137.                   ELSE
  138.                         CALL CHIADY(IDX,NXDIM,IDYT,NDY)
  139.                         IF(NDY.EQ.0)THEN
  140. C       IDYT N EST PAS SIMPLE IL FAUT PRECISER LE COMPOSANT IMMOBILE
  141. C      WRITE(6,*)  IDYT,' N EST PAS SIMPLE PRECISEZ COMP3 '
  142.                               INTERR(1)=IDYT
  143.                               CALL ERREUR(775)
  144.                               RETURN
  145.                         ENDIF
  146.  
  147.                   ENDIF
  148.    50             CONTINUE
  149.                   SEGDES MLENT1
  150.             ELSE
  151.                   MOTERR(1:11)='CLIM COMP3 '
  152.                   MOTERR(12:20)='LISTENTI'
  153.                   CALL ERREUR(627)
  154.                   RETURN
  155.             ENDIF
  156.       ELSE
  157.            IF(NL.NE.0)THEN
  158.            DO 55 J=1,NL
  159.                  IDYT=MLENT1.LECT(J)
  160.                         CALL CHIADY(IDX,NXDIM,IDYT,NDY)
  161.                         IF(NDY.EQ.0)THEN
  162. C       IDYT N EST PAS SIMPLE IL FAUT PRECISER LA COMPOSANTE IMMOBILE
  163. C      WRITE(6,*)  IDYT,' N EST PAS SIMPLE PRECISEZ COMP3 '
  164.                               INTERR(1)=IDYT
  165.                               CALL ERREUR(775)
  166.                               RETURN
  167.                         ENDIF
  168.    55      CONTINUE
  169.            SEGDES MLENT1
  170.            ENDIF
  171.       ENDIF
  172.       IVALI=1
  173.       XVALI=0.D0
  174.       IRETI=0
  175.       IVALR=0
  176.       XVALR=0.D0
  177.       IRETR=0
  178.       MTYPI='MOT     '
  179.       MTYPR='        '
  180.       CHARR='        '
  181.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP6',.TRUE.,
  182.      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  183.       IF(MTYPR.NE.'        ')THEN
  184.             IF(MTYPR.EQ.'LISTENTI')THEN
  185.                   MLENT2=IRETR
  186.                   SEGACT MLENT2
  187.                   NL=MLENT2.LECT(/1)
  188.                   LTYPE=6
  189.                   DO 90 J=1,NL
  190.                         IDYT=MLENT2.LECT(J)
  191.                         II=0
  192.                         DO 70 L=1,6
  193.                               LL=L
  194.                               IF(NN(L).NE.0)THEN
  195.                                     I0=II+1
  196.                                     II=II+NN(L)
  197.                                     DO 60 I=I0,II
  198.                                     IF(IDY(I).EQ.IDYT)GO TO 80
  199.    60                               CONTINUE
  200.                               ENDIF
  201.    70                   CONTINUE
  202. C           WRITE(6,*) IDYT,' N EST PAS UNE ESPECE CONNUE '
  203.                         INTERR(1)=IDYT
  204.                         CALL ERREUR(772)
  205.                         RETURN
  206.    80                   CONTINUE
  207.                         CALL CHIREX(IDSCHI,IDYT,LL,LTYPE)
  208. C        SI IADR EXISTE ON ENLEVE IDYT DE CETTE LISTE
  209.                         IF(IZIADR.NE.0)THEN
  210.                         CALL CHIADY(IADR,NCR,IDYT,JJ)
  211.                         IF(JJ.GT.0)THEN
  212.                              NCR=NCR-1
  213.                              DO 85 KJ=JJ,NCR
  214.                                   IADR(KJ)=IADR(KJ+1)
  215.    85                        CONTINUE
  216.                              SEGADJ IZIADR
  217.                              WRITE(6,*)'chiclm type6 iziadr=',iziadr
  218.                         ENDIF
  219.                         ENDIF
  220.    90             CONTINUE
  221.                   SEGDES MLENT2
  222.             ELSE
  223.                   MOTERR(1:11)='CLIM TYP6  '
  224.                   MOTERR(12:20)='LISTENTI'
  225.                   CALL ERREUR(627)
  226.                   RETURN
  227.             ENDIF
  228.       ENDIF
  229.       IVALI=1
  230.       XVALI=0.D0
  231.       IRETI=0
  232.       IVALR=0
  233.       XVALR=0.D0
  234.       IRETR=0
  235.       MTYPI='MOT     '
  236.       MTYPR='        '
  237.       CHARR='        '
  238.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP4',.TRUE.,
  239.      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  240.       IF(MTYPR.NE.'        ')THEN
  241.             IF(MTYPR.EQ.'LISTENTI')THEN
  242.                   MLENT2=IRETR
  243.                   SEGACT MLENT2
  244.                   NL=MLENT2.LECT(/1)
  245.                   LTYPE=4
  246.                   DO 190 J=1,NL
  247.                         IDYT=MLENT2.LECT(J)
  248.                         II=0
  249.                         DO 170 L=1,6
  250.                               LL=L
  251.                               IF(NN(L).NE.0)THEN
  252.                                     I0=II+1
  253.                                     II=II+NN(L)
  254.                                     DO 160 I=I0,II
  255.                                     IF(IDY(I).EQ.IDYT)GO TO 180
  256.   160                               CONTINUE
  257.                               ENDIF
  258.   170                   CONTINUE
  259. C           WRITE(6,*) IDYT,' N EST PAS UNE ESPECE CONNUE '
  260.                         INTERR(1)=IDYT
  261.                         CALL ERREUR(772)
  262.                         RETURN
  263.   180                   CONTINUE
  264.                         CALL CHIREX(IDSCHI,IDYT,LL,LTYPE)
  265. C        SI IADR EXISTE ON ENLEVE IDYT DE CETTE LISTE
  266.                         IF(IZIADR.NE.0)THEN
  267.                         CALL CHIADY(IADR,NCR,IDYT,JJ)
  268.                         IF(JJ.GT.0)THEN
  269.                              NCR=NCR-1
  270.                              DO 185 KJ=JJ,NCR
  271.                                   IADR(KJ)=IADR(KJ+1)
  272.   185                        CONTINUE
  273.                              SEGADJ IZIADR
  274.                              write(6,*)'chiclm type4 iziadr=',iziadr
  275.                         ENDIF
  276.                         ENDIF
  277.   190             CONTINUE
  278.                   SEGDES MLENT2
  279.             ELSE
  280.                   MOTERR(1:11)='CLIM TYP4  '
  281.                   MOTERR(12:20)='LISTENTI'
  282.                   CALL ERREUR(627)
  283.                   RETURN
  284.             ENDIF
  285.       ENDIF
  286.       IVALI=1
  287.       XVALI=0.D0
  288.       IRETI=0
  289.       IVALR=0
  290.       XVALR=0.D0
  291.       IRETR=0
  292.       MTYPI='MOT     '
  293.       MTYPR='        '
  294.       CHARR='        '
  295.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP5',.TRUE.,
  296.      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  297.       IF(MTYPR.NE.'        ')THEN
  298.             IF(MTYPR.EQ.'LISTENTI')THEN
  299.                   MLENT2=IRETR
  300.                   SEGACT MLENT2
  301.                   NL=MLENT2.LECT(/1)
  302.                   LTYPE=5
  303.                   DO 290 J=1,NL
  304.                         IDYT=MLENT2.LECT(J)
  305.                         II=0
  306.                         DO 270 L=1,6
  307.                               LL=L
  308.                               IF(NN(L).NE.0)THEN
  309.                                     I0=II+1
  310.                                     II=II+NN(L)
  311.                                     DO 260 I=I0,II
  312.                                     IF(IDY(I).EQ.IDYT)GO TO 280
  313.   260                               CONTINUE
  314.                               ENDIF
  315.   270                   CONTINUE
  316. C           WRITE(6,*) IDYT,' N EST PAS UNE ESPECE CONNUE '
  317.                         INTERR(1)=IDYT
  318.                         CALL ERREUR(772)
  319.                         RETURN
  320.   280                   CONTINUE
  321.                         CALL CHIREX(IDSCHI,IDYT,LL,LTYPE)
  322. C        SI IADR EXISTE ON ENLEVE IDYT DE CETTE LISTE
  323.                         IF(IZIADR.NE.0)THEN
  324.                         CALL CHIADY(IADR,NCR,IDYT,JJ)
  325.                         IF(JJ.GT.0)THEN
  326.                              NCR=NCR-1
  327.                              DO 285 KJ=JJ,NCR
  328.                                   IADR(KJ)=IADR(KJ+1)
  329.   285                        CONTINUE
  330.                              SEGADJ IZIADR
  331.                              write(6,*)'chiclm type5 iziadr=',iziadr
  332.                         ENDIF
  333.                         ENDIF
  334.   290             CONTINUE
  335.                   SEGDES MLENT2
  336.             ELSE
  337.                   MOTERR(1:11)='CLIM TYP5  '
  338.                   MOTERR(12:20)='LISTENTI'
  339.                   CALL ERREUR(627)
  340.                   RETURN
  341.             ENDIF
  342.       ENDIF
  343.       SEGDES MTAB1
  344.       RETURN
  345.       END
  346.  
  347.  
  348.  
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  

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