|
◆ 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 1795 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
|