obsseaice_io.h90 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270
  1. !!----------------------------------------------------------------------
  2. !! NEMO/OPA 3.3 , NEMO Consortium (2010)
  3. !! $Id: obsseaice_io.h90 2287 2010-10-18 07:53:52Z smasson $
  4. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  5. !!----------------------------------------------------------------------
  6. SUBROUTINE read_seaice( cdfilename, inpfile, kunit, ldwp, ldgrid )
  7. !!---------------------------------------------------------------------
  8. !!
  9. !! ** ROUTINE read_seaice **
  10. !!
  11. !! ** Purpose : Read from file the SEAICE observations.
  12. !!
  13. !! ** Method : The data file is a NetCDF file.
  14. !!
  15. !! ** Action :
  16. !!
  17. !! References :
  18. !!
  19. !! History :
  20. !! ! 09-01 (K. Mogensen) Original based on old versions
  21. !!----------------------------------------------------------------------
  22. !! * Arguments
  23. CHARACTER(LEN=*) :: cdfilename ! Input filename
  24. TYPE(obfbdata) :: inpfile ! Output obfbdata structure
  25. INTEGER :: kunit ! Unit for output
  26. LOGICAL :: ldwp ! Print info
  27. LOGICAL :: ldgrid ! Save grid info in data structure
  28. !! * Local declarations
  29. CHARACTER(LEN=12),PARAMETER :: cpname = 'read_seaice'
  30. INTEGER :: i_file_id ! netcdf IDS
  31. INTEGER :: i_time_id
  32. INTEGER :: i_ni_id
  33. INTEGER :: i_data_id
  34. INTEGER :: i_var_id
  35. INTEGER :: i_data ! Number of data per parameter in current file
  36. INTEGER :: i_time ! Number of reference times in file
  37. INTEGER, DIMENSION(:), POINTER :: &
  38. & i_reftime ! Reference time in file in seconds since 1/1/1981.
  39. INTEGER, DIMENSION(:,:), POINTER :: &
  40. & i_dtime, & ! Offset in seconds since reference time
  41. & i_qc, & ! Quality control flag.
  42. & i_type ! Type of seaice measurement.
  43. REAL(wp), DIMENSION(:), POINTER :: &
  44. & z_phi, & ! Latitudes
  45. & z_lam ! Longitudes
  46. REAL(wp), DIMENSION(:,:), POINTER :: &
  47. & z_seaice ! Seaice data
  48. INTEGER, PARAMETER :: imaxdim = 2 ! Assumed maximum for no. dims. in file
  49. INTEGER, DIMENSION(2) :: idims ! Dimensions in file
  50. INTEGER :: iilen ! Length of netCDF attributes
  51. INTEGER :: itype ! Typeof netCDF attributes
  52. REAL(KIND=wp) :: zsca ! Scale factor
  53. REAL(KIND=wp) :: zoff ! Offset for data in netcdf file
  54. REAL(KIND=wp) :: z_offset ! Offset for time conversion
  55. REAL(KIND=wp) :: zfill ! Fill value in netcdf file
  56. CHARACTER (len=33) ::creftime ! Reference time of file
  57. INTEGER :: i_refyear ! Integer version of reference time
  58. INTEGER :: i_refmonth
  59. INTEGER :: i_refday
  60. INTEGER :: i_refhour
  61. INTEGER :: i_refmin
  62. INTEGER :: i_refsec
  63. INTEGER :: ichunk
  64. INTEGER :: jtim
  65. INTEGER :: jobs
  66. INTEGER :: iobs
  67. CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
  68. & i_file_id, chunksize=ichunk), cpname, __LINE__ )
  69. ! Get the netCDF dimensions
  70. CALL chkerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ), &
  71. & cpname, __LINE__ )
  72. CALL chkerr( nf90_inquire_dimension( i_file_id, i_time_id, &
  73. & len = i_time ), &
  74. & cpname, __LINE__ )
  75. CALL chkerr( nf90_inq_dimid( i_file_id, 'ni', i_ni_id ), &
  76. & cpname, __LINE__ )
  77. CALL chkerr( nf90_inquire_dimension( i_file_id, i_ni_id, &
  78. & len = i_data ), &
  79. & cpname, __LINE__ )
  80. ! Allocate NetCDF variables
  81. ALLOCATE( &
  82. & i_reftime ( i_time ), &
  83. & i_dtime ( i_data,i_time ), &
  84. & i_qc ( i_data,i_time ), &
  85. & i_type ( i_data,i_time ), &
  86. & z_phi ( i_data ), &
  87. & z_lam ( i_data ), &
  88. & z_seaice ( i_data,i_time ) &
  89. & )
  90. ! Get reference time of file which is in seconds since 1981/1/1 00:00.
  91. CALL chkerr( nf90_inq_varid( i_file_id, 'time', i_var_id ), &
  92. & cpname, __LINE__ )
  93. idims(1) = i_time
  94. CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
  95. CALL chkerr( nf90_get_var ( i_file_id, i_var_id, i_reftime),&
  96. & cpname, __LINE__ )
  97. IF (nf90_inquire_attribute( i_file_id, i_var_id, "units") &
  98. & == nf90_noerr) THEN
  99. CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
  100. & "units",creftime), cpname, __LINE__ )
  101. ELSE
  102. creftime = "seconds since 1981-01-01 00:00:00"
  103. ENDIF
  104. READ(creftime(15:18),*)i_refyear
  105. READ(creftime(20:21),*)i_refmonth
  106. READ(creftime(23:24),*)i_refday
  107. READ(creftime(26:27),*)i_refhour
  108. READ(creftime(29:30),*)i_refmin
  109. READ(creftime(32:33),*)i_refsec
  110. !Work out offset in days between reference time and 1/1/1950.
  111. CALL greg2jul( i_refsec, i_refmin, i_refhour, i_refday, &
  112. & i_refmonth, i_refyear, z_offset)
  113. ! Get list of times for each ob in seconds relative to reference time
  114. CALL chkerr( nf90_inq_varid( i_file_id, 'SeaIce_dtime', i_var_id ), &
  115. & cpname, __LINE__ )
  116. idims(1) = i_data
  117. idims(2) = i_time
  118. CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
  119. CALL chkerr( nf90_get_var ( i_file_id, i_var_id, i_dtime),&
  120. & cpname, __LINE__ )
  121. zsca = 1.0
  122. IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
  123. & == nf90_noerr) THEN
  124. CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
  125. & "scale_factor",zsca), cpname, __LINE__ )
  126. ENDIF
  127. zoff = 0.0
  128. IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") &
  129. & == nf90_noerr) THEN
  130. CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
  131. & "add_offset",zoff), cpname, __LINE__ )
  132. ENDIF
  133. i_dtime(:,:) = NINT((zsca * FLOAT(i_dtime(:,:))) &
  134. & + zoff)
  135. ! Get longitudes
  136. CALL chkerr( nf90_inq_varid( i_file_id, 'lon', i_var_id ), &
  137. & cpname, __LINE__ )
  138. idims(1) = i_data
  139. CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
  140. CALL chkerr( nf90_get_var ( i_file_id, i_var_id, z_lam), &
  141. & cpname, __LINE__ )
  142. ! Get latitudes
  143. CALL chkerr( nf90_inq_varid( i_file_id, 'lat', i_var_id ), &
  144. & cpname, __LINE__ )
  145. idims(1) = i_data
  146. CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
  147. CALL chkerr( nf90_get_var ( i_file_id, i_var_id, z_phi), &
  148. & cpname, __LINE__ )
  149. ! Get seaice data
  150. CALL chkerr( nf90_inq_varid( i_file_id, 'sea_ice_concentration', &
  151. & i_var_id ), &
  152. & cpname, __LINE__ )
  153. idims(1) = i_data
  154. idims(2) = i_time
  155. CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
  156. CALL chkerr( nf90_get_var ( i_file_id, i_var_id, z_seaice), &
  157. & cpname, __LINE__ )
  158. zoff = 0.
  159. IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
  160. & == nf90_noerr) THEN
  161. CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
  162. & "scale_factor",zsca), cpname, __LINE__ )
  163. ENDIF
  164. zsca = 1.0
  165. IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
  166. & == nf90_noerr) THEN
  167. CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
  168. & "scale_factor",zsca), cpname, __LINE__ )
  169. ENDIF
  170. zfill = 0.0
  171. IF (nf90_inquire_attribute( i_file_id, i_var_id, "_FillValue") &
  172. & == nf90_noerr) THEN
  173. CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
  174. & "_FillValue",zfill), cpname, __LINE__ )
  175. ENDIF
  176. WHERE(z_seaice(:,:) /= zfill)
  177. z_seaice(:,:) = (zsca * z_seaice(:,:)) + zoff
  178. ELSEWHERE
  179. z_seaice(:,:) = fbrmdi
  180. END WHERE
  181. ! Get QC flag
  182. CALL chkerr( nf90_inq_varid( i_file_id, 'confidence_flag', i_var_id ), &
  183. & cpname, __LINE__ )
  184. idims(1) = i_data
  185. idims(2) = i_time
  186. CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
  187. CALL chkerr( nf90_get_var ( i_file_id, i_var_id, i_qc), &
  188. & cpname, __LINE__ )
  189. ! Get seaice obs type
  190. i_type(:,:)=1
  191. ! Close the file
  192. CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
  193. ! Fill the obfbdata structure
  194. ! Allocate obfbdata
  195. iobs = i_data * i_time
  196. CALL init_obfbdata( inpfile )
  197. CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
  198. inpfile%cname(1) = 'SEAICE'
  199. ! Fill the obfbdata structure from input data
  200. inpfile%cdjuldref = "19500101000000"
  201. iobs = 0
  202. DO jtim = 1, i_time
  203. DO jobs = 1, i_data
  204. iobs = iobs + 1
  205. ! Characters
  206. WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'seaice',' '
  207. WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim)
  208. ! Real values
  209. inpfile%plam(iobs) = z_lam(jobs)
  210. inpfile%pphi(iobs) = z_phi(jobs)
  211. inpfile%pob(1,iobs,1) = z_seaice(jobs,jtim)
  212. inpfile%ptim(iobs) = &
  213. & REAL(i_reftime(jtim))/(60.*60.*24.) + &
  214. & z_offset + REAL(i_dtime(jobs,jtim))/(60.*60.*24.)
  215. inpfile%pdep(1,iobs) = 0.0
  216. ! Integers
  217. inpfile%kindex(iobs) = iobs
  218. IF ( z_seaice(jobs,jtim) == fbrmdi ) THEN
  219. inpfile%ioqc(iobs) = 4
  220. inpfile%ivqc(iobs,1) = 4
  221. inpfile%ivlqc(1,iobs,1) = 4
  222. ELSE
  223. inpfile%ioqc(iobs) = i_qc(jobs,jtim)
  224. inpfile%ivqc(iobs,1) = i_qc(jobs,jtim)
  225. inpfile%ivlqc(1,iobs,1) = 1
  226. ENDIF
  227. inpfile%ipqc(iobs) = 0
  228. inpfile%ipqcf(:,iobs) = 0
  229. inpfile%itqc(iobs) = 0
  230. inpfile%itqcf(:,iobs) = 0
  231. inpfile%ivqcf(:,iobs,1) = 0
  232. inpfile%ioqcf(:,iobs) = 0
  233. inpfile%idqc(1,iobs) = 0
  234. inpfile%idqcf(1,1,iobs) = 0
  235. inpfile%ivlqcf(:,1,iobs,1) = 0
  236. END DO
  237. END DO
  238. END SUBROUTINE read_seaice