libsim Versione 7.2.0

◆ 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 
)
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]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 1783 del file volgrid6d_class.F90.

1785 IF (c_e(var_coord_vol)) THEN
1786 CALL l4f_category_log(volgrid6d_in%category, l4f_info, &
1787 'Coordinate for vertint found in input volume at position '// &
1788 t2c(var_coord_vol))
1789 ENDIF
1790
1791 ENDIF
1792 ENDIF
1793
1794 CALL init(volgrid6d_out, griddim=volgrid6d_in%griddim, &
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)
1799 ELSE
1800 CALL init(grid_trans, this, lev_in=volgrid6d_in%level, lev_out=lev_out, &
1801 categoryappend=categoryappend)
1802 ENDIF
1803
1804 CALL get_val(grid_trans, output_level_auto=llev_out) ! get levels if auto-generated
1805 IF (.NOT.ASSOCIATED(llev_out)) llev_out => lev_out
1806 nlevel = SIZE(llev_out)
1807 ELSE
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) ! initialize to empty
1811 CALL raise_error()
1812 RETURN
1813 ENDIF
1814
1815ELSE
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)
1820ENDIF
1821
1822
1823IF (c_e(grid_trans)) THEN ! transformation is valid
1824
1825 CALL volgrid6d_alloc(volgrid6d_out, ntime=ntime, nlevel=nlevel, &
1826 ntimerange=ntimerange, nvar=nvar)
1827
1828 IF (PRESENT(decode)) THEN ! explicitly set decode status
1829 ldecode = decode
1830 ELSE ! take it from input
1831 ldecode = ASSOCIATED(volgrid6d_in%voldati)
1832 ENDIF
1833! force decode if gaid is readonly
1834 decode_loop: DO i6 = 1,nvar
1835 DO i5 = 1, ntimerange
1836 DO i4 = 1, ntime
1837 DO i3 = 1, nlevel
1838 IF (c_e(volgrid6d_in%gaid(i3,i4,i5,i6))) THEN
1839.OR. ldecode = ldecode grid_id_readonly(volgrid6d_in%gaid(i3,i4,i5,i6))
1840 EXIT decode_loop
1841 ENDIF
1842 ENDDO
1843 ENDDO
1844 ENDDO
1845 ENDDO decode_loop
1846
1847 IF (PRESENT(decode)) THEN
1848.NEQV. IF (ldecodedecode) 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')
1851 ENDIF
1852 ENDIF
1853
1854 CALL volgrid6d_alloc_vol(volgrid6d_out, decode=ldecode)
1855
1856!ensure unproj was called
1857!call griddim_unproj(volgrid6d_out%griddim)
1858
1859 IF (trans_type == 'vertint') THEN
1860#ifdef DEBUG
1861 CALL l4f_category_log(volgrid6d_in%category, L4F_DEBUG, &
1862 "volgrid6d_transform: vertint to "//t2c(nlevel)//" levels")
1863#endif
1864 CALL compute(grid_trans, volgrid6d_in, volgrid6d_out, lev_out=llev_out, &
1865 var_coord_vol=var_coord_vol, clone=clone)
1866 ELSE
1867 CALL compute(grid_trans, volgrid6d_in, volgrid6d_out, clone=clone)
1868 ENDIF
1869
1870 IF (cf_out == 0) THEN ! unrotated components are desired
1871 CALL wind_unrot(volgrid6d_out) ! unrotate if necessary
1872 ELSE IF (cf_out == 1) THEN ! rotated components are desired
1873 CALL wind_rot(volgrid6d_out) ! rotate if necessary
1874 ENDIF
1875
1876ELSE
1877! should log with grid_trans%category, but it is private
1878 CALL l4f_category_log(volgrid6d_in%category, L4F_ERROR, &
1879 'volgrid6d_transform: transformation not valid')
1880 CALL raise_error()
1881ENDIF
1882
1883CALL delete (grid_trans)
1884
1885END SUBROUTINE volgrid6d_transform
1886
1887
1888!> Performs the specified abstract transformation on the arrays of
1889!! data provided. The abstract transformation is specified by \a this
1890!! parameter; the corresponding specifical transformation (\a
1891!! grid_transform object) is created and destroyed internally. The
1892!! output transformed object is created internally and it does not
1893!! require preliminary initialisation. According to the input data and
1894!! to the transformation type, the output array may have of one or
1895!! more \a volgrid6d elements on different grids.
1896SUBROUTINE volgrid6dv_transform(this, griddim, volgrid6d_in, volgrid6d_out, &
1897 lev_out, volgrid6d_coord_in, maskgrid, maskbounds, clone, decode, categoryappend)
1898TYPE(transform_def),INTENT(in) :: this !< object specifying the abstract transformation
1899TYPE(griddim_def),INTENT(in),OPTIONAL :: griddim !< griddim specifying the output grid (required by most transformation types)
1900TYPE(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)
1901TYPE(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
1902TYPE(vol7d_level),INTENT(in),OPTIONAL :: lev_out(:) !< vol7d_level object defining target vertical grid
1903TYPE(volgrid6d),INTENT(in),OPTIONAL :: volgrid6d_coord_in !< object providing time constant input vertical coordinate for some kind of vertical interpolations
1904REAL,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')
1905REAL,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')
1906LOGICAL,INTENT(in),OPTIONAL :: clone !< if provided and \a .TRUE. , clone the \a gaid's from \a volgrid6d_in to \a volgrid6d_out
1907LOGICAL,INTENT(in),OPTIONAL :: decode
1908CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend !< append this suffix to log4fortran namespace category
1909
1910INTEGER :: i, stallo
1911
1912
1913allocate(volgrid6d_out(size(volgrid6d_in)),stat=stallo)
1914if (stallo /= 0)then
1915 call l4f_log(l4f_fatal,"allocating memory")
1916 call raise_fatal_error()
1917end if
1918
1919do 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)
1924end do
1925
1926END SUBROUTINE volgrid6dv_transform
1927
1928
1929! Internal method for performing grid to sparse point computations
1930SUBROUTINE volgrid6d_v7d_transform_compute(this, volgrid6d_in, vol7d_out, &
1931 networkname, noconvert)
1932TYPE(grid_transform),INTENT(in) :: this ! oggetto di trasformazione per grigliato
1933type(volgrid6d), INTENT(in) :: volgrid6d_in ! oggetto da trasformare
1934type(vol7d), INTENT(inout) :: vol7d_out ! oggetto trasformato
1935CHARACTER(len=*),OPTIONAL,INTENT(in) :: networkname ! imposta il network in vol7d_out (default='generic')
1936LOGICAL,OPTIONAL,INTENT(in) :: noconvert
1937
1938INTEGER :: nntime, nana, ntime, ntimerange, nlevel, nvar, stallo
1939INTEGER :: itime, itimerange, ivar, inetwork
1940REAL,ALLOCATABLE :: voldatir_out(:,:,:)
1941TYPE(conv_func),POINTER :: c_func(:)
1942TYPE(datetime),ALLOCATABLE :: validitytime(:,:)
1943REAL,POINTER :: voldatiin(:,:,:)
1944
1945#ifdef DEBUG
1946call l4f_category_log(volgrid6d_in%category,L4F_DEBUG,"start volgrid6d_v7d_transform_compute")
1947#endif
1948
1949ntime=0
1950ntimerange=0
1951nlevel=0
1952nvar=0
1953NULLIFY(c_func)
1954
1955if (present(networkname))then
1956 call init(vol7d_out%network(1),name=networkname)
1957else
1958 call init(vol7d_out%network(1),name='generic')
1959end if
1960
1961if (associated(volgrid6d_in%timerange))then
1962 ntimerange=size(volgrid6d_in%timerange)
1963 vol7d_out%timerange=volgrid6d_in%timerange
1964end if
1965
1966if (associated(volgrid6d_in%time))then
1967 ntime=size(volgrid6d_in%time)
1968
1969 if (vol7d_out%time_definition == volgrid6d_in%time_definition) then
1970
1971 ! i time sono definiti uguali: assegno
1972 vol7d_out%time=volgrid6d_in%time
1973
1974 else
1975 ! converto reference in validity
1976 allocate (validitytime(ntime,ntimerange),stat=stallo)
1977 if (stallo /=0)then
1978 call l4f_category_log(volgrid6d_in%category,l4f_fatal,"allocating memory")
1979 call raise_fatal_error()
1980 end if
1981
1982 do itime=1,ntime
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)
1987 else
1988 validitytime(itime,itimerange) = &
1989 volgrid6d_in%time(itime) - timedelta_new(sec=volgrid6d_in%timerange(itimerange)%p1)
1990 end if
1991 end do
1992 end do
1993
1994 nntime = count_distinct(reshape(validitytime,(/ntime*ntimerange/)), back=.true.)
1995 vol7d_out%time=pack_distinct(reshape(validitytime,(/ntime*ntimerange/)), nntime,back=.true.)
1996
1997 end if
1998end if
1999
2000IF (ASSOCIATED(volgrid6d_in%level)) THEN
2001 nlevel = SIZE(volgrid6d_in%level)
2002 vol7d_out%level=volgrid6d_in%level
2003ENDIF
2004
2005IF (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)
2009 ENDIF
2010ENDIF
2011
2012nana = SIZE(vol7d_out%ana)
2013
2014! allocate once for speed
2015IF (.NOT.ASSOCIATED(volgrid6d_in%voldati)) THEN
2016 ALLOCATE(voldatiin(volgrid6d_in%griddim%dim%nx, volgrid6d_in%griddim%dim%ny, &
2017 nlevel))
2018ENDIF
2019
2020ALLOCATE(voldatir_out(nana,1,nlevel),stat=stallo)
2021IF (stallo /= 0) THEN
2022 CALL l4f_category_log(volgrid6d_in%category,l4f_fatal,"allocating memory")
2023 CALL raise_fatal_error()
2024ENDIF
2025
2026inetwork=1
2027do itime=1,ntime
2028 do itimerange=1,ntimerange
2029! do ilevel=1,nlevel
2030 do ivar=1,nvar
2031
2032 !non è chiaro se questa sezione è utile o no
2033 !ossia il compute sotto sembra prevedere voldatir_out solo in out
2034!!$ if (vol7d_out%time_definition == volgrid6d_in%time_definition) then
2035!!$ voldatir_out=reshape(vol7d_out%voldatir(:,itime,ilevel,itimerange,ivar,inetwork),(/nana,1/))
2036!!$ else
2037!!$ voldatir_out=reshape(vol7d_out%voldatir(:,index(vol7d_out%time,validitytime(itime,ilevel)),ilevel,itimerange,ivar,inetwork),(/nana,1/))
2038!!$ end if
2039
2040 CALL volgrid_get_vol_3d(volgrid6d_in, itime, itimerange, ivar, &
2041 voldatiin)
2042
2043 CALL compute(this, voldatiin, voldatir_out, vol7d_out%dativar%r(ivar))
2044
2045 if (vol7d_out%time_definition == volgrid6d_in%time_definition) then
2046 vol7d_out%voldatir(:,itime,:,itimerange,ivar,inetwork) = &
2047 voldatir_out(:,1,:)
2048 else
2049 vol7d_out%voldatir(:,index(vol7d_out%time,validitytime(itime,itimerange)),:,itimerange,ivar,inetwork)=&
2050 reshape(voldatir_out,(/nana,nlevel/))
2051 end if
2052
2053! 1 indice della dimensione "anagrafica"
2054! 2 indice della dimensione "tempo"
2055! 3 indice della dimensione "livello verticale"
2056! 4 indice della dimensione "intervallo temporale"
2057! 5 indice della dimensione "variabile"
2058! 6 indice della dimensione "rete"
2059
2060 end do
2061! end do
2062 end do
2063end do
2064
2065deallocate(voldatir_out)
2066IF (.NOT.ASSOCIATED(volgrid6d_in%voldati)) THEN
2067 DEALLOCATE(voldatiin)
2068ENDIF
2069if (allocated(validitytime)) deallocate(validitytime)
2070
2071! Rescale valid data according to variable conversion table
2072IF (ASSOCIATED(c_func)) THEN
Index method.

Generated with Doxygen.