|
◆ volgrid6d_transform()
subroutine volgrid6d_class::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 |
|
) |
| |
|
private |
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 1843 del file volgrid6d_class.F90.
1843 time_definition=volgrid6d_in%time_definition, categoryappend=categoryappend) 1844 IF (c_e(var_coord_in)) THEN 1845 CALL init(grid_trans, this, lev_in=volgrid6d_in%level, lev_out=lev_out, & 1846 coord_3d_in=coord_3d_in, categoryappend=categoryappend) 1848 CALL init(grid_trans, this, lev_in=volgrid6d_in%level, lev_out=lev_out, & 1849 categoryappend=categoryappend) 1852 CALL get_val(grid_trans, output_level_auto=llev_out) 1853 IF (.NOT. ASSOCIATED(llev_out)) llev_out => lev_out 1854 nlevel = SIZE(llev_out) 1856 CALL l4f_category_log(volgrid6d_in%category, l4f_error, & 1857 'volgrid6d_transform: vertint requested but lev_out not provided') 1858 CALL init(volgrid6d_out) 1864 CALL init(volgrid6d_out, griddim=griddim, & 1865 time_definition=volgrid6d_in%time_definition, categoryappend=categoryappend) 1866 CALL init(grid_trans, this, in=volgrid6d_in%griddim, out=volgrid6d_out%griddim, & 1867 maskgrid=maskgrid, maskbounds=maskbounds, categoryappend=categoryappend) 1871 IF (c_e(grid_trans)) THEN 1873 CALL volgrid6d_alloc(volgrid6d_out, ntime=ntime, nlevel=nlevel, & 1874 ntimerange=ntimerange, nvar=nvar) 1876 IF ( PRESENT(decode)) THEN 1879 ldecode = ASSOCIATED(volgrid6d_in%voldati) 1882 decode_loop: DO i6 = 1,nvar 1883 DO i5 = 1, ntimerange 1886 IF (c_e(volgrid6d_in%gaid(i3,i4,i5,i6))) THEN 1887 ldecode = ldecode .OR. grid_id_readonly(volgrid6d_in%gaid(i3,i4,i5,i6)) 1895 IF ( PRESENT(decode)) THEN 1896 IF (ldecode.NEQV.decode) THEN 1897 CALL l4f_category_log(volgrid6d_in%category, l4f_warn, & 1898 'volgrid6d_transform: decode status forced to .TRUE. because driver does not allow copy') 1902 CALL volgrid6d_alloc_vol(volgrid6d_out, decode=ldecode) 1907 IF (trans_type == 'vertint') THEN 1909 CALL l4f_category_log(volgrid6d_in%category, l4f_debug, & 1910 "volgrid6d_transform: vertint to "//t2c(nlevel)// " levels") 1912 CALL compute(grid_trans, volgrid6d_in, volgrid6d_out, lev_out=llev_out, & 1913 var_coord_vol=var_coord_vol, clone=clone) 1915 CALL compute(grid_trans, volgrid6d_in, volgrid6d_out, clone=clone) 1918 IF (cf_out == 0) THEN 1919 CALL wind_unrot(volgrid6d_out) 1920 ELSE IF (cf_out == 1) THEN 1921 CALL wind_rot(volgrid6d_out) 1926 CALL l4f_category_log(volgrid6d_in%category, l4f_error, & 1927 'volgrid6d_transform: transformation not valid') 1931 CALL delete (grid_trans) 1933 END SUBROUTINE volgrid6d_transform 1944 SUBROUTINE volgrid6dv_transform(this, griddim, volgrid6d_in, volgrid6d_out, & 1945 lev_out, volgrid6d_coord_in, maskgrid, maskbounds, clone, decode, categoryappend) 1946 TYPE(transform_def), INTENT(in) :: this 1947 TYPE(griddim_def), INTENT(in), OPTIONAL :: griddim 1948 TYPE(volgrid6d), INTENT(inout) :: volgrid6d_in(:) 1949 TYPE(volgrid6d), POINTER :: volgrid6d_out(:) 1950 TYPE(vol7d_level), INTENT(in), OPTIONAL :: lev_out(:) 1951 TYPE(volgrid6d), INTENT(in), OPTIONAL :: volgrid6d_coord_in 1952 REAL, INTENT(in), OPTIONAL :: maskgrid(:,:) 1953 REAL, INTENT(in), OPTIONAL :: maskbounds(:) 1954 LOGICAL, INTENT(in), OPTIONAL :: clone 1955 LOGICAL, INTENT(in), OPTIONAL :: decode 1956 CHARACTER(len=*), INTENT(in), OPTIONAL :: categoryappend 1958 INTEGER :: i, stallo 1961 allocate(volgrid6d_out( size(volgrid6d_in)),stat=stallo) 1962 if (stallo /= 0) then 1963 call l4f_log(l4f_fatal, "allocating memory") 1964 call raise_fatal_error() 1967 do i=1, size(volgrid6d_in) 1968 call transform(this, griddim, volgrid6d_in(i), volgrid6d_out(i), & 1969 lev_out=lev_out, volgrid6d_coord_in=volgrid6d_coord_in, & 1970 maskgrid=maskgrid, maskbounds=maskbounds, & 1971 clone=clone, decode=decode, categoryappend=categoryappend) 1974 END SUBROUTINE volgrid6dv_transform 1978 SUBROUTINE volgrid6d_v7d_transform_compute(this, volgrid6d_in, vol7d_out, & 1979 networkname, noconvert) 1980 TYPE(grid_transform), INTENT(in) :: this 1981 type(volgrid6d), INTENT(in) :: volgrid6d_in 1982 type(vol7d), INTENT(inout) :: vol7d_out 1983 CHARACTER(len=*), OPTIONAL, INTENT(in) :: networkname 1984 LOGICAL, OPTIONAL, INTENT(in) :: noconvert 1986 INTEGER :: nntime, nana, ntime, ntimerange, nlevel, nvar, stallo 1987 INTEGER :: itime, itimerange, ivar, inetwork 1988 REAL, ALLOCATABLE :: voldatir_out(:,:,:) 1989 TYPE(conv_func), POINTER :: c_func(:) 1990 TYPE(datetime), ALLOCATABLE :: validitytime(:,:) 1991 REAL, POINTER :: voldatiin(:,:,:) 1994 call l4f_category_log(volgrid6d_in%category,l4f_debug, "start volgrid6d_v7d_transform_compute") 2003 if ( present(networkname)) then 2004 call init(vol7d_out%network(1),name=networkname) 2006 call init(vol7d_out%network(1),name= 'generic') 2009 if ( associated(volgrid6d_in%timerange)) then 2010 ntimerange= size(volgrid6d_in%timerange) 2011 vol7d_out%timerange=volgrid6d_in%timerange 2014 if ( associated(volgrid6d_in%time)) then 2015 ntime= size(volgrid6d_in%time) 2017 if (vol7d_out%time_definition == volgrid6d_in%time_definition) then 2020 vol7d_out%time=volgrid6d_in%time 2024 allocate (validitytime(ntime,ntimerange),stat=stallo) 2026 call l4f_category_log(volgrid6d_in%category,l4f_fatal, "allocating memory") 2027 call raise_fatal_error() 2031 do itimerange=1,ntimerange 2032 if (vol7d_out%time_definition > volgrid6d_in%time_definition) then 2033 validitytime(itime,itimerange) = & 2034 volgrid6d_in%time(itime) + timedelta_new(sec=volgrid6d_in%timerange(itimerange)%p1) 2036 validitytime(itime,itimerange) = & 2037 volgrid6d_in%time(itime) - timedelta_new(sec=volgrid6d_in%timerange(itimerange)%p1) 2042 nntime = count_distinct(reshape(validitytime,(/ntime*ntimerange/)), back=.true.) 2043 vol7d_out%time=pack_distinct(reshape(validitytime,(/ntime*ntimerange/)), nntime,back=.true.) 2048 IF ( ASSOCIATED(volgrid6d_in%level)) THEN 2049 nlevel = SIZE(volgrid6d_in%level) 2050 vol7d_out%level=volgrid6d_in%level 2053 IF ( ASSOCIATED(volgrid6d_in%var)) THEN 2054 nvar = SIZE(volgrid6d_in%var) 2055 IF (.NOT. optio_log(noconvert)) THEN 2056 CALL vargrib2varbufr(volgrid6d_in%var, vol7d_out%dativar%r, c_func) 2060 nana = SIZE(vol7d_out%ana) 2063 IF (.NOT. ASSOCIATED(volgrid6d_in%voldati)) THEN 2064 ALLOCATE(voldatiin(volgrid6d_in%griddim%dim%nx, volgrid6d_in%griddim%dim%ny, & 2068 ALLOCATE(voldatir_out(nana,1,nlevel),stat=stallo) 2069 IF (stallo /= 0) THEN 2070 CALL l4f_category_log(volgrid6d_in%category,l4f_fatal, "allocating memory") 2071 CALL raise_fatal_error() 2076 do itimerange=1,ntimerange 2088 CALL volgrid_get_vol_3d(volgrid6d_in, itime, itimerange, ivar, & 2091 CALL compute(this, voldatiin, voldatir_out, vol7d_out%dativar%r(ivar)) 2093 if (vol7d_out%time_definition == volgrid6d_in%time_definition) then 2094 vol7d_out%voldatir(:,itime,:,itimerange,ivar,inetwork) = & 2097 vol7d_out%voldatir(:, index(vol7d_out%time,validitytime(itime,itimerange)),:,itimerange,ivar,inetwork)=& 2098 reshape(voldatir_out,(/nana,nlevel/)) 2113 deallocate(voldatir_out) 2114 IF (.NOT. ASSOCIATED(volgrid6d_in%voldati)) THEN 2115 DEALLOCATE(voldatiin) 2117 if ( allocated(validitytime)) deallocate(validitytime) 2120 IF ( ASSOCIATED(c_func)) THEN 2122 CALL compute(c_func(ivar), vol7d_out%voldatir(:,:,:,:,ivar,:)) 2127 end SUBROUTINE volgrid6d_v7d_transform_compute
|