!!---------------------------------------------------------------------- !! NEMO/OPA 3.3 , NEMO Consortium (2010) !! $Id$ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- SUBROUTINE read_enactfile( cdfilename, inpfile, kunit, ldwp, ldgrid ) !!--------------------------------------------------------------------- !! !! ** ROUTINE read_enactfile ** !! !! ** Purpose : Read from file the profile ENACT observations. !! !! ** Method : The data file is a NetCDF file. !! !! ** Action : !! !! 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 INTEGER :: iobs ! Number of observations INTEGER :: ilev ! Number of levels INTEGER :: i_file_id INTEGER :: i_obs_id INTEGER :: i_lev_id INTEGER :: i_phi_id INTEGER :: i_lam_id INTEGER :: i_depth_id INTEGER :: i_var_id INTEGER :: i_pl_num_id INTEGER :: i_reference_date_time_id INTEGER :: i_format_version_id INTEGER :: i_juld_id INTEGER :: i_data_type_id INTEGER :: i_wmo_inst_type_id INTEGER :: i_qc_var_id INTEGER :: i_dc_ref_id INTEGER :: i_qc_flag_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_tp CHARACTER(LEN=40) :: cl_fld_var_s CHARACTER(LEN=40) :: cl_fld_var_ti CHARACTER(LEN=40) :: cl_fld_var_juld_qc CHARACTER(LEN=40) :: cl_fld_var_pos_qc CHARACTER(LEN=40) :: cl_fld_var_depth_qc CHARACTER(LEN=40) :: cl_fld_var_qc_t CHARACTER(LEN=40) :: cl_fld_var_qc_s CHARACTER(LEN=40) :: cl_fld_var_prof_qc_t CHARACTER(LEN=40) :: cl_fld_var_prof_qc_s CHARACTER(LEN=40) :: cl_fld_reference_date_time CHARACTER(LEN=40) :: cl_fld_juld CHARACTER(LEN=40) :: cl_fld_data_type CHARACTER(LEN=40) :: cl_fld_pl_num CHARACTER(LEN=40) :: cl_fld_format_version CHARACTER(LEN=40) :: cl_fld_wmo_inst_type CHARACTER(LEN=40) :: cl_fld_qc_flags_profiles CHARACTER(LEN=40) :: cl_fld_qc_flags_levels CHARACTER(LEN=14), PARAMETER :: cl_name = 'read_enactfile' CHARACTER(LEN=16) :: cl_data_type = '' CHARACTER(LEN=4 ) :: cl_format_version = '' INTEGER, DIMENSION(1) :: istart1, icount1 INTEGER, DIMENSION(2) :: istart2, icount2 CHARACTER(len=imaxlev) :: clqc CHARACTER(len=1) :: cqc INTEGER :: ji, jk INTEGER, ALLOCATABLE, DIMENSION(:) :: iqc1 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iqc2 !----------------------------------------------------------------------- ! Initialization !----------------------------------------------------------------------- cl_fld_lam = 'LONGITUDE' cl_fld_phi = 'LATITUDE' cl_fld_depth = 'DEPH_CORRECTED' cl_fld_reference_date_time = 'REFERENCE_DATE_TIME' cl_fld_juld = 'JULD' cl_fld_data_type = 'DATA_TYPE' cl_fld_format_version = 'FORMAT_VERSION' cl_fld_wmo_inst_type = 'WMO_INST_TYPE' cl_fld_pl_num = 'PLATFORM_NUMBER' cl_fld_var_qc_t = 'POTM_CORRECTED_QC' cl_fld_var_prof_qc_t = 'PROFILE_POTM_QC' cl_fld_var_tp = 'POTM_CORRECTED' cl_fld_var_qc_s = 'PSAL_CORRECTED_QC' cl_fld_var_prof_qc_s = 'PROFILE_PSAL_QC' cl_fld_var_s = 'PSAL_CORRECTED' cl_fld_var_depth_qc = 'DEPH_CORRECTED_QC' cl_fld_var_juld_qc = 'JULD_QC' cl_fld_var_pos_qc = 'POSITION_QC' cl_fld_var_ti = 'TEMP' cl_fld_qc_flags_profiles = 'QC_FLAGS_PROFILES' cl_fld_qc_flags_levels = 'QC_FLAGS_LEVELS' icount1(1) = 1 !----------------------------------------------------------------------- ! Open file !----------------------------------------------------------------------- CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, & & i_file_id ), cl_name, __LINE__ ) !----------------------------------------------------------------------- ! Read the heading of the file !----------------------------------------------------------------------- CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_data_type, & & i_data_type_id ), cl_name, __LINE__ ) CALL chkerr( nf90_get_var ( i_file_id, i_data_type_id, & & cl_data_type ), cl_name, __LINE__ ) CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_format_version, & & i_format_version_id ), cl_name, __LINE__ ) CALL chkerr( nf90_get_var ( i_file_id, i_format_version_id, & & cl_format_version ), cl_name, __LINE__ ) CALL str_c_to_for( cl_data_type ) CALL str_c_to_for( cl_format_version ) IF(ldwp)WRITE(kunit,*) IF(ldwp)WRITE(kunit,*) ' read_enactfile :' IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~' IF(ldwp)WRITE(kunit,*) ' Data type = ', & & TRIM( ADJUSTL( cl_data_type ) ) IF(ldwp)WRITE(kunit,*) ' Format version = ', & & TRIM( ADJUSTL( cl_format_version ) ) IF ( ( ( INDEX( cl_data_type,"ENACT v1.0" ) == 1 ) .OR. & & ( INDEX( cl_data_type,"ENACT v1.4" ) == 1 ) .OR. & & ( INDEX( cl_data_type,"ENACT v1.5" ) == 1 ) .OR. & & ( INDEX( cl_data_type,"ENSEMBLES EN3 v1" ) == 1 ) ) & & .AND. & & ( INDEX( cl_format_version,"2.0" ) == 1 ) ) THEN IF(ldwp)WRITE(kunit,*)' Valid input file' ELSE CALL fatal_error( 'Invalid input file', __LINE__ ) ENDIF !--------------------------------------------------------------------- ! Read the number of observations and levels to allocate arrays !--------------------------------------------------------------------- CALL chkerr( nf90_inq_dimid ( i_file_id, 'N_PROF', i_obs_id ), & & cl_name, __LINE__ ) CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ), & & cl_name, __LINE__ ) CALL chkerr( nf90_inq_dimid ( i_file_id, 'N_LEVELS', i_lev_id ), & & cl_name, __LINE__ ) CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), & & cl_name, __LINE__ ) IF(ldwp)WRITE(kunit,*) ' No. of data records = ', iobs IF(ldwp)WRITE(kunit,*) ' No. of levels = ', ilev IF(ldwp)WRITE(kunit,*) IF (ilev > imaxlev) THEN CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ ) ENDIF !--------------------------------------------------------------------- ! Allocate arrays !--------------------------------------------------------------------- CALL init_obfbdata( inpfile ) CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid ) inpfile%cname(1) = 'POTM' inpfile%cname(2) = 'PSAL' inpfile%coblong(1) = 'Potential temperature' inpfile%coblong(2) = 'Practical salinity' inpfile%cobunit(1) = 'Degrees Celsius' inpfile%cobunit(2) = 'PSU' inpfile%cextname(1) = 'TEMP' inpfile%cextlong(1) = 'Insitu temperature' inpfile%cextunit(1) = 'Degrees Celsius' !--------------------------------------------------------------------- ! Read the QC atributes !--------------------------------------------------------------------- CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ), & & cl_name, __LINE__ ) istart2(1) = 1 icount2(2) = 1 icount2(1) = ilev DO ji = 1, iobs istart2(2) = ji CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, clqc, & & start = istart2, count = icount2), & & cl_name, __LINE__ ) DO jk = 1, ilev inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) END DO END DO CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ), & & cl_name, __LINE__ ) DO ji = 1, iobs istart2(2) = ji CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, clqc, & & start = istart2, count = icount2), & & cl_name, __LINE__ ) DO jk = 1, ilev inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) END DO END DO ! No depth QC in files DO ji = 1, iobs DO jk = 1, ilev inpfile%idqc(jk,ji) = 1 inpfile%idqcf(:,jk,ji) = 0 END DO END DO CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ), & & cl_name, __LINE__ ) DO ji = 1,iobs istart1(1) = ji CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, cqc, & & start = istart1, count = icount1), & & cl_name, __LINE__ ) inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' ) END DO CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ), & & cl_name, __LINE__ ) DO ji = 1,iobs istart1(1) = ji CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, cqc, & & start = istart1, count = icount1), & & cl_name, __LINE__ ) inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' ) END DO !! CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_juld_qc, i_qc_var_id ), & !! & cl_name, __LINE__ ) !! !DO ji = 1,iobs !! istart1(1) = ji !! CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, cqc, & !! & start = istart1, count = icount1), & !! & cl_name, __LINE__ ) !! inpfile%itqc(ji) = IACHAR( cqc ) - IACHAR( '0' ) !! inpfile%itqcf(:,ji) = 0 !! END DO ! Since the flags are not set in the ENACT files we reset them to 0 inpfile%itqc(:) = 1 inpfile%itqcf(:,:) = 0 CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ), & & cl_name, __LINE__ ) DO ji = 1,iobs istart1(1) = ji CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, cqc, & & start = istart1, count = icount1), & & cl_name, __LINE__ ) inpfile%ipqc(ji) = IACHAR( cqc ) - IACHAR( '0' ) inpfile%ipqcf(:,ji) = 0 END DO DO ji = 1,iobs inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) ) END DO IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_profiles, i_qc_flag_id ) == nf90_noerr ) THEN ALLOCATE( & & iqc1(iobs) & & ) CALL chkerr( nf90_get_var ( i_file_id, i_qc_flag_id, iqc1 ), & & cl_name, __LINE__ ) DO ji = 1,iobs inpfile%ioqcf(1,ji) = iqc1(ji) inpfile%ivqcf(1,ji,:) = iqc1(ji) inpfile%ioqcf(2,ji) = 0 inpfile%ivqcf(2,ji,:) = 0 END DO DEALLOCATE( & & iqc1 & & ) ELSE IF(ldwp) WRITE(kunit,*)'No QC profile flags in file' inpfile%ioqcf(:,:) = 0 inpfile%ivqcf(:,:,:) = 0 ENDIF IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_levels, i_qc_flag_id ) == nf90_noerr ) THEN ALLOCATE( & & iqc2(ilev,iobs) & & ) CALL chkerr( nf90_get_var ( i_file_id, i_qc_flag_id, iqc2 ), & & cl_name, __LINE__ ) DO ji = 1,iobs DO jk = 1,ilev inpfile%ivlqcf(1,jk,ji,:) = iqc2(jk,ji) inpfile%ivlqcf(2,jk,ji,:) = 0 END DO END DO DEALLOCATE( & & iqc2 & & ) ELSE IF(ldwp) WRITE(kunit,*)'No QC level flags in file' inpfile%ivlqcf(:,:,:,:) = 0 ENDIF !--------------------------------------------------------------------- ! Read the time/position variables !--------------------------------------------------------------------- CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ), & & cl_name, __LINE__ ) CALL chkerr( nf90_get_var ( i_file_id, i_juld_id, inpfile%ptim ), & & 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, inpfile%pdep ), & & 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, inpfile%pphi ), & & 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, inpfile%plam ), & & cl_name, __LINE__ ) CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_reference_date_time, i_reference_date_time_id ), & & cl_name, __LINE__ ) CALL chkerr( nf90_get_var ( i_file_id, i_reference_date_time_id, inpfile%cdjuldref ), & & cl_name, __LINE__ ) !--------------------------------------------------------------------- ! Read the platform information !--------------------------------------------------------------------- CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ), & & cl_name, __LINE__ ) CALL chkerr( nf90_get_var ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ), & & cl_name, __LINE__ ) CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ), & & cl_name, __LINE__ ) CALL chkerr( nf90_get_var ( i_file_id, i_pl_num_id, inpfile%cdwmo ), & & cl_name, __LINE__ ) !--------------------------------------------------------------------- ! Read the variables !--------------------------------------------------------------------- CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_tp, i_var_id ), & & cl_name, __LINE__ ) CALL chkerr( nf90_get_var ( i_file_id, i_var_id, inpfile%pob(:,:,1) ), & & cl_name, __LINE__ ) CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ), & & cl_name, __LINE__ ) CALL chkerr( nf90_get_var ( i_file_id, i_var_id, inpfile%pob(:,:,2) ), & & cl_name, __LINE__ ) CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_ti, i_var_id ), & & cl_name, __LINE__ ) CALL chkerr( nf90_get_var ( i_file_id, i_var_id, inpfile%pext(:,:,1) ), & & cl_name, __LINE__ ) !--------------------------------------------------------------------- ! Close file !--------------------------------------------------------------------- CALL chkerr( nf90_close( i_file_id ), cl_name, __LINE__ ) !--------------------------------------------------------------------- ! Set file indexes !--------------------------------------------------------------------- DO ji = 1, inpfile%nobs inpfile%kindex(ji) = ji END DO END SUBROUTINE read_enactfile SUBROUTINE read_coriofile( cdfilename, inpfile, kunit, ldwp, ldgrid ) !!--------------------------------------------------------------------- !! !! ** ROUTINE read_coriofile ** !! !! ** Purpose : Read from file the profile CORIO observations. !! !! ** Method : The data file is a NetCDF file. !! !! ** Action : !! !! History : !! ! 09-01 (K. Mogensen) Original based on old versions !!---------------------------------------------------------------------- !! * Arguments CHARACTER(LEN=*) :: cdfilename ! Input filename TYPE(obfbdata) :: inpfile ! Output enactfile structure INTEGER :: kunit ! Unit for output LOGICAL :: ldwp ! Print info LOGICAL :: ldgrid ! Save grid info in data structure INTEGER :: & & iobs, & & ilev !! * Local declarations INTEGER :: & & i_file_id, & & i_obs_id, & & i_lev_id, & & i_phi_id, & & i_lam_id, & & i_depth_id, & & i_pres_id, & & i_var_id, & & i_pl_num_id, & & i_format_version_id, & & i_juld_id, & & i_data_type_id, & & i_wmo_inst_type_id, & & i_qc_var_id, & & i_dc_ref_id CHARACTER(LEN=40) :: & & cl_fld_lam, & & cl_fld_phi, & & cl_fld_depth, & & cl_fld_depth_qc, & & cl_fld_pres, & & cl_fld_pres_qc, & & cl_fld_var_t, & & cl_fld_var_s, & & cl_fld_var_ti, & & cl_fld_var_pos_qc, & & cl_fld_var_qc_t, & & cl_fld_var_qc_s, & & cl_fld_var_prof_qc_t, & & cl_fld_var_prof_qc_s, & & cl_fld_dc_ref, & & cl_fld_juld, & & cl_fld_pl_num, & & cl_fld_wmo_inst_type CHARACTER(LEN=14), PARAMETER :: & & cl_name = 'read_coriofile' CHARACTER(LEN=4 ) :: & & cl_format_version = '' INTEGER, DIMENSION(1) :: & & istart1, icount1 INTEGER, DIMENSION(2) :: & & istart2, icount2 CHARACTER(len=imaxlev) :: & & clqc CHARACTER(len=1) :: & & cqc CHARACTER(len=256) :: & & cdjulref INTEGER :: & & ji, jk INTEGER :: & & iformat LOGICAL :: & & lsal REAL(fbdp), DIMENSION(:,:), ALLOCATABLE :: & & zpres INTEGER, DIMENSION(:,:), ALLOCATABLE :: & & ipresqc CHARACTER(len=256) :: & & cerr !----------------------------------------------------------------------- ! Initialization !----------------------------------------------------------------------- icount1(1) = 1 lsal = .TRUE. !----------------------------------------------------------------------- ! Open file !----------------------------------------------------------------------- CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, & & i_file_id ), cl_name, __LINE__ ) !----------------------------------------------------------------------- ! Check format and set variables accordingly !----------------------------------------------------------------------- IF ( ( nf90_inq_dimid( i_file_id, 'N_PROF', i_obs_id ) == nf90_noerr ) .AND. & & ( nf90_inq_dimid( i_file_id, 'N_LEVELS', i_lev_id ) == nf90_noerr ) ) THEN iformat = 1 ELSEIF ( ( nf90_inq_dimid( i_file_id, 'mN_PROF', i_obs_id ) == nf90_noerr ) .AND. & & ( nf90_inq_dimid( i_file_id, 'mN_ZLEV', i_lev_id ) == nf90_noerr ) ) THEN iformat = 2 ELSE WRITE(cerr,'(2A)')'Invalid data format in ',cl_name CALL fatal_error( cerr, __LINE__ ) ENDIF IF ( iformat == 1 ) THEN cl_fld_lam = 'LONGITUDE' cl_fld_phi = 'LATITUDE' cl_fld_depth = 'DEPH' cl_fld_depth_qc = 'DEPH_QC' cl_fld_pres = 'PRES' cl_fld_pres_qc = 'PRES_QC' cl_fld_juld = 'JULD' cl_fld_wmo_inst_type = 'WMO_INST_TYPE' cl_fld_dc_ref = 'DC_REFERENCE' cl_fld_pl_num = 'PLATFORM_NUMBER' cl_fld_var_qc_t = 'TEMP_QC' cl_fld_var_prof_qc_t = 'PROFILE_TEMP_QC' cl_fld_var_t = 'TEMP' cl_fld_var_qc_s = 'PSAL_QC' cl_fld_var_prof_qc_s = 'PROFILE_PSAL_QC' cl_fld_var_s = 'PSAL' cl_fld_var_pos_qc = 'POSITION_QC' ELSEIF ( iformat==2 ) THEN cl_fld_lam = 'LONGITUDE' cl_fld_phi = 'LATITUDE' cl_fld_depth = 'DEPH' cl_fld_depth_qc = 'QC_DEPH' cl_fld_pres = 'PRES' cl_fld_pres_qc = 'QC_PRES' cl_fld_juld = 'JULD' cl_fld_wmo_inst_type = 'INST_TYPE' cl_fld_dc_ref = 'REFERENCE' cl_fld_pl_num = 'PLATFORM_NUMBER' cl_fld_var_qc_t = 'QC_TEMP' cl_fld_var_prof_qc_t = 'Q_PROFILE_TEMP' cl_fld_var_t = 'TEMP' cl_fld_var_qc_s = 'QC_PSAL' cl_fld_var_prof_qc_s = 'Q_PROFILE_PSAL' cl_fld_var_s = 'PSAL' cl_fld_var_pos_qc = 'Q_POSITION' ENDIF !----------------------------------------------------------------------- ! Read the heading of the file !----------------------------------------------------------------------- IF(ldwp)WRITE(kunit,*) IF(ldwp)WRITE(kunit,*) ' read_coriofile :' IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~' IF(ldwp)WRITE(kunit,*) ' Format version = ', iformat !--------------------------------------------------------------------- ! Read the number of observations and levels to allocate arrays !--------------------------------------------------------------------- CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ), & & cl_name, __LINE__ ) CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), & & cl_name, __LINE__ ) IF(ldwp)WRITE(kunit,*) ' No. of data records = ', iobs IF(ldwp)WRITE(kunit,*) ' No. of levels = ', ilev IF(ldwp)WRITE(kunit,*) IF (ilev > imaxlev) THEN CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ ) ENDIF !--------------------------------------------------------------------- ! Allocate arrays !--------------------------------------------------------------------- CALL init_obfbdata( inpfile ) CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid ) inpfile%cname(1) = 'POTM' inpfile%cname(2) = 'PSAL' inpfile%coblong(1) = 'Potential temperature' inpfile%coblong(2) = 'Practical salinity' inpfile%cobunit(1) = 'Degrees Celsius' inpfile%cobunit(2) = 'PSU' inpfile%cextname(1) = 'TEMP' inpfile%cextlong(1) = 'Insitu temperature' inpfile%cextunit(1) = 'Degrees Celsius' ALLOCATE( & & zpres(ilev,iobs), & & ipresqc(ilev,iobs) & & ) !--------------------------------------------------------------------- ! Get julian data reference (iformat==2) !--------------------------------------------------------------------- IF (iformat==2) THEN CALL chkerr ( nf90_get_att( i_file_id, nf90_global, & & "Reference_date_time", cdjulref ), & & cl_name, __LINE__ ) inpfile%cdjuldref = cdjulref(7:10)//cdjulref(4:5)// & & cdjulref(1:2)//cdjulref(12:13)//cdjulref(15:16)//cdjulref(18:19) ENDIF !--------------------------------------------------------------------- ! Read the QC attributes !--------------------------------------------------------------------- CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ), & & cl_name, __LINE__ ) istart2(1) = 1 icount2(2) = 1 icount2(1) = ilev DO ji = 1, iobs istart2(2) = ji CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, clqc, & & start = istart2, count = icount2), & & cl_name, __LINE__ ) DO jk = 1, ilev inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) END DO END DO IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ) == nf90_noerr ) THEN DO ji = 1, iobs istart2(2) = ji CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, clqc, & & start = istart2, count = icount2), & & cl_name, __LINE__ ) DO jk = 1, ilev inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) END DO END DO ELSE inpfile%ivlqc(:,:,2) = 4 inpfile%pob(:,:,2) = fbrmdi lsal = .FALSE. ENDIF CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ), & & cl_name, __LINE__ ) DO ji = 1,iobs istart1(1) = ji CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, cqc, & & start = istart1, count = icount1), & & cl_name, __LINE__ ) inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' ) END DO IF (lsal) THEN CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ), & & cl_name, __LINE__ ) DO ji = 1,iobs istart1(1) = ji CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, cqc, & & start = istart1, count = icount1), & & cl_name, __LINE__ ) inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' ) END DO ELSE inpfile%ivqc(:,2) = 4 ENDIF DO ji = 1,iobs inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) ) END DO CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ), & & cl_name, __LINE__ ) DO ji = 1, iobs istart1(1) = ji CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, cqc, & & start = istart1, count = icount1), & & cl_name, __LINE__ ) inpfile%ipqc(ji) = IACHAR( cqc ) - IACHAR( '0' ) END DO !--------------------------------------------------------------------- ! Read the time/position variables !--------------------------------------------------------------------- CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ), & & cl_name, __LINE__ ) CALL chkerr( nf90_get_var ( i_file_id, i_juld_id, inpfile%ptim ), & & cl_name, __LINE__ ) IF (iformat==1) THEN CALL chkerr ( nf90_get_att( i_file_id, i_juld_id, & & "units", cdjulref ), & & cl_name, __LINE__ ) inpfile%cdjuldref = cdjulref(12:15)//cdjulref(17:18)// & & cdjulref(20:21)//cdjulref(23:24)//cdjulref(26:27)//& & cdjulref(29:30) ENDIF IF ( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ) == nf90_noerr ) THEN CALL chkerr( nf90_get_var ( i_file_id, i_depth_id, inpfile%pdep ), & & cl_name, __LINE__ ) CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth_qc, i_qc_var_id ), & & cl_name, __LINE__ ) DO ji = 1, iobs istart2(2) = ji CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, clqc, & & start = istart2, count = icount2), & & cl_name, __LINE__ ) DO jk = 1, ilev inpfile%idqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) END DO END DO ELSE inpfile%pdep(:,:) = fbrmdi inpfile%idqc(:,:) = 4 ENDIF IF ( nf90_inq_varid( i_file_id, cl_fld_pres, i_pres_id ) == nf90_noerr ) THEN CALL chkerr( nf90_get_var ( i_file_id, i_pres_id, zpres ), & & cl_name, __LINE__ ) CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pres_qc, i_qc_var_id ), & & cl_name, __LINE__ ) DO ji = 1, iobs istart2(2) = ji CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, clqc, & & start = istart2, count = icount2), & & cl_name, __LINE__ ) DO jk = 1, ilev ipresqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) END DO END DO ELSE zpres(:,:) = fbrmdi ipresqc(:,:) = 4 ENDIF 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, inpfile%pphi ), & & 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, inpfile%plam ), & & cl_name, __LINE__ ) !--------------------------------------------------------------------- ! Read the platform information !--------------------------------------------------------------------- CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ), & & cl_name, __LINE__ ) CALL chkerr( nf90_get_var ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ), & & cl_name, __LINE__ ) CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ), & & cl_name, __LINE__ ) CALL chkerr( nf90_get_var ( i_file_id, i_pl_num_id, inpfile%cdwmo ), & & cl_name, __LINE__ ) !--------------------------------------------------------------------- ! Read the variables !--------------------------------------------------------------------- CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_t, i_var_id ), & & cl_name, __LINE__ ) CALL chkerr( nf90_get_var ( i_file_id, i_var_id, inpfile%pext(:,:,1) ), & & cl_name, __LINE__ ) IF (lsal) THEN CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ), & & cl_name, __LINE__ ) CALL chkerr( nf90_get_var ( i_file_id, i_var_id, inpfile%pob(:,:,2) ), & & cl_name, __LINE__ ) ENDIF !--------------------------------------------------------------------- ! Close file !--------------------------------------------------------------------- CALL chkerr( nf90_close( i_file_id ), cl_name, __LINE__ ) !--------------------------------------------------------------------- ! Set file indexes !--------------------------------------------------------------------- DO ji = 1, inpfile%nobs inpfile%kindex(ji) = ji END DO !--------------------------------------------------------------------- ! Coriolis data conversion from insitu to potential temperature !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! Convert pressure to depth if depth not present !--------------------------------------------------------------------- DO ji = 1, inpfile%nobs IF ( inpfile%pphi(ji) < 9999.0 ) THEN DO jk = 1, inpfile%nlev IF ( inpfile%pdep(jk,ji) >= 9999.0 ) THEN IF ( zpres(jk,ji) < 9999.0 ) THEN inpfile%pdep(jk,ji) = & & p_to_dep( REAL(zpres(jk,ji),wp), REAL(inpfile%pphi(ji),wp) ) inpfile%idqc(jk,ji) = ipresqc(jk,ji) ENDIF ENDIF END DO ENDIF END DO !--------------------------------------------------------------------- ! Convert depth to pressure if pressure not present !--------------------------------------------------------------------- DO ji = 1, inpfile%nobs IF ( inpfile%pphi(ji) < 9999.0 ) THEN DO jk = 1, inpfile%nlev IF ( zpres(jk,ji) >= 9999.0 ) THEN IF ( inpfile%pdep(jk,ji) < 9999.0 ) THEN zpres(jk,ji) = dep_to_p( REAL(inpfile%pdep(jk,ji),wp), & & REAL(inpfile%pphi(ji),wp) ) ipresqc(jk,ji) = inpfile%idqc(jk,ji) ENDIF ENDIF END DO ENDIF END DO !--------------------------------------------------------------------- ! Convert insitu temperature to potential temperature if ! salinity, insitu temperature and pressure are present !--------------------------------------------------------------------- DO ji = 1, inpfile%nobs DO jk = 1, inpfile%nlev IF (( inpfile%pob(jk,ji,2) < 9999.0 ) .AND. & &( inpfile%pext(jk,ji,1) < 9999.0 ) .AND. & &( zpres(jk,ji) < 9999.0 ) ) THEN inpfile%pob(jk,ji,1) = potemp( REAL(inpfile%pob(jk,ji,2), wp), & & REAL(inpfile%pext(jk,ji,1), wp), & & REAL(zpres(jk,ji),wp), & & 0.0_wp ) ELSE inpfile%pob(jk,ji,1) = fbrmdi ENDIF END DO END DO !--------------------------------------------------------------------- ! Initialize flags since they are not in the CORIOLIS input files !--------------------------------------------------------------------- inpfile%ioqcf(:,:) = 0 inpfile%ipqcf(:,:) = 0 inpfile%itqcf(:,:) = 0 inpfile%idqcf(:,:,:) = 0 inpfile%ivqcf(:,:,:) = 0 inpfile%ivlqcf(:,:,:,:) = 0 END SUBROUTINE read_coriofile