Numérotation des lignes :

C PRRAYE    SOURCE    CB215821  16/12/05    22:04:18     9237                 subroutine prraye      implicit real*8(a-h,o-z)      implicit integer(i-n)-INC CCOPTIO-INC SMMODEL-INC SMCHAML      segment itrav(nmod)       mchel1=0      mchel2=0      mchel3=0       call lirobj('MMODEL',mmodel,1,iretou)      if(ierr.ne.0) return       call lirobj('MCHAML',IPIN,1,iretou)      if(ierr.ne.0) return      CALL REDUAF(IPIN,mmodel,mchel1,0,IR,KER)      IF(IR   .NE. 1) CALL ERREUR(KER)      IF(IERR .NE. 0) RETURN       call lirobj('MCHAML',IPIN,1,iretou)      if(ierr.ne.0) return      CALL REDUAF(IPIN,mmodel,mchel2,0,IR,KER)      IF(IR   .NE. 1) CALL ERREUR(KER)      IF(IERR .NE. 0) RETURN       call lirobj('MCHAML',IPIN,0,iretou)      if(ierr.ne.0) return      mchel3=0      if( iretou .EQ. 1) then        CALL REDUAF(IPIN,mmodel,mchel3,0,IR,KER)        IF(IR   .NE. 1) CALL ERREUR(KER)        IF(IERR .NE. 0) RETURN         kmatr=0         call lirree(xval,0,iret)         if( iret.eq.1) then           errj= xval         else           errj=1.d-10         endif      endif       segact mmodel      nmod=kmodel(/1)      segini itrav      iresu=0      do io=1,nmod        if(itrav(io).eq.0) then          n1=nmod         imodel=kmodel(io)         segact imodel         itrav(io)=1         segini mmode2         ia=1         mmode2.kmodel(ia)=imodel         do 1 iy=io+1,kmodel(/1)            if(itrav(iy).ne.0) go to 1            imode2=kmodel(iy)            segact imode2            if(conmod.eq.imode2.conmod) then              itrav(iy)=1              ia=ia+1              mmode2.kmodel(ia)=imode2            endif    1    continue         n1=ia         if( n1.ne.mmode2.kmodel(/1)) segadj mmode2         call reduaf ( mchel1,mmode2,mche1r,1,iretr,kerre)         if( iretr.ne.1) then           call erreur (kerre)           return         endif         call reduaf ( mchel2,mmode2,mche2r,1,iretr,kerre)         if( iretr.ne.1) then           call erreur (kerre)           return         endif         mche3r=mchel3         if( mchel3.ne.0) then           call reduaf ( mchel3,mmode2,mche3r,1,iretr,kerre)           if( iretr.ne.1) then             call erreur (kerre)             return           endif         endif         call rayen(mmode2,mche1r,mche2r,mche3r,errj,ifact)         if(iresu.eq.0) then           iresu=ifact         else           call fuschl(iresu,ifact,ires)           iresu=ires         endif        endif      enddo      segsup itrav       if( iresu.ne.0)call ecrobj('MCHAML',iresu)      return      end

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