libsim  Versione6.3.0

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

1813  'volgrid6d_transform: vertint requested but lev_out not provided')
1814  CALL init(volgrid6d_out) ! initialize to empty
1815  CALL raise_error()
1816  RETURN
1817  ENDIF
1818 
1819 ELSE
1820  CALL init(volgrid6d_out, griddim=griddim, &
1821  time_definition=volgrid6d_in%time_definition, categoryappend=categoryappend)
1822  CALL init(grid_trans, this, in=volgrid6d_in%griddim, out=volgrid6d_out%griddim, &
1823  maskgrid=maskgrid, maskbounds=maskbounds, categoryappend=categoryappend)
1824 ENDIF
1825 
1826 
1827 IF (c_e(grid_trans)) THEN ! transformation is valid
1828 
1829  CALL volgrid6d_alloc(volgrid6d_out, ntime=ntime, nlevel=nlevel, &
1830  ntimerange=ntimerange, nvar=nvar)
1831 
1832  IF (PRESENT(decode)) THEN ! explicitly set decode status
1833  ldecode = decode
1834  ELSE ! take it from input
1835  ldecode = ASSOCIATED(volgrid6d_in%voldati)
1836  ENDIF
1837 ! force decode if gaid is readonly
1838  decode_loop: DO i6 = 1,nvar
1839  DO i5 = 1, ntimerange
1840  DO i4 = 1, ntime
1841  DO i3 = 1, nlevel
1842  IF (c_e(volgrid6d_in%gaid(i3,i4,i5,i6))) THEN
1843  ldecode = ldecode .OR. grid_id_readonly(volgrid6d_in%gaid(i3,i4,i5,i6))
1844  EXIT decode_loop
1845  ENDIF
1846  ENDDO
1847  ENDDO
1848  ENDDO
1849  ENDDO decode_loop
1850 
1851  IF (PRESENT(decode)) THEN
1852  IF (ldecode.NEQV.decode) THEN
1853  CALL l4f_category_log(volgrid6d_in%category, l4f_warn, &
1854  'volgrid6d_transform: decode status forced to .TRUE. because driver does not allow copy')
1855  ENDIF
1856  ENDIF
1857 
1858  CALL volgrid6d_alloc_vol(volgrid6d_out, decode=ldecode)
1859 
1860 !ensure unproj was called
1861 !call griddim_unproj(volgrid6d_out%griddim)
1862 
1863  IF (trans_type == 'vertint') THEN
1864 #ifdef DEBUG
1865  CALL l4f_category_log(volgrid6d_in%category, l4f_debug, &
1866  "volgrid6d_transform: vertint to "//t2c(nlevel)//" levels")
1867 #endif
1868  CALL compute(grid_trans, volgrid6d_in, volgrid6d_out, lev_out=llev_out, &
1869  var_coord_vol=var_coord_vol, clone=clone)
1870  ELSE
1871  CALL compute(grid_trans, volgrid6d_in, volgrid6d_out, clone=clone)
1872  ENDIF
1873 
1874  IF (cf_out == 0) THEN ! unrotated components are desired
1875  CALL wind_unrot(volgrid6d_out) ! unrotate if necessary
1876  ELSE IF (cf_out == 1) THEN ! rotated components are desired
1877  CALL wind_rot(volgrid6d_out) ! rotate if necessary
1878  ENDIF
1879 
1880 ELSE
1881 ! should log with grid_trans%category, but it is private
1882  CALL l4f_category_log(volgrid6d_in%category, l4f_error, &
1883  'volgrid6d_transform: transformation not valid')
1884  CALL raise_error()
1885 ENDIF
1886 
1887 CALL delete (grid_trans)
1888 
1889 END SUBROUTINE volgrid6d_transform
1890 
1891 
1900 SUBROUTINE volgrid6dv_transform(this, griddim, volgrid6d_in, volgrid6d_out, &
1901  lev_out, volgrid6d_coord_in, maskgrid, maskbounds, clone, decode, categoryappend)
1902 TYPE(transform_def),INTENT(in) :: this
1903 TYPE(griddim_def),INTENT(in),OPTIONAL :: griddim
1904 ! TODO ripristinare intent(in) dopo le opportune modifiche in grid_class.F90
1905 TYPE(volgrid6d),INTENT(inout) :: volgrid6d_in(:)
1906 TYPE(volgrid6d),POINTER :: volgrid6d_out(:)
1907 TYPE(vol7d_level),INTENT(in),OPTIONAL :: lev_out(:)
1908 TYPE(volgrid6d),INTENT(in),OPTIONAL :: volgrid6d_coord_in
1909 REAL,INTENT(in),OPTIONAL :: maskgrid(:,:)
1910 REAL,INTENT(in),OPTIONAL :: maskbounds(:)
1911 LOGICAL,INTENT(in),OPTIONAL :: clone
1912 LOGICAL,INTENT(in),OPTIONAL :: decode
1913 CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend
1914 
1915 INTEGER :: i, stallo
1916 
1917 
1918 allocate(volgrid6d_out(size(volgrid6d_in)),stat=stallo)
1919 if (stallo /= 0)then
1920  call l4f_log(l4f_fatal,"allocating memory")
1921  call raise_fatal_error()
1922 end if
1923 
1924 do i=1,size(volgrid6d_in)
1925  call transform(this, griddim, volgrid6d_in(i), volgrid6d_out(i), &
1926  lev_out=lev_out, volgrid6d_coord_in=volgrid6d_coord_in, &
1927  maskgrid=maskgrid, maskbounds=maskbounds, &
1928  clone=clone, decode=decode, categoryappend=categoryappend)
1929 end do
1930 
1931 END SUBROUTINE volgrid6dv_transform
1932 
1933 
1934 ! Internal method for performing grid to sparse point computations
1935 SUBROUTINE volgrid6d_v7d_transform_compute(this, volgrid6d_in, vol7d_out, &
1936  networkname, noconvert)
1937 TYPE(grid_transform),INTENT(in) :: this ! oggetto di trasformazione per grigliato
1938 type(volgrid6d), INTENT(in) :: volgrid6d_in ! oggetto da trasformare
1939 type(vol7d), INTENT(inout) :: vol7d_out ! oggetto trasformato
1940 CHARACTER(len=*),OPTIONAL,INTENT(in) :: networkname ! imposta il network in vol7d_out (default='generic')
1941 LOGICAL,OPTIONAL,INTENT(in) :: noconvert
1942 
1943 INTEGER :: nntime, nana, ntime, ntimerange, nlevel, nvar, stallo
1944 INTEGER :: itime, itimerange, ivar, inetwork
1945 REAL,ALLOCATABLE :: voldatir_out(:,:,:)
1946 TYPE(conv_func),POINTER :: c_func(:)
1947 TYPE(datetime),ALLOCATABLE :: validitytime(:,:)
1948 REAL,POINTER :: voldatiin(:,:,:)
1949 
1950 #ifdef DEBUG
1951 call l4f_category_log(volgrid6d_in%category,l4f_debug,"start volgrid6d_v7d_transform_compute")
1952 #endif
1953 
1954 ntime=0
1955 ntimerange=0
1956 nlevel=0
1957 nvar=0
1958 NULLIFY(c_func)
1959 
1960 if (present(networkname))then
1961  call init(vol7d_out%network(1),name=networkname)
1962 else
1963  call init(vol7d_out%network(1),name='generic')
1964 end if
1965 
1966 if (associated(volgrid6d_in%timerange))then
1967  ntimerange=size(volgrid6d_in%timerange)
1968  vol7d_out%timerange=volgrid6d_in%timerange
1969 end if
1970 
1971 if (associated(volgrid6d_in%time))then
1972  ntime=size(volgrid6d_in%time)
1973 
1974  if (vol7d_out%time_definition == volgrid6d_in%time_definition) then
1975 
1976  ! i time sono definiti uguali: assegno
1977  vol7d_out%time=volgrid6d_in%time
1978 
1979  else
1980  ! converto reference in validity
1981  allocate (validitytime(ntime,ntimerange),stat=stallo)
1982  if (stallo /=0)then
1983  call l4f_category_log(volgrid6d_in%category,l4f_fatal,"allocating memory")
1984  call raise_fatal_error()
1985  end if
1986 
1987  do itime=1,ntime
1988  do itimerange=1,ntimerange
1989  if (vol7d_out%time_definition > volgrid6d_in%time_definition) then
1990  validitytime(itime,itimerange) = &
1991  volgrid6d_in%time(itime) + timedelta_new(sec=volgrid6d_in%timerange(itimerange)%p1)
1992  else
1993  validitytime(itime,itimerange) = &
1994  volgrid6d_in%time(itime) - timedelta_new(sec=volgrid6d_in%timerange(itimerange)%p1)
1995  end if
1996  end do
1997  end do
1998 
1999  nntime = count_distinct(reshape(validitytime,(/ntime*ntimerange/)), back=.true.)
2000  vol7d_out%time=pack_distinct(reshape(validitytime,(/ntime*ntimerange/)), nntime,back=.true.)
2001 
2002  end if
2003 end if
2004 
2005 IF (ASSOCIATED(volgrid6d_in%level)) THEN
2006  nlevel = SIZE(volgrid6d_in%level)
2007  vol7d_out%level=volgrid6d_in%level
2008 ENDIF
2009 
2010 IF (ASSOCIATED(volgrid6d_in%var)) THEN
2011  nvar = SIZE(volgrid6d_in%var)
2012  IF (.NOT. optio_log(noconvert)) THEN
2013  CALL vargrib2varbufr(volgrid6d_in%var, vol7d_out%dativar%r, c_func)
2014  ENDIF
2015 ENDIF
2016 
2017 nana = SIZE(vol7d_out%ana)
2018 
2019 ! allocate once for speed
2020 IF (.NOT.ASSOCIATED(volgrid6d_in%voldati)) THEN
2021  ALLOCATE(voldatiin(volgrid6d_in%griddim%dim%nx, volgrid6d_in%griddim%dim%ny, &
2022  nlevel))
2023 ENDIF
2024 
2025 ALLOCATE(voldatir_out(nana,1,nlevel),stat=stallo)
2026 IF (stallo /= 0) THEN
2027  CALL l4f_category_log(volgrid6d_in%category,l4f_fatal,"allocating memory")
2028  CALL raise_fatal_error()
2029 ENDIF
2030 
2031 inetwork=1
2032 do itime=1,ntime
2033  do itimerange=1,ntimerange
2034 ! do ilevel=1,nlevel
2035  do ivar=1,nvar
2036 
2037  !non è chiaro se questa sezione è utile o no
2038  !ossia il compute sotto sembra prevedere voldatir_out solo in out
2039 !!$ if (vol7d_out%time_definition == volgrid6d_in%time_definition) then
2040 !!$ voldatir_out=reshape(vol7d_out%voldatir(:,itime,ilevel,itimerange,ivar,inetwork),(/nana,1/))
2041 !!$ else
2042 !!$ voldatir_out=reshape(vol7d_out%voldatir(:,index(vol7d_out%time,validitytime(itime,ilevel)),ilevel,itimerange,ivar,inetwork),(/nana,1/))
2043 !!$ end if
2044 
2045  CALL volgrid_get_vol_3d(volgrid6d_in, itime, itimerange, ivar, &
2046  voldatiin)
2047 
2048  CALL compute(this, voldatiin, voldatir_out, vol7d_out%dativar%r(ivar))
2049 
2050  if (vol7d_out%time_definition == volgrid6d_in%time_definition) then
2051  vol7d_out%voldatir(:,itime,:,itimerange,ivar,inetwork) = &
2052  voldatir_out(:,1,:)
2053  else
2054  vol7d_out%voldatir(:,index(vol7d_out%time,validitytime(itime,itimerange)),:,itimerange,ivar,inetwork)=&
2055  reshape(voldatir_out,(/nana,nlevel/))
2056  end if
2057 
2058 ! 1 indice della dimensione "anagrafica"
2059 ! 2 indice della dimensione "tempo"
2060 ! 3 indice della dimensione "livello verticale"
2061 ! 4 indice della dimensione "intervallo temporale"
2062 ! 5 indice della dimensione "variabile"
2063 ! 6 indice della dimensione "rete"
2064 
2065  end do
2066 ! end do
2067  end do
2068 end do
2069 
2070 deallocate(voldatir_out)
2071 IF (.NOT.ASSOCIATED(volgrid6d_in%voldati)) THEN
2072  DEALLOCATE(voldatiin)
2073 ENDIF
2074 if (allocated(validitytime)) deallocate(validitytime)
2075 
2076 ! Rescale valid data according to variable conversion table
2077 IF (ASSOCIATED(c_func)) THEN
2078  DO ivar = 1, nvar
2079  CALL compute(c_func(ivar), vol7d_out%voldatir(:,:,:,:,ivar,:))
2080  ENDDO
2081  DEALLOCATE(c_func)
2082 ENDIF
2083 
2084 end SUBROUTINE volgrid6d_v7d_transform_compute
2085 
2086 
2093 SUBROUTINE volgrid6d_v7d_transform(this, volgrid6d_in, vol7d_out, v7d, &
2094  maskgrid, maskbounds, networkname, noconvert, categoryappend)
2095 TYPE(transform_def),INTENT(in) :: this
2096 TYPE(volgrid6d),INTENT(inout) :: volgrid6d_in
2097 TYPE(vol7d),INTENT(out) :: vol7d_out
2098 TYPE(vol7d),INTENT(in),OPTIONAL :: v7d
2099 REAL,INTENT(in),OPTIONAL :: maskgrid(:,:)
2100 REAL,INTENT(in),OPTIONAL :: maskbounds(:)
2101 CHARACTER(len=*),OPTIONAL,INTENT(in) :: networkname
Functions that return a trimmed CHARACTER representation of the input variable.
Distruttori per le 2 classi.
Index method.
Costruttori per le classi datetime e timedelta.

Generated with Doxygen.