123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286 |
- !!----------------------------------------------------------------------
- !! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: obssst_io.h90 2287 2010-10-18 07:53:52Z smasson $
- !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
- !!----------------------------------------------------------------------
- SUBROUTINE read_ghrsst( cdfilename, inpfile, kunit, ldwp, ldgrid )
- !!---------------------------------------------------------------------
- !!
- !! ** ROUTINE read_ghrsst **
- !!
- !! ** Purpose : Read from file the GHRSST observations.
- !!
- !! ** Method : The data file is a NetCDF file.
- !!
- !! ** Action :
- !!
- !! References :
- !!
- !! History :
- !! ! 09-01 (K. Mogensen) Original based on old versions
- !!----------------------------------------------------------------------
- !! * Arguments
- CHARACTER(LEN=*) :: cdfilename ! Input filename
- TYPE(obfbdata) :: inpfile ! Output obfbdata structure
- INTEGER :: kunit ! Unit for output
- LOGICAL :: ldwp ! Print info
- LOGICAL :: ldgrid ! Save grid info in data structure
- !! * Local declarations
- CHARACTER(LEN=12),PARAMETER :: cpname
- INTEGER
- INTEGER
- INTEGER
- INTEGER
- INTEGER
- INTEGER
- INTEGER
- INTEGER, DIMENSION(:), POINTER
- & i_reftime /1/
- INTEGER, DIMENSION(:,:), POINTER
- & i_dtime, & ! Offset
- & i_qc, & ! Quality
- & i_type
- REAL(wp), DIMENSION(:), POINTER
- & z_phi, & ! Latitudes
- & z_lam
- REAL(wp), DIMENSION(:,:), POINTER
- & z_sst
- INTEGER, PARAMETER
- INTEGER, DIMENSION(2)
- INTEGER
- INTEGER
- REAL(KIND=wp) :: zsca
- REAL(KIND=wp) :: zoff
- REAL(KIND=wp) :: z_offset
- REAL(KIND=wp) :: zfill
- CHARACTER
- INTEGER
- INTEGER
- INTEGER
- INTEGER
- INTEGER
- INTEGER
- INTEGER
- INTEGER
- INTEGER
- INTEGER
- CALL
- & i_file_id, chunksize=ichunk), cpname, __LINE__
-
- ! Get
-
- CALL
- & cpname, __LINE__
- CALL
- & len
- & cpname, __LINE__
-
- CALL
- & cpname, __LINE__
- CALL
- & len
- & cpname, __LINE__
-
-
- ! Allocate
-
- ALLOCATE( &
- & i_reftime
- & i_dtime
- & i_qc
- & i_type
- & z_phi
- & z_lam
- & z_sst
- & )
-
- ! Get /1/
-
- CALL
- & cpname, __LINE__
- idims(1)
- CALL
- CALL
- & cpname, __LINE__
- IF
- & == nf90_noerr) THEN
- CALL
- & "units",creftime), cpname, __LINE__
- ELSE
- creftime
- ENDIF
- READ(creftime(15:18),*)i_refyear
- READ(creftime(20:21),*)i_refmonth
- READ(creftime(23:24),*)i_refday
- READ(creftime(26:27),*)i_refhour
- READ(creftime(29:30),*)i_refmin
- READ(creftime(32:33),*)i_refsec
- !Work /1/
- CALL
- & i_refmonth, i_refyear, z_offset)
-
- ! Get
-
- CALL
- & cpname, __LINE__
- idims(1)
- idims(2)
- CALL
- CALL
- & cpname, __LINE__
- zsca
- IF
- & == nf90_noerr) THEN
- CALL
- & "scale_factor",zsca), cpname, __LINE__
- ENDIF
- zoff
- IF
- & == nf90_noerr) THEN
- CALL
- & "add_offset",zoff), cpname, __LINE__
- ENDIF
- i_dtime(:,:) = NINT((zsca
- & + zoff)
-
- ! Get
-
- CALL
- & cpname, __LINE__
- idims(1)
- CALL
- CALL
- & cpname, __LINE__
-
- ! Get
-
- CALL
- & cpname, __LINE__
- idims(1)
- CALL
- CALL
- & cpname, __LINE__
-
- ! Get
-
- CALL
- & i_var_id
- & cpname, __LINE__
- idims(1)
- idims(2)
- CALL
- CALL
- & cpname, __LINE__
- zoff
- IF
- & == nf90_noerr) THEN
- CALL
- & "scale_factor",zsca), cpname, __LINE__
- ENDIF
- zsca
- IF
- & == nf90_noerr) THEN
- CALL
- & "scale_factor",zsca), cpname, __LINE__
- ENDIF
- zfill
- IF
- & == nf90_noerr) THEN
- CALL
- & "_FillValue",zfill), cpname, __LINE__
- ENDIF
- WHERE(z_sst(:,:) /= zfill)
- z_sst(:,:) = (zsca * z_sst(:,:)) + zoff
- ELSEWHERE
- z_sst(:,:) = fbrmdi
- END WHERE
-
- ! Get QC flag
-
- CALL chkerr( nf90_inq_varid( i_file_id, , i_var_id ), &
- & cpname, __LINE__ )
- idims(1) = i_data
- idims(2) = i_time
- CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
- CALL chkerr( nf90_get_var ( i_file_id, i_var_id, i_qc), &
- & cpname, __LINE__ )
-
- ! Get SST obs type
-
- CALL chkerr( nf90_inq_varid( i_file_id, , i_var_id ), &
- & cpname, __LINE__ )
- idims(1) = i_data
- idims(2) = i_time
- CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
- CALL chkerr( nf90_get_var ( i_file_id, i_var_id, i_type), &
- & cpname, __LINE__ )
-
- ! Close the file
-
- CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
- ! Fill the obfbdata structure
- ! Allocate obfbdata
-
- iobs = i_data * i_time
- CALL init_obfbdata( inpfile )
- CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
- inpfile%cname(1) =
- ! Fill the obfbdata structure from input data
- inpfile%cdjuldref =
- iobs = 0
- DO jtim = 1, i_time
- DO jobs = 1, i_data
- iobs = iobs + 1
- ! Characters
- WRITE(inpfile%cdwmo(iobs),) ,
- WRITE(inpfile%cdtyp(iobs),) i_type(jobs,jtim)
- ! Real values
- inpfile%plam(iobs) = z_lam(jobs)
- inpfile%pphi(iobs) = z_phi(jobs)
- inpfile%pob(1,iobs,1) = z_sst(jobs,jtim)
- inpfile%ptim(iobs) = &
- & REAL(i_reftime(jtim))/(60.*60.*24.) + &
- & z_offset /(60.*60.*24.)
- inpfile%pdep(1,iobs) = 0.0
- ! Integers
- inpfile%kindex(iobs) = iobs
- IF ( z_sst(jobs,jtim) == fbrmdi ) THEN
- inpfile%ioqc(iobs) = 4
- inpfile%ivqc(iobs,1) = 4
- inpfile%ivlqc(1,iobs,1) = 4
- ELSE
- inpfile%ioqc(iobs) = i_qc(jobs,jtim)
- inpfile%ivqc(iobs,1) = i_qc(jobs,jtim)
- inpfile%ivlqc(1,iobs,1) = 1
- ENDIF
- inpfile%ipqc(iobs) = 0
- inpfile%ipqcf(:,iobs) = 0
- inpfile%itqc(iobs) = 0
- inpfile%itqcf(:,iobs) = 0
- inpfile%ivqcf(:,iobs,1) = 0
- inpfile%ioqcf(:,iobs) = 0
- inpfile%idqc(1,iobs) = 0
- inpfile%idqcf(1,1,iobs) = 0
- inpfile%ivlqcf(:,1,iobs,1) = 0
- END DO
- END DO
- DEALLOCATE( &
- & i_reftime, &
- & i_dtime, &
- & i_qc, &
- & i_type, &
- & z_phi, &
- & z_lam, &
- & z_sst &
- & )
- END SUBROUTINE read_ghrsst
|