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 1851 del file volgrid6d_class.F90. 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 ldecode = ldecode .OR. grid_id_readonly(volgrid6d_in%gaid(i3,i4,i5,i6)) EXIT decode_loop ENDIF ENDDO ENDDO ENDDO ENDDO decode_loop IF (PRESENT(decode)) THEN IF (ldecode.NEQV.decode) 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 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 TYPE(griddim_def),INTENT(in),OPTIONAL :: griddim TYPE(volgrid6d),INTENT(inout) :: volgrid6d_in(:) TYPE(volgrid6d),POINTER :: volgrid6d_out(:) TYPE(vol7d_level),INTENT(in),OPTIONAL :: lev_out(:) TYPE(volgrid6d),INTENT(in),OPTIONAL :: volgrid6d_coord_in REAL,INTENT(in),OPTIONAL :: maskgrid(:,:) REAL,INTENT(in),OPTIONAL :: maskbounds(:) LOGICAL,INTENT(in),OPTIONAL :: clone LOGICAL,INTENT(in),OPTIONAL :: decode CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend 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 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 DO ivar = 1, nvar CALL compute(c_func(ivar), vol7d_out%voldatir(:,:,:,:,ivar,:)) ENDDO DEALLOCATE(c_func) ENDIF end SUBROUTINE volgrid6d_v7d_transform_compute