libsim  Versione 7.2.4

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

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  ldecode = ldecode .OR. 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  IF (ldecode.NEQV.decode) 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 
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
1899 TYPE(griddim_def),INTENT(in),OPTIONAL :: griddim
1900 TYPE(volgrid6d),INTENT(inout) :: volgrid6d_in(:)
1901 TYPE(volgrid6d),POINTER :: volgrid6d_out(:)
1902 TYPE(vol7d_level),INTENT(in),OPTIONAL :: lev_out(:)
1903 TYPE(volgrid6d),INTENT(in),OPTIONAL :: volgrid6d_coord_in
1904 REAL,INTENT(in),OPTIONAL :: maskgrid(:,:)
1905 REAL,INTENT(in),OPTIONAL :: maskbounds(:)
1906 LOGICAL,INTENT(in),OPTIONAL :: clone
1907 LOGICAL,INTENT(in),OPTIONAL :: decode
1908 CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend
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 
2079 end SUBROUTINE volgrid6d_v7d_transform_compute
2080 
2081 
Index method.

Generated with Doxygen.