1 : C SUTRAV SOURCE GOUNAND 05/12/21 21:37:00 5281 2 : SUBROUTINE SUTRAV(TATRAV,IMPR,IRET) 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : SUTRAV 7 : C DESCRIPTION : Supprimme l' objet TATRAV de l'include SMPOUET 8 : C 9 : C 10 : C 11 : C LANGAGE : ESOPE 12 : C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 13 : C mél : gounand@semt2.smts.cea.fr 14 : C*********************************************************************** 15 : C APPELES : 16 : C APPELES (E/S) : 17 : C APPELES (BLAS) : 18 : C APPELES (CALCUL) : 19 : C APPELE PAR : 20 : C*********************************************************************** 21 : C SYNTAXE GIBIANE : 22 : C ENTREES : 23 : C ENTREES/SORTIES : 24 : C SORTIES : 25 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 26 : C*********************************************************************** 27 : C VERSION : v1, 15/12/2005, version initiale 28 : C HISTORIQUE : 29 : C HISTORIQUE : 30 : C*********************************************************************** 31 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 32 : C en cas de modification de ce sous-programme afin de faciliter 33 : C la maintenance ! 34 : C*********************************************************************** 35 : -INC CCOPTIO 36 : * Segments à moi 37 : CBEGININCLUDE SMPOUET 38 : SEGMENT TABGEO 39 : CHARACTER*4 DISGEO 40 : POINTEUR IGEO.MCHAEL 41 : ENDSEGMENT 42 : SEGMENT TABVDC 43 : INTEGER VVARPR(NUMVPR) 44 : INTEGER VVARDU(NUMVDU) 45 : INTEGER VDATPR(NUMDPR) 46 : INTEGER VDATDU(NUMDDU) 47 : INTEGER VCOFPR(NUMCPR) 48 : INTEGER VCOFDU(NUMCDU) 49 : INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR) 50 : INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU) 51 : POINTEUR VLCOF(JLCOF).MLENTI 52 : POINTEUR VCOMP(JGCOF).COMP 53 : POINTEUR VLDAT(JGCOF).MLENTI 54 : INTEGER DJSVD(JGVD) 55 : POINTEUR NOMVD(JGVD).MLMOTS 56 : POINTEUR MVD(JGVD).MCHPOI 57 : REAL*8 XVD(JGVD) 58 : CHARACTER*4 DISVD(KGVD) 59 : ENDSEGMENT 60 : SEGMENT TATRAV 61 : POINTEUR VVCOF(JLCOF).MCHEVA 62 : POINTEUR VCOF(JGCOF).MCHEVA 63 : POINTEUR IVD(JGVD).MCHAEL 64 : POINTEUR VD(JGVD).MCHEVA 65 : POINTEUR DVD(JGVD).MCHEVA 66 : POINTEUR FFVD(KGVD).MCHEVA 67 : POINTEUR DFFVD(KGVD).MCHEVA 68 : LOGICAL LVCOF(JGCOF) 69 : LOGICAL LVD(JGVD) 70 : LOGICAL LDVD(JGVD) 71 : LOGICAL LFFVD(KGVD) 72 : LOGICAL LDFFVD(KGVD) 73 : ENDSEGMENT 74 : SEGMENT TABMAT 75 : POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL 76 : ENDSEGMENT 77 : CENDINCLUDE SMPOUET 78 : CBEGININCLUDE SMCHAEL 79 : SEGMENT MCHAEL 80 : POINTEUR IMACHE(N1).MELEME 81 : POINTEUR ICHEVA(N1).MCHEVA 82 : ENDSEGMENT 83 : SEGMENT MCHEVA 84 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) 85 : ENDSEGMENT 86 : SEGMENT LCHEVA 87 : POINTEUR LISCHE(NBCHE).MCHEVA 88 : ENDSEGMENT 89 : CENDINCLUDE SMCHAEL 90 : POINTEUR MYMCHA.MCHAEL 91 : * 92 : INTEGER IMPR,IRET 93 : * 94 : * Executable statements 95 : * 96 : IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans sutrav.eso' 97 : * Destruction de TATRAV 98 : IF (TATRAV.NE.0) THEN 99 : SEGACT TATRAV*MOD 100 : JGVD=TATRAV.IVD(/1) 101 : DO IJVD=1,JGVD 102 : MYMCHA=TATRAV.IVD(IJVD) 102 : CALL SUCAEL(MYMCHA,IMPR,IRET) 103 : IF (IRET.NE.0) GOTO 9999 104 : ENDDO 105 : SEGSUP TATRAV 106 : ENDIF 107 : * 108 : * Normal termination 109 : * 110 : IRET=0 111 : RETURN 112 : * 113 : * Format handling 114 : * 115 : * 116 : * Error handling 117 : * 118 : 9999 CONTINUE 119 : IRET=1 120 : WRITE(IOIMP,*) 'An error was detected in subroutine sutrav' 121 : RETURN 122 : * 123 : * End of subroutine SUTRAV 124 : * 125 : END 126 : 127 :
© Cast3M 2003 - All rights reserved.
Disclaimer