program conv_gtmba_net2imma use, non_intrinsic :: netcdf implicit none !tr! ----------------------------------------------------------------- !tr! Program to extract data from NetCDF files generated from the PMEL !tr! delayed mode archive of Tropical Moored Buoy Data and convert to !tr! IMMA1 format !tr! Written by Elizabeth Kent, National Oceanography Centre, Aug 2015 !tr! ----------------------------------------------------------------- ! logical :: exist integer (kind = 4) :: i, j, irec integer (kind = 2) :: year, month character (len = 4):: cyear ! character (len = 20):: cdum ! Variables to read in character (len=12), allocatable :: buoy_loc(:) integer (kind = 2), allocatable :: yr(:), mo(:), dy(:) integer (kind = 4), allocatable :: wmo_no(:) real (kind = 4), allocatable :: lat(:), lon(:), hr(:) integer (kind = 2), allocatable :: lat_qc(:), lon_qc(:) real (kind = 4), allocatable :: sst(:), at(:), rh(:), ws(:) real (kind = 4), allocatable :: wd(:), sss(:), slp(:), bp(:) real (kind = 4), allocatable :: u(:), v(:) integer (kind = 2), allocatable :: sst_qc(:), at_qc(:) integer (kind = 2), allocatable :: rh_qc(:), ws_qc(:) integer (kind = 2), allocatable :: wd_qc(:), sss_qc(:) integer (kind = 2), allocatable :: slp_qc(:), bp_qc(:) integer (kind = 2), allocatable :: u_qc(:), v_qc(:) integer (kind = 2), allocatable :: sst_sam(:), at_sam(:) integer (kind = 2), allocatable :: rh_sam(:), ws_sam(:) integer (kind = 2), allocatable :: sss_sam(:), bp_sam(:) integer (kind = 2), allocatable :: sst_sou(:), at_sou(:) integer (kind = 2), allocatable :: rh_sou(:), ws_sou(:) integer (kind = 2), allocatable :: sss_sou(:), bp_sou(:) integer (kind = 2), allocatable :: sss_inst(:) ! integer (kind = 2), allocatable :: cur_sou(:), lw_sou(:) ! integer (kind = 2), allocatable :: rad_sou(:) ! integer (kind = 2), allocatable :: rain_sou(:) real (kind = 4), allocatable :: sst_ht(:), at_ht(:) real (kind = 4), allocatable :: rh_ht(:), ws_ht(:) real (kind = 4), allocatable :: sss_ht(:), bp_ht(:) ! real (kind = 4 ) :: slp_out !------------------------------------------------------ ! netcdf variables !------------------------------------------------------ integer (kind = 4 ) :: ncid !, iabs4 integer (kind = 2 ) :: iabs2 ! integer (kind = 4 ) :: status, dimid(2), vid, ovid(100), odim integer (kind = 4 ) :: status, vid, idim, nrec ! integer (kind = 4 ) :: ivid, idim ! integer (kind = 4 ) :: nrec, start(1), start2(2) real (kind = 4 ) :: rabs character (len=12) :: dname ! character (len=30) :: tunits character (len=80) :: ncfile !------------------------------------------------------ ! IMMA variables !------------------------------------------------------ character (len=80) :: imma_file(12) character (len=9) :: id_imma character (len=87) :: supd_imma integer (kind = 4 ) :: imma_unit(12), imu integer (kind = 4 ) :: yr_imma, mo_imma, dy_imma integer (kind = 4 ) :: im_imma, attc_imma, ti_imma, li_imma, ii_imma integer (kind = 4 ) :: di_imma, wi_imma, t1_imma, si_imma, dck_imma integer (kind = 4 ) :: sid_imma, pt_imma, rhi_imma, dos_imma, hot_imma integer (kind = 4 ) :: hob_imma, hoa_imma, d_imma, mds_imma integer (kind = 4 ) :: ht_to_op real (kind = 4) :: hr_imma real (kind = 4) :: otz_imma, osz_imma data imma_file/"pmel_imma1.XXXX.01", & "pmel_imma1.XXXX.02", & "pmel_imma1.XXXX.03", & "pmel_imma1.XXXX.04", & "pmel_imma1.XXXX.01", & "pmel_imma1.XXXX.06", & "pmel_imma1.XXXX.07", & "pmel_imma1.XXXX.08", & "pmel_imma1.XXXX.09", & "pmel_imma1.XXXX.10", & "pmel_imma1.XXXX.11", & "pmel_imma1.XXXX.12"/ !tr! ---------------------------------------------------------------- !tr! ... Source code definitions [var_sou] !tr! ... Value Definition !tr! ... 0 No Sensor, No Data !tr! ... 1 Real Time (Telemetered Mode) !tr! ... 2 Derived from Real Time !tr! ... 3 Temporally Interpolated from Real Time !tr! ... 4 Not used !tr! ... 5 Recovered from Instrument Random Access Memory (RAM) (Delayed Mode) !tr! ... 6 Derived from RAM !tr! ... 7 Temporally Interpolated from RAM !tr! ---------------------------------------------------------------- !tr! ... Quality index definitions [var_qc] !tr! ... Value Observation Quality Definition !tr! ... 0 Datum missing. !tr! ... 1 Highest quality; Pre/post-deployment calibrations agree to within !tr! sensor specifications. In most cases only pre-deployment calibrations !tr! have been applied. !tr! ... 2 Default quality; Pre-deployment calibrations were applied. Default !tr! value for sensors presently deployed at the ocean and for sensors !tr! which were either not recovered or not calibratable when recovered. !tr! ... 3 Adjusted data; Pre/post calibrations differ, or original data do !tr! not agree with other data sources (e.g., other in situ data or !tr! climatology), or original data are noisy. Data have been adjusted !tr! to correct for error. !tr! ... 4 Lower quality; Pre/post calibrations differ, or data do not !tr! agree with other data sources (e.g., other in situ data or !tr! climatology), or data are noisy. Data could not be confidently !tr! adjusted to correct for error. !tr! ... 5 Sensor failed !tr! ---------------------------------------------------------------- !tr! ... Location quality flag definitions [lat_qc, lon_qc] !tr! ... Value Location Quality Definition !tr! ... 0 Position missing (replaced with nominal position) !tr! ... 2 Position of default quality !tr! ... 3 Position interpolated over gap of one day !tr! ... 5 Position differs from deployment position by more than 6 nautical miles !tr! ---------------------------------------------------------------- rabs = -999.0 print*,'input year' read*,cyear do i = 1,12 imma_file(i)(12:15) = cyear ! need to delete any existing imma output files as we are appending ! reports to the appropriate monthly files imma_unit(i) = i+14 open ( unit=imma_unit(i), file=imma_file(i), & & status = "unknown") close( unit=imma_unit(i), status = "delete") open ( unit=imma_unit(i), file=imma_file(i), & & status = "unknown", access = "append" ) enddo ! ncfile = "gtmba_hour_cf_1978.nc" print*,'input netcdf file name' read(*,'(a80)')ncfile !tr! ---------------------------------------------------------------- !tr! read in data from annual netcdf file of PMEL GTMBA data !tr! ---------------------------------------------------------------- ! open file status = nf90_open ( ncfile, nf90_nowrite, ncid ) if (status /= nf90_noerr) call handle_err(status) ! read number of records status = nf90_inq_dimid(ncid, "recordno", idim) if (status /= nf90_noerr) call handle_err(status) status = nf90_inquire_dimension(ncid, idim, dname, nrec) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in year, i*2 variable !tr! ... --> ICOADS variable YR if ( allocated(yr) ) deallocate(yr) allocate(yr(nrec)) status = nf90_inq_varid(ncid, "year", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, yr ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in cal_month, i*2 variable !tr! ... --> ICOADS variable MO if ( allocated(mo) ) deallocate(mo) allocate(mo(nrec)) status = nf90_inq_varid(ncid, "cal_month", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, mo ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in day_of_month, i*2 variable !tr! ... --> ICOADS variable DY if ( allocated(dy) ) deallocate(dy) allocate(dy(nrec)) status = nf90_inq_varid(ncid, "day_of_month", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, dy ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in hour of day, r*4 variable, UTC !tr! ... --> ICOADS variable HR if ( allocated(hr) ) deallocate(hr) allocate(hr(nrec)) status = nf90_inq_varid(ncid, "hour_of_day", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, hr ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in longitude, r*4 variable, degrees E !tr! ... --> ICOADS variable LON if ( allocated(lon) ) deallocate(lon) allocate(lon(nrec)) status = nf90_inq_varid(ncid, "longitude", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, lon ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in longitude qc flag, i*2 variable, flag values 0-5 !tr! ... --> ICOADS SUPD col 11 if ( allocated(lon_qc) ) deallocate(lon_qc) allocate(lon_qc(nrec)) status = nf90_inq_varid(ncid, "longitude_qc", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, lon_qc ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in latitude, r*4 variable, degrees N !tr! ... --> ICOADS variable LAT if ( allocated(lat) ) deallocate(lat) allocate(lat(nrec)) status = nf90_inq_varid(ncid, "latitude", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, lat ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in latitude qc flag, i*2 variable, flag values 0-5 !tr! ... --> ICOADS SUPD col 12 if ( allocated(lat_qc) ) deallocate(lat_qc) allocate(lat_qc(nrec)) status = nf90_inq_varid(ncid, "latitude_qc", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, lat_qc ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in location_id, char*12 variable, location name !tr! ... --> ICOADS SUPD col 1-10 !tr! ... If WMO_ID >= 90000 then location_id --> ICOADS ID if ( allocated(wmo_no) ) deallocate(wmo_no) allocate(wmo_no(nrec)) status = nf90_inq_varid(ncid, "WMO_ID", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, wmo_no ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in WMO_ID, i*4 variable, WMO ID or assigned if >= 90000 !tr! ... --> ICOADS variable ID if < 90000 [else location_id] if ( allocated(buoy_loc) ) deallocate(buoy_loc) allocate(buoy_loc(nrec)) status = nf90_inq_varid(ncid, "location_id", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, buoy_loc ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in SST, r*4 variable, degC !tr! ... --> ICOADS variable SST if ( allocated(sst) ) deallocate(sst) allocate(sst(nrec)) status = nf90_inq_varid(ncid, "SST", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, SST) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in SST_qc, i*2 variable, flag values 0-5 !tr! ... --> ICOADS SUPD col 13 if ( allocated(sst_qc) ) deallocate(sst_qc) allocate(sst_qc(nrec)) status = nf90_inq_varid(ncid, "SST_qc", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, sst_qc ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in SST_depth, r*4 variable, m below sea level !tr! ... --> ICOADS variable DOS [integer value] !tr! ... --> ICOADS variable OTZ [real value] !tr! ... --> ICOADS SUPD cols 14-16 *10 if ( allocated(sst_ht) ) deallocate(sst_ht) allocate(sst_ht(nrec)) status = nf90_inq_varid(ncid, "SST_depth", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, sst_ht ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in SST_source, i*2 variable, flag values 0-7 !tr! ... --> ICOADS SUPD col 21 if ( allocated(sst_sou) ) deallocate(sst_sou) allocate(sst_sou(nrec)) status = nf90_inq_varid(ncid, "SST_source", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, sst_sou ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in SST_samp, i*2 variable, sampling period, min !tr! ... --> ICOADS SUPD cols 17-20 if ( allocated(sst_sam) ) deallocate(sst_sam) allocate(sst_sam(nrec)) status = nf90_inq_varid(ncid, "SST_samp", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, sst_sam ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in AT, r*4 variable, degC !tr! ... --> ICOADS variable AT if ( allocated(at) ) deallocate(at) allocate(at(nrec)) status = nf90_inq_varid(ncid, "AT", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, at ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in AT_qc, i*2 variable, flag values 0-5 !tr! ... --> ICOADS SUPD col 22 if ( allocated(at_qc) ) deallocate(at_qc) allocate(at_qc(nrec)) status = nf90_inq_varid(ncid, "AT_qc", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, at_qc ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in AT_height, r*4 variable, m above sea level !tr! ... --> ICOADS variable HOT [* -1, integer value ] !tr! ... --> ICOADS SUPD cols 23-25 * 10 if ( allocated(at_ht) ) deallocate(at_ht) allocate(at_ht(nrec)) status = nf90_inq_varid(ncid, "AT_height", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, at_ht ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in AT_source, i*2 variable, flag values 0-7 !tr! ... --> ICOADS SUPD col 30 if ( allocated(at_sou) ) deallocate(at_sou) allocate(at_sou(nrec)) status = nf90_inq_varid(ncid, "AT_source", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, at_sou ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in AT_samp, i*2 variable, sampling period, min !tr! ... --> ICOADS SUPD cols 26-29 if ( allocated(at_sam) ) deallocate(at_sam) allocate(at_sam(nrec)) status = nf90_inq_varid(ncid, "AT_samp", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, at_sam ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in RH, r*4 variable, % !tr! ... --> ICOADS variable RH if ( allocated(rh) ) deallocate(rh) allocate(rh(nrec)) status = nf90_inq_varid(ncid, "RH", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, rh ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in RH_qc, i*2 variable, flag values 0-5 !tr! ... --> ICOADS SUPD col 31 if ( allocated(rh_qc) ) deallocate(rh_qc) allocate(rh_qc(nrec)) status = nf90_inq_varid(ncid, "RH_qc", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, rh_qc ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in RH_height, r*4 variable, m above sea level !tr! ... --> ICOADS SUPD cols 32-34 *10 if ( allocated(rh_ht) ) deallocate(rh_ht) allocate(rh_ht(nrec)) status = nf90_inq_varid(ncid, "RH_height", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, rh_ht ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in RH_source, i*2 variable, flag values 0-7 !tr! ... --> ICOADS SUPD col 39 if ( allocated(rh_sou) ) deallocate(rh_sou) allocate(rh_sou(nrec)) status = nf90_inq_varid(ncid, "RH_source", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, rh_sou ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in RH_samp, i*2 variable, sampling period, min !tr! ... --> ICOADS SUPD cols 35-38 if ( allocated(rh_sam) ) deallocate(rh_sam) allocate(rh_sam(nrec)) status = nf90_inq_varid(ncid, "RH_samp", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, rh_sam ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in SSS, r*4 variable, practical salinity !tr! ... --> ICOADS variable OSV if ( allocated(sss) ) deallocate(sss) allocate(sss(nrec)) status = nf90_inq_varid(ncid, "SSS", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, sss ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in SSS_qc, i*2 variable, flag values 0-5 !tr! ... --> ICOADS SUPD col 40 if ( allocated(sss_qc) ) deallocate(sss_qc) allocate(sss_qc(nrec)) status = nf90_inq_varid(ncid, "SSS_qc", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, sss_qc ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in SSS_depth, r*4 variable, m below sea level !tr! ... --> ICOADS variable OSZ [real value] if ( allocated(sss_ht) ) deallocate(sss_ht) allocate(sss_ht(nrec)) status = nf90_inq_varid(ncid, "SSS_depth", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, sss_ht ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in SSS_source, i*2 variable, flag values 0-7 !tr! ... --> ICOADS SUPD col 48 if ( allocated(sss_sou) ) deallocate(sss_sou) allocate(sss_sou(nrec)) status = nf90_inq_varid(ncid, "SSS_source", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, sss_sou ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in SSS_samp, i*2 variable, sampling period, min !tr! ... --> ICOADS SUPD cols 44-47 if ( allocated(sss_sam) ) deallocate(sss_sam) allocate(sss_sam(nrec)) status = nf90_inq_varid(ncid, "SSS_samp", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, sss_sam ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in SSS_instrument, i*2 variable, flag values 0-99 !tr! ... --> ICOADS SUPD cols 49-50 if ( allocated(sss_inst) ) deallocate(sss_inst) allocate(sss_inst(nrec)) status = nf90_inq_varid(ncid, "SSS_instrument", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, sss_inst ) if (status /= nf90_noerr) call handle_err(status) !tr! ...------------------------------------------------------------- !tr! ... SSS instrument flags !tr! ... Value Definition !tr! ... 0 No Sensor !tr! ... 14 ATLAS-NG Conductivity !tr! ... 24 ATLAS-NG Conductivity (Firmware version 5.03+) !tr! ... 70 Seacat Conductivity !tr! ... 71 Microcat Conductivity !tr! ... 99 Unknown !tr! ...------------------------------------------------------------- !tr! ... ! !tr! ... read in PRES (pressure @ meas. ht.), r*4 variable, mb !tr! ... --> ICOADS SUPD cols 60-65 *10 if ( allocated(bp) ) deallocate(bp) allocate(bp(nrec)) status = nf90_inq_varid(ncid, "PRES", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, bp ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in PRES_qc, i*2 variable, flag values 0-5 !tr! ... --> ICOADS SUPD col 51 if ( allocated(bp_qc) ) deallocate(bp_qc) allocate(bp_qc(nrec)) status = nf90_inq_varid(ncid, "PRES_qc", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, bp_qc ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in PRES_height, r*4 variable, m above sea level !tr! ... --> ICOADS variable HOB [* -1, integer value ] !tr! ... --> ICOADS SUPD cols 52-54 *10 if ( allocated(bp_ht) ) deallocate(bp_ht) allocate(bp_ht(nrec)) status = nf90_inq_varid(ncid, "PRES_height", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, bp_ht ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in PRES_source, i*2 variable, flag values 0-7 !tr! ... --> ICOADS SUPD col 59 if ( allocated(bp_sou) ) deallocate(bp_sou) allocate(bp_sou(nrec)) status = nf90_inq_varid(ncid, "PRES_source", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, bp_sou ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in PRES_samp, i*2 variable, sampling period, min !tr! ... --> ICOADS SUPD cols 55-58 if ( allocated(bp_sam) ) deallocate(bp_sam) allocate(bp_sam(nrec)) status = nf90_inq_varid(ncid, "PRES_samp", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, bp_sam ) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in SLP, r*4 variable, sea level pressure, mb !tr! ... --> ICOADS variable SLP if ( allocated(slp) ) deallocate(slp) allocate(slp(nrec)) status = nf90_inq_varid(ncid, "SLP", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, slp) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in wind_speed, r*4 variable, m/s !tr! ... --> ICOADS variable W if ( allocated(ws) ) deallocate(ws) allocate(ws(nrec)) status = nf90_inq_varid(ncid, "wind_speed", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, ws) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in wind_speed_qc, i*2 variable, flag values 0-5 !tr! ... --> ICOADS SUPD col 66 if ( allocated(ws_qc) ) deallocate(ws_qc) allocate(ws_qc(nrec)) status = nf90_inq_varid(ncid, "wind_speed_qc", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, ws_qc) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in wind_direction, r*4 variable, deg T !tr! ... --> ICOADS variable D, +180 deg (ocean -> met conv.) if ( allocated(wd) ) deallocate(wd) allocate(wd(nrec)) status = nf90_inq_varid(ncid, "wind_direction", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, wd) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in wind_direction_qc, i*2 variable, flag values 0-5 !tr! ... --> ICOADS SUPD col 67 if ( allocated(wd_qc) ) deallocate(wd_qc) allocate(wd_qc(nrec)) status = nf90_inq_varid(ncid, "wind_direction_qc", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, wd_qc) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in wind_height, r*4 variable, m above sea level !tr! ... --> ICOADS variable HOA [* -1, integer value ] !tr! ... --> ICOADS SUPD cols 68-70 *10 if ( allocated(ws_ht) ) deallocate(ws_ht) allocate(ws_ht(nrec)) status = nf90_inq_varid(ncid, "wind_height", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, ws_ht) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in wind_speed_source, i*2, flag values 0-7 !tr! ... --> ICOADS SUPD col 75 if ( allocated(ws_sou) ) deallocate(ws_sou) allocate(ws_sou(nrec)) status = nf90_inq_varid(ncid, "wind_speed_source", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, ws_sou) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in wind_samp, i*2, sampling period, min !tr! ... --> ICOADS SUPD cols 71-74 if ( allocated(ws_sam) ) deallocate(ws_sam) allocate(ws_sam(nrec)) status = nf90_inq_varid(ncid, "wind_samp", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, ws_sam) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in uwind, r*4 variable, m/s !tr! ... --> ICOADS SUPD cols 77-81 *10 if ( allocated(u) ) deallocate(u) allocate(u(nrec)) status = nf90_inq_varid(ncid, "uwind", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, u) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in uwind_qc, i*2 variable, flag_values 0-5 !tr! ... --> ICOADS SUPD col 76 if ( allocated(u_qc) ) deallocate(u_qc) allocate(u_qc(nrec)) status = nf90_inq_varid(ncid, "uwind_qc", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, u_qc) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in vwind, r*4 variable, m/s !tr! ... --> ICOADS SUPD cols 83-87 *10 if ( allocated(v) ) deallocate(v) allocate(v(nrec)) status = nf90_inq_varid(ncid, "vwind", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, v) if (status /= nf90_noerr) call handle_err(status) ! !tr! ... read in vwind_qc, i*2 variable, flag_values 0-5 !tr! ... --> ICOADS SUPD col 82 if ( allocated(v_qc) ) deallocate(v_qc) allocate(v_qc(nrec)) status = nf90_inq_varid(ncid, "vwind_qc", vid) if (status /= nf90_noerr) call handle_err(status) status = nf90_get_var(ncid, vid, v_qc) if (status /= nf90_noerr) call handle_err(status) status = nf90_close(ncid) if (status /= nf90_noerr) call handle_err(status) ! now write out IMMA file do irec = 1, nrec ! do irec = 1, 1 ! imma_unit = 15 ! open(unit=imma_unit, file=imma_file(mo(irec)), status = "unknown", access = "append" ) ! construct supplemental attachment !tr! Format of supplemental attachment for PMEL TAO data (Deck 146) !tr! 1-10 : station name !tr! 11 : longitude qc flag !tr! 12 : latitude qc flag !tr! 13 : SST qc flag !tr! 14-16 : SST depth (m*10) !tr! 17-20 : SST sampling period (min) !tr! 21 : SST source !tr! 22 : AT qc flag !tr! 23-25 : AT height (m*10) !tr! 26-29 : AT sampling period (min) !tr! 30 : AT source !tr! 31 : RH qc flag !tr! 32-34 : RH height (m*10) !tr! 35-38 : RH sampling period (min) !tr! 39 : RH source !tr! 40 : SSS qc flag !tr! 41-43 : SSS depth (m*10) !tr! 44-47 : SSS sampling period (min) !tr! 48 : SSS source !tr! 49-50 : SSS instrument code !tr! 51 : PRES qc flag !tr! 52-54 : PRES height (m*10) !tr! 55-58 : PRES sampling period (min) !tr! 59 : PRES source !tr! 60-65 : PRES at measurement height (10*mb) !tr! 66 : W qc flag !tr! 67 : D qc flag !tr! 68-70 : wind height (m*10) !tr! 71-74 : wind sampling period (min) !tr! 75 : wind source !tr! 76 : u-wind qc flag !tr! 77-81 : u-wind speed (m/s*10) !tr! 82 : v-wind qc flag !tr! 83-87 : v-wind speed (m/s*10) supd_imma = " " do i = 1, 10 if ( ichar(buoy_loc(irec)(i:i)) == 0 ) buoy_loc(irec)(i:i) = " " enddo supd_imma(1:10) = buoy_loc(irec)(1:10) ! position if (lon_qc(irec) >= 0 .and. lon_qc(irec) <= 5 ) & write( supd_imma(11:11), '(i1)') lon_qc(irec) if (lat_qc(irec) >= 0 .and. lat_qc(irec) <= 5 ) & write( supd_imma(12:12), '(i1)') lat_qc(irec) ! SST if (sst_qc(irec) >= 0 .and. sst_qc(irec) <= 5 ) & write( supd_imma(13:13), '(i1)') sst_qc(irec) if (sst_ht(irec) > 0.0 ) then ht_to_op = nint(sst_ht(irec)*10.0) write( supd_imma(14:16), '(i3)') ht_to_op endif if ( sst_sam(irec) > 0 ) write( supd_imma(17:20), '(i4)') sst_sam(irec) if (sst_sou(irec) >= 0 .and. sst_sou(irec) <= 7 ) & write( supd_imma(21:21), '(i1)') sst_sou(irec) ! AT if (at_qc(irec) >= 0 .and. at_qc(irec) <= 5 ) & write( supd_imma(22:22), '(i1)') at_qc(irec) if (at_ht(irec) < 0.0 .and. at_ht(irec) > -50.0 ) then ht_to_op = nint(at_ht(irec)*(-10.0)) write( supd_imma(23:25), '(i3)') ht_to_op endif if ( at_sam(irec) > 0 ) write( supd_imma(26:29), '(i4)') at_sam(irec) if (at_sou(irec) >= 0 .and. at_sou(irec) <= 7 ) & write( supd_imma(30:30), '(i1)') at_sou(irec) ! RH if (rh_qc(irec) >= 0 .and. rh_qc(irec) <= 5 ) & write( supd_imma(31:31), '(i1)') rh_qc(irec) if (rh_ht(irec) < 0.0 .and. rh_ht(irec) > -50.0 ) then ht_to_op = nint(rh_ht(irec)*(-10.0)) write( supd_imma(32:34), '(i3)') ht_to_op endif if ( rh_sam(irec) > 0 ) write( supd_imma(35:38), '(i4)') rh_sam(irec) if (rh_sou(irec) >= 0 .and. rh_sou(irec) <= 7 ) & write( supd_imma(39:39), '(i1)') rh_sou(irec) ! SSS if (sss_qc(irec) >= 0 .and. sss_qc(irec) <= 5 ) & write( supd_imma(40:40), '(i1)') sss_qc(irec) if (sss_ht(irec) > 0.0 ) then ht_to_op = nint(sss_ht(irec)*10.0) write( supd_imma(41:43), '(i3)') ht_to_op endif if ( sss_sam(irec) > 0 ) write( supd_imma(44:47), '(i4)') sss_sam(irec) if (sss_sou(irec) >= 0 .and. sss_sou(irec) <= 7 ) & write( supd_imma(48:48), '(i1)') sss_sou(irec) if (sss_inst(irec) > 0 .and. sss_inst(irec) <= 99 ) & write( supd_imma(49:50), '(i2)') sss_inst(irec) ! PRES if (bp_qc(irec) >= 0 .and. bp_qc(irec) <= 5 ) & write( supd_imma(51:51), '(i1)') bp_qc(irec) if (bp_ht(irec) < 0.0 .and. bp_ht(irec) > -50.0 ) then ht_to_op = nint(bp_ht(irec)*(-10.0)) write( supd_imma(52:54), '(i3)') ht_to_op endif if ( bp_sam(irec) > 0 ) write( supd_imma(55:58), '(i4)') bp_sam(irec) if (bp_sou(irec) >= 0 .and. bp_sou(irec) <= 7 ) & write( supd_imma(59:59), '(i1)') bp_sou(irec) if (bp(irec) >= 0 ) write( supd_imma(60:65), '(i5)') nint(bp(irec)*10.0) ! wind speed if (ws_qc(irec) >= 0 .and. ws_qc(irec) <= 5 ) & write( supd_imma(66:66), '(i1)') ws_qc(irec) ! wind direction if (wd_qc(irec) >= 0 .and. wd_qc(irec) <= 5 ) & write( supd_imma(67:67), '(i1)') wd_qc(irec) ! wind if (ws_ht(irec) < 0.0 .and. ws_ht(irec) > -50.0 ) then ht_to_op = nint(ws_ht(irec)*(-10.0)) write( supd_imma(68:70), '(i3)') ht_to_op endif if ( ws_sam(irec) > 0 ) write( supd_imma(71:74), '(i4)') ws_sam(irec) if ( ws_sou(irec) > 0 ) write( supd_imma(75:75), '(i1)') ws_sou(irec) ! u-wind if (u_qc(irec) >= 0 .and. u_qc(irec) <= 5 ) & write( supd_imma(76:76), '(i1)') u_qc(irec) if (abs(u(irec)) <= 900.0 ) write( supd_imma(77:81), '(i5)') nint(u(irec)*10.0) ! v-wind if (v_qc(irec) >= 0 .and. v_qc(irec) <= 5 ) & write( supd_imma(82:82), '(i1)') v_qc(irec) if (abs(v(irec)) <= 900.0 ) write( supd_imma(83:87), '(i5)') nint(v(irec)*10.0) !write(*,'(a)')trim(supd_imma) !stop !xxxx yr_imma = yr(irec) mo_imma = mo(irec) dy_imma = dy(irec) hr_imma = hr(irec) !tr! IM, IMMA version = 1 im_imma = 1 ! imma version !tr! ATTC, IMMA attachment count = 5 [ICOADS, IMMT, SHIP METADATA, NOCN, SUPPL] attc_imma = 5 ! ICOADS, IMMT, SHIP METADATA, NOCN, SUPPL !tr! TI, time indicator = 3 (high resolution) ti_imma = 3 ! high resolution !tr! LI, position indicator = 5 (high resolution standard value) !tr! LI = 3 if position is interpolated; LI = 6 if default position (other) li_imma = 5 ! standard is high resolution data !tr! if ( lon_qc(irec) == 3 ) then li_imma = 3 ! interpolated elseif ( lon_qc(irec) == 0 ) then li_imma = 6 ! other, default position endif id_imma = " " ! set ID to WMO # if available, else use buoy location identifier !tr! II, ID indicator = 6 for buoy location identifier (station name) !tr! II, ID indicator = 3 for WMO buoy number if ( wmo_no(irec) > 70000 ) then ii_imma = 6 ! station name ! id_imma = trim(buoy_loc(irec)) id_imma = buoy_loc(irec) ! print*,'buoy loc' ! print*,id_imma else ii_imma = 3 ! WMO buoy number write( id_imma, '(i5)') wmo_no(irec) ! print*,'wmo no' ! print*,id_imma endif do i = 1, 9 if ( ichar(id_imma(i:i)) == 0 ) id_imma(i:i) = " " enddo !tr! DI, Wind direction indicator = 6 (high resolution) !tr! If ws < 1.0 m/s then direction = 361 (calm) di_imma = 6 ! high resolution (1dp) if ( wd(irec) > -181.0 ) then d_imma = nint(wd(irec) + 180.0) ! convert to meteorological convention if ( d_imma >= 360 ) d_imma = d_imma - 360 if ( ws(irec) < 1.0 ) d_imma = 361 ! calm, vane/prop stalled at least part of the time else d_imma = rabs endif wi_imma = 8 ! high resolution t1_imma = 8 ! high resolution si_imma = 12 ! electronic sensor dck_imma = 146 ! assigned value sid_imma = 170 ! GTMBA DM if (sst_sou(irec) >= 1 .and. sst_sou(irec) <= 3 ) then sid_imma = 169 ! GTMBA RT elseif (at_sou(irec) >= 1 .and. at_sou(irec) <= 3 ) then sid_imma = 169 ! GTMBA RT elseif (ws_sou(irec) >= 1 .and. ws_sou(irec) <= 3 ) then sid_imma = 169 ! GTMBA RT ! elseif (cur_sou(irec) >= 1 .and. cur_sou(irec) <= 3 ) then ! sid_imma = 169 ! GTMBA RT elseif (bp_sou(irec) >= 1 .and. bp_sou(irec) <= 3 ) then sid_imma = 169 ! GTMBA RT elseif (rh_sou(irec) >= 1 .and. rh_sou(irec) <= 3 ) then sid_imma = 169 ! GTMBA RT elseif (sss_sou(irec) >= 1 .and. sss_sou(irec) <= 3 ) then sid_imma = 169 ! GTMBA RT endif pt_imma = 6 ! moored buoy rhi_imma = 0 ! observed to tenths dos_imma = nint(sst_ht(irec)) mds_imma = 2 if ( at(irec) > -20.0 ) then hot_imma = nint(at_ht(irec))*(-1) else hot_imma = -9999 endif if ( ws(irec) >= 0.0 ) then hoa_imma = nint(ws_ht(irec))*(-1) else hoa_imma = -9999 endif if ( slp(irec) > 500.0 ) then hob_imma = nint(bp_ht(irec))*(-1) else hob_imma = -9999 endif otz_imma = sst_ht(irec) osz_imma = sss_ht(irec) imu = imma_unit(mo_imma) call rwimma1_01B_sub ( imu, yr_imma, mo_imma, & dy_imma, hr_imma, lat(irec), lon(irec), & im_imma, attc_imma, ti_imma, li_imma, ii_imma, & id_imma, di_imma, d_imma, wi_imma, ws(irec), & slp(irec), t1_imma, at(irec), si_imma, sst(irec), & dck_imma, sid_imma, pt_imma, & rhi_imma, rh(irec), mds_imma, dos_imma, hot_imma, & hob_imma, hoa_imma, sst(irec), & otz_imma, sss(irec), osz_imma, supd_imma ) enddo ! do i = 1, 12 close (imma_unit(i)) enddo stop end program conv_gtmba_net2imma ! =========================================================================== ! ===========================================================================