SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
readhead.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! #########
6  SUBROUTINE readhead(KGLB,PGLBLATMIN,PGLBLATMAX,PGLBLONMIN,PGLBLONMAX,&
7  knblat,knblon,pcutval,pdlat,pdlon,plat,plon,kerr)
8 ! ################################################################
9 !
10 !!**** *READHEAD* writes the head a the local 'latlon' file.
11 !!
12 !! PURPOSE
13 !! -------
14 !!
15 !! METHOD
16 !! ------
17 !!
18 !! A header of a data set is of the form:
19 !!
20 !! 1 line of comment
21 !! nodata: -999
22 !! north: 90N (or S or nothing)
23 !! south: 50N (or S or nothing)
24 !! east: 90W (or E or nothing)
25 !! west: 110W (or E or nothing)
26 !! rows: 180
27 !! cols: 60
28 !!
29 !! EXTERNAL
30 !! --------
31 !!
32 !!
33 !! IMPLICIT ARGUMENTS
34 !! ------------------
35 !!
36 !!
37 !! REFERENCE
38 !! ---------
39 !!
40 !! AUTHOR
41 !! ------
42 !!
43 !! V. Masson Meteo-France
44 !!
45 !! MODIFICATION
46 !! ------------
47 !!
48 !! Original 29/08/95
49 !! J.Escobar 06/2013 for REAL4/8 add EPSILON management
50 !!
51 !----------------------------------------------------------------------------
52 !
53 !* 0. DECLARATION
54 ! -----------
55 !
56 !
57 USE yomhook ,ONLY : lhook, dr_hook
58 USE parkind1 ,ONLY : jprb
59 USE modd_csts ,ONLY : xsurf_epsilon
60 !
61 IMPLICIT NONE
62 !
63 !* 0.1 Declaration of arguments
64 ! ------------------------
65 !
66 INTEGER, INTENT(IN) :: kglb ! logical unit of the file
67 REAL, INTENT(OUT) :: pglblatmin ! min latitude of the file.
68 REAL, INTENT(OUT) :: pglblatmax ! max latitude of the file.
69 REAL, INTENT(OUT) :: pglblonmin ! min longitude of the file.
70 REAL, INTENT(OUT) :: pglblonmax ! min longitude of the file.
71 INTEGER, INTENT(OUT) :: knblat ! number of latitude rows in file
72 INTEGER, INTENT(OUT) :: knblon ! number of longitude rows in file
73 REAL, INTENT(OUT) :: pcutval ! special value in data file
74 REAL, INTENT(OUT) :: pdlat ! latitude mesh in the data file
75 REAL, INTENT(OUT) :: pdlon ! longitude mesh in the data file
76 REAL, DIMENSION(:), POINTER :: plat ! latitude of data points
77 REAL, DIMENSION(:), POINTER :: plon ! longitude of data points
78 INTEGER, INTENT(OUT) :: kerr ! return code
79 !
80 !* 0.2 Declaration of local variables
81 ! ------------------------------
82 !
83 INTEGER :: jlat ! loop control
84 INTEGER :: jlon ! loop control
85 INTEGER :: jhead ! loop control
86 INTEGER :: inindex ! index of character 'N' in YSTRING1
87 INTEGER :: isindex ! index of character 'S' in YSTRING1
88 INTEGER :: ieindex ! index of character 'E' in YSTRING1
89 INTEGER :: iwindex ! index of character 'W' in YSTRING1
90 REAL, DIMENSION(7) :: zval ! values of the head data
91 INTEGER :: ihead ! index of the data in the array ZVAL
92  CHARACTER(LEN=100) :: ystring ! total string in the head
93  CHARACTER(LEN=100) :: ystring1 ! string less the begining line descriptor
94  CHARACTER(LEN=100) :: yval ! absolute value of the data of the line
95 INTEGER :: ipoint ! index of '.' in the string YVAL
96 INTEGER :: ilength ! length of the string YVAL
97 INTEGER :: ifraclength! length of the fractional part in string YVAL
98  CHARACTER(LEN=2) :: ylength ! length of the string YVAL
99  CHARACTER(LEN=2) :: yfraclength! length of the fractional part in string YVAL
100  CHARACTER(LEN=10) :: yinternalformat ! format to read YVAL in real ZVAL
101 REAL(KIND=JPRB) :: zhook_handle
102 !-------------------------------------------------------------------------------
103 !
104 IF (lhook) CALL dr_hook('READHEAD',0,zhook_handle)
105 kerr=0
106 !
107 !* 1. Line of comments
108 ! ----------------
109 !
110 READ (kglb,'(A100)',end=99) ystring
111 !
112 !-------------------------------------------------------------------------------
113 !
114 !* 2. Other lines
115 ! -----------
116 !
117 DO jhead=1,7
118  READ (kglb,'(A100)',end=99) ystring
119  ystring=adjustl(ystring)
120 !
121 !* 2.1 Selection of the line
122 ! ---------------------
123 !
124  SELECT CASE (ystring(1:5))
125  CASE('cutva')
126  ihead=1
127  ystring1=ystring(10:100)
128  CASE('nodat')
129  ihead=1
130  ystring1=ystring(8:100)
131  CASE('north')
132  ihead=2
133  ystring1=ystring(7:100)
134  CASE('south')
135  ihead=3
136  ystring1=ystring(7:100)
137  CASE('east:')
138  ihead=4
139  ystring1=ystring(6:100)
140  CASE('west:')
141  ihead=5
142  ystring1=ystring(6:100)
143  CASE('rows:')
144  ihead=6
145  ystring1=ystring(6:100)
146  CASE('cols:')
147  ihead=7
148  ystring1=ystring(6:100)
149  END SELECT
150 !
151 !* 2.2 Test on presence of geographical descritor (N, E, S or W)
152 ! ---------------------------------------------------------
153 !
154  inindex=index(ystring1,'N')
155  isindex=index(ystring1,'S')
156  ieindex=index(ystring1,'E')
157  iwindex=index(ystring1,'W')
158  yval=adjustl(ystring1)
159  IF (inindex/=0) yval=adjustl(ystring1(1:inindex-1))
160  IF (isindex/=0) yval='-'//adjustl(ystring1(1:isindex-1))
161  IF (ieindex/=0) yval=adjustl(ystring1(1:ieindex-1))
162  IF (iwindex/=0) yval='-'//adjustl(ystring1(1:iwindex-1))
163 !
164 !* 2.3 Transformation of the data in real
165 ! ----------------------------------
166 !
167  ipoint=index(yval,'.')
168  IF (ipoint==0) yval=adjustl(adjustr(yval)//'.')
169 !
170 !* 2.4 Definition of the format of the data
171 ! ------------------------------------
172 !
173  ilength=len_trim(adjustl(adjustr(yval)))
174  ifraclength=ilength-index(yval,'.')
175  WRITE(ylength,'(I2)') ilength
176  WRITE(yfraclength,'(I2)') ifraclength
177  yinternalformat='(F'//ylength//'.'//yfraclength//')'
178 !
179 !* 2.5 Data definition
180 ! ---------------
181 !
182  READ(yval,adjustl(yinternalformat)) zval(ihead)
183 !
184 ENDDO
185 !
186 !-------------------------------------------------------------------------------
187 !
188 !* 3. Initialization of arguments, longitudes and latitudes
189 ! -----------------------------------------------------
190 !
191 pcutval=zval(1)
192 pglblatmax=zval(2)
193 pglblatmin=zval(3)
194 pglblonmin=zval(5)
195 pglblonmax=zval(4)+nint((zval(5)-zval(4)+180.*(1.0+xsurf_epsilon))/360.)*360.
196 knblat=nint(zval(6))
197 knblon=nint(zval(7))
198 !
199 pdlat=(pglblatmax-pglblatmin)/knblat
200 pdlon=(pglblonmax-pglblonmin)/knblon
201 ALLOCATE(plat(knblat))
202 ALLOCATE(plon(knblon))
203 plat(:)=(/ (pglblatmax-(jlat-0.5)*pdlat, jlat=1,knblat) /)
204 plon(:)=(/ (pglblonmin+(jlon-0.5)*pdlon, jlon=1,knblon) /)
205 !
206 IF (lhook) CALL dr_hook('READHEAD',1,zhook_handle)
207 RETURN
208 99 CONTINUE
209 kerr=-1
210 IF (lhook) CALL dr_hook('READHEAD',1,zhook_handle)
211 !-------------------------------------------------------------------------------
212 END SUBROUTINE readhead
readhead
subroutine readhead(KGLB, PGLBLATMIN, PGLBLATMAX, PGLBLONMIN, PGLBLONMAX, KNBLAT, KNBLON, PCUTVAL, PDLAT, PDLON, PLAT, PLON, KERR)
Definition: readhead.F90:6
modd_csts
Definition: modd_csts.F90:6
Generated on Fri May 13 2016 09:31:05 for SURFEX by   doxygen 1.8.5