|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE READHEAD(KGLB,PGLBLATMIN,PGLBLATMAX,PGLBLONMIN,PGLBLONMAX,& 00003 KNBLAT,KNBLON,PCUTVAL,PDLAT,PDLON,PLAT,PLON,KERR) 00004 ! ################################################################ 00005 ! 00006 !!**** *READHEAD* writes the head a the local 'latlon' file. 00007 !! 00008 !! PURPOSE 00009 !! ------- 00010 !! 00011 !! METHOD 00012 !! ------ 00013 !! 00014 !! A header of a data set is of the form: 00015 !! 00016 !! 1 line of comment 00017 !! nodata: -999 00018 !! north: 90N (or S or nothing) 00019 !! south: 50N (or S or nothing) 00020 !! east: 90W (or E or nothing) 00021 !! west: 110W (or E or nothing) 00022 !! rows: 180 00023 !! cols: 60 00024 !! 00025 !! EXTERNAL 00026 !! -------- 00027 !! 00028 !! 00029 !! IMPLICIT ARGUMENTS 00030 !! ------------------ 00031 !! 00032 !! 00033 !! REFERENCE 00034 !! --------- 00035 !! 00036 !! AUTHOR 00037 !! ------ 00038 !! 00039 !! V. Masson Meteo-France 00040 !! 00041 !! MODIFICATION 00042 !! ------------ 00043 !! 00044 !! Original 29/08/95 00045 !! 00046 !---------------------------------------------------------------------------- 00047 ! 00048 !* 0. DECLARATION 00049 ! ----------- 00050 ! 00051 ! 00052 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00053 USE PARKIND1 ,ONLY : JPRB 00054 ! 00055 IMPLICIT NONE 00056 ! 00057 !* 0.1 Declaration of arguments 00058 ! ------------------------ 00059 ! 00060 INTEGER, INTENT(IN) :: KGLB ! logical unit of the file 00061 REAL, INTENT(OUT) :: PGLBLATMIN ! min latitude of the file. 00062 REAL, INTENT(OUT) :: PGLBLATMAX ! max latitude of the file. 00063 REAL, INTENT(OUT) :: PGLBLONMIN ! min longitude of the file. 00064 REAL, INTENT(OUT) :: PGLBLONMAX ! min longitude of the file. 00065 INTEGER, INTENT(OUT) :: KNBLAT ! number of latitude rows in file 00066 INTEGER, INTENT(OUT) :: KNBLON ! number of longitude rows in file 00067 REAL, INTENT(OUT) :: PCUTVAL ! special value in data file 00068 REAL, INTENT(OUT) :: PDLAT ! latitude mesh in the data file 00069 REAL, INTENT(OUT) :: PDLON ! longitude mesh in the data file 00070 REAL, DIMENSION(:), POINTER :: PLAT ! latitude of data points 00071 REAL, DIMENSION(:), POINTER :: PLON ! longitude of data points 00072 INTEGER, INTENT(OUT) :: KERR ! return code 00073 ! 00074 !* 0.2 Declaration of local variables 00075 ! ------------------------------ 00076 ! 00077 INTEGER :: JLAT ! loop control 00078 INTEGER :: JLON ! loop control 00079 INTEGER :: JHEAD ! loop control 00080 INTEGER :: ININDEX ! index of character 'N' in YSTRING1 00081 INTEGER :: ISINDEX ! index of character 'S' in YSTRING1 00082 INTEGER :: IEINDEX ! index of character 'E' in YSTRING1 00083 INTEGER :: IWINDEX ! index of character 'W' in YSTRING1 00084 REAL, DIMENSION(7) :: ZVAL ! values of the head data 00085 INTEGER :: IHEAD ! index of the data in the array ZVAL 00086 CHARACTER(LEN=100) :: YSTRING ! total string in the head 00087 CHARACTER(LEN=100) :: YSTRING1 ! string less the begining line descriptor 00088 CHARACTER(LEN=100) :: YVAL ! absolute value of the data of the line 00089 INTEGER :: IPOINT ! index of '.' in the string YVAL 00090 INTEGER :: ILENGTH ! length of the string YVAL 00091 INTEGER :: IFRACLENGTH! length of the fractional part in string YVAL 00092 CHARACTER(LEN=2) :: YLENGTH ! length of the string YVAL 00093 CHARACTER(LEN=2) :: YFRACLENGTH! length of the fractional part in string YVAL 00094 CHARACTER(LEN=10) :: YINTERNALFORMAT ! format to read YVAL in real ZVAL 00095 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00096 !------------------------------------------------------------------------------- 00097 ! 00098 IF (LHOOK) CALL DR_HOOK('READHEAD',0,ZHOOK_HANDLE) 00099 KERR=0 00100 ! 00101 !* 1. Line of comments 00102 ! ---------------- 00103 ! 00104 READ (KGLB,'(A100)',END=99) YSTRING 00105 ! 00106 !------------------------------------------------------------------------------- 00107 ! 00108 !* 2. Other lines 00109 ! ----------- 00110 ! 00111 DO JHEAD=1,7 00112 READ (KGLB,'(A100)',END=99) YSTRING 00113 YSTRING=ADJUSTL(YSTRING) 00114 ! 00115 !* 2.1 Selection of the line 00116 ! --------------------- 00117 ! 00118 SELECT CASE (YSTRING(1:5)) 00119 CASE('cutva') 00120 IHEAD=1 00121 YSTRING1=YSTRING(10:100) 00122 CASE('nodat') 00123 IHEAD=1 00124 YSTRING1=YSTRING(8:100) 00125 CASE('north') 00126 IHEAD=2 00127 YSTRING1=YSTRING(7:100) 00128 CASE('south') 00129 IHEAD=3 00130 YSTRING1=YSTRING(7:100) 00131 CASE('east:') 00132 IHEAD=4 00133 YSTRING1=YSTRING(6:100) 00134 CASE('west:') 00135 IHEAD=5 00136 YSTRING1=YSTRING(6:100) 00137 CASE('rows:') 00138 IHEAD=6 00139 YSTRING1=YSTRING(6:100) 00140 CASE('cols:') 00141 IHEAD=7 00142 YSTRING1=YSTRING(6:100) 00143 END SELECT 00144 ! 00145 !* 2.2 Test on presence of geographical descritor (N, E, S or W) 00146 ! --------------------------------------------------------- 00147 ! 00148 ININDEX=INDEX(YSTRING1,'N') 00149 ISINDEX=INDEX(YSTRING1,'S') 00150 IEINDEX=INDEX(YSTRING1,'E') 00151 IWINDEX=INDEX(YSTRING1,'W') 00152 YVAL=ADJUSTL(YSTRING1) 00153 IF (ININDEX/=0) YVAL=ADJUSTL(YSTRING1(1:ININDEX-1)) 00154 IF (ISINDEX/=0) YVAL='-'//ADJUSTL(YSTRING1(1:ISINDEX-1)) 00155 IF (IEINDEX/=0) YVAL=ADJUSTL(YSTRING1(1:IEINDEX-1)) 00156 IF (IWINDEX/=0) YVAL='-'//ADJUSTL(YSTRING1(1:IWINDEX-1)) 00157 ! 00158 !* 2.3 Transformation of the data in real 00159 ! ---------------------------------- 00160 ! 00161 IPOINT=INDEX(YVAL,'.') 00162 IF (IPOINT==0) YVAL=ADJUSTL(ADJUSTR(YVAL)//'.') 00163 ! 00164 !* 2.4 Definition of the format of the data 00165 ! ------------------------------------ 00166 ! 00167 ILENGTH=LEN_TRIM(ADJUSTL(ADJUSTR(YVAL))) 00168 IFRACLENGTH=ILENGTH-INDEX(YVAL,'.') 00169 WRITE(YLENGTH,'(I2)') ILENGTH 00170 WRITE(YFRACLENGTH,'(I2)') IFRACLENGTH 00171 YINTERNALFORMAT='(F'//YLENGTH//'.'//YFRACLENGTH//')' 00172 ! 00173 !* 2.5 Data definition 00174 ! --------------- 00175 ! 00176 READ(YVAL,ADJUSTL(YINTERNALFORMAT)) ZVAL(IHEAD) 00177 ! 00178 ENDDO 00179 ! 00180 !------------------------------------------------------------------------------- 00181 ! 00182 !* 3. Initialization of arguments, longitudes and latitudes 00183 ! ----------------------------------------------------- 00184 ! 00185 PCUTVAL=ZVAL(1) 00186 PGLBLATMAX=ZVAL(2) 00187 PGLBLATMIN=ZVAL(3) 00188 PGLBLONMIN=ZVAL(5) 00189 PGLBLONMAX=ZVAL(4)+NINT((ZVAL(5)-ZVAL(4)+180.+1.E-10)/360.)*360. 00190 KNBLAT=NINT(ZVAL(6)) 00191 KNBLON=NINT(ZVAL(7)) 00192 ! 00193 PDLAT=(PGLBLATMAX-PGLBLATMIN)/KNBLAT 00194 PDLON=(PGLBLONMAX-PGLBLONMIN)/KNBLON 00195 ALLOCATE(PLAT(KNBLAT)) 00196 ALLOCATE(PLON(KNBLON)) 00197 PLAT(:)=(/ (PGLBLATMAX-(JLAT-0.5)*PDLAT, JLAT=1,KNBLAT) /) 00198 PLON(:)=(/ (PGLBLONMIN+(JLON-0.5)*PDLON, JLON=1,KNBLON) /) 00199 ! 00200 IF (LHOOK) CALL DR_HOOK('READHEAD',1,ZHOOK_HANDLE) 00201 RETURN 00202 99 CONTINUE 00203 KERR=-1 00204 IF (LHOOK) CALL DR_HOOK('READHEAD',1,ZHOOK_HANDLE) 00205 !------------------------------------------------------------------------------- 00206 END SUBROUTINE READHEAD
1.8.0
