Changeset 1263 for LMDZ4/branches/LMDZ4-dev/libf/bibio

Timestamp:

Nov 17, 2009, 2:00:14 PM (15 years ago)

Author:

lguez

Message:

1) Reactivated ability to read ozone (that was deactivated because of
dependency on version of IOIPSL). Added ability to read a pressure
coordinate in Pa in "regr_lat_time_climoz".

2) Added the ability to read a second ozone climatology, corresponding to
daylight ozone:

-- "read_climoz" is now an integer variable, instead of a logical
variable.

-- Added argument "read_climoz" to "phys_state_var_init",
"phys_output_open" and "regr_lat_time_climoz".

-- Created new variable "ozone_daylight" for "hist*.nc" output files.

-- Added a third dimension to variable "wo" in module
"phys_state_var_mod" and variable "POZON" in "radlwsw": index 1 for
average day-night ozone, index 2 for daylight ozone.

-- Added a fourth dimension to variables "o3_in", "o3_regr_lat" and
"o3_out" in "regr_lat_time_climoz": index 1 for average day-night
ozone, index 2 for daylight ozone.

-- In "physiq", moved call to "conf_phys" before call to
"phys_state_var_init". Thus, "conf_phys" is now inside the block "if
(first)" instead of "IF (debut)". There were definitions of "bl95_b0"
and "bl95_b1" that were useless because the variables were overwritten
by "conf_phys". Removed those definitions.

-- In "radlwsw", we pass the average day-night ozone to "LW_LMDAR4"
and the daylight ozone, if we have it, to "SW_LMDAR4" or
"SW_AEROAR4". If we do not have a specific field for daylight ozone
then "SW_LMDAR4" or "SW_AEROAR4" just get the average day-night ozone.

-- "regr_lat_time_climoz" now manages latitudes where the input ozone
field is missing at all levels (polar night).

-- Encapsulated "radlwsw" in a module.

3) Modifications to make sequential and parallel versions of
"create_etat0_limit" almost identical:

-- In "dyn3dpar/create_etat0_limit.F". No need to call
"phys_state_var_init", removed "use phys_state_var_mod" statement. No
need for "clesphys.h", removed "include" statement.

-- In "dyn3dpar/etat0_netcdf.F". Added argument "tau_ratqs" in call to
"conf_phys" (this bug was already corrected in "dyn3d"). Moved call to
"inifilr" after call to "infotrac_init" (as in "dyn3d").

4) Other peripheral modifications:

-- Added procedures "nf95_get_att" and "nf95_def_var_scalar" in
NetCDF95 interface. Overloaded "nf95_put_var" with three more
procedures: "nf95_put_var_FourByteReal", "nf95_put_var_FourByteInt",
"nf95_put_var_1D_FourByteInt".

-- Overloaded "regr1_step_av" with one more procedure:
"regr14_step_av". Overloaded "regr3_lint" with one more procedure:
"regr34_lint".

-- Corrected call to "Init_Phys_lmdz" in "dyn3d/create_etat0_limit.F":
the last argument should be an array, not a scalar.

-- Encapsulated "conf_phys" in a module.

-- Splitted module "regr_pr" into "regr_pr_av_m" and "regr_pr_int_m".

5) Tests:

This revision was compared to revision 1259, with optimization options
"debug" and "dev", parallelization options "none", "mpi", "omp" and
"mpi_omp", 1 and 2 MPI processes, 1 and 2 OpenMP threads, with the
compiler "FORTRAN90/SX Version 2.0 for SX-8". Both programs
"create_etat0_limit" and "gcm" were tested. In all cases,
parallelization does not change the results. With "read_climoz = 0" in
the ".def" files, the results of revision 1259 and of this revision
are the same.

Location:

LMDZ4/branches/LMDZ4-dev/libf/bibio

Files:

• netcdf95.F90 (modified) (2 diffs)
• nf95_def_var_m.F90 (modified) (2 diffs)
• nf95_get_att_m.F90 (added)
• nf95_put_var_m.F90 (modified) (3 diffs)
• regr1_step_av_m.F90 (modified) (2 diffs)
• regr3_lint_m.F90 (modified) (2 diffs)
• simple.F90 (modified) (1 diff)

LMDZ4/branches/LMDZ4-dev/libf/bibio/netcdf95.F90

@@ -25 +25 @@
   ! criticisms for some (not all) procedures.
 
+  ! "nf95_get_att" is more secure than "nf90_get_att" because it
+  ! checks that the "values" argument is long enough and removes the
+  ! null terminator, if any.
+
   ! This module replaces some of the official NetCDF procedures.
   ! This module also provides the procedures "handle_err" and "nf95_gw_var".
@@ -35 +39 @@
   use nf95_gw_var_m
   use nf95_put_att_m
+  use nf95_get_att_m
   use simple
   use handle_err_m

LMDZ4/branches/LMDZ4-dev/libf/bibio/nf95_def_var_m.F90

@@ -1 +1 @@
 ! $Id$
 module nf95_def_var_m
+
+  ! The generic procedure name "nf90_def_var" applies to
+  ! "nf90_def_var_Scalar" but we cannot apply the generic procedure name
+  ! "nf95_def_var" to "nf95_def_var_scalar" because of the additional
+  ! optional argument.
+  ! "nf95_def_var_scalar" cannot be distinguished from "nf95_def_var_oneDim".
 
   implicit none
@@ -9 +15 @@
 
   private
-  public nf95_def_var
+  public nf95_def_var, nf95_def_var_scalar
 
 contains
+
+  subroutine nf95_def_var_scalar(ncid, name, xtype, varid, ncerr)
+
+    use netcdf, only: nf90_def_var
+    use handle_err_m, only: handle_err
+
+    integer,               intent( in) :: ncid
+    character (len = *),   intent( in) :: name
+    integer,               intent( in) :: xtype
+    integer,               intent(out) :: varid
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_def_var(ncid, name, xtype, varid)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_def_var_scalar " // name, ncerr_not_opt, ncid)
+    end if
+
+  end subroutine nf95_def_var_scalar
+
+  !***********************
 
   subroutine nf95_def_var_oneDim(ncid, name, xtype, dimids, varid, ncerr)

LMDZ4/branches/LMDZ4-dev/libf/bibio/nf95_put_var_m.F90

@@ -5 +5 @@
 
   interface nf95_put_var
-     module procedure nf95_put_var_1D_FourByteReal, &
+     module procedure nf95_put_var_FourByteReal, nf95_put_var_FourByteInt, &
+          nf95_put_var_1D_FourByteReal, nf95_put_var_1D_FourByteInt, &
           nf95_put_var_2D_FourByteReal, nf95_put_var_3D_FourByteReal, &
           nf95_put_var_4D_FourByteReal
@@ -19 +20 @@
 contains
 
+  subroutine nf95_put_var_FourByteReal(ncid, varid, values, start, ncerr)
+
+    use netcdf, only: nf90_put_var
+    use handle_err_m, only: handle_err
+
+    integer, intent( in) :: ncid, varid
+    real, intent( in) :: values
+    integer, dimension(:), optional, intent( in) :: start
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_var(ncid, varid, values, start)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_var_FourByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_put_var_FourByteReal
+
+  !***********************
+
+  subroutine nf95_put_var_FourByteInt(ncid, varid, values, start, ncerr)
+
+    use netcdf, only: nf90_put_var
+    use handle_err_m, only: handle_err
+
+    integer, intent( in) :: ncid, varid
+    integer, intent( in) :: values
+    integer, dimension(:), optional, intent( in) :: start
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_var(ncid, varid, values, start)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_var_FourByteInt", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_put_var_FourByteInt
+
+  !***********************
+
   subroutine nf95_put_var_1D_FourByteReal(ncid, varid, values, start, count, &
        stride, map, ncerr)
@@ -45 +100 @@
 
   end subroutine nf95_put_var_1D_FourByteReal
+
+  !***********************
+
+  subroutine nf95_put_var_1D_FourByteInt(ncid, varid, values, start, count, &
+       stride, map, ncerr)
+
+    use netcdf, only: nf90_put_var
+    use handle_err_m, only: handle_err
+
+    integer,                         intent(in) :: ncid, varid
+    integer, intent(in) :: values(:)
+    integer, dimension(:), optional, intent(in) :: start, count, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count, stride, &
+         map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_var_1D_FourByteInt", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_put_var_1D_FourByteInt
 
   !***********************

LMDZ4/branches/LMDZ4-dev/libf/bibio/regr1_step_av_m.F90

@@ -17 +17 @@
      ! The difference between the procedures is the rank of the first argument.
 
-     module procedure regr11_step_av, regr12_step_av, regr13_step_av
+     module procedure regr11_step_av, regr12_step_av, regr13_step_av, &
+          regr14_step_av
   end interface
 
@@ -203 +204 @@
   end function regr13_step_av
 
+  !********************************************
+
+  function regr14_step_av(vs, xs, xt) result(vt)
+
+    ! "vs" has rank 4.
+
+    use assert_eq_m, only: assert_eq
+    use assert_m, only: assert
+    use interpolation, only: locate
+
+    real, intent(in):: vs(:, :, :, :) ! values of steps on the source grid
+    ! (Step "is" is between "xs(is)" and "xs(is + 1)".)
+
+    real, intent(in):: xs(:)
+    ! (edges of steps on the source grid, in strictly increasing order)
+
+    real, intent(in):: xt(:)
+    ! (edges of cells of the target grid, in strictly increasing order)
+
+    real vt(size(xt) - 1, size(vs, 2), size(vs, 3), size(vs, 4))
+    ! (average values on the target grid)
+    ! (Cell "it" is between "xt(it)" and "xt(it + 1)".)
+
+    ! Variables local to the procedure:
+    integer is, it, ns, nt
+    real left_edge
+
+    !---------------------------------------------
+
+    ns = assert_eq(size(vs, 1), size(xs) - 1, "regr14_step_av ns")
+    nt = size(xt) - 1
+
+    ! Quick check on sort order:
+    call assert(xs(1) < xs(2), "regr14_step_av xs bad order")
+    call assert(xt(1) < xt(2), "regr14_step_av xt bad order")
+
+    call assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
+         "regr14_step_av extrapolation")
+
+    is = locate(xs, xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
+    do it = 1, nt
+       ! 1 <= is <= ns
+       ! xs(is) <= xt(it) < xs(is + 1)
+       ! Compute "vt(it, :, :, :)":
+       left_edge = xt(it)
+       vt(it, :, :, :) = 0.
+       do while (xs(is + 1) < xt(it + 1))
+          ! 1 <= is <= ns - 1
+          vt(it, :, :, :) = vt(it, :, :, :) + (xs(is + 1) - left_edge) &
+               * vs(is, :, :, :)
+          is = is + 1
+          left_edge = xs(is)
+       end do
+       ! 1 <= is <= ns
+       vt(it, :, :, :) = (vt(it, :, :, :) + (xt(it + 1) - left_edge) &
+            * vs(is, :, :, :)) / (xt(it + 1) - xt(it))
+       if (xs(is + 1) == xt(it + 1)) is = is + 1
+       ! 1 <= is <= ns .or. it == nt
+    end do
+
+  end function regr14_step_av
+
 end module regr1_step_av_m

LMDZ4/branches/LMDZ4-dev/libf/bibio/regr3_lint_m.F90

@@ -11 +11 @@
      ! input array.
      ! The difference betwwen the procedures is the rank of the first argument.
-     module procedure regr33_lint
+     module procedure regr33_lint, regr34_lint
   end interface
 
@@ -57 +57 @@
   end function regr33_lint
 
+  !*********************************************************
+
+  function regr34_lint(vs, xs, xt) result(vt)
+
+    ! "vs" has rank 4.
+
+    use assert_eq_m, only: assert_eq
+    use interpolation, only: hunt
+
+    real, intent(in):: vs(:, :, :, :)
+    ! (values of the function at source points "xs")
+
+    real, intent(in):: xs(:)
+    ! (abscissas of points in source grid, in strictly monotonic order)
+
+    real, intent(in):: xt(:)
+    ! (abscissas of points in target grid)
+
+    real vt(size(vs, 1), size(vs, 2), size(xt), size(vs, 4))
+    ! (values of the function on the target grid)
+
+    ! Variables local to the procedure:
+    integer is, it, ns
+    integer is_b ! "is" bound between 1 and "ns - 1"
+
+    !--------------------------------------
+
+    ns = assert_eq(size(vs, 3), size(xs), "regr34_lint ns")
+
+    is = -1 ! go immediately to bisection on first call to "hunt"
+
+    do it = 1, size(xt)
+       call hunt(xs, xt(it), is)
+       is_b = min(max(is, 1), ns - 1)
+       vt(:, :, it, :) = ((xs(is_b+1) - xt(it)) * vs(:, :, is_b, :) &
+            + (xt(it) - xs(is_b)) * vs(:, :, is_b+1, :)) &
+            / (xs(is_b+1) - xs(is_b))
+    end do
+
+  end function regr34_lint
+
 end module regr3_lint_m

LMDZ4/branches/LMDZ4-dev/libf/bibio/simple.F90

@@ -118 +118 @@
     ! unknown in the calling procedure, before the call.
     ! Here we use a better solution: a pointer argument array.
-    ! This procedure associates and defines '"dimids" if it is present.
+    ! This procedure associates and defines "dimids" if it is present.
 
     use netcdf, only: nf90_inquire_variable, nf90_max_var_dims