obs_read_sst.F90 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771
  1. MODULE obs_read_sst
  2. !!======================================================================
  3. !! *** MODULE obs_read_sst ***
  4. !! Observation diagnostics: Read the SST data from the GHRSST database
  5. !! or any SST data from feedback files
  6. !!======================================================================
  7. !!----------------------------------------------------------------------
  8. !! obs_rea_sst : Driver for reading SST data from the GHRSST/feedback
  9. !! obs_rea_sst_rey : Driver for reading SST data from Reynolds
  10. !!----------------------------------------------------------------------
  11. !! * Modules used
  12. USE par_kind ! Precision variables
  13. USE in_out_manager ! I/O manager
  14. USE dom_oce ! Ocean space and time domain variables
  15. USE obs_mpp ! MPP support routines for observation diagnostics
  16. USE julian ! Julian date routines
  17. USE obs_utils ! Observation operator utility functions
  18. USE obs_grid ! Grid search
  19. USE obs_sort ! Sorting observation arrays
  20. USE obs_surf_def ! Surface observation definitions
  21. USE obs_types ! Observation type definitions
  22. USE obs_sst_io ! I/O for sst files
  23. USE iom ! I/O of fields for Reynolds data
  24. USE netcdf ! NetCDF library
  25. IMPLICIT NONE
  26. !! * Routine accessibility
  27. PRIVATE
  28. PUBLIC obs_rea_sst ! Read the SST observations from the point data
  29. PUBLIC obs_rea_sst_rey ! Read the gridded Reynolds SST
  30. !!----------------------------------------------------------------------
  31. !! NEMO/OPA 3.3 , NEMO Consortium (2010)
  32. !! $Id: obs_read_sst.F90 4990 2014-12-15 16:42:49Z timgraham $
  33. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  34. !!----------------------------------------------------------------------
  35. CONTAINS
  36. SUBROUTINE obs_rea_sst( kformat, &
  37. & sstdata, knumfiles, cfilenames, &
  38. & kvars, kextr, kstp, ddobsini, ddobsend, &
  39. & ldignmis, ldmod )
  40. !!---------------------------------------------------------------------
  41. !!
  42. !! *** ROUTINE obs_rea_sst ***
  43. !!
  44. !! ** Purpose : Read from file the SST data
  45. !!
  46. !! ** Method : Depending on kformat either AVISO or
  47. !! feedback data files are read
  48. !!
  49. !! ** Action :
  50. !!
  51. !!
  52. !! History :
  53. !! ! : 2009-01 (K. Mogensen) Initial version based on old versions
  54. !!----------------------------------------------------------------------
  55. !! * Modules used
  56. !! * Arguments
  57. INTEGER :: kformat ! Format of input data
  58. ! ! 0: Feedback
  59. ! ! 1: GHRSST
  60. TYPE(obs_surf), INTENT(INOUT) :: sstdata ! SST data to be read
  61. INTEGER, INTENT(IN) :: knumfiles ! Number of corio format files to read in
  62. CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in
  63. INTEGER, INTENT(IN) :: kvars ! Number of variables in sstdata
  64. INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var in sstdata
  65. INTEGER, INTENT(IN) :: kstp ! Ocean time-step index
  66. LOGICAL, INTENT(IN) :: ldignmis ! Ignore missing files
  67. LOGICAL, INTENT(IN) :: ldmod ! Initialize model from input data
  68. REAL(KIND=dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS
  69. REAL(KIND=dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS
  70. !! * Local declarations
  71. CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_sst'
  72. INTEGER :: ji
  73. INTEGER :: jj
  74. INTEGER :: jk
  75. INTEGER :: iflag
  76. INTEGER :: inobf
  77. INTEGER :: i_file_id
  78. INTEGER :: inowin
  79. INTEGER :: iyea
  80. INTEGER :: imon
  81. INTEGER :: iday
  82. INTEGER :: ihou
  83. INTEGER :: imin
  84. INTEGER :: isec
  85. INTEGER, DIMENSION(knumfiles) :: irefdate
  86. INTEGER :: iobsmpp
  87. INTEGER, PARAMETER :: isstmaxtype = 1024
  88. INTEGER, DIMENSION(0:isstmaxtype) :: &
  89. & ityp, &
  90. & itypmpp
  91. INTEGER, DIMENSION(:), ALLOCATABLE :: &
  92. & iobsi, &
  93. & iobsj, &
  94. & iproc, &
  95. & iindx, &
  96. & ifileidx, &
  97. & isstidx
  98. INTEGER :: itype
  99. REAL(wp), DIMENSION(:), ALLOCATABLE :: &
  100. & zphi, &
  101. & zlam
  102. real(wp), DIMENSION(:), ALLOCATABLE :: &
  103. & zdat
  104. LOGICAL :: llvalprof
  105. TYPE(obfbdata), POINTER, DIMENSION(:) :: &
  106. & inpfiles
  107. real(wp), DIMENSION(knumfiles) :: &
  108. & djulini, &
  109. & djulend
  110. INTEGER :: iobs
  111. INTEGER :: iobstot
  112. INTEGER :: ios
  113. INTEGER :: ioserrcount
  114. CHARACTER(len=8) :: cl_refdate
  115. ! Local initialization
  116. iobs = 0
  117. !-----------------------------------------------------------------------
  118. ! Check data the model part is just with feedback data files
  119. !-----------------------------------------------------------------------
  120. IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
  121. CALL ctl_stop( 'Model can only be read from feedback data' )
  122. RETURN
  123. ENDIF
  124. !-----------------------------------------------------------------------
  125. ! Count the number of files needed and allocate the obfbdata type
  126. !-----------------------------------------------------------------------
  127. inobf = knumfiles
  128. ALLOCATE( inpfiles(inobf) )
  129. sst_files : DO jj = 1, inobf
  130. CALL init_obfbdata( inpfiles(jj) )
  131. !---------------------------------------------------------------------
  132. ! Prints
  133. !---------------------------------------------------------------------
  134. IF(lwp) THEN
  135. WRITE(numout,*)
  136. WRITE(numout,*) ' obs_rea_sst : Reading from file = ', &
  137. & TRIM( TRIM( cfilenames(jj) ) )
  138. WRITE(numout,*) ' ~~~~~~~~~~~'
  139. WRITE(numout,*)
  140. ENDIF
  141. !---------------------------------------------------------------------
  142. ! Initialization: Open file and get dimensions only
  143. !---------------------------------------------------------------------
  144. iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
  145. & i_file_id )
  146. IF ( iflag /= nf90_noerr ) THEN
  147. IF ( ldignmis ) THEN
  148. inpfiles(jj)%nobs = 0
  149. CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
  150. & ' not found' )
  151. ELSE
  152. CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
  153. & ' not found' )
  154. ENDIF
  155. ELSE
  156. !------------------------------------------------------------------
  157. ! Close the file since it is opened in read_proffile
  158. !------------------------------------------------------------------
  159. iflag = nf90_close( i_file_id )
  160. !------------------------------------------------------------------
  161. ! Read the profile file into inpfiles
  162. !------------------------------------------------------------------
  163. IF ( kformat == 0 ) THEN
  164. IF(lwp) THEN
  165. WRITE(numout,*)
  166. WRITE(numout,*)'Reading from feedback file :', &
  167. & TRIM( cfilenames(jj) )
  168. ENDIF
  169. CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
  170. & ldgrid = .TRUE. )
  171. IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
  172. CALL ctl_stop( 'Model not in input data' )
  173. RETURN
  174. ENDIF
  175. ELSEIF ( kformat == 1) THEN
  176. CALL read_ghrsst( TRIM( cfilenames(jj) ), inpfiles(jj), &
  177. & numout, lwp, .TRUE. )
  178. ELSE
  179. CALL ctl_stop( 'File format unknown' )
  180. ENDIF
  181. !------------------------------------------------------------------
  182. ! Change longitude (-180,180)
  183. !------------------------------------------------------------------
  184. DO ji = 1, inpfiles(jj)%nobs
  185. IF ( inpfiles(jj)%plam(ji) < -180. ) &
  186. & inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
  187. IF ( inpfiles(jj)%plam(ji) > 180. ) &
  188. & inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
  189. END DO
  190. !------------------------------------------------------------------
  191. ! Calculate the date (change eventually)
  192. !------------------------------------------------------------------
  193. cl_refdate=inpfiles(jj)%cdjuldref(1:8)
  194. READ(cl_refdate,'(I8)') irefdate(jj)
  195. CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
  196. CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
  197. & krefdate = irefdate(jj) )
  198. CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
  199. CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
  200. & krefdate = irefdate(jj) )
  201. IF ( inpfiles(jj)%nobs > 0 ) THEN
  202. inpfiles(jj)%iproc = -1
  203. inpfiles(jj)%iobsi = -1
  204. inpfiles(jj)%iobsj = -1
  205. ENDIF
  206. inowin = 0
  207. DO ji = 1, inpfiles(jj)%nobs
  208. IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. &
  209. & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
  210. inowin = inowin + 1
  211. ENDIF
  212. END DO
  213. ALLOCATE( zlam(inowin) )
  214. ALLOCATE( zphi(inowin) )
  215. ALLOCATE( iobsi(inowin) )
  216. ALLOCATE( iobsj(inowin) )
  217. ALLOCATE( iproc(inowin) )
  218. inowin = 0
  219. DO ji = 1, inpfiles(jj)%nobs
  220. IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. &
  221. & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
  222. inowin = inowin + 1
  223. zlam(inowin) = inpfiles(jj)%plam(ji)
  224. zphi(inowin) = inpfiles(jj)%pphi(ji)
  225. ENDIF
  226. END DO
  227. CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
  228. inowin = 0
  229. DO ji = 1, inpfiles(jj)%nobs
  230. IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. &
  231. & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
  232. inowin = inowin + 1
  233. inpfiles(jj)%iproc(ji,1) = iproc(inowin)
  234. inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
  235. inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
  236. ENDIF
  237. END DO
  238. DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
  239. DO ji = 1, inpfiles(jj)%nobs
  240. IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. &
  241. & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
  242. IF ( nproc == 0 ) THEN
  243. IF ( inpfiles(jj)%iproc(ji,1) > nproc ) CYCLE
  244. ELSE
  245. IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
  246. ENDIF
  247. llvalprof = .FALSE.
  248. IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
  249. & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
  250. iobs = iobs + 1
  251. ENDIF
  252. ENDIF
  253. END DO
  254. ENDIF
  255. END DO sst_files
  256. !-----------------------------------------------------------------------
  257. ! Get the time ordered indices of the input data
  258. !-----------------------------------------------------------------------
  259. !---------------------------------------------------------------------
  260. ! Loop over input data files to count total number of profiles
  261. !---------------------------------------------------------------------
  262. iobstot = 0
  263. DO jj = 1, inobf
  264. DO ji = 1, inpfiles(jj)%nobs
  265. IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. &
  266. & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
  267. iobstot = iobstot + 1
  268. ENDIF
  269. END DO
  270. END DO
  271. ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
  272. & isstidx(iobstot), zdat(iobstot) )
  273. jk = 0
  274. DO jj = 1, inobf
  275. DO ji = 1, inpfiles(jj)%nobs
  276. IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. &
  277. & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
  278. jk = jk + 1
  279. ifileidx(jk) = jj
  280. isstidx(jk) = ji
  281. zdat(jk) = inpfiles(jj)%ptim(ji)
  282. ENDIF
  283. END DO
  284. END DO
  285. CALL sort_dp_indx( iobstot, &
  286. & zdat, &
  287. & iindx )
  288. CALL obs_surf_alloc( sstdata, iobs, kvars, kextr, kstp, jpi, jpj )
  289. ! * Read obs/positions, QC, all variable and assign to sstdata
  290. iobs = 0
  291. ityp (:) = 0
  292. itypmpp(:) = 0
  293. ioserrcount = 0
  294. DO jk = 1, iobstot
  295. jj = ifileidx(iindx(jk))
  296. ji = isstidx(iindx(jk))
  297. IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. &
  298. & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
  299. IF ( nproc == 0 ) THEN
  300. IF ( inpfiles(jj)%iproc(ji,1) > nproc ) CYCLE
  301. ELSE
  302. IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
  303. ENDIF
  304. ! Set observation information
  305. IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
  306. & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
  307. iobs = iobs + 1
  308. CALL jul2greg( isec, &
  309. & imin, &
  310. & ihou, &
  311. & iday, &
  312. & imon, &
  313. & iyea, &
  314. & inpfiles(jj)%ptim(ji), &
  315. & irefdate(jj) )
  316. ! SST time coordinates
  317. sstdata%nyea(iobs) = iyea
  318. sstdata%nmon(iobs) = imon
  319. sstdata%nday(iobs) = iday
  320. sstdata%nhou(iobs) = ihou
  321. sstdata%nmin(iobs) = imin
  322. ! SST space coordinates
  323. sstdata%rlam(iobs) = inpfiles(jj)%plam(ji)
  324. sstdata%rphi(iobs) = inpfiles(jj)%pphi(ji)
  325. ! Coordinate search parameters
  326. sstdata%mi (iobs) = inpfiles(jj)%iobsi(ji,1)
  327. sstdata%mj (iobs) = inpfiles(jj)%iobsj(ji,1)
  328. ! Instrument type
  329. READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype
  330. 901 IF ( ios /= 0 ) THEN
  331. IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' )
  332. ioserrcount = ioserrcount + 1
  333. itype = 0
  334. ENDIF
  335. sstdata%ntyp(iobs) = itype
  336. IF ( itype < isstmaxtype + 1 ) THEN
  337. ityp(itype+1) = ityp(itype+1) + 1
  338. ELSE
  339. IF(lwp)WRITE(numout,*)'WARNING:Increase isstmaxtype in ',&
  340. & cpname
  341. ENDIF
  342. ! Bookkeeping data to match observations
  343. sstdata%nsidx(iobs) = iobs
  344. sstdata%nsfil(iobs) = iindx(jk)
  345. ! QC flags
  346. sstdata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)
  347. ! Observed value
  348. sstdata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)
  349. ! Model and MDT is set to fbrmdi unless read from file
  350. IF ( ldmod ) THEN
  351. sstdata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
  352. ELSE
  353. sstdata%rmod(iobs,1) = fbrmdi
  354. ENDIF
  355. ENDIF
  356. ENDIF
  357. END DO
  358. !-----------------------------------------------------------------------
  359. ! Sum up over processors
  360. !-----------------------------------------------------------------------
  361. CALL obs_mpp_sum_integer( iobs, iobsmpp )
  362. !-----------------------------------------------------------------------
  363. ! Output number of observations.
  364. !-----------------------------------------------------------------------
  365. IF (lwp) THEN
  366. WRITE(numout,*)
  367. WRITE(numout,'(1X,A)')'SST data types'
  368. WRITE(numout,'(1X,A)')'--------------'
  369. DO jj = 1,8
  370. IF ( itypmpp(jj) > 0 ) THEN
  371. WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj)
  372. ENDIF
  373. END DO
  374. WRITE(numout,'(1X,A50)')'--------------------------------------------------'
  375. WRITE(numout,'(1X,A40,I10)')'Total = ',iobsmpp
  376. WRITE(numout,*)
  377. ENDIF
  378. !-----------------------------------------------------------------------
  379. ! Deallocate temporary data
  380. !-----------------------------------------------------------------------
  381. DEALLOCATE( ifileidx, isstidx, zdat )
  382. !-----------------------------------------------------------------------
  383. ! Deallocate input data
  384. !-----------------------------------------------------------------------
  385. DO jj = 1, inobf
  386. IF ( inpfiles(jj)%lalloc ) THEN
  387. CALL dealloc_obfbdata( inpfiles(jj) )
  388. ENDIF
  389. END DO
  390. DEALLOCATE( inpfiles )
  391. END SUBROUTINE obs_rea_sst
  392. SUBROUTINE obs_rea_sst_rey( sstname, cdsstfmt, sstdata, kvars, kextra, &
  393. & kstp, ddobsini, ddobsend )
  394. !!---------------------------------------------------------------------
  395. !!
  396. !! *** ROUTINE obs_rea_sst ***
  397. !!
  398. !! ** Purpose : Read from file the pseudo SST data from Reynolds
  399. !!
  400. !! ** Method :
  401. !!
  402. !! ** Action :
  403. !!
  404. !! References :
  405. !!
  406. !! History :
  407. !! ! :
  408. !!----------------------------------------------------------------------
  409. !! * Modules used
  410. USE par_oce ! Ocean parameters
  411. !! * Arguments
  412. CHARACTER(len=128), INTENT(IN) :: sstname ! Generic file name
  413. CHARACTER(len=12), INTENT(IN) :: cdsstfmt ! Format of SST files (yearly/monthly)
  414. TYPE(obs_surf), INTENT(INOUT) :: sstdata ! SST data
  415. REAL(KIND=dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS
  416. REAL(KIND=dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS
  417. INTEGER, INTENT(IN) :: kvars ! Number of variables in sstdata structures
  418. INTEGER, INTENT(IN) :: kextra ! Number of extra variables in sstdata structures
  419. INTEGER, INTENT(IN) :: kstp ! Ocean time-step index
  420. INTEGER :: iyear
  421. INTEGER :: imon
  422. INTEGER :: iday
  423. INTEGER :: ihour
  424. INTEGER :: imin
  425. INTEGER :: isec
  426. INTEGER :: ihhmmss
  427. INTEGER :: iyear1
  428. INTEGER :: iyear2
  429. INTEGER :: imon1
  430. INTEGER :: imon2
  431. INTEGER :: iyearf
  432. INTEGER :: imonf
  433. REAL(KIND=wp) :: pjulini
  434. REAL(KIND=wp) :: pjulend
  435. REAL(KIND=wp) :: pjulb
  436. REAL(KIND=wp) :: pjule
  437. REAL(KIND=wp) :: pjul
  438. INTEGER :: inumsst
  439. INTEGER :: itotrec
  440. INTEGER :: inumobs
  441. INTEGER :: irec
  442. INTEGER :: ifld
  443. INTEGER :: inum
  444. INTEGER :: ji, jj
  445. CHARACTER(len=128) :: clname
  446. CHARACTER(len=4) :: cdyear
  447. CHARACTER(len=2) :: cdmon
  448. REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:) :: zsstin
  449. IF (lwp) WRITE(numout,*)'In obs_rea_sst_rey',sstname
  450. !-----------------------------------------------------------------------
  451. ! Convert observation window to julian dates.
  452. !-----------------------------------------------------------------------
  453. iyear1 = NINT( ddobsini / 10000 )
  454. imon1 = NINT( ( ddobsini - iyear1 * 10000 ) / 100 )
  455. iday = MOD( NINT( ddobsini ), 100 )
  456. ihhmmss = ( ddobsini - NINT( ddobsini ) ) * 1000000
  457. ihour = ihhmmss / 10000
  458. imin = ( ihhmmss - ihour * 100 ) / 100
  459. isec = MOD( ihhmmss, 100 )
  460. CALL greg2jul ( isec, imin, ihour, iday, imon1, iyear1, pjulini )
  461. IF (lwp) WRITE(numout,*)'dateini',ddobsini,iyear1,imon1,iday,ihour, &
  462. & imin,isec,pjulini
  463. iyear2 = NINT( ddobsini / 10000 )
  464. imon2 = NINT( ( ddobsend - iyear2 * 10000 ) / 100 )
  465. iday = MOD( NINT( ddobsend ), 100 )
  466. ihhmmss = ( ddobsend - NINT( ddobsend ) ) * 1000000
  467. ihour = ihhmmss / 10000
  468. imin = ( ihhmmss - ihour * 100 ) / 100
  469. isec = MOD( ihhmmss, 100 )
  470. CALL greg2jul ( isec, imin, ihour, iday, imon2, iyear2, pjulend )
  471. IF (lwp) WRITE(numout,*)'dateend',ddobsend,iyear2,imon2,iday,ihour, &
  472. & imin,isec,pjulend
  473. itotrec = NINT( pjulend - pjulini )
  474. ALLOCATE( &
  475. & zsstin( jpi, jpj, itotrec) &
  476. & )
  477. pjul = pjulini + 1
  478. iyearf = -1
  479. imonf = -1
  480. IF ( TRIM(cdsstfmt) == 'yearly' ) THEN
  481. DO
  482. CALL jul2greg( isec, imin, ihour, iday, imon, iyear, &
  483. & pjul, 19500101 )
  484. !
  485. IF ( iyear /= iyearf ) THEN
  486. CALL greg2jul ( 0, 0, 0, 1, 1, iyear, pjulb )
  487. IF ( iyearf /= -1 ) THEN
  488. CALL iom_close ( inumsst )
  489. ENDIF
  490. clname = sstname
  491. jj = INDEX( clname, 'YYYY' )
  492. IF ( jj == 0 ) THEN
  493. CALL ctl_stop( 'obs_rea_sst_rey : ', &
  494. & 'Error processing filename ' // TRIM(sstname) )
  495. ENDIF
  496. WRITE(cdyear,'(I4.4)') iyear
  497. clname(jj:jj+3) = cdyear
  498. IF(lwp) WRITE(numout,*)'Reading from Reynolds SST file : ',&
  499. & TRIM(clname)
  500. inumsst = 0
  501. CALL iom_open ( clname, inumsst )
  502. IF ( inumsst == 0 ) THEN
  503. CALL ctl_stop( 'obs_rea_sst_rey : ', &
  504. & 'Error reading ' // TRIM(clname) )
  505. ENDIF
  506. iyearf = iyear
  507. ENDIF
  508. irec = pjul - pjulb + 1
  509. ifld = pjul - pjulini
  510. CALL iom_get ( inumsst, jpdom_data, 'sst', zsstin(:,:,ifld), irec )
  511. pjul = pjul + 1
  512. IF ( pjul > pjulend ) EXIT
  513. END DO
  514. ELSEIF ( TRIM(cdsstfmt) == 'monthly' ) THEN
  515. DO
  516. CALL jul2greg( isec, imin, ihour, iday, imon, iyear, &
  517. & pjul, 19500101 )
  518. !
  519. IF ( iyear /= iyearf .OR. imon /= imonf ) THEN
  520. CALL greg2jul ( 0, 0, 0, 1, imon, iyear, pjulb )
  521. IF ( iyearf /= -1 .AND. imonf /= -1 ) THEN
  522. CALL iom_close ( inumsst )
  523. ENDIF
  524. clname = sstname
  525. jj = INDEX( clname, 'YYYY' )
  526. IF ( jj == 0 ) THEN
  527. CALL ctl_stop( 'obs_rea_sst_rey : ', &
  528. & 'Error processing filename ' // TRIM(sstname) )
  529. ENDIF
  530. WRITE(cdyear,'(I4.4)') iyear
  531. clname(jj:jj+3) = cdyear
  532. jj = INDEX( clname, 'MM' )
  533. IF ( jj == 0 ) THEN
  534. CALL ctl_stop( 'obs_rea_sst_rey : ', &
  535. & 'Error processing filename ' // TRIM(sstname) )
  536. ENDIF
  537. WRITE(cdmon,'(I2.2)') imon
  538. clname(jj:jj+1) = cdmon
  539. IF(lwp) WRITE(numout,*)'Reading from Reynolds SST file : ',&
  540. & TRIM(clname)
  541. inumsst = 0
  542. CALL iom_open ( clname, inumsst )
  543. IF ( inumsst == 0 ) THEN
  544. CALL ctl_stop( 'obs_rea_sst_rey : ', &
  545. & 'Error reading ' // TRIM(clname) )
  546. ENDIF
  547. iyearf = iyear
  548. imonf = iyear
  549. ENDIF
  550. irec = pjul - pjulb + 1
  551. ifld = pjul - pjulini
  552. CALL iom_get ( inumsst, jpdom_data, 'sst', zsstin(:,:,ifld), irec )
  553. pjul = pjul + 1
  554. IF ( pjul > pjulend ) EXIT
  555. END DO
  556. ELSE
  557. CALL ctl_stop('Unknown REYNOLDS sst input data file format')
  558. ENDIF
  559. CALL iom_close ( inumsst )
  560. inumobs = 0
  561. DO jj = nldj, nlej
  562. DO ji = nldi, nlei
  563. IF ( tmask(ji,jj,1) == 1.0_wp ) inumobs = inumobs + 1
  564. END DO
  565. END DO
  566. inumobs = inumobs * itotrec
  567. ! Allocate obs_surf data structure for time sorted data
  568. CALL obs_surf_alloc( sstdata, inumobs, kvars, kextra, kstp, jpi, jpj )
  569. pjul = pjulini + 1
  570. inumobs = 0
  571. DO
  572. CALL jul2greg( isec, imin, ihour, iday, imon, iyear, &
  573. & pjul, 19500101 )
  574. ifld = pjul - pjulini
  575. DO jj = nldj, nlej
  576. DO ji = nldi, nlei
  577. IF ( tmask(ji,jj,1) == 1.0_wp ) THEN
  578. inumobs = inumobs + 1
  579. ! Integer values
  580. IF (ln_grid_global) THEN
  581. sstdata%mi(inumobs) = MAX(mig(ji),2)
  582. sstdata%mj(inumobs) = MAX(mjg(jj),2)
  583. ELSE
  584. sstdata%mi(inumobs) = MAX(ji,2)
  585. sstdata%mj(inumobs) = MAX(jj,2)
  586. ENDIF
  587. sstdata%nsidx(inumobs) = 0
  588. sstdata%nsfil(inumobs) = 0
  589. sstdata%nyea(inumobs) = iyear
  590. sstdata%nmon(inumobs) = imon
  591. sstdata%nday(inumobs) = iday
  592. sstdata%nhou(inumobs) = ihour
  593. sstdata%nmin(inumobs) = imin
  594. sstdata%mstp(inumobs) = 0
  595. sstdata%nqc(inumobs) = 0
  596. sstdata%ntyp(inumobs) = 0
  597. ! Real values
  598. sstdata%rlam(inumobs) = glamt(ji,jj)
  599. sstdata%rphi(inumobs) = gphit(ji,jj)
  600. sstdata%robs(inumobs,1) = zsstin(ji,jj,ifld)
  601. sstdata%rmod(inumobs,1) = fbrmdi
  602. sstdata%rext(inumobs,:) = fbrmdi
  603. ENDIF
  604. END DO
  605. END DO
  606. pjul = pjul + 1
  607. IF ( pjul > pjulend ) EXIT
  608. END DO
  609. END SUBROUTINE obs_rea_sst_rey
  610. END MODULE obs_read_sst