libsim  Versione 7.1.8

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

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 
1815 ELSE
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)
1820 ENDIF
1821 
1822 
1823 IF (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 
1876 ELSE
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()
1881 ENDIF
1882 
1883 CALL delete (grid_trans)
1884 
1885 END 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.
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 !< object specifying the abstract transformation
1899 TYPE(griddim_def),INTENT(in),OPTIONAL :: griddim !< griddim specifying the output grid (required by most transformation types)
1900 TYPE(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)
1901 TYPE(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
1902 TYPE(vol7d_level),INTENT(in),OPTIONAL :: lev_out(:) !< vol7d_level object defining target vertical grid
1903 TYPE(volgrid6d),INTENT(in),OPTIONAL :: volgrid6d_coord_in !< object providing time constant input vertical coordinate for some kind of vertical interpolations
1904 REAL,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')
1905 REAL,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')
1906 LOGICAL,INTENT(in),OPTIONAL :: clone !< if provided and \a .TRUE. , clone the \a gaid's from \a volgrid6d_in to \a volgrid6d_out
1907 LOGICAL,INTENT(in),OPTIONAL :: decode
1908 CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend !< append this suffix to log4fortran namespace category
1909 
1910 INTEGER :: i, stallo
1911 
1912 
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()
1917 end if
1918 
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)
1924 end do
1925 
1926 END SUBROUTINE volgrid6dv_transform
1927 
1928 
1929 ! Internal method for performing grid to sparse point computations
1930 SUBROUTINE volgrid6d_v7d_transform_compute(this, volgrid6d_in, vol7d_out, &
1931  networkname, noconvert)
1932 TYPE(grid_transform),INTENT(in) :: this ! oggetto di trasformazione per grigliato
1933 type(volgrid6d), INTENT(in) :: volgrid6d_in ! oggetto da trasformare
1934 type(vol7d), INTENT(inout) :: vol7d_out ! oggetto trasformato
1935 CHARACTER(len=*),OPTIONAL,INTENT(in) :: networkname ! imposta il network in vol7d_out (default='generic')
1936 LOGICAL,OPTIONAL,INTENT(in) :: noconvert
1937 
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(:,:,:)
1944 
1945 #ifdef DEBUG
1946 call l4f_category_log(volgrid6d_in%category,L4F_DEBUG,"start volgrid6d_v7d_transform_compute")
1947 #endif
1948 
1949 ntime=0
1950 ntimerange=0
1951 nlevel=0
1952 nvar=0
1953 NULLIFY(c_func)
1954 
1955 if (present(networkname))then
1956  call init(vol7d_out%network(1),name=networkname)
1957 else
1958  call init(vol7d_out%network(1),name='generic')
1959 end if
1960 
1961 if (associated(volgrid6d_in%timerange))then
1962  ntimerange=size(volgrid6d_in%timerange)
1963  vol7d_out%timerange=volgrid6d_in%timerange
1964 end if
1965 
1966 if (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
1998 end if
1999 
2000 IF (ASSOCIATED(volgrid6d_in%level)) THEN
2001  nlevel = SIZE(volgrid6d_in%level)
2002  vol7d_out%level=volgrid6d_in%level
2003 ENDIF
2004 
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)
2009  ENDIF
2010 ENDIF
2011 
2012 nana = SIZE(vol7d_out%ana)
2013 
2014 ! allocate once for speed
2015 IF (.NOT.ASSOCIATED(volgrid6d_in%voldati)) THEN
2016  ALLOCATE(voldatiin(volgrid6d_in%griddim%dim%nx, volgrid6d_in%griddim%dim%ny, &
2017  nlevel))
2018 ENDIF
2019 
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()
2024 ENDIF
2025 
2026 inetwork=1
2027 do 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
2063 end do
2064 
2065 deallocate(voldatir_out)
2066 IF (.NOT.ASSOCIATED(volgrid6d_in%voldati)) THEN
2067  DEALLOCATE(voldatiin)
2068 ENDIF
2069 if (allocated(validitytime)) deallocate(validitytime)
2070 
2071 ! Rescale valid data according to variable conversion table
2072 IF (ASSOCIATED(c_func)) THEN
2073  DO ivar = 1, nvar
2074  CALL compute(c_func(ivar), vol7d_out%voldatir(:,:,:,:,ivar,:))
2075  ENDDO
2076  DEALLOCATE(c_func)
2077 ENDIF
2078 
Index method.

Generated with Doxygen.