IOIPSL/Flincom/flinfindcood.f90

module flinfindcood_m

  implicit none

contains

  SUBROUTINE flinfindcood (fid_in, axtype, vid, ndim)

    ! This subroutine explores the file in order to find
    ! the coordinate according to a number of rules

    USE errioipsl, ONLY: histerr
    use flininfo_m, only: NCIDS, NCNBVA
    USE netcdf, ONLY: nf90_get_att, nf90_inquire_dimension, &
         nf90_inquire_variable, nf90_noerr
    USE strlowercase_m, ONLY: strlowercase

    ! ARGUMENTS

    INTEGER, intent(in):: fid_in
    integer vid, ndim
    CHARACTER(LEN=3):: axtype

    ! LOCAL

    INTEGER:: iv, iret, dimnb
    CHARACTER(LEN=40):: dimname, dimuni1, dimuni2, dimuni3
    CHARACTER(LEN=30):: str1
    LOGICAL:: found_rule = .FALSE.
    !---------------------------------------------------------------------
    vid = -1

    ! Make sure all strings are invalid

    dimname = '?-?'
    dimuni1 = '?-?'
    dimuni2 = '?-?'
    dimuni3 = '?-?'

    ! First rule: we look for the correct units
    ! lon: east
    ! lat: north
    ! We make an exact check as it would be too easy to mistake
    ! some units by just comparing the substrings.

    SELECTCASE(axtype)
    CASE ('lon')
       dimuni1 = 'degree_e'
       dimuni2 = 'degrees_e'
       found_rule = .TRUE.
    CASE('lat')
       dimuni1 = 'degree_n'
       dimuni2 = 'degrees_n'
       found_rule = .TRUE.
    CASE('lev')
       dimuni1 = 'm'
       dimuni2 = 'km'
       dimuni3 = 'hpa'
       found_rule = .TRUE.
    CASE DEFAULT
       found_rule = .FALSE.
    END SELECT

    IF (found_rule) THEN
       iv = 0
       DO WHILE ((vid < 0).AND.(iv < ncnbva(fid_in)))
          iv = iv+1
          str1 = ''
          iret = NF90_GET_ATT (ncids(fid_in), iv, 'units', str1)
          IF (iret == NF90_NOERR) THEN
             CALL strlowercase (str1)
             IF ((INDEX(str1, TRIM(dimuni1)) == 1) &
                  .OR.(INDEX(str1, TRIM(dimuni2)) == 1) &
                  .OR.(INDEX(str1, TRIM(dimuni3)) == 1)) THEN
                vid = iv
                iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, ndims=ndim)
             ENDIF
          ENDIF
       ENDDO
    ENDIF

    ! Second rule: we find specific names:
    ! lon: nav_lon
    ! lat: nav_lat
    ! Here we can check if we find the substring as the
    ! names are more specific.

    SELECTCASE(axtype)
    CASE ('lon')
       dimname = 'nav_lon lon longitude'
       found_rule = .TRUE.
    CASE('lat')
       dimname = 'nav_lat lat latitude'
       found_rule = .TRUE.
    CASE('lev')
       dimname = 'plev level depth deptht'
       found_rule = .TRUE.
    CASE DEFAULT
       found_rule = .FALSE.
    END SELECT

    IF (found_rule) THEN
       iv = 0
       DO WHILE ((vid < 0).AND.(iv < ncnbva(fid_in)))
          iv = iv+1
          str1=''
          iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
               name=str1, ndims=ndim)
          IF (INDEX(dimname, TRIM(str1)) >= 1) THEN
             vid = iv
          ENDIF
       ENDDO
    ENDIF

    ! Third rule: we find a variable with the same name as the dimension
    ! lon = 1
    ! lat = 2
    ! lev = 3

    IF (vid < 0) THEN
       SELECTCASE(axtype)
       CASE ('lon')
          dimnb = 1
          found_rule = .TRUE.
       CASE('lat')
          dimnb = 2
          found_rule = .TRUE.
       CASE('lev')
          dimnb = 3
          found_rule = .TRUE.
       CASE DEFAULT
          found_rule = .FALSE.
       END SELECT

       IF (found_rule) THEN
          iret = NF90_INQUIRE_DIMENSION (ncids(fid_in), dimnb, name=dimname)
          iv = 0
          DO WHILE ((vid < 0).AND.(iv < ncnbva(fid_in)))
             iv = iv+1
             str1=''
             iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
                  name=str1, ndims=ndim)
             IF (INDEX(dimname, TRIM(str1)) == 1) THEN
                vid = iv
             ENDIF
          ENDDO
       ENDIF
    ENDIF

    ! Stop the program if no coordinate was found

    IF (vid < 0) THEN
       CALL histerr (3, 'flinfindcood', &
            'No coordinate axis was found in the file', &
            'The data in this file can not be used', axtype)
    ENDIF

  END SUBROUTINE flinfindcood

end module flinfindcood_m
1	module flinfindcood_m
2
3	implicit none
4
5	contains
6
7	SUBROUTINE flinfindcood (fid_in, axtype, vid, ndim)
8
9	! This subroutine explores the file in order to find
10	! the coordinate according to a number of rules
11
12	USE errioipsl, ONLY: histerr
13	use flininfo_m, only: NCIDS, NCNBVA
14	USE netcdf, ONLY: nf90_get_att, nf90_inquire_dimension, &
15	nf90_inquire_variable, nf90_noerr
16	USE strlowercase_m, ONLY: strlowercase
17
18	! ARGUMENTS
19
20	INTEGER, intent(in):: fid_in
21	integer vid, ndim
22	CHARACTER(LEN=3):: axtype
23
24	! LOCAL
25
26	INTEGER:: iv, iret, dimnb
27	CHARACTER(LEN=40):: dimname, dimuni1, dimuni2, dimuni3
28	CHARACTER(LEN=30):: str1
29	LOGICAL:: found_rule = .FALSE.
30	!---------------------------------------------------------------------
31	vid = -1
32
33	! Make sure all strings are invalid
34
35	dimname = '?-?'
36	dimuni1 = '?-?'
37	dimuni2 = '?-?'
38	dimuni3 = '?-?'
39
40	! First rule: we look for the correct units
41	! lon: east
42	! lat: north
43	! We make an exact check as it would be too easy to mistake
44	! some units by just comparing the substrings.
45
46	SELECTCASE(axtype)
47	CASE ('lon')
48	dimuni1 = 'degree_e'
49	dimuni2 = 'degrees_e'
50	found_rule = .TRUE.
51	CASE('lat')
52	dimuni1 = 'degree_n'
53	dimuni2 = 'degrees_n'
54	found_rule = .TRUE.
55	CASE('lev')
56	dimuni1 = 'm'
57	dimuni2 = 'km'
58	dimuni3 = 'hpa'
59	found_rule = .TRUE.
60	CASE DEFAULT
61	found_rule = .FALSE.
62	END SELECT
63
64	IF (found_rule) THEN
65	iv = 0
66	DO WHILE ((vid < 0).AND.(iv < ncnbva(fid_in)))
67	iv = iv+1
68	str1 = ''
69	iret = NF90_GET_ATT (ncids(fid_in), iv, 'units', str1)
70	IF (iret == NF90_NOERR) THEN
71	CALL strlowercase (str1)
72	IF ((INDEX(str1, TRIM(dimuni1)) == 1) &
73	.OR.(INDEX(str1, TRIM(dimuni2)) == 1) &
74	.OR.(INDEX(str1, TRIM(dimuni3)) == 1)) THEN
75	vid = iv
76	iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, ndims=ndim)
77	ENDIF
78	ENDIF
79	ENDDO
80	ENDIF
81
82	! Second rule: we find specific names:
83	! lon: nav_lon
84	! lat: nav_lat
85	! Here we can check if we find the substring as the
86	! names are more specific.
87
88	SELECTCASE(axtype)
89	CASE ('lon')
90	dimname = 'nav_lon lon longitude'
91	found_rule = .TRUE.
92	CASE('lat')
93	dimname = 'nav_lat lat latitude'
94	found_rule = .TRUE.
95	CASE('lev')
96	dimname = 'plev level depth deptht'
97	found_rule = .TRUE.
98	CASE DEFAULT
99	found_rule = .FALSE.
100	END SELECT
101
102	IF (found_rule) THEN
103	iv = 0
104	DO WHILE ((vid < 0).AND.(iv < ncnbva(fid_in)))
105	iv = iv+1
106	str1=''
107	iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
108	name=str1, ndims=ndim)
109	IF (INDEX(dimname, TRIM(str1)) >= 1) THEN
110	vid = iv
111	ENDIF
112	ENDDO
113	ENDIF
114
115	! Third rule: we find a variable with the same name as the dimension
116	! lon = 1
117	! lat = 2
118	! lev = 3
119
120	IF (vid < 0) THEN
121	SELECTCASE(axtype)
122	CASE ('lon')
123	dimnb = 1
124	found_rule = .TRUE.
125	CASE('lat')
126	dimnb = 2
127	found_rule = .TRUE.
128	CASE('lev')
129	dimnb = 3
130	found_rule = .TRUE.
131	CASE DEFAULT
132	found_rule = .FALSE.
133	END SELECT
134
135	IF (found_rule) THEN
136	iret = NF90_INQUIRE_DIMENSION (ncids(fid_in), dimnb, name=dimname)
137	iv = 0
138	DO WHILE ((vid < 0).AND.(iv < ncnbva(fid_in)))
139	iv = iv+1
140	str1=''
141	iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
142	name=str1, ndims=ndim)
143	IF (INDEX(dimname, TRIM(str1)) == 1) THEN
144	vid = iv
145	ENDIF
146	ENDDO
147	ENDIF
148	ENDIF
149
150	! Stop the program if no coordinate was found
151
152	IF (vid < 0) THEN
153	CALL histerr (3, 'flinfindcood', &
154	'No coordinate axis was found in the file', &
155	'The data in this file can not be used', axtype)
156	ENDIF
157
158	END SUBROUTINE flinfindcood
159
160	end module flinfindcood_m