libsim  Versione7.2.6

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

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 
1863 ELSE
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)
1868 ENDIF
1869 
1870 
1871 IF (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  ldecode = ldecode .OR. 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  IF (ldecode.NEQV.decode) 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 
1924 ELSE
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()
1929 ENDIF
1930 
1931 CALL delete (grid_trans)
1932 
1933 END SUBROUTINE volgrid6d_transform
1934 
1935 
1944 SUBROUTINE volgrid6dv_transform(this, griddim, volgrid6d_in, volgrid6d_out, &
1945  lev_out, volgrid6d_coord_in, maskgrid, maskbounds, clone, decode, categoryappend)
1946 TYPE(transform_def),INTENT(in) :: this
1947 TYPE(griddim_def),INTENT(in),OPTIONAL :: griddim
1948 TYPE(volgrid6d),INTENT(inout) :: volgrid6d_in(:)
1949 TYPE(volgrid6d),POINTER :: volgrid6d_out(:)
1950 TYPE(vol7d_level),INTENT(in),OPTIONAL :: lev_out(:)
1951 TYPE(volgrid6d),INTENT(in),OPTIONAL :: volgrid6d_coord_in
1952 REAL,INTENT(in),OPTIONAL :: maskgrid(:,:)
1953 REAL,INTENT(in),OPTIONAL :: maskbounds(:)
1954 LOGICAL,INTENT(in),OPTIONAL :: clone
1955 LOGICAL,INTENT(in),OPTIONAL :: decode
1956 CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend
1957 
1958 INTEGER :: i, stallo
1959 
1960 
1961 allocate(volgrid6d_out(size(volgrid6d_in)),stat=stallo)
1962 if (stallo /= 0)then
1963  call l4f_log(l4f_fatal,"allocating memory")
1964  call raise_fatal_error()
1965 end if
1966 
1967 do 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)
1972 end do
1973 
1974 END SUBROUTINE volgrid6dv_transform
1975 
1976 
1977 ! Internal method for performing grid to sparse point computations
1978 SUBROUTINE volgrid6d_v7d_transform_compute(this, volgrid6d_in, vol7d_out, &
1979  networkname, noconvert)
1980 TYPE(grid_transform),INTENT(in) :: this ! oggetto di trasformazione per grigliato
1981 type(volgrid6d), INTENT(in) :: volgrid6d_in ! oggetto da trasformare
1982 type(vol7d), INTENT(inout) :: vol7d_out ! oggetto trasformato
1983 CHARACTER(len=*),OPTIONAL,INTENT(in) :: networkname ! imposta il network in vol7d_out (default='generic')
1984 LOGICAL,OPTIONAL,INTENT(in) :: noconvert
1985 
1986 INTEGER :: nntime, nana, ntime, ntimerange, nlevel, nvar, stallo
1987 INTEGER :: itime, itimerange, ivar, inetwork
1988 REAL,ALLOCATABLE :: voldatir_out(:,:,:)
1989 TYPE(conv_func),POINTER :: c_func(:)
1990 TYPE(datetime),ALLOCATABLE :: validitytime(:,:)
1991 REAL,POINTER :: voldatiin(:,:,:)
1992 
1993 #ifdef DEBUG
1994 call l4f_category_log(volgrid6d_in%category,l4f_debug,"start volgrid6d_v7d_transform_compute")
1995 #endif
1996 
1997 ntime=0
1998 ntimerange=0
1999 nlevel=0
2000 nvar=0
2001 NULLIFY(c_func)
2002 
2003 if (present(networkname))then
2004  call init(vol7d_out%network(1),name=networkname)
2005 else
2006  call init(vol7d_out%network(1),name='generic')
2007 end if
2008 
2009 if (associated(volgrid6d_in%timerange))then
2010  ntimerange=size(volgrid6d_in%timerange)
2011  vol7d_out%timerange=volgrid6d_in%timerange
2012 end if
2013 
2014 if (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
2046 end if
2047 
2048 IF (ASSOCIATED(volgrid6d_in%level)) THEN
2049  nlevel = SIZE(volgrid6d_in%level)
2050  vol7d_out%level=volgrid6d_in%level
2051 ENDIF
2052 
2053 IF (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
2058 ENDIF
2059 
2060 nana = SIZE(vol7d_out%ana)
2061 
2062 ! allocate once for speed
2063 IF (.NOT.ASSOCIATED(volgrid6d_in%voldati)) THEN
2064  ALLOCATE(voldatiin(volgrid6d_in%griddim%dim%nx, volgrid6d_in%griddim%dim%ny, &
2065  nlevel))
2066 ENDIF
2067 
2068 ALLOCATE(voldatir_out(nana,1,nlevel),stat=stallo)
2069 IF (stallo /= 0) THEN
2070  CALL l4f_category_log(volgrid6d_in%category,l4f_fatal,"allocating memory")
2071  CALL raise_fatal_error()
2072 ENDIF
2073 
2074 inetwork=1
2075 do 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
2111 end do
2112 
2113 deallocate(voldatir_out)
2114 IF (.NOT.ASSOCIATED(volgrid6d_in%voldati)) THEN
2115  DEALLOCATE(voldatiin)
2116 ENDIF
2117 if (allocated(validitytime)) deallocate(validitytime)
2118 
2119 ! Rescale valid data according to variable conversion table
2120 IF (ASSOCIATED(c_func)) THEN
2121  DO ivar = 1, nvar
2122  CALL compute(c_func(ivar), vol7d_out%voldatir(:,:,:,:,ivar,:))
2123  ENDDO
2124  DEALLOCATE(c_func)
2125 ENDIF
2126 
2127 end SUBROUTINE volgrid6d_v7d_transform_compute
2128 
2129 
Index method.

Generated with Doxygen.