program generate_txcor ! Purpose ! ------- ! Generates the auxiliary files txcor.nc and tycor.nc for the new, ! high-resolution version of the Mk3L coupled model. ! ! These files contain the zonal wind stress adjustments [TXCOR] and the ! meridional wind stress adjustments [TYCOR]. ! ! Note that the climatological wind stresses for the OGCM must be the wind ! stresses that were used to spin up the model. Specifically, the stresses must ! be the monthly values that were supplied to the OGCM via the auxiliary file ! stress.nc. ! ! Note also that this program assumes that the surface wind stress data for the ! AGCM is provided at 32-bit precision, but that the climatological wind ! stresses used to force the OGCM are provided at 64-bit precision. ! ! Usage ! ----- ! ./generate_txcor ! ! ! where: ! ! agcm_file file containing climatological wind stresses for the AGCM ! agcm_var variable containing climatological wind stresses for the AGCM ! ogcm_file file containing climatological wind stresses for the OGCM ! ogcm_var variable containing climatological wind stresses 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 txcor.nc or tycor.nc] ! ! History ! ------- ! 2008 Feb 23 Steven Phipps Original version implicit none include 'netcdf.inc' ! Define local parameters integer, parameter :: nx = 128, & ny = 112 real, dimension(12), parameter :: days = (/ 31.0, 28.0, 31.0, 30.0, & 31.0, 30.0, 31.0, 31.0, & 30.0, 31.0, 30.0, 31.0 /) ! 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, month, monthm1, & monthp1, monvid, ncid, status real :: a, b real(kind=4), dimension(nx) :: lonuv real(kind=4), dimension(ny) :: latuv real(kind=4), dimension(nx, ny, 12) :: agcm, ogcm real, dimension(nx, ny, 12) :: clim, 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 ("txcor.nc") aux_var = "txcor" case ("tycor.nc") aux_var = "tycor" case default write (*, *) write (*, *) & "*** ERROR: Auxiliary file name must be either txcor.nc or tycor.nc" write (*, *) stop end select ! Get AGCM wind stresses 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 wind stresses 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, lonuv) if (status /= nf_noerr) stop "*** netCDF error" status = nf_get_var_real(ncid, latvid, latuv) if (status /= nf_noerr) stop "*** netCDF error" status = nf_get_var_double(ncid, datid, clim) if (status /= nf_noerr) stop "*** netCDF error" status = nf_close(ncid) if (status /= nf_noerr) stop "*** netCDF error" ! Derive the mean wind stresses applied to the OGCM for each month do month = 1, 12 monthm1 = month - 1 if (month == 1) monthm1 = 12 monthp1 = month + 1 if (month == 12) monthp1 = 1 a = days(month) / (days(monthm1) + days(month)) b = days(month) / (days(month) + days(monthp1)) ogcm(:, :, month) = 0.25 * a * clim(:, :, monthm1) + & 0.25 * (4.0 - a - b) * clim(:, :, month) + & 0.25 * b * clim(:, :, monthp1) end do ! 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, "lonuv", nx, londid) if (status /= nf_noerr) stop "*** netCDF error" status = nf_def_dim(ncid, "latuv", 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, "lonuv", nf_float, 1, londid, lonvid) if (status /= nf_noerr) stop "*** netCDF error" status = nf_def_var(ncid, "latuv", 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 UV gridpoints") if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_att_text(ncid, latvid, "long_name", 25, & "Latitude of UV 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, lonuv) if (status /= nf_noerr) stop "*** netCDF error" status = nf_put_var_real(ncid, latvid, latuv) 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_txcor