Numérotation des lignes :

chiesp
C CHIESP    SOURCE    CHAT      05/01/12    21:57:16     5004      SUBROUTINE CHIESP(NVESP,IDSCHI)      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)C------------------------------------------------------------------CC     PRISE EN COMPTE DE NOUVELLES ESPECESCC-------------------------------------------------------------------INC SMTABLE-INC SMLENTI-INC SMLREEL -INC PPARAM-INC CCOPTIO      POINTEUR MLIDEN.MLENTI      SEGMENT IDSCHI        REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)        INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)        INTEGER IDECY(NYDIM),IONZ(NXDIM)        CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)      ENDSEGMENT      CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR      CHARACTER*32 CHARM      LOGICAL LOGRE      INTEGER LINITC      NYDIM=IDY(/1)      NXDIM=IDX(/1)      NZDIM=IDZ(/1)      NPDIM=IDP(/1)      MTAB1=NVESP      SEGACT MTAB1      NNESP= MTAB1.MLOTABC     WRITE(6,*)'CHIESP',NNESP      NBIESP=NNESP         IVALI=0         XVALI=0.D0         IRETI=0         IVALR=0         XVALR=0.D0         IRETR=0         MTYPI='MOT     '         MTYPR='        '         CHARR='        '         CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'CLASSE',.TRUE.,IRETI,     *        MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)         IF(IERR.NE.0)RETURN         SEGACT MTAB1         IF(MTYPR.EQ.'MOT     ')THENC   on a trouvé CLASSE c'est un objet on va compter les indices entier         NBIESP= 0      DO 5 IESP=1,NNESPC     write(6,*)' chiesp',mtabti(iesp),mtabtv(iesp),RMTABI(iesp),C    * MTABII(iesp),MTABIV(iesp),RMTABV(iesp)      IF((MTAB1.MTABTI(IESP)).EQ.'ENTIER') NBIESP= NBIESP+1    5 CONTINUE       ENDIF      DO 80 IESP=1,NBIESP         IVALI=IESP         XVALI=0.D0         IRETI=0         IVALR=0         XVALR=0.D0         IRETR=0         MTYPI='ENTIER  '         MTYPR='        '         CHARR='        '         CHARI='        '         CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,CHARI,.TRUE.,IRETI,     *        MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)         IF(IERR.NE.0)RETURN         SEGACT MTAB1         IF((MTYPR.EQ.'TABLE   ').OR.(MTYPR.EQ.'OBJET   '))THEN         MTAB2=IRETR         SEGACT MTAB2         IVALI=1         XVALI=0.D0         IRETI=0         IVALR=0         XVALR=0.D0         IRETR=0         MTYPI='MOT     '         MTYPR='ENTIER  '         CHARR='        '         CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDEN',.TRUE.,IRETI,     *        MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)         IF(IERR.NE.0)RETURN         SEGACT MTAB1         IDESP=IVALR         IVALI=1         XVALI=0.D0         IRETI=0         IVALR=0         XVALR=0.D0         IRETR=0         MTYPI='MOT     '         MTYPR='FLOTTANT'         CHARR='        '         CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'LOGK',.TRUE.,IRETI,     *        MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)         IF(IERR.NE.0)RETURN         SEGACT MTAB1         GKESP=XVALR         IVALI=1         XVALI=0.D0         IRETI=0         IVALR=0         XVALR=0.D0         IRETR=0         MTYPI='MOT     '         MTYPR='        '         CHARR='        '         CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'COMP',.TRUE.,     *        IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)         SEGACT MTAB1         IF(MTYPR.EQ.'        ')THEN            CALL CHIADY(IDY,NYDIM,IDESP,K)            IF(K.EQ.0) THENC     WRITE(6,*)' MODIF LOGK DE L ESPECE ',IDESP,' IMPOSSIBLE'C     WRITE(6,*)' CETTE ESPECE N A PAS ÉTÉ RETENUE  '               MOTERR(1:40)='********** NVESP . LOGK                 '               CALL ERREUR(-301)               INTERR(1)=IDESP               CALL ERREUR(776)               RETURN            ENDIF            GK(K)=GKESP         ELSEIF(MTYPR.EQ.'LISTENTI')THEN            MLENTI=IRETR            SEGACT MLENTI            CALL CHIADY(IDY,NYDIM,IDESP,K)            IF(K.NE.0) THENC     WRITE(6,*)' L ESPECE ',IDESP,' EXISTE DEJA '               INTERR(1)=IDESP               CALL ERREUR(777)               RETURN            ENDIF            IVALI=1            XVALI=0.D0            IRETI=0            IVALR=0            XVALR=0.D0            IRETR=0            MTYPI='MOT     '            MTYPR='ENTIER  '            CHARR='        '            CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'ITYP',.TRUE.,IRETI,     *           MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)            IF(IERR.NE.0)RETURN         SEGACT MTAB1            ITJP=IVALR            IVALI=1            XVALI=0.D0            IRETI=0            IVALR=0            XVALR=0.D0            IRETR=0            MTYPI='MOT     '            MTYPR='LISTREEL'            CHARR='        '            CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'STOECH',.TRUE.,     *           IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)            IF(IERR.NE.0)RETURN         SEGACT MTAB1            MLREEL=IRETR            SEGACT MLREEL         IVALI=1         XVALI=0.D0         IRETI=0         IVALR=0         XVALR=0.D0         IRETR=0         MTYPI='MOT     '         MTYPR='        '         CHARM='                                '         CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMESPECE',.TRUE.,IRETI,     *        MTYPR,IVALR,XVALR,CHARM,LOGRE,IRETR)         IF(IERR.NE.0)RETURN         SEGACT MTAB1CC     ON TRAITECC     WRITE(6,*)'CHIESP ',IDESP,ITJP,GKESP,MLENTI,MLREEL            LB=LECT(/1)            LC=PROG(/1)            IF(LB.NE.LC)THEN               MOTERR(1:40)='********** NVESP . STOECH               '               CALL ERREUR(-301)               CALL ERREUR(21)               RETURN            ENDIF***   VERIF COMPOSITION            DO 20 L=1,LB               IF(LECT(L).NE.0) THEN                  IDCK = LECT(L)                  CALL CHIADY(IDX,NXDIM,IDCK,K)                  IF(K.EQ.0) THENC     WRITE(6,*)' LE COMPOSANT ',IDCK,' N A PAS ÉTÉ RETENU'C     WRITE(6,*)' LE COMPLEXE ',IDESP,' NE PEUT ETRE FORMÉ '                     MOTERR(1:40)='************ NVESP . COMP         '                     CALL ERREUR(-301)                     INTERR(1)=IDCK                     CALL ERREUR(776)                     RETURN                  ENDIF               ELSE                  GOTO 30               ENDIF 20         CONTINUE***   INSERTION 30         CONTINUE            NN(6)=NN(6)+1            NYDIM=NYDIM+1            SEGADJ IDSCHI            IDY(NYDIM)=IDESP            DO 40 IX=1,LB               IF(LECT(IX).EQ.0) GO TO 50               IDCK = LECT(IX)               CALL CHIADY(IDX,NXDIM,IDCK,IK)               AA(NYDIM,IK)=PROG(IX)               GK(NYDIM)  =GKESP               NAMESP(NYDIM)=CHARM 40         CONTINUE 50         CONTINUE*     WRITE(6,*)' IDJP ',IDJP,' ITJP ',ITJP            LINIT=6            CALL CHIREX(IDSCHI,IDESP,LINIT,ITJP )            IF(ITJP.NE.2)THEN               NPDIM=NPDIM+1               SEGADJ IDSCHI               IDP(NPDIM)=IDESP            ENDIF            SEGDES MLENTI,MLREEL         ELSE            MOTERR(1:11)='COMP       '            MOTERR(12:20)='LISTENTI'            CALL ERREUR(627)            RETURN         ENDIF         SEGDES MTAB2      ELSE        MOTERR(1:40)='********         NVESP     ???????????  '        CALL ERREUR(-301)      CALL ERREUR(21)      RETURN      ENDIF 80   CONTINUE      SEGDES MTAB1*     WRITE(6,*)'IDX',(IDX(I),I=1,NXDIM)*     WRITE(6,*)'IDY',(IDY(I),I=1,NYDIM)*     write(6,*)'chiesp IDP',(idp(i),i=1,npdim)C     WRITE(6,*)'GK',(GK(I),I=1,NYDIM)C     WRITE(6,110)((AA(I,J),I=1,NYDIM),J=1,NXDIM) 110  FORMAT( 2X ,'AA',(10(1PE10.3)))        RETURN      END         

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