|
◆ volgrid6d_transform()
subroutine volgrid6d_transform |
( |
type(transform_def), intent(in) |
this, |
|
|
type(griddim_def), intent(in), optional |
griddim, |
|
|
type(volgrid6d), intent(inout) |
volgrid6d_in, |
|
|
type(volgrid6d), intent(out) |
volgrid6d_out, |
|
|
type(vol7d_level), dimension(:), intent(in), optional, target |
lev_out, |
|
|
type(volgrid6d), intent(in), optional |
volgrid6d_coord_in, |
|
|
real, dimension(:,:), intent(in), optional |
maskgrid, |
|
|
real, dimension(:), intent(in), optional |
maskbounds, |
|
|
logical, intent(in), optional |
clone, |
|
|
logical, intent(in), optional |
decode, |
|
|
character(len=*), intent(in), optional |
categoryappend |
|
) |
| |
Performs the specified abstract transformation on the data provided.
The abstract transformation is specified by this parameter; the corresponding specifical transformation (grid_transform object) is created and destroyed internally. The output transformed object is created internally and it does not require preliminary initialisation. - Parametri
-
[in] | this | object specifying the abstract transformation |
[in] | griddim | griddim specifying the output grid (required by most transformation types) |
[in,out] | volgrid6d_in | object to be transformed, it is not modified, despite the INTENT(inout) |
[out] | volgrid6d_out | transformed object, it does not require initialisation |
[in] | lev_out | vol7d_level object defining target vertical grid, for vertical interpolations |
[in] | volgrid6d_coord_in | object providing time constant input vertical coordinate for some kind of vertical interpolations |
[in] | maskgrid | 2D field to be used for defining subareas according to its values, it must have the same shape as the field to be interpolated (for transformation subtype 'maskfill') |
[in] | maskbounds | array of boundary values for defining a subset of valid points where the values of maskgrid are within the first and last value of maskbounds (for transformation type 'metamorphosis:maskfill') |
[in] | clone | if provided and .TRUE. , clone the gaid's from volgrid6d_in to volgrid6d_out |
[in] | decode | determine whether the data in volgrid6d_out should be decoded or remain coded in gaid, if not provided, the decode status is taken from volgrid6d_in |
[in] | categoryappend | append this suffix to log4fortran namespace category |
Definizione alla linea 1793 del file volgrid6d_class.F90.
1795 time_definition=volgrid6d_in%time_definition, categoryappend=categoryappend)
1796 IF (c_e(var_coord_in)) THEN
1797 CALL init(grid_trans, this, lev_in=volgrid6d_in%level, lev_out=lev_out, &
1798 coord_3d_in=coord_3d_in, categoryappend=categoryappend)
1800 CALL init(grid_trans, this, lev_in=volgrid6d_in%level, lev_out=lev_out, &
1801 categoryappend=categoryappend)
1804 CALL get_val(grid_trans, output_level_auto=llev_out)
1805 IF (.NOT. ASSOCIATED(llev_out)) llev_out => lev_out
1806 nlevel = SIZE(llev_out)
1808 CALL l4f_category_log(volgrid6d_in%category, l4f_error, &
1809 'volgrid6d_transform: vertint requested but lev_out not provided')
1810 CALL init(volgrid6d_out)
1816 CALL init(volgrid6d_out, griddim=griddim, &
1817 time_definition=volgrid6d_in%time_definition, categoryappend=categoryappend)
1818 CALL init(grid_trans, this, in=volgrid6d_in%griddim, out=volgrid6d_out%griddim, &
1819 maskgrid=maskgrid, maskbounds=maskbounds, categoryappend=categoryappend)
1823 IF (c_e(grid_trans)) THEN
1825 CALL volgrid6d_alloc(volgrid6d_out, ntime=ntime, nlevel=nlevel, &
1826 ntimerange=ntimerange, nvar=nvar)
1828 IF ( PRESENT(decode)) THEN
1831 ldecode = ASSOCIATED(volgrid6d_in%voldati)
1834 decode_loop: DO i6 = 1,nvar
1835 DO i5 = 1, ntimerange
1838 IF (c_e(volgrid6d_in%gaid(i3,i4,i5,i6))) THEN
1839 ldecode = ldecode .OR. grid_id_readonly(volgrid6d_in%gaid(i3,i4,i5,i6))
1847 IF ( PRESENT(decode)) THEN
1848 IF (ldecode.NEQV.decode) THEN
1849 CALL l4f_category_log(volgrid6d_in%category, l4f_warn, &
1850 'volgrid6d_transform: decode status forced to .TRUE. because driver does not allow copy')
1854 CALL volgrid6d_alloc_vol(volgrid6d_out, decode=ldecode)
1859 IF (trans_type == 'vertint') THEN
1861 CALL l4f_category_log(volgrid6d_in%category, l4f_debug, &
1862 "volgrid6d_transform: vertint to "//t2c(nlevel)// " levels")
1864 CALL compute(grid_trans, volgrid6d_in, volgrid6d_out, lev_out=llev_out, &
1865 var_coord_vol=var_coord_vol, clone=clone)
1867 CALL compute(grid_trans, volgrid6d_in, volgrid6d_out, clone=clone)
1870 IF (cf_out == 0) THEN
1871 CALL wind_unrot(volgrid6d_out)
1872 ELSE IF (cf_out == 1) THEN
1873 CALL wind_rot(volgrid6d_out)
1878 CALL l4f_category_log(volgrid6d_in%category, l4f_error, &
1879 'volgrid6d_transform: transformation not valid')
1883 CALL delete (grid_trans)
1885 END SUBROUTINE volgrid6d_transform
1896 SUBROUTINE volgrid6dv_transform(this, griddim, volgrid6d_in, volgrid6d_out, &
1897 lev_out, volgrid6d_coord_in, maskgrid, maskbounds, clone, decode, categoryappend)
1898 TYPE(transform_def), INTENT(in) :: this
1899 TYPE(griddim_def), INTENT(in), OPTIONAL :: griddim
1900 TYPE(volgrid6d), INTENT(inout) :: volgrid6d_in(:)
1901 TYPE(volgrid6d), POINTER :: volgrid6d_out(:)
1902 TYPE(vol7d_level), INTENT(in), OPTIONAL :: lev_out(:)
1903 TYPE(volgrid6d), INTENT(in), OPTIONAL :: volgrid6d_coord_in
1904 REAL, INTENT(in), OPTIONAL :: maskgrid(:,:)
1905 REAL, INTENT(in), OPTIONAL :: maskbounds(:)
1906 LOGICAL, INTENT(in), OPTIONAL :: clone
1907 LOGICAL, INTENT(in), OPTIONAL :: decode
1908 CHARACTER(len=*), INTENT(in), OPTIONAL :: categoryappend
1910 INTEGER :: i, stallo
1913 allocate(volgrid6d_out( size(volgrid6d_in)),stat=stallo)
1914 if (stallo /= 0) then
1915 call l4f_log(l4f_fatal, "allocating memory")
1916 call raise_fatal_error()
1919 do i=1, size(volgrid6d_in)
1920 call transform(this, griddim, volgrid6d_in(i), volgrid6d_out(i), &
1921 lev_out=lev_out, volgrid6d_coord_in=volgrid6d_coord_in, &
1922 maskgrid=maskgrid, maskbounds=maskbounds, &
1923 clone=clone, decode=decode, categoryappend=categoryappend)
1926 END SUBROUTINE volgrid6dv_transform
1930 SUBROUTINE volgrid6d_v7d_transform_compute(this, volgrid6d_in, vol7d_out, &
1931 networkname, noconvert)
1932 TYPE(grid_transform), INTENT(in) :: this
1933 type(volgrid6d), INTENT(in) :: volgrid6d_in
1934 type(vol7d), INTENT(inout) :: vol7d_out
1935 CHARACTER(len=*), OPTIONAL, INTENT(in) :: networkname
1936 LOGICAL, OPTIONAL, INTENT(in) :: noconvert
1938 INTEGER :: nntime, nana, ntime, ntimerange, nlevel, nvar, stallo
1939 INTEGER :: itime, itimerange, ivar, inetwork
1940 REAL, ALLOCATABLE :: voldatir_out(:,:,:)
1941 TYPE(conv_func), POINTER :: c_func(:)
1942 TYPE(datetime), ALLOCATABLE :: validitytime(:,:)
1943 REAL, POINTER :: voldatiin(:,:,:)
1946 call l4f_category_log(volgrid6d_in%category,l4f_debug, "start volgrid6d_v7d_transform_compute")
1955 if ( present(networkname)) then
1956 call init(vol7d_out%network(1),name=networkname)
1958 call init(vol7d_out%network(1),name= 'generic')
1961 if ( associated(volgrid6d_in%timerange)) then
1962 ntimerange= size(volgrid6d_in%timerange)
1963 vol7d_out%timerange=volgrid6d_in%timerange
1966 if ( associated(volgrid6d_in%time)) then
1967 ntime= size(volgrid6d_in%time)
1969 if (vol7d_out%time_definition == volgrid6d_in%time_definition) then
1972 vol7d_out%time=volgrid6d_in%time
1976 allocate (validitytime(ntime,ntimerange),stat=stallo)
1978 call l4f_category_log(volgrid6d_in%category,l4f_fatal, "allocating memory")
1979 call raise_fatal_error()
1983 do itimerange=1,ntimerange
1984 if (vol7d_out%time_definition > volgrid6d_in%time_definition) then
1985 validitytime(itime,itimerange) = &
1986 volgrid6d_in%time(itime) + timedelta_new(sec=volgrid6d_in%timerange(itimerange)%p1)
1988 validitytime(itime,itimerange) = &
1989 volgrid6d_in%time(itime) - timedelta_new(sec=volgrid6d_in%timerange(itimerange)%p1)
1994 nntime = count_distinct(reshape(validitytime,(/ntime*ntimerange/)), back=.true.)
1995 vol7d_out%time=pack_distinct(reshape(validitytime,(/ntime*ntimerange/)), nntime,back=.true.)
2000 IF ( ASSOCIATED(volgrid6d_in%level)) THEN
2001 nlevel = SIZE(volgrid6d_in%level)
2002 vol7d_out%level=volgrid6d_in%level
2005 IF ( ASSOCIATED(volgrid6d_in%var)) THEN
2006 nvar = SIZE(volgrid6d_in%var)
2007 IF (.NOT. optio_log(noconvert)) THEN
2008 CALL vargrib2varbufr(volgrid6d_in%var, vol7d_out%dativar%r, c_func)
2012 nana = SIZE(vol7d_out%ana)
2015 IF (.NOT. ASSOCIATED(volgrid6d_in%voldati)) THEN
2016 ALLOCATE(voldatiin(volgrid6d_in%griddim%dim%nx, volgrid6d_in%griddim%dim%ny, &
2020 ALLOCATE(voldatir_out(nana,1,nlevel),stat=stallo)
2021 IF (stallo /= 0) THEN
2022 CALL l4f_category_log(volgrid6d_in%category,l4f_fatal, "allocating memory")
2023 CALL raise_fatal_error()
2028 do itimerange=1,ntimerange
2040 CALL volgrid_get_vol_3d(volgrid6d_in, itime, itimerange, ivar, &
2043 CALL compute(this, voldatiin, voldatir_out, vol7d_out%dativar%r(ivar))
2045 if (vol7d_out%time_definition == volgrid6d_in%time_definition) then
2046 vol7d_out%voldatir(:,itime,:,itimerange,ivar,inetwork) = &
2049 vol7d_out%voldatir(:, index(vol7d_out%time,validitytime(itime,itimerange)),:,itimerange,ivar,inetwork)=&
2050 reshape(voldatir_out,(/nana,nlevel/))
2065 deallocate(voldatir_out)
2066 IF (.NOT. ASSOCIATED(volgrid6d_in%voldati)) THEN
2067 DEALLOCATE(voldatiin)
2069 if ( allocated(validitytime)) deallocate(validitytime)
2072 IF ( ASSOCIATED(c_func)) THEN
2074 CALL compute(c_func(ivar), vol7d_out%voldatir(:,:,:,:,ivar,:))
2079 end SUBROUTINE volgrid6d_v7d_transform_compute
|