ecearth3/sources/nemo-3.6/NEMO/OPA_SRC/OBS/obsvel_io.h90

   !!----------------------------------------------------------------------
   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
   !! $Id: obsvel_io.h90 2287 2010-10-18 07:53:52Z smasson $
   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
   !!----------------------------------------------------------------------

   SUBROUTINE read_taondbc( cdfilename, inpfile, kunit, ldwp, ldgrid )
      !!---------------------------------------------------------------------
      !!
      !!                     ** ROUTINE read_enactfile **
      !!
      !! ** Purpose : Read from file the TAO data fro NDBC.
      !!
      !! ** Method  : The data file is a NetCDF file. 
      !!
      !! ** Action  :
      !!
      !! ** Reference : http://tao.noaa.gov/tao/data_deliv/deliv_ndbc.shtml
      !! History : 
      !!          ! 09-01 (K. Mogensen) Original version.
      !!----------------------------------------------------------------------
      !! * 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
      INTEGER :: iobs                ! Number of observations
      INTEGER :: ilev                ! Number of levels
      INTEGER :: ilat                ! Number of latitudes
      INTEGER :: ilon                ! Number of longtudes
      INTEGER :: itim                ! Number of obs. times
      INTEGER :: i_file_id
      INTEGER :: i_dimid_id
      INTEGER :: i_phi_id
      INTEGER :: i_lam_id
      INTEGER :: i_depth_id
      INTEGER :: i_var_id
      INTEGER :: i_time_id
      INTEGER :: i_time2_id
      INTEGER :: i_qc_var_id
      CHARACTER(LEN=40) :: cl_fld_lam
      CHARACTER(LEN=40) :: cl_fld_phi
      CHARACTER(LEN=40) :: cl_fld_depth
      CHARACTER(LEN=40) :: cl_fld_var_u
      CHARACTER(LEN=40) :: cl_fld_var_v
      CHARACTER(LEN=40) :: cl_fld_var_qc_uv1
      CHARACTER(LEN=40) :: cl_fld_var_qc_uv2
      CHARACTER(LEN=40) :: cl_fld_time
      CHARACTER(LEN=40) :: cl_fld_time2
      INTEGER :: ja
      INTEGER :: jo
      INTEGER :: jk
      INTEGER :: jt
      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: &
         & zv,     &
         & zu,     &
         & zuv1qc, &
         & zuv2qc
      REAL(wp), ALLOCATABLE, DIMENSION(:) :: &
         & zdep, &
         & zlat, &
         & zlon, &
         & zjuld
      REAL(wp) :: zl
      INTEGER, ALLOCATABLE, DIMENSION(:) :: &
         & itime, &
         & itime2
      CHARACTER(LEN=50) :: cdjulref
      CHARACTER(LEN=12), PARAMETER :: cl_name = 'read_taondbc'
      CHARACTER(len=1) :: cns, cew

      !-----------------------------------------------------------------------
      ! Initialization
      !-----------------------------------------------------------------------
      cl_fld_lam                 = 'lon'
      cl_fld_phi                 = 'lat'
      cl_fld_depth               = 'depth'
      cl_fld_time                = 'time'
      cl_fld_time2               = 'time2'

      !-----------------------------------------------------------------------
      ! Open file
      !-----------------------------------------------------------------------

      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
            &      i_file_id ),           cl_name, __LINE__ )

      !-----------------------------------------------------------------------
      ! Read the heading of the file
      !-----------------------------------------------------------------------
      IF(ldwp) WRITE(kunit,*)
      IF(ldwp) WRITE(kunit,*) ' read_taondbc :' 
      IF(ldwp) WRITE(kunit,*) ' ~~~~~~~~~~~~'
      
      !---------------------------------------------------------------------
      ! Read the number of observations and of levels to allocate array
      !---------------------------------------------------------------------
      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'time', i_dimid_id ),        &
         &         cl_name, __LINE__ )
      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = itim ),    &
         &         cl_name, __LINE__ )
      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'depth', i_dimid_id ),       &
         &         cl_name, __LINE__ )
      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilev ),    &
         &         cl_name, __LINE__ )
      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'lat', i_dimid_id ),           &
         &         cl_name, __LINE__ )
      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilat ),    &
         &         cl_name, __LINE__ )
      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'lon', i_dimid_id ),         &
         &         cl_name, __LINE__ )
      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilon ),    &
         &         cl_name, __LINE__ ) 

      iobs = itim * ilat * ilon
      IF(ldwp)WRITE(kunit,*) '         No. of data records = ', iobs
      IF(ldwp)WRITE(kunit,*) '         No. of levels       = ', ilev
      IF(ldwp)WRITE(kunit,*) 

      !---------------------------------------------------------------------
      ! Allocate arrays
      !---------------------------------------------------------------------

      CALL init_obfbdata( inpfile )
      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 0, ldgrid )
      inpfile%cname(1) = 'UVEL'
      inpfile%cname(2) = 'VVEL'
      inpfile%coblong(1) = 'Zonal current'
      inpfile%coblong(2) = 'Meridional current'
      inpfile%cobunit(1) = 'Meters per second'
      inpfile%cobunit(2) = 'Meters per second'

      ALLOCATE( &
         & zu(ilon,ilat,ilev,itim),     &
         & zv(ilon,ilat,ilev,itim),     &
         & zdep(ilev),                  &
         & zuv1qc(ilon,ilat,ilev,itim), &
         & zuv2qc(ilon,ilat,ilev,itim), &
         & itime(itim),                 &
         & itime2(itim),                &
         & zlat(ilat),                  &
         & zlon(ilon),                  &
         & zjuld(itim)                  &
         & )

      !---------------------------------------------------------------------
      ! Read the time/position variables 
      !---------------------------------------------------------------------
      
      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_time, i_time_id ),                               &
         &         cl_name, __LINE__ )
      CALL chkerr( nf90_get_var  ( i_file_id, i_time_id, itime ),                                     &
         &         cl_name, __LINE__ )

      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_time2, i_time2_id ),                             &
         &         cl_name, __LINE__ )
      CALL chkerr( nf90_get_var  ( i_file_id, i_time2_id, itime2 ),                                   &
         &         cl_name, __LINE__ )
      
      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ),                             &
            &         cl_name, __LINE__ )         
      CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, zdep ),                                     &
         &         cl_name, __LINE__ )
      
      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
         &         cl_name, __LINE__ )
      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, zlat ),                                       &
         &         cl_name, __LINE__ )
      
      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
         &         cl_name, __LINE__ )
      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, zlon ),                                       &
         &         cl_name, __LINE__ )
      
      !---------------------------------------------------------------------
      ! Read the variables
      !---------------------------------------------------------------------

      ! ADCP format assumed
      cl_fld_var_u = 'u_1205'
      IF ( nf90_inq_varid( i_file_id, cl_fld_var_u, i_var_id ) /= nf90_noerr ) THEN
         ! Try again with current meter format
         cl_fld_var_u = 'U_320'
         IF ( nf90_inq_varid( i_file_id, cl_fld_var_u, i_var_id ) /= nf90_noerr ) THEN
            CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
         ENDIF
      ENDIF
      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zu ),                                         &
         &         cl_name, __LINE__ )
      
      ! ADCP format assumed
      cl_fld_var_v = 'v_1206'
      IF ( nf90_inq_varid( i_file_id, cl_fld_var_v, i_var_id ) /= nf90_noerr ) THEN
         ! Try again with current meter format
         cl_fld_var_v = 'V_321'
         IF ( nf90_inq_varid( i_file_id, cl_fld_var_v, i_var_id ) /= nf90_noerr ) THEN
            CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
         ENDIF
      ENDIF
      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zv ),                                         &
         &         cl_name, __LINE__ )

      !---------------------------------------------------------------------
      ! Read the QC attributes
      !---------------------------------------------------------------------
      
      ! ADCP format assumed
      cl_fld_var_qc_uv1 = 'QU_5205'
      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
         ! Try again with current meter format
         cl_fld_var_qc_uv1 = 'QCS_5300'
         IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
            ! Try again with high freq. current meter format
            cl_fld_var_qc_uv1 = 'QCU_5320'
            IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
               CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
            ENDIF
         ENDIF
      ENDIF
      CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, zuv1qc),                                   &
         &         cl_name, __LINE__ )

      ! ADCP format assumed
      cl_fld_var_qc_uv2 = 'QV_5206'
      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
         ! Try again with current meter format
         cl_fld_var_qc_uv2 = 'QCD_5310'
         IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
            ! Try again with high freq. current meter format
            cl_fld_var_qc_uv2 = 'QCV_5321'
            IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
               CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
            ENDIF
         ENDIF
      ENDIF
      CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, zuv2qc),                                   &
         &         cl_name, __LINE__ )

      !---------------------------------------------------------------------
      ! Close file
      !---------------------------------------------------------------------

      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )

      !---------------------------------------------------------------------
      ! Convert to to 19500101 based Julian date
      !---------------------------------------------------------------------
      DO jt = 1, itim
         zjuld(jt) = REAL(itime(jt),wp) + REAL(itime2(jt),wp)/86400000.0_wp &
            &           - 2433283.0_wp
      END DO
      inpfile%cdjuldref = '19500101000000'

      !---------------------------------------------------------------------
      ! Copy info to obfbdata structure
      !---------------------------------------------------------------------

      iobs = 0
      DO jt = 1, itim
         DO ja = 1, ilat
            DO jo = 1, ilon
               iobs = iobs + 1
               zl = zlon(jo)
               IF ( zl > 180.0_wp ) zl = zl - 360.0_wp
               IF ( zl < 0 ) THEN
                  cew = 'w'
               ELSE
                  cew = 'e'
               ENDIF
               IF ( zlat(jo) < 0 ) THEN
                  cns = 's'
               ELSE
                  cns = 'n'
               ENDIF
               WRITE(inpfile%cdwmo(iobs),'(A1,I2.2,A1,I3.3)') &
                  & cns, ABS(NINT(zlat(ja))), cew, ABS(NINT(zl))
               DO jk = 1, ilev
                  inpfile%pob(jk,iobs,1)     = zu(jo,ja,jk,jt)
                  inpfile%pob(jk,iobs,2)     = zv(jo,ja,jk,jt)
                  inpfile%pdep(jk,iobs)      = zdep(jk)
                  inpfile%ivlqc(jk,iobs,1:2) = INT( MAX( zuv1qc(jo,ja,jk,jt), zuv2qc(jo,ja,jk,jt) ) )
               END DO
               inpfile%plam(iobs) = zlon(jo)
               inpfile%pphi(iobs) = zlat(ja)
               inpfile%ptim(iobs) = zjuld(jt)
            END DO
         END DO
      END DO

      ! No position, time, depth and variable QC in input files
      DO jo = 1, iobs
         inpfile%ipqc(jo) = 1
         inpfile%itqc(jo) = 1
         inpfile%ivqc(jo,1:2) = 1
         DO jk = 1, ilev
            inpfile%idqc(jk,jo) = 1
         END DO
      END DO

      !---------------------------------------------------------------------
      ! Set the platform information
      !---------------------------------------------------------------------
      inpfile%cdtyp(:)=' 820'

      !---------------------------------------------------------------------
      ! Set QC flags for missing data and rescale to m/s
      !---------------------------------------------------------------------

      DO jo = 1, iobs
         DO jk = 1, ilev
            IF ( ( ABS(inpfile%pob(jk,jo,1)) > 10000.0_wp ) .OR. &
               & ( ABS(inpfile%pob(jk,jo,2)) > 10000.0_wp ) ) THEN
               inpfile%ivlqc(jk,jo,:) = 4
               inpfile%pob(jk,jo,1) = fbrmdi
               inpfile%pob(jk,jo,2) = fbrmdi
            ELSE
               inpfile%pob(jk,jo,1) = 0.01 * inpfile%pob(jk,jo,1)
               inpfile%pob(jk,jo,2) = 0.01 * inpfile%pob(jk,jo,2)
            ENDIF
         END DO
      END DO

      !---------------------------------------------------------------------
      ! Set file indexes
      !---------------------------------------------------------------------

      DO jo = 1, inpfile%nobs
         inpfile%kindex(jo) = jo
      END DO

      !---------------------------------------------------------------------
      ! Initialize flags since they are not in the TAO input files
      !---------------------------------------------------------------------

      inpfile%ioqcf(:,:)      = 0
      inpfile%ipqcf(:,:)      = 0
      inpfile%itqcf(:,:)      = 0
      inpfile%idqcf(:,:,:)    = 0
      inpfile%ivqcf(:,:,:)    = 0
      inpfile%ivlqcf(:,:,:,:) = 0

      !---------------------------------------------------------------------
      ! Deallocate data
      !---------------------------------------------------------------------
      DEALLOCATE( &
         & zu,     &
         & zv,     &
         & zdep,   &
         & zuv1qc, &
         & zuv2qc, &
         & itime,  &
         & itime2, &
         & zlat,   &
         & zlon,   &
         & zjuld   &
         & )

   END SUBROUTINE read_taondbc