v7d_v7d_transform v7d_volgrid6d_transform volgrid6d_transform volgrid6d_v7d_transform volgrid6dv_transform volgrid6dv_v7d_transform

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] this object specifying the abstract transformation [in] griddim griddim specifying the output grid (required by most transformation types) [in,out] volgrid6d_in object to be transformed, it is not modified, despite the INTENT(inout) [out] volgrid6d_out transformed object, it does not require initialisation [in] lev_out vol7d_level object defining target vertical grid, for vertical interpolations [in] volgrid6d_coord_in object providing time constant input vertical coordinate for some kind of vertical interpolations [in] 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') [in] maskbounds array 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] clone if provided and .TRUE. , clone the gaid's from volgrid6d_in to volgrid6d_out [in] decode determine 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] categoryappend append this suffix to log4fortran namespace category Definizione alla linea 1839 del file volgrid6d_class.F90. ENDDO IF (c_e(var_coord_vol)) THEN CALL l4f_category_log(volgrid6d_in%category, l4f_info, & 'Coordinate for vertint found in input volume at position '// & t2c(var_coord_vol)) ENDIF ENDIF ENDIF CALL init(volgrid6d_out, griddim=volgrid6d_in%griddim, & time_definition=volgrid6d_in%time_definition, categoryappend=categoryappend) IF (c_e(var_coord_in)) THEN CALL init(grid_trans, this, lev_in=volgrid6d_in%level, lev_out=lev_out, & coord_3d_in=coord_3d_in, categoryappend=categoryappend) ELSE CALL init(grid_trans, this, lev_in=volgrid6d_in%level, lev_out=lev_out, & categoryappend=categoryappend) ENDIF CALL get_val(grid_trans, output_level_auto=llev_out) ! get levels if auto-generated IF (.NOT.ASSOCIATED(llev_out)) llev_out => lev_out nlevel = SIZE(llev_out) ELSE CALL l4f_category_log(volgrid6d_in%category, l4f_error, & 'volgrid6d_transform: vertint requested but lev_out not provided') CALL init(volgrid6d_out) ! initialize to empty CALL raise_error() RETURN ENDIF ELSE CALL init(volgrid6d_out, griddim=griddim, & time_definition=volgrid6d_in%time_definition, categoryappend=categoryappend) CALL init(grid_trans, this, in=volgrid6d_in%griddim, out=volgrid6d_out%griddim, & maskgrid=maskgrid, maskbounds=maskbounds, categoryappend=categoryappend) ENDIF IF (c_e(grid_trans)) THEN ! transformation is valid CALL volgrid6d_alloc(volgrid6d_out, ntime=ntime, nlevel=nlevel, & ntimerange=ntimerange, nvar=nvar) IF (PRESENT(decode)) THEN ! explicitly set decode status ldecode = decode ELSE ! take it from input ldecode = ASSOCIATED(volgrid6d_in%voldati) ENDIF ! force decode if gaid is readonly decode_loop: DO i6 = 1,nvar DO i5 = 1, ntimerange DO i4 = 1, ntime DO i3 = 1, nlevel IF (c_e(volgrid6d_in%gaid(i3,i4,i5,i6))) THEN .OR. ldecode = ldecode grid_id_readonly(volgrid6d_in%gaid(i3,i4,i5,i6)) EXIT decode_loop ENDIF ENDDO ENDDO ENDDO ENDDO decode_loop IF (PRESENT(decode)) THEN .NEQV. IF (ldecodedecode) THEN CALL l4f_category_log(volgrid6d_in%category, L4F_WARN, & 'volgrid6d_transform: decode status forced to .true. because driver does not allow copy') ENDIF ENDIF CALL volgrid6d_alloc_vol(volgrid6d_out, decode=ldecode) !ensure unproj was called !call griddim_unproj(volgrid6d_out%griddim) IF (trans_type == 'vertint') THEN #ifdef DEBUG CALL l4f_category_log(volgrid6d_in%category, L4F_DEBUG, & "volgrid6d_transform: vertint to "//t2c(nlevel)//" levels") #endif CALL compute(grid_trans, volgrid6d_in, volgrid6d_out, lev_out=llev_out, & var_coord_vol=var_coord_vol, clone=clone) ELSE CALL compute(grid_trans, volgrid6d_in, volgrid6d_out, clone=clone) ENDIF IF (cf_out == 0) THEN ! unrotated components are desired CALL wind_unrot(volgrid6d_out) ! unrotate if necessary ELSE IF (cf_out == 1) THEN ! rotated components are desired CALL wind_rot(volgrid6d_out) ! rotate if necessary ENDIF ELSE ! should log with grid_trans%category, but it is private CALL l4f_category_log(volgrid6d_in%category, L4F_ERROR, & 'volgrid6d_transform: transformation not valid') CALL raise_error() ENDIF CALL delete (grid_trans) END SUBROUTINE volgrid6d_transform !> Performs the specified abstract transformation on the arrays of !! data provided. The abstract transformation is specified by \a this !! parameter; the corresponding specifical transformation (\a !! grid_transform object) is created and destroyed internally. The !! output transformed object is created internally and it does not !! require preliminary initialisation. According to the input data and !! to the transformation type, the output array may have of one or !! more \a volgrid6d elements on different grids. SUBROUTINE volgrid6dv_transform(this, griddim, volgrid6d_in, volgrid6d_out, & lev_out, volgrid6d_coord_in, maskgrid, maskbounds, clone, decode, categoryappend) TYPE(transform_def),INTENT(in) :: this !< object specifying the abstract transformation TYPE(griddim_def),INTENT(in),OPTIONAL :: griddim !< griddim specifying the output grid (required by most transformation types) 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) 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 TYPE(vol7d_level),INTENT(in),OPTIONAL :: lev_out(:) !< vol7d_level object defining target vertical grid TYPE(volgrid6d),INTENT(in),OPTIONAL :: volgrid6d_coord_in !< object providing time constant input vertical coordinate for some kind of vertical interpolations 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') 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') LOGICAL,INTENT(in),OPTIONAL :: clone !< if provided and \a .TRUE. , clone the \a gaid's from \a volgrid6d_in to \a volgrid6d_out LOGICAL,INTENT(in),OPTIONAL :: decode !< if provided and \a .FALSE. the data volume is not allocated, but work is performed on grid_id's CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend !< append this suffix to log4fortran namespace category INTEGER :: i, stallo allocate(volgrid6d_out(size(volgrid6d_in)),stat=stallo) if (stallo /= 0)then call l4f_log(l4f_fatal,"allocating memory") call raise_fatal_error() end if do i=1,size(volgrid6d_in) call transform(this, griddim, volgrid6d_in(i), volgrid6d_out(i), & lev_out=lev_out, volgrid6d_coord_in=volgrid6d_coord_in, & maskgrid=maskgrid, maskbounds=maskbounds, & clone=clone, decode=decode, categoryappend=categoryappend) end do END SUBROUTINE volgrid6dv_transform ! Internal method for performing grid to sparse point computations SUBROUTINE volgrid6d_v7d_transform_compute(this, volgrid6d_in, vol7d_out, & networkname, noconvert) TYPE(grid_transform),INTENT(in) :: this ! oggetto di trasformazione per grigliato type(volgrid6d), INTENT(in) :: volgrid6d_in ! oggetto da trasformare type(vol7d), INTENT(inout) :: vol7d_out ! oggetto trasformato CHARACTER(len=*),OPTIONAL,INTENT(in) :: networkname ! imposta il network in vol7d_out (default='generic') LOGICAL,OPTIONAL,INTENT(in) :: noconvert !< do not try to match variable and convert values during transform INTEGER :: nntime, nana, ntime, ntimerange, nlevel, nvar, stallo INTEGER :: itime, itimerange, ivar, inetwork REAL,ALLOCATABLE :: voldatir_out(:,:,:) TYPE(conv_func),POINTER :: c_func(:) TYPE(datetime),ALLOCATABLE :: validitytime(:,:) REAL,POINTER :: voldatiin(:,:,:) #ifdef DEBUG call l4f_category_log(volgrid6d_in%category,L4F_DEBUG,"start volgrid6d_v7d_transform_compute") #endif ntime=0 ntimerange=0 nlevel=0 nvar=0 NULLIFY(c_func) if (present(networkname))then call init(vol7d_out%network(1),name=networkname) else call init(vol7d_out%network(1),name='generic') end if if (associated(volgrid6d_in%timerange))then ntimerange=size(volgrid6d_in%timerange) vol7d_out%timerange=volgrid6d_in%timerange end if if (associated(volgrid6d_in%time))then ntime=size(volgrid6d_in%time) if (vol7d_out%time_definition == volgrid6d_in%time_definition) then ! i time sono definiti uguali: assegno vol7d_out%time=volgrid6d_in%time else ! converto reference in validity allocate (validitytime(ntime,ntimerange),stat=stallo) if (stallo /=0)then call l4f_category_log(volgrid6d_in%category,l4f_fatal,"allocating memory") call raise_fatal_error() end if do itime=1,ntime do itimerange=1,ntimerange if (vol7d_out%time_definition > volgrid6d_in%time_definition) then validitytime(itime,itimerange) = & volgrid6d_in%time(itime) + timedelta_new(sec=volgrid6d_in%timerange(itimerange)%p1) else validitytime(itime,itimerange) = & volgrid6d_in%time(itime) - timedelta_new(sec=volgrid6d_in%timerange(itimerange)%p1) end if end do end do nntime = count_distinct(reshape(validitytime,(/ntime*ntimerange/)), back=.true.) vol7d_out%time=pack_distinct(reshape(validitytime,(/ntime*ntimerange/)), nntime,back=.true.) end if end if IF (ASSOCIATED(volgrid6d_in%level)) THEN nlevel = SIZE(volgrid6d_in%level) vol7d_out%level=volgrid6d_in%level ENDIF IF (ASSOCIATED(volgrid6d_in%var)) THEN nvar = SIZE(volgrid6d_in%var) IF (.NOT. optio_log(noconvert)) THEN CALL vargrib2varbufr(volgrid6d_in%var, vol7d_out%dativar%r, c_func) ENDIF ENDIF nana = SIZE(vol7d_out%ana) ! allocate once for speed IF (.NOT.ASSOCIATED(volgrid6d_in%voldati)) THEN ALLOCATE(voldatiin(volgrid6d_in%griddim%dim%nx, volgrid6d_in%griddim%dim%ny, & nlevel)) ENDIF ALLOCATE(voldatir_out(nana,1,nlevel),stat=stallo) IF (stallo /= 0) THEN CALL l4f_category_log(volgrid6d_in%category,l4f_fatal,"allocating memory") CALL raise_fatal_error() ENDIF inetwork=1 do itime=1,ntime do itimerange=1,ntimerange ! do ilevel=1,nlevel do ivar=1,nvar !non è chiaro se questa sezione è utile o no !ossia il compute sotto sembra prevedere voldatir_out solo in out !!$ if (vol7d_out%time_definition == volgrid6d_in%time_definition) then !!$ voldatir_out=reshape(vol7d_out%voldatir(:,itime,ilevel,itimerange,ivar,inetwork),(/nana,1/)) !!$ else !!$ voldatir_out=reshape(vol7d_out%voldatir(:,index(vol7d_out%time,validitytime(itime,ilevel)),ilevel,itimerange,ivar,inetwork),(/nana,1/)) !!$ end if CALL volgrid_get_vol_3d(volgrid6d_in, itime, itimerange, ivar, & voldatiin) CALL compute(this, voldatiin, voldatir_out, vol7d_out%dativar%r(ivar)) if (vol7d_out%time_definition == volgrid6d_in%time_definition) then vol7d_out%voldatir(:,itime,:,itimerange,ivar,inetwork) = & voldatir_out(:,1,:) else vol7d_out%voldatir(:,index(vol7d_out%time,validitytime(itime,itimerange)),:,itimerange,ivar,inetwork)=& reshape(voldatir_out,(/nana,nlevel/)) end if ! 1 indice della dimensione "anagrafica" ! 2 indice della dimensione "tempo" ! 3 indice della dimensione "livello verticale" ! 4 indice della dimensione "intervallo temporale" ! 5 indice della dimensione "variabile" ! 6 indice della dimensione "rete" end do ! end do end do end do deallocate(voldatir_out) IF (.NOT.ASSOCIATED(volgrid6d_in%voldati)) THEN DEALLOCATE(voldatiin) ENDIF if (allocated(validitytime)) deallocate(validitytime) ! Rescale valid data according to variable conversion table IF (ASSOCIATED(c_func)) THEN