program generate_hfcor ! Purpose ! ------- ! Generates the auxiliary files hfcor.nc and sfcor.nc for the new, ! high-resolution version of the Mk3L coupled model. ! ! These files contain the surface heat flux adjustments [HFCOR] and the surface ! salinity tendency adjustments [SFCOR]. ! ! Note that this program assumes that the surface flux data for both the AGCM ! and OGCM is provided at 32-bit precision. ! ! Usage ! ----- ! ./generate_hfcor ! ! ! where: ! ! agcm_file file containing climatological surface fluxes for the AGCM ! agcm_var variable containing climatological surface fluxes for the AGCM ! ogcm_file file containing climatological surface fluxes for the OGCM ! ogcm_var variable containing climatological surface fluxes for the OGCM ! lon_var variable containing longitude data for the OGCM ! lat_var variable containing latitude data for the OGCM ! aux_file auxiliary file to generate [must be hfcor.nc or sfcor.nc] ! ! History ! ------- ! 2008 Feb 23 Steven Phipps Original version implicit none include 'netcdf.inc' ! Define local parameters integer, parameter :: nx = 128, & ny = 112 ! Declare local variables character(len=5) :: aux_var character(len=80) :: agcm_file, agcm_var, aux_file, lat_var, lon_var, & ogcm_file, ogcm_var, title character(len=160) :: history integer :: datid, latdid, latvid, londid, lonvid, mondid, monvid, ncid, & status real(kind=4), dimension(nx) :: lonts real(kind=4), dimension(ny) :: latts real(kind=4), dimension(nx, ny, 12) :: agcm, ogcm real, dimension(nx, ny, 12) :: fa ! Get command-line arguments call getarg(1, agcm_file) call getarg(2, agcm_var) call getarg(3, ogcm_file) call getarg(4, ogcm_var) call getarg(5, lon_var) call getarg(6, lat_var) call getarg(7, aux_file) ! Derive name of output variable select case (trim(aux_file)) case ("hfcor.nc") aux_var = "hfcor" case ("sfcor.nc") aux_var = "sfcor" case default write (*, *) write (*, *) & "*** ERROR: Auxiliary file name must be either hfcor.nc or sfcor.nc" write (*, *) stop end select ! Get AGCM surface fluxes status = nf_open(trim(agcm_file), nf_nowrite, ncid) if (status /= nf_noerr) stop "*** netCDF error" status = nf_inq_varid(ncid, trim(agcm_var), datid) if (status /= nf_noerr) stop "*** netCDF error" status = nf_get_var_real(ncid, datid, agcm) if (status /= nf_noerr) stop "*** netCDF error" status = nf_close(ncid) if (status /= nf_noerr) stop "*** netCDF error" ! Get OGCM surface fluxes status = nf_open(trim(ogcm_file), nf_nowrite, ncid) if (status /= nf_noerr) stop "*** netCDF error" status = nf_inq_varid(ncid, trim(lon_var), lonvid) if (status /= nf_noerr) stop "*** netCDF error" status = nf_inq_varid(ncid, trim(lat_var), latvid) if (status /= nf_noerr) stop "*** netCDF error" status = nf_inq_varid(ncid, trim(ogcm_var), datid) if (status /= nf_noerr) stop "*** netCDF error" status = nf_get_var_real(ncid, lonvid, lonts) if (status /= nf_noerr) stop "*** netCDF error" status = nf_get_var_real(ncid, latvid, latts) if (status /= nf_noerr) stop "*** netCDF error" status = nf_get_var_real(ncid, datid, ogcm) if (status /= nf_noerr) stop "*** netCDF error" status = nf_close(ncid) if (status /= nf_noerr) stop "*** netCDF error" ! Derive the flux adjustments fa = agcm - ogcm ! Get title and history data for netCDF output file write (*, *) write (*, *) "Please enter the title and history for the output file :" write (*, *) write (*, '(a)', advance='no') "Title : " read (*, '(a)') title write (*, '(a)', advance='no') "History : " read (*, '(a)') history ! Generate netCDF output file ! ! (1) Create netCDF file status = nf_create(trim(aux_file), nf_noclobber, ncid) if (status /= nf_noerr) stop "*** netCDF error" ! (2) Define dimensions status = nf_def_dim(ncid, "lonts", nx, londid) if (status /= nf_noerr) stop "*** netCDF error" status = nf_def_dim(ncid, "latts", ny, latdid) if (status /= nf_noerr) stop "*** netCDF error" status = nf_def_dim(ncid, "month", 12, mondid) if (status /= nf_noerr) stop "*** netCDF error" ! (3) Define variables status = nf_def_var(ncid, "lonts", nf_float, 1, londid, lonvid) if (status /= nf_noerr) stop "*** netCDF error" status = nf_def_var(ncid, "latts", nf_float, 1, latdid, latvid) if (status /= nf_noerr) stop "*** netCDF error" status = nf_def_var(ncid, "month", nf_int, 1, mondid, monvid) if (status /= nf_noerr) stop "*** netCDF error" status = nf_def_var(ncid, trim(aux_var), nf_double, 3, & (/ londid, latdid, mondid /), datid) if (status /= nf_noerr) stop "*** netCDF error" ! (4) Create attributes status = nf_put_att_text(ncid, lonvid, "long_name", 26, & "Longitude of TS gridpoints") if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_att_text(ncid, latvid, "long_name", 25, & "Latitude of TS gridpoints") if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_att_text(ncid, lonvid, "units", 12, "degrees_east") if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_att_text(ncid, latvid, "units", 13, "degrees_north") if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_att_text(ncid, monvid, "units", 6, "months") if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_att_text(ncid, lonvid, "modulo", 1, " ") if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_att_text(ncid, monvid, "modulo", 1, " ") if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_att_text(ncid, lonvid, "point_spacing", 4, "even") if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_att_text(ncid, latvid, "point_spacing", 6, "uneven") if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_att_text(ncid, monvid, "point_spacing", 4, "even") if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_att_text(ncid, nf_global, "title", len(trim(title)), & trim(title)) if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_att_text(ncid, nf_global, "history", len(trim(history)), & trim(history)) if (status /= nf_noerr) stop "*** netCDF error" ! (5) Exit define mode status = nf_enddef(ncid) if (status /= nf_noerr) stop "*** netCDF error" ! (6) Write data status = nf_put_var_real(ncid, lonvid, lonts) if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_var_real(ncid, latvid, latts) if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_var_int(ncid, monvid, (/ 1, 2, 3, 4, 5, 6, & 7, 8, 9, 10, 11, 12 /)) if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_var_double(ncid, datid, fa) if (status /= nf_noerr) stop "*** netCDF error" ! (7) Close netCDF file status = nf_close(ncid) if (status /= nf_noerr) stop "*** netCDF error" end program generate_hfcor