source: trunk/LMDZ.GENERIC/libf/bibio/isitor.F @ 1243

Last change on this file since 1243 was 135, checked in by aslmd, 14 years ago

CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET

File size: 1.6 KB
Line 
1
2      SUBROUTINE isitor(filename,writeornot,filenum, files)
3
4C--------------------------------------------------------------------
5C Subroutine qui determine si un fichier doit etre ecrit ou non
6C--------------------------------------------------------------------
7C     ARGUMENTS
8C     +++++++++
9C     filename: CHARACTER*20
10C               nom du fichier dont on veut savoir si il doit etre ecrit
11C     writeornot: LOGICAL
12C                 Variable de sortie qui est vraie si le champ doit etre ecrit
13C     filenum: INTEGER
14C              nombre de fichier dans la list files
15C     files: CHARACTER*20 files(100)
16C            c'est la liste des fichier qui doivent etre ecrit et dans
17C            lequel on vas voir si filename y est.
18C
19
20
21      IMPLICIT NONE
22      CHARACTER*20 filename, checkname
23      CHARACTER*1 separator
24      LOGICAL writeornot, check
25      INTEGER iletter, ifile
26      INTEGER filenum
27      CHARACTER*20 files(100)
28
29      writeornot = .FALSE.
30      check = .FALSE.
31      separator = '/'
32
33      DO 6565 iletter = 20,1,-1
34
35        IF (filename(iletter:iletter) .EQ. separator) THEN
36
37          checkname = filename(iletter+1:20)
38   
39        ELSE
40        ENDIF
41 6565 CONTINUE
42
43      IF (check) THEN
44        WRITE(*,*) 'ISITORNOT:: filename=',filename,
45     &             'checkname=',checkname
46      ENDIF
47
48      DO 6767 ifile = 1,filenum
49
50      IF (files(ifile) .EQ. checkname ) THEN
51       
52      writeornot = .TRUE.
53
54      ENDIF
55
56      IF (check) THEN
57        WRITE(*,*) 'ISITORNOT:: writeornot=',writeornot
58      ENDIF
59
60 6767 CONTINUE
61
62      RETURN
63      END
64
Note: See TracBrowser for help on using the repository browser.