libsim  Versione 7.2.6

◆ qccliinit()

subroutine modqccli::qccliinit ( type(qcclitype), intent(inout)  qccli,
type (vol7d), intent(in), target  v7d,
character(len=*), dimension(:), intent(in)  var,
type(datetime), intent(in), optional  timei,
type(datetime), intent(in), optional  timef,
integer, dimension(:,:,:,:,:), intent(in), optional, target  data_id_in,
character(len=*), intent(in), optional  macropath,
character(len=*), intent(in), optional  climapath,
character(len=*), intent(in), optional  extremepath,
character(len=*), intent(in), optional  dsncli,
character(len=*), intent(in), optional  dsnextreme,
character(len=*), intent(in), optional  user,
character(len=*), intent(in), optional  password,
logical, intent(in), optional  height2level,
character(len=*), intent(in), optional  categoryappend 
)
private

Init del controllo di qualità climatico.

Effettua la lettura dei file e altre operazioni di inizializzazione.

Parametri
[in,out]qccliOggetto per il controllo climatico
[in]v7dIl volume Vol7d da controllare
[in]varvariabili da importare secondo la tabella B locale o relativi alias
[in]timeiestremi temporali (inizio e fine) dell'estrazione per l'importazione
[in]timefestremi temporali (inizio e fine) dell'estrazione per l'importazione
[in]data_id_inIndici dei dati in DB
[in]macropathfile delle macroaree
[in]climapathfile con il volume del clima
[in]extremepathfile con il volume del clima
[in]height2leveluse conventional level starting from station height
[in]categoryappendappennde questo suffisso al namespace category di log4fortran $!> coordinate minime e massime che definiscono il $!! rettangolo di estrazione per l'importazione $TYPE(geo_coord),INTENT(inout),optional :: coordmin,coordmax

Definizione alla linea 371 del file modqccli.F90.

377  else
378 
379  ltimei=cyclicdatetime_to_conventional(cyclicdatetime_new(month=monthi, hour=00))
380  ltimef=cyclicdatetime_to_conventional(cyclicdatetime_new(month=monthf, hour=23))
381 
382  end if
383 
384 else
385  ! if you span years or months or days I read all the climat dataset (should be optimized not so easy)
386  ltimei=datetime_miss
387  ltimef=datetime_miss
388 
389 end if
390 
391 call init(network,"qcclima-perc")
392 call optio(dsnextreme,ldsnextreme)
393 
394 if (.not. c_e(ldsnextreme)) then
395 
396 #endif
397 
398  if (.not. c_e(filepathextreme)) then
399  filepathextreme=get_package_filepath('qcclima-extreme.v7d', filetype_data)
400  end if
401 
402  if (c_e(filepathextreme)) then
403 
404  select case (trim(lowercase(suffixname(filepathextreme))))
405 
406  case("v7d")
407  iuni=getunit()
408  call import(qccli%extreme,filename=filepathextreme,unit=iuni)
409  close (unit=iuni)
410 
411 #ifdef HAVE_DBALLE
412  case("bufr")
413  call init(v7d_dballeextreme,file=.true.,filename=filepathextreme,categoryappend=trim(a_name)//".climaextreme")
414  !call import(v7d_dballeextreme)
415  call import(v7d_dballeextreme,var=var,coordmin=lcoordmin, coordmax=lcoordmax, timei=ltimei, timef=ltimef, &
416  varkind=(/("r",i=1,size(var))/),attr=(/qcattrvarsbtables(2)/),attrkind=(/"b"/),network=network)
417  call copy(v7d_dballeextreme%vol7d,qccli%extreme)
418  call delete(v7d_dballeextreme)
419 #endif
420 
421  case default
422 
423  if (c_e(filepathextreme)) then
424  call l4f_category_log(qccli%category,l4f_error,&
425  "file type not supported (user .v7d or .bufr suffix only): "//trim(filepathextreme))
426  call raise_error()
427  end if
428  end select
429 
430  else
431  call l4f_category_log(qccli%category,l4f_warn,"extreme volume not iniziatized: QC or normalize data will not be possible")
432 ! call raise_fatal_error()
433  call init(qccli%extreme)
434  end if
435 
436 
437 #ifdef HAVE_DBALLE
438 else
439 
440  call l4f_category_log(qccli%category,l4f_debug,"init v7d_dballeextreme")
441  call init(v7d_dballeextreme,dsn=ldsnextreme,user=luser,password=lpassword,&
442  write=.false.,file=.false.,categoryappend=trim(a_name)//".climaextreme")
443  call l4f_category_log(qccli%category,l4f_debug,import v7d_dballeextreme")
444 
445  call import(v7d_dballeextreme,var=var,coordmin=lcoordmin, coordmax=lcoordmax, timei=ltimei, timef=ltimef, &
446  varkind=(/("r",i=1,size(var))/),attr=(/qcattrvarsbtables(2)/),attrkind=(/"b"/),network=network)
447  call copy(v7d_dballeextreme%vol7d,qccli%extreme)
448  call delete(v7d_dballeextreme)
449 
450 end if
451 
452 call delete(ltimei)
453 call delete(ltimef)
454 #endif
455 
456 
457 call qcclialloc(qccli)
458 
459 
460 ! valuto in quale macroarea sono le stazioni
461 
462 !!$IF (macroa%arraysize <= 0) THEN
463 !!$ CALL l4f_category_log(qccli%category,L4F_ERROR,"maskgen: poly parameter missing or empty")
464 !!$ CALL raise_fatal_error()
465 !!$ENDIF
466 
467 if (associated(qccli%in_macroa)) then
468  qccli%in_macroa = imiss
469 
470  DO i = 1, SIZE(qccli%v7d%ana)
471  ! temporary, improve!!!!
472  CALL getval(qccli%v7d%ana(i)%coord,lon=lon,lat=lat)
473  point = georef_coord_new(x=lon, y=lat)
474  DO j = 1, macroa%arraysize
475  IF (inside(point, macroa%array(j))) THEN
476  qccli%in_macroa(i) = j
477  EXIT
478  ENDIF
479  ENDDO
480  ENDDO
481 end if
482 
483 call delete(macroa)
484 
485 return
486 end subroutine qccliinit
487 
488 
489 !>\brief Allocazioni di memoria
490 subroutine qcclialloc(qccli)
491  ! pseudo costruttore con distruttore automatico
492 
493 type(qcclitype),intent(in out) :: qccli !< Oggetto per il controllo climatico
494 
495 integer :: istatt
496 integer :: sh(5)
497 
498 ! se ti sei dimenticato di deallocare ci penso io
499 call qcclidealloc(qccli)
500 
501 
502 !!$if (associated (qccli%v7d%dativar%r )) then
503 !!$ nv=size(qccli%v7d%dativar%r)
504 !!$
505 !!$ allocate(qccli%valminr(nv),stat=istat)
506 !!$ istatt=istatt+istat
507 !!$ allocate(qccli%valmaxr(nv),stat=istat)
508 !!$ istatt=istatt+istat
509 !!$
510 !!$ if (istatt /= 0) ier=1
511 !!$
512 !!$end if
513 
514 if (associated (qccli%v7d%ana )) then
515  allocate (qccli%in_macroa(size(qccli%v7d%ana )),stat=istatt)
516  if (istatt /= 0) then
517  call l4f_category_log(qccli%category,L4F_ERROR,"allocate error")
518  call raise_error("allocate error")
519  end if
520 end if
521 
522 if (associated(qccli%data_id_in))then
523  sh=shape(qccli%data_id_in)
524  allocate (qccli%data_id_out(sh(1),sh(2),sh(3),sh(4),sh(5)),stat=istatt)
525  if (istatt /= 0)then
526  call l4f_category_log(qccli%category,L4F_ERROR,"allocate error")
527  call raise_error("allocate error")
528  else
529  qccli%data_id_out=imiss
530  end if
531 end if
532 
533 return
534 
535 end subroutine qcclialloc
536 
537 
538 !>\brief Deallocazione della memoria
539 
540 subroutine qcclidealloc(qccli)
541  ! pseudo distruttore
542 
543 type(qcclitype),intent(in out) :: qccli !< Oggetto per l controllo climatico
544 
545 !!$if ( associated ( qccli%valminr)) then
546 !!$ deallocate(qccli%valminr)
547 !!$end if
548 !!$
549 !!$if ( associated ( qccli%valmaxr)) then
550 !!$ deallocate(qccli%valmaxr)
551 !!$end if
552 
553 if (associated (qccli%in_macroa)) then
554  deallocate (qccli%in_macroa)
555 end if
556 
557 if (associated(qccli%data_id_out))then
558  deallocate (qccli%data_id_out)
559 end if
560 
561 return
562 end subroutine qcclidealloc
563 
564 
565 !>\brief Cancellazione
566 
567 
568 subroutine qcclidelete(qccli)
569  ! decostruttore a mezzo
570 type(qcclitype),intent(in out) :: qccli !< Oggetto per l controllo climatico
571 
572 call qcclidealloc(qccli)
573 
574 call delete(qccli%clima)
575 call delete(qccli%extreme)
576 
577 !delete logger
578 call l4f_category_delete(qccli%category)
579 
580 return
581 end subroutine qcclidelete
582 
583 
584 
585 !> Modulo 1: Calcolo dei parametri di normalizzazione dei dati
586 °°°!! I parametri di normalizzazione sono il 25, il 50 e il 75 percentile
587 !! (p25,p50,p75)
588 !!oppure (p15.87,p50.,p84.13)
589 !! Tali parametri verranno calcolati per ogni mese, per ogni ora, per ogni area.
590 !! Modulo 2: Normalizzazione dati
591 à!! Ciascun dato D verr normalizzato come segue:
592 !! DN = (D-p50)*2/(p75-p25)
593 !! oppure DN = (D-p50)*2/(p16-p84)
594 è!! dove DN il valore normalizzato.
595 !! La scelta dei parametri di normalizzazione dipende dal mese, dall'ora,
596 !! dall'area.
597 SUBROUTINE vol7d_normalize_data(qccli)
598 
599 TYPE(qcclitype),INTENT(inout) :: qccli !< volume providing data to be computed, it is modified by the method
600 !character (len=10) ,intent(in),optional :: battrinv !< attributo invalidated in input/output
601 
602 real :: datoqui, perc25, perc50,perc75
603 integer :: indana , indtime ,indlevel ,indtimerange ,inddativarr, indnetwork
604 integer :: indcana, indvar,indctime,indclevel,indctimerange,indcdativarr,indcnetwork
605 !integer :: indbattrinv
606 integer :: iclv(size(qccli%v7d%ana))
607 real :: height
608 character(len=1) :: type
609 TYPE(vol7d_var) :: var
610 TYPE(vol7d_ana) :: ana
611 TYPE(datetime) :: time, nintime
612 TYPE(vol7d_level):: level
613 integer :: mese, ora, desc, iarea, k
614 
615 integer :: clev
616 character(len=1) :: mycanc, canc = "#"
617 
618 CHARACTER(len=vol7d_ana_lenident) :: ident
619 
620 
621 !!$indbattrinv=0
622 !!$if (associated(qccli%v7d%dativarattr%b))then
623 !!$ if (present(battrinv))then
624 !!$ indbattrinv = index_c(qccli%v7d%dativarattr%b(:)%btable, battrinv)
625 !!$ else
626 !!$ indbattrinv = index_c(qccli%v7d%dativarattr%b(:)%btable, qcattrvarsbtables(1))
627 !!$ end if
628 !!$end if
629 
630 
631 .not.if ( associated(qccli%extreme%voldatir))then
632  call l4f_category_log(qccli%category,L4F_WARN,"extreme data not associated: normalize data not possible")
633  qccli%v7d%voldatir=rmiss
634  ! call raise_fatal_error()
635  return
636 end if
637 
638 
639 if (qccli%height2level) then
640  call init(var, btable="b07030") ! height
641 
642  type=cmiss
643  indvar = index(qccli%v7d%anavar, var, type=type)
644 
645  do indana=1,size(qccli%v7d%ana)
646  height=rmiss
647 
648  ! here we take the height fron any network (the first network win)
649  do indnetwork=1,size(qccli%v7d%network)
650 
651  if( indvar > 0 ) then
652  select case (type)
653  case("d")
654  height=realdat(qccli%v7d%volanad(indana,indvar,indnetwork),qccli%v7d%anavar%d(indvar))
655  case("r")
656  height=realdat(qccli%v7d%volanar(indana,indvar,indnetwork),qccli%v7d%anavar%r(indvar))
657  case ("i")
658  height=realdat(qccli%v7d%volanai(indana,indvar,indnetwork),qccli%v7d%anavar%i(indvar))
659  case("b")
660  height=realdat(qccli%v7d%volanab(indana,indvar,indnetwork),qccli%v7d%anavar%b(indvar))
661  case("c")
662  height=realdat(qccli%v7d%volanac(indana,indvar,indnetwork),qccli%v7d%anavar%c(indvar))
663  end select
664  end if
665 
666  if (c_e(height)) exit
667  end do
668 
669  if (c_e(height)) then
670 .and. iclv(indana)=firsttrue(cli_level1 <= height height <= cli_level2 )
671  else
672  iclv(indana)=imiss
673  endif
674 
675 #ifdef DEBUG
676  call l4f_category_log(qccli%category,L4F_DEBUG, 'vol7d_normalize_data height has value '//t2c(height,"missing"))
677  call l4f_category_log(qccli%category,L4F_DEBUG, 'for indana having number '//t2c(indana)//&
678  ' iclv has value '//t2c(iclv(indana),"missing"))
679 #endif
680  end do
681 
682 endif
683 

Generated with Doxygen.