Parent Directory
| 
Revision Log
This revision is not in working order. Pending some moving of files. Important changes. In the program "etat0_lim": ozone coefficients from Mobidic are regridded in time instead of pressure ; consequences in "etat0". In the program "gcm", ozone coefficients from Mobidic are read once per day only for the current day and regridded in pressure ; consequences in "o3_chem_m", "regr_pr_coefoz", "phytrac" and "regr_pr_comb_coefoz_m". NetCDF95 is a library and does not export NetCDF. New variables "nag_gl_options", "nag_fcalls_options" and "nag_cross_options" in "nag_tools.mk". "check_coefoz.jnl" rewritten entirely for new version of "coefoz_LMDZ.nc". Target "obj_etat0_lim" moved from "GNUmakefile" to "nag_rules.mk". Added some "intent" attributes in "calfis", "clmain", "clqh", "cltrac", "cltracrn", "cvltr", "ini_undefSTD", "moy_undefSTD", "nflxtr", "phystokenc", "phytrac", "readsulfate", "readsulfate_preind" and "undefSTD". In "dynetat0", "dynredem0" and "gcm", "phis" has rank 2 instead of 1. "phis" has assumed shape in "dynredem0". Added module containing "dynredem0". Changed some calls with NetCDF Fortran 77 interface to calls with NetCDF95 interface. Replaced calls to "ssum" by calls to "sum" in "inigeom". In "make.sh", new option "-c" to change compiler. In "aaam_bud", argument "rjour" deleted. In "physiq": renamed some variables; deleted variable "xjour". In "phytrac": renamed some variables; new argument "lmt_pas".
| 1 | module regr3_lint_m |
| 2 | |
| 3 | implicit none |
| 4 | |
| 5 | interface regr3_lint |
| 6 | ! Each procedure regrids by linear interpolation. |
| 7 | ! The regridding operation is done on the third dimension of the |
| 8 | ! input array. |
| 9 | ! The difference betwwen the procedures is the rank of the first argument. |
| 10 | module procedure regr33_lint |
| 11 | end interface |
| 12 | |
| 13 | private |
| 14 | public regr3_lint |
| 15 | |
| 16 | contains |
| 17 | |
| 18 | function regr33_lint(vs, xs, xt) result(vt) |
| 19 | |
| 20 | ! "vs" has rank 3. |
| 21 | |
| 22 | use nrutil, only: assert_eq |
| 23 | use interpolation, only: hunt |
| 24 | |
| 25 | real, intent(in):: vs(:, :, :) |
| 26 | ! (values of the function at source points "xs") |
| 27 | |
| 28 | real, intent(in):: xs(:) |
| 29 | ! (abscissas of points in source grid, in strictly monotonic order) |
| 30 | |
| 31 | real, intent(in):: xt(:) |
| 32 | ! (abscissas of points in target grid) |
| 33 | |
| 34 | real vt(size(vs, 1), size(vs, 2), size(xt)) |
| 35 | ! (values of the function on the target grid) |
| 36 | |
| 37 | ! Variables local to the procedure: |
| 38 | integer is, it, ns |
| 39 | integer is_b ! "is" bound between 1 and "ns - 1" |
| 40 | |
| 41 | !-------------------------------------- |
| 42 | |
| 43 | ns = assert_eq(size(vs, 3), size(xs), "regr33_lint ns") |
| 44 | |
| 45 | is = -1 ! go immediately to bisection on first call to "hunt" |
| 46 | |
| 47 | do it = 1, size(xt) |
| 48 | call hunt(xs, xt(it), is) |
| 49 | is_b = min(max(is, 1), ns - 1) |
| 50 | vt(:, :, it) = ((xs(is_b+1) - xt(it)) * vs(:, :, is_b) & |
| 51 | + (xt(it) - xs(is_b)) * vs(:, :, is_b+1)) / (xs(is_b+1) - xs(is_b)) |
| 52 | end do |
| 53 | |
| 54 | end function regr33_lint |
| 55 | |
| 56 | end module regr3_lint_m |
| ViewVC Help | |
| Powered by ViewVC 1.1.21 |