--- trunk/libf/phylmd/Mobidic/regr_pr_coefoz.f90 2008/04/18 14:45:53 10 +++ trunk/Sources/phylmd/Mobidic/regr_pr_av.f 2015/09/09 10:41:47 168 @@ -1,141 +1,86 @@ -module regr_pr_coefoz +module regr_pr_av_m implicit none contains - subroutine regr_pr_av_coefoz(ncid, name, julien, press_in_edg, v3) + subroutine regr_pr_av(ncid, name, julien, paprs, v3) - ! "regr_pr_av_coefoz" stands for "regrid pressure averaging - ! coefficient ozone". - ! This procedure reads a single Mobidic ozone coefficient from - !"coefoz_LMDZ.nc", at the current day, regrids this parameter in - ! pressure to the LMDZ vertical grid and packs it to the LMDZ - ! horizontal "physics" grid. - ! Regridding in pressure is done by averaging a step function. + ! "regr_pr_av" stands for "regrid pressure averaging". - use dimens_m, only: iim, jjm, llm - use dimphy, only: klon - use netcdf95, only: nf95_inq_varid, handle_err - use netcdf, only: nf90_get_var - use grid_change, only: dyn_phy - use regr_pr, only: regr_pr_av - use nrutil, only: assert - - integer, intent(in):: ncid ! NetCDF ID of the file - character(len=*), intent(in):: name ! of the NetCDF variable - integer, intent(in):: julien ! jour julien, 1 <= julien <= 360 + ! This procedure reads a 2D latitude-pressure field from a NetCDF + ! file, at a given day, regrids this field in pressure to the LMDZ + ! vertical grid and packs it to the LMDZ horizontal "physics" + ! grid. - real, intent(in):: press_in_edg(:) - ! (edges of pressure intervals for Mobidic data, in Pa, in - ! strictly increasing order) + ! We assume that, in the input file, the field has 3 dimensions: + ! latitude, pressure, julian day. - real, intent(out):: v3(:, :) ! (klon, llm) - ! (ozone coefficient from Mobidic on the "physics" grid) - ! ("v3(i, k)" is at longitude "xlon(i)", latitude - ! "xlat(i)", middle of layer "k".) + ! We assume that the input field is already on the LMDZ "rlatu" + ! latitudes, except that latitudes are in ascending order in the + ! input file. - ! Variables local to the procedure: - integer varid, ncerr - integer k - - real v1(jjm + 1, size(press_in_edg) - 1) - ! (ozone coefficient from "coefoz_LMDZ.nc" at day "julien") - ! ("v1(j, k)" is at latitude "rlatu(j)" and for - ! pressure interval "[press_in_edg(k), press_in_edg(k+1)]".) - - real v2(iim + 1, jjm + 1, llm) - ! (ozone parameter from Mobidic on the "dynamics" grid) - ! "v2(i, j, k)" is at longitude "rlonv(i)", latitude - ! "rlatu(j)", middle of layer "k".) - - !-------------------------------------------- - - call assert(shape(v3) == (/klon, llm/), "regr_pr_av_coefoz") - - call nf95_inq_varid(ncid, name, varid) - - ! Get data at the right day from the input file: - ncerr = nf90_get_var(ncid, varid, v1, start=(/1, 1, julien/)) - call handle_err("regr_pr_av_coefoz nf90_get_var " // name, ncerr, ncid) - ! Latitudes are in increasing order in the input file while - ! "rlatu" is in decreasing order so we need to invert order: - v1 = v1(jjm+1:1:-1, :) - - ! Regrid in pressure at each horizontal position: - v2 = regr_pr_av(v1, press_in_edg) - - forall (k = 1:llm) v3(:, k) = pack(v2(:, :, k), dyn_phy) - - end subroutine regr_pr_av_coefoz - - !*************************************************************** - - subroutine regr_pr_int_coefoz(ncid, name, julien, plev, top_value, v3) - - ! This procedure reads a single Mobidic ozone coefficient from - !"coefoz_LMDZ.nc", at the current day, regrids this parameter in - ! pressure to the LMDZ vertical grid and packs it to the LMDZ - ! horizontal "physics" grid. - ! Regridding is by linear interpolation. + ! The target vertical LMDZ grid is the grid of layer boundaries. + ! Regridding in pressure is done by averaging a step function of pressure. use dimens_m, only: iim, jjm, llm use dimphy, only: klon - use netcdf95, only: nf95_inq_varid, handle_err - use netcdf, only: nf90_get_var - use grid_change, only: dyn_phy - use regr_pr, only: regr_pr_int - use nrutil, only: assert + use grid_change, only: gr_dyn_phy + use netcdf95, only: nf95_inq_varid, nf95_get_var + use nr_util, only: assert + use numer_rec_95, only: regr1_step_av + use press_coefoz_m, only: press_in_edg integer, intent(in):: ncid ! NetCDF ID of the file character(len=*), intent(in):: name ! of the NetCDF variable integer, intent(in):: julien ! jour julien, 1 <= julien <= 360 - real, intent(in):: plev(:) - ! (pressure levels of Mobidic data, in Pa, in strictly increasing order) - - real, intent(in):: top_value - ! (extra value of ozone coefficient at 0 pressure) + real, intent(in):: paprs(:, :) ! (klon, llm + 1) + ! (pression pour chaque inter-couche, en Pa) real, intent(out):: v3(:, :) ! (klon, llm) - ! (ozone parameter from Mobidic on the "physics" grid) - ! ("v3(i, k)" is at longitude "xlon(i)", latitude - ! "xlat(i)", middle of layer "k".) + ! regridded field on the partial "physics" grid + ! "v3(i, k)" is at longitude "xlon(i)", latitude "xlat(i)", in + ! layer "k". ! Variables local to the procedure: - integer varid, ncerr - integer k - real v1(jjm + 1, 0:size(plev)) - ! (ozone coefficient from "coefoz_LMDZ.nc" at day "julien") - ! ("v1(j, k >=1)" is at latitude "rlatu(j)" and pressure "plev(k)".) - - real v2(iim + 1, jjm + 1, llm) - ! (ozone parameter from Mobidic on the "dynamics" grid) - ! "v2(i, j, k)" is at longitude "rlonv(i)", latitude - ! "rlatu(j)", middle of layer "k".) + integer varid ! for NetCDF + + real v1(jjm + 1, size(press_in_edg) - 1) + ! input field at day "julien" + ! "v1(j, k)" is at latitude "rlatu(j)" and for + ! pressure interval "[press_in_edg(k), press_in_edg(k+1)]". + + real v2(klon, size(press_in_edg) - 1) + ! Field on the "physics" horizontal grid. "v2(i, k)" is at + ! longitude "xlon(i)", latitude "xlat(i)" and for pressure + ! interval "[press_in_edg(k), press_in_edg(k+1)]".) + + integer i !-------------------------------------------- - call assert(shape(v3) == (/klon, llm/), "regr_pr_int_coefoz") + call assert(shape(v3) == (/klon, llm/), "regr_pr_av klon llm") + call assert(shape(paprs) == (/klon, llm+1/), "regr_pr_av paprs") call nf95_inq_varid(ncid, name, varid) ! Get data at the right day from the input file: - ncerr = nf90_get_var(ncid, varid, v1(:, 1:), start=(/1, 1, julien/)) - call handle_err("regr_pr_int_coefoz nf90_get_var " // name, ncerr, ncid) - ! Latitudes are in increasing order in the input file while - ! "rlatu" is in decreasing order so we need to invert order: - v1(:, 1:) = v1(jjm+1:1:-1, 1:) + call nf95_get_var(ncid, varid, v1, start=(/1, 1, julien/)) + ! Latitudes are in ascending order in the input file while + ! "rlatu" is in descending order so we need to invert order: + v1 = v1(jjm+1:1:-1, :) - ! Complete "v1" with the value at 0 pressure: - v1(:, 0) = top_value + v2 = gr_dyn_phy(spread(v1, dim = 1, ncopies = iim + 1)) ! Regrid in pressure at each horizontal position: - v2 = regr_pr_int(v1, (/0., plev/)) - - forall (k = 1:llm) v3(:, k) = pack(v2(:, :, k), dyn_phy) + do i = 1, klon + v3(i, llm:1:-1) = regr1_step_av(v2(i, :), press_in_edg, & + paprs(i, llm+1:1:-1)) + ! (invert order of indices because "paprs" is in descending order) + end do - end subroutine regr_pr_int_coefoz + end subroutine regr_pr_av -end module regr_pr_coefoz +end module regr_pr_av_m