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