libsim Versione 7.2.6

◆ 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]thisobject specifying the abstract transformation
[in]griddimgriddim specifying the output grid (required by most transformation types)
[in,out]volgrid6d_inobject to be transformed, it is not modified, despite the INTENT(inout)
[out]volgrid6d_outtransformed object, it does not require initialisation
[in]lev_outvol7d_level object defining target vertical grid, for vertical interpolations
[in]volgrid6d_coord_inobject providing time constant input vertical coordinate for some kind of vertical interpolations
[in]maskgrid2D 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]maskboundsarray 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]cloneif provided and .TRUE. , clone the gaid's from volgrid6d_in to volgrid6d_out
[in]decodedetermine 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]categoryappendappend this suffix to log4fortran namespace category

Definizione alla linea 1831 del file volgrid6d_class.F90.

1833 IF (c_e(var_coord_vol)) THEN
1834 CALL l4f_category_log(volgrid6d_in%category, l4f_info, &
1835 'Coordinate for vertint found in input volume at position '// &
1836 t2c(var_coord_vol))
1837 ENDIF
1838
1839 ENDIF
1840 ENDIF
1841
1842 CALL init(volgrid6d_out, griddim=volgrid6d_in%griddim, &
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)
1847 ELSE
1848 CALL init(grid_trans, this, lev_in=volgrid6d_in%level, lev_out=lev_out, &
1849 categoryappend=categoryappend)
1850 ENDIF
1851
1852 CALL get_val(grid_trans, output_level_auto=llev_out) ! get levels if auto-generated
1853 IF (.NOT.ASSOCIATED(llev_out)) llev_out => lev_out
1854 nlevel = SIZE(llev_out)
1855 ELSE
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) ! initialize to empty
1859 CALL raise_error()
1860 RETURN
1861 ENDIF
1862
1863ELSE
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)
1868ENDIF
1869
1870
1871IF (c_e(grid_trans)) THEN ! transformation is valid
1872
1873 CALL volgrid6d_alloc(volgrid6d_out, ntime=ntime, nlevel=nlevel, &
1874 ntimerange=ntimerange, nvar=nvar)
1875
1876 IF (PRESENT(decode)) THEN ! explicitly set decode status
1877 ldecode = decode
1878 ELSE ! take it from input
1879 ldecode = ASSOCIATED(volgrid6d_in%voldati)
1880 ENDIF
1881! force decode if gaid is readonly
1882 decode_loop: DO i6 = 1,nvar
1883 DO i5 = 1, ntimerange
1884 DO i4 = 1, ntime
1885 DO i3 = 1, nlevel
1886 IF (c_e(volgrid6d_in%gaid(i3,i4,i5,i6))) THEN
1887.OR. ldecode = ldecode grid_id_readonly(volgrid6d_in%gaid(i3,i4,i5,i6))
1888 EXIT decode_loop
1889 ENDIF
1890 ENDDO
1891 ENDDO
1892 ENDDO
1893 ENDDO decode_loop
1894
1895 IF (PRESENT(decode)) THEN
1896.NEQV. IF (ldecodedecode) 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')
1899 ENDIF
1900 ENDIF
1901
1902 CALL volgrid6d_alloc_vol(volgrid6d_out, decode=ldecode)
1903
1904!ensure unproj was called
1905!call griddim_unproj(volgrid6d_out%griddim)
1906
1907 IF (trans_type == 'vertint') THEN
1908#ifdef DEBUG
1909 CALL l4f_category_log(volgrid6d_in%category, L4F_DEBUG, &
1910 "volgrid6d_transform: vertint to "//t2c(nlevel)//" levels")
1911#endif
1912 CALL compute(grid_trans, volgrid6d_in, volgrid6d_out, lev_out=llev_out, &
1913 var_coord_vol=var_coord_vol, clone=clone)
1914 ELSE
1915 CALL compute(grid_trans, volgrid6d_in, volgrid6d_out, clone=clone)
1916 ENDIF
1917
1918 IF (cf_out == 0) THEN ! unrotated components are desired
1919 CALL wind_unrot(volgrid6d_out) ! unrotate if necessary
1920 ELSE IF (cf_out == 1) THEN ! rotated components are desired
1921 CALL wind_rot(volgrid6d_out) ! rotate if necessary
1922 ENDIF
1923
1924ELSE
1925! should log with grid_trans%category, but it is private
1926 CALL l4f_category_log(volgrid6d_in%category, L4F_ERROR, &
1927 'volgrid6d_transform: transformation not valid')
1928 CALL raise_error()
1929ENDIF
1930
1931CALL delete (grid_trans)
1932
1933END SUBROUTINE volgrid6d_transform
1934
1935
1936!> Performs the specified abstract transformation on the arrays of
1937!! data provided. The abstract transformation is specified by \a this
1938!! parameter; the corresponding specifical transformation (\a
1939!! grid_transform object) is created and destroyed internally. The
1940!! output transformed object is created internally and it does not
1941!! require preliminary initialisation. According to the input data and
1942!! to the transformation type, the output array may have of one or
1943!! more \a volgrid6d elements on different grids.
1944SUBROUTINE volgrid6dv_transform(this, griddim, volgrid6d_in, volgrid6d_out, &
1945 lev_out, volgrid6d_coord_in, maskgrid, maskbounds, clone, decode, categoryappend)
1946TYPE(transform_def),INTENT(in) :: this !< object specifying the abstract transformation
1947TYPE(griddim_def),INTENT(in),OPTIONAL :: griddim !< griddim specifying the output grid (required by most transformation types)
1948TYPE(volgrid6d),INTENT(inout) :: volgrid6d_in(:) !< object to be transformed, it is an array of volgrid6d objects, each of which will be transformed, it is not modified, despite the INTENT(inout)
1949TYPE(volgrid6d),POINTER :: volgrid6d_out(:) !< transformed object, it is a non associated pointer to an array of volgrid6d objects which will be allocated by the method
1950TYPE(vol7d_level),INTENT(in),OPTIONAL :: lev_out(:) !< vol7d_level object defining target vertical grid
1951TYPE(volgrid6d),INTENT(in),OPTIONAL :: volgrid6d_coord_in !< object providing time constant input vertical coordinate for some kind of vertical interpolations
1952REAL,INTENT(in),OPTIONAL :: 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')
1953REAL,INTENT(in),OPTIONAL :: maskbounds(:) !< array of boundary values for defining a subset of valid points where the values of \a maskgrid are within the first and last value of \a maskbounds (for transformation type 'metamorphosis:maskfill')
1954LOGICAL,INTENT(in),OPTIONAL :: clone !< if provided and \a .TRUE. , clone the \a gaid's from \a volgrid6d_in to \a volgrid6d_out
1955LOGICAL,INTENT(in),OPTIONAL :: decode !< if provided and \a .FALSE. the data volume is not allocated, but work is performed on grid_id's
1956CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend !< append this suffix to log4fortran namespace category
1957
1958INTEGER :: i, stallo
1959
1960
1961allocate(volgrid6d_out(size(volgrid6d_in)),stat=stallo)
1962if (stallo /= 0)then
1963 call l4f_log(l4f_fatal,"allocating memory")
1964 call raise_fatal_error()
1965end if
1966
1967do 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)
1972end do
1973
1974END SUBROUTINE volgrid6dv_transform
1975
1976
1977! Internal method for performing grid to sparse point computations
1978SUBROUTINE volgrid6d_v7d_transform_compute(this, volgrid6d_in, vol7d_out, &
1979 networkname, noconvert)
1980TYPE(grid_transform),INTENT(in) :: this ! oggetto di trasformazione per grigliato
1981type(volgrid6d), INTENT(in) :: volgrid6d_in ! oggetto da trasformare
1982type(vol7d), INTENT(inout) :: vol7d_out ! oggetto trasformato
1983CHARACTER(len=*),OPTIONAL,INTENT(in) :: networkname ! imposta il network in vol7d_out (default='generic')
1984LOGICAL,OPTIONAL,INTENT(in) :: noconvert !< do not try to match variable and convert values during transform
1985
1986INTEGER :: nntime, nana, ntime, ntimerange, nlevel, nvar, stallo
1987INTEGER :: itime, itimerange, ivar, inetwork
1988REAL,ALLOCATABLE :: voldatir_out(:,:,:)
1989TYPE(conv_func),POINTER :: c_func(:)
1990TYPE(datetime),ALLOCATABLE :: validitytime(:,:)
1991REAL,POINTER :: voldatiin(:,:,:)
1992
1993#ifdef DEBUG
1994call l4f_category_log(volgrid6d_in%category,L4F_DEBUG,"start volgrid6d_v7d_transform_compute")
1995#endif
1996
1997ntime=0
1998ntimerange=0
1999nlevel=0
2000nvar=0
2001NULLIFY(c_func)
2002
2003if (present(networkname))then
2004 call init(vol7d_out%network(1),name=networkname)
2005else
2006 call init(vol7d_out%network(1),name='generic')
2007end if
2008
2009if (associated(volgrid6d_in%timerange))then
2010 ntimerange=size(volgrid6d_in%timerange)
2011 vol7d_out%timerange=volgrid6d_in%timerange
2012end if
2013
2014if (associated(volgrid6d_in%time))then
2015 ntime=size(volgrid6d_in%time)
2016
2017 if (vol7d_out%time_definition == volgrid6d_in%time_definition) then
2018
2019 ! i time sono definiti uguali: assegno
2020 vol7d_out%time=volgrid6d_in%time
2021
2022 else
2023 ! converto reference in validity
2024 allocate (validitytime(ntime,ntimerange),stat=stallo)
2025 if (stallo /=0)then
2026 call l4f_category_log(volgrid6d_in%category,l4f_fatal,"allocating memory")
2027 call raise_fatal_error()
2028 end if
2029
2030 do itime=1,ntime
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)
2035 else
2036 validitytime(itime,itimerange) = &
2037 volgrid6d_in%time(itime) - timedelta_new(sec=volgrid6d_in%timerange(itimerange)%p1)
2038 end if
2039 end do
2040 end do
2041
2042 nntime = count_distinct(reshape(validitytime,(/ntime*ntimerange/)), back=.true.)
2043 vol7d_out%time=pack_distinct(reshape(validitytime,(/ntime*ntimerange/)), nntime,back=.true.)
2044
2045 end if
2046end if
2047
2048IF (ASSOCIATED(volgrid6d_in%level)) THEN
2049 nlevel = SIZE(volgrid6d_in%level)
2050 vol7d_out%level=volgrid6d_in%level
2051ENDIF
2052
2053IF (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)
2057 ENDIF
2058ENDIF
2059
2060nana = SIZE(vol7d_out%ana)
2061
2062! allocate once for speed
2063IF (.NOT.ASSOCIATED(volgrid6d_in%voldati)) THEN
2064 ALLOCATE(voldatiin(volgrid6d_in%griddim%dim%nx, volgrid6d_in%griddim%dim%ny, &
2065 nlevel))
2066ENDIF
2067
2068ALLOCATE(voldatir_out(nana,1,nlevel),stat=stallo)
2069IF (stallo /= 0) THEN
2070 CALL l4f_category_log(volgrid6d_in%category,l4f_fatal,"allocating memory")
2071 CALL raise_fatal_error()
2072ENDIF
2073
2074inetwork=1
2075do itime=1,ntime
2076 do itimerange=1,ntimerange
2077! do ilevel=1,nlevel
2078 do ivar=1,nvar
2079
2080 !non è chiaro se questa sezione è utile o no
2081 !ossia il compute sotto sembra prevedere voldatir_out solo in out
2082!!$ if (vol7d_out%time_definition == volgrid6d_in%time_definition) then
2083!!$ voldatir_out=reshape(vol7d_out%voldatir(:,itime,ilevel,itimerange,ivar,inetwork),(/nana,1/))
2084!!$ else
2085!!$ voldatir_out=reshape(vol7d_out%voldatir(:,index(vol7d_out%time,validitytime(itime,ilevel)),ilevel,itimerange,ivar,inetwork),(/nana,1/))
2086!!$ end if
2087
2088 CALL volgrid_get_vol_3d(volgrid6d_in, itime, itimerange, ivar, &
2089 voldatiin)
2090
2091 CALL compute(this, voldatiin, voldatir_out, vol7d_out%dativar%r(ivar))
2092
2093 if (vol7d_out%time_definition == volgrid6d_in%time_definition) then
2094 vol7d_out%voldatir(:,itime,:,itimerange,ivar,inetwork) = &
2095 voldatir_out(:,1,:)
2096 else
2097 vol7d_out%voldatir(:,index(vol7d_out%time,validitytime(itime,itimerange)),:,itimerange,ivar,inetwork)=&
2098 reshape(voldatir_out,(/nana,nlevel/))
2099 end if
2100
2101! 1 indice della dimensione "anagrafica"
2102! 2 indice della dimensione "tempo"
2103! 3 indice della dimensione "livello verticale"
2104! 4 indice della dimensione "intervallo temporale"
2105! 5 indice della dimensione "variabile"
2106! 6 indice della dimensione "rete"
2107
2108 end do
2109! end do
2110 end do
2111end do
2112
2113deallocate(voldatir_out)
2114IF (.NOT.ASSOCIATED(volgrid6d_in%voldati)) THEN
2115 DEALLOCATE(voldatiin)
2116ENDIF
2117if (allocated(validitytime)) deallocate(validitytime)
2118
2119! Rescale valid data according to variable conversion table
2120IF (ASSOCIATED(c_func)) THEN
Index method.

Generated with Doxygen.