1 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
2 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
3 | !----------------------------------------------------------------------- |
---|
4 | ! CVS m_Filename.F90,v 1.3 2004-04-21 22:54:44 jacob Exp |
---|
5 | ! CVS MCT_2_8_0 |
---|
6 | !BOP ------------------------------------------------------------------- |
---|
7 | ! |
---|
8 | ! !MODULE: m_Filename - Filename manipulation routines |
---|
9 | ! |
---|
10 | ! !DESCRIPTION: |
---|
11 | ! |
---|
12 | ! !INTERFACE: |
---|
13 | |
---|
14 | module m_Filename |
---|
15 | implicit none |
---|
16 | private ! except |
---|
17 | |
---|
18 | public :: Filename_base ! basename() |
---|
19 | public :: Filename_dir ! dirname() |
---|
20 | |
---|
21 | interface Filename_base; module procedure base_; end interface |
---|
22 | interface Filename_dir; module procedure dir_; end interface |
---|
23 | |
---|
24 | ! !REVISION HISTORY: |
---|
25 | ! 14Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
26 | ! - initial prototype/prolog/code |
---|
27 | !EOP ___________________________________________________________________ |
---|
28 | |
---|
29 | character(len=*),parameter :: myname='MCT(MPEU)::m_Filename' |
---|
30 | |
---|
31 | contains |
---|
32 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
33 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
34 | !BOP ------------------------------------------------------------------- |
---|
35 | ! |
---|
36 | ! !IROUTINE: base_ - basename |
---|
37 | ! |
---|
38 | ! !DESCRIPTION: |
---|
39 | ! |
---|
40 | ! !INTERFACE: |
---|
41 | |
---|
42 | function base_(cstr,sfx) |
---|
43 | implicit none |
---|
44 | character(len=*) ,intent(in) :: cstr |
---|
45 | character(len=*),optional,intent(in) :: sfx |
---|
46 | character(len=len(cstr)) :: base_ |
---|
47 | |
---|
48 | ! !REVISION HISTORY: |
---|
49 | ! 14Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
50 | ! - initial prototype/prolog/code |
---|
51 | !EOP ___________________________________________________________________ |
---|
52 | |
---|
53 | character(len=*),parameter :: myname_=myname//'::base_' |
---|
54 | integer :: l,lb,le |
---|
55 | |
---|
56 | l =index(cstr,'/',back=.true.) |
---|
57 | lb=l+1 ! correct either a '/' is in the string or not. |
---|
58 | le=len_trim(cstr) |
---|
59 | |
---|
60 | if(present(sfx)) then |
---|
61 | |
---|
62 | l=le-len_trim(sfx) |
---|
63 | if(sfx==cstr(l+1:le)) le=l |
---|
64 | |
---|
65 | endif |
---|
66 | |
---|
67 | base_=cstr(lb:le) |
---|
68 | |
---|
69 | end function base_ |
---|
70 | |
---|
71 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
72 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
73 | !BOP ------------------------------------------------------------------- |
---|
74 | ! |
---|
75 | ! !IROUTINE: dir_ - dirname |
---|
76 | ! |
---|
77 | ! !DESCRIPTION: |
---|
78 | ! |
---|
79 | ! !INTERFACE: |
---|
80 | |
---|
81 | function dir_(cstr) |
---|
82 | implicit none |
---|
83 | character(len=*),intent(in) :: cstr |
---|
84 | character(len=len(cstr)) :: dir_ |
---|
85 | |
---|
86 | ! !REVISION HISTORY: |
---|
87 | ! 14Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
88 | ! - initial prototype/prolog/code |
---|
89 | !EOP ___________________________________________________________________ |
---|
90 | |
---|
91 | character(len=*),parameter :: myname_=myname//'::dir_' |
---|
92 | integer :: l |
---|
93 | |
---|
94 | l =index(cstr,'/',back=.true.) |
---|
95 | select case(l) |
---|
96 | case(0) |
---|
97 | dir_='.' |
---|
98 | case(1) |
---|
99 | dir_='/' |
---|
100 | case default |
---|
101 | dir_=cstr(1:l-1) |
---|
102 | end select |
---|
103 | |
---|
104 | end function dir_ |
---|
105 | |
---|
106 | end module m_Filename |
---|