Numérotation des lignes :

C TRACHP    SOURCE    CB215821  19/08/20    21:22:32     10287                SUBROUTINE TRACHP(MCHPOI,MTRAV)**   MET UN CHAMP POINT SOUS FORME DE TRAVAIL*      IMPLICIT INTEGER(I-N)-INC SMCOORD -INC PPARAM-INC CCOPTIO-INC SMCHPOI-INC SMELEME-INC TMTRAV      SEGMENT ITRAV          CHARACTER*4 INC(NN)          INTEGER  IHAR(NN)      ENDSEGMENT      NN = 0      SEGACT MCHPOI**  ON ACTIVE TOUS LES SEGMENTS  MSOUPO*      DO 1 I=1,IPCHP(/1)      MSOUPO=IPCHP(I)      SEGACT MSOUPO      NN = NN + NOCOMP(/2)   1  CONTINUE**    CREATION DE ITRAV ET REMPLISSAGE*      NNNOE=0      SEGINI ITRAV      NNIN=0      DO 2 I=1,IPCHP(/1)      MSOUPO=IPCHP(I)      DO 3 J=1,NOCOMP(/2)      DO 4 K=1,NNIN      IF(INC(K).NE.NOCOMP(J)) GO TO 4      IF(IHAR(K).EQ.NOHARM(J)) GO TO 3    4 CONTINUE      NNIN=NNIN+1      INC(NNIN)=NOCOMP(J)      IHAR(NNIN)=NOHARM(J)   3  CONTINUE      MELEME=IGEOC      SEGACT MELEME      NNNOE=NNNOE+NUM(/2)   2  CONTINUE**   CREATION DE MTRAV ET REMPLISSAGE*      NDEJ=0      SEGINI MTRAV      DO 7 I=1,IPCHP(/1)      MSOUPO=IPCHP(I)      MPOVAL=IPOVAL      SEGACT MPOVAL      DO 8 J=1,NOCOMP(/2)      DO 9 K=1,NNIN      IF(NOCOMP(J).NE.INC(K)) GO TO 9      IF(NOHARM(J).EQ.IHAR(K)) GO TO 10   9  CONTINUE      CALL ERREUR (5)  10  CONTINUE      KK=K      MELEME=IGEOC      DO 11 K=1,NUM(/2)      BB(KK,K+NDEJ)=VPOCHA(K,J)      IBIN(KK,K+NDEJ)=1      IGEO(K+NDEJ)=NUM(1,K)  11  CONTINUE   8  CONTINUE      NDEJ=NDEJ+NUM(/2)   7  CONTINUE      DO 13 I=1,NNIN      INCO(I)=INC(I)      NHAR(I)=IHAR(I)  13  CONTINUE*     WRITE(6,30) (INCO(I),I=1,NNIN)*     WRITE(6,31) (NHAR(I),I=1,NNIN)*     WRITE(6,32) (( IBIN(I,J),I=1,NNIN),J=1,NNNOE)*     WRITE(6,33) (( BB(I,J),I=1,NNIN),J=1,NNNOE)*     WRITE(6,36) ( IGEO(I),I=1,NNNOE)* 36  FORMAT('  IGEO ', /,(20I4))* 30  FORMAT('  INCO ', 6A6)* 31  FORMAT('  NHAR ', 6I6)* 32  FORMAT('  IBIN  ',/,(20I4))* 33  FORMAT('  BB    ',/,(1X,6E12.5))      SEGSUP ITRAV      END

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