libsim Versione 7.2.1

◆ qccliinit()

subroutine 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 361 del file modqccli.F90.

367call delete(ltimei)
368call delete(ltimef)
369
370if ( c_e(yeari) .and. c_e(yearf) .and. yeari == yearf .and. monthi == monthf ) then
371
372 if ( dayi == dayf .and. houri == hourf .and. minutei == minutef .and. mseci == msecf ) then
373
374 ltimei=cyclicdatetime_to_conventional(cyclicdatetime_new(month=monthi, hour=houri))
375 ltimef=cyclicdatetime_to_conventional(cyclicdatetime_new(month=monthf, hour=hourf))
376
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
384else
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
389end if
390
391call init(network,"qcclima-perc")
392call optio(dsnextreme,ldsnextreme)
393
394if (.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
438else
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
450end if
451
452call delete(ltimei)
453call delete(ltimef)
454#endif
455
456
457call 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
467if (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
481end if
482
483call delete(macroa)
484
485return
486end subroutine qccliinit
487
488
490subroutine qcclialloc(qccli)
491 ! pseudo costruttore con distruttore automatico
492
493type(qcclitype),intent(in out) :: qccli
494
495integer :: istatt
496integer :: sh(5)
497
498! se ti sei dimenticato di deallocare ci penso io
499call 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
514if (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
520end if
521
522if (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
531end if
532
533return
534
535end subroutine qcclialloc
536
537
539
540subroutine qcclidealloc(qccli)
541 ! pseudo distruttore
542
543type(qcclitype),intent(in out) :: qccli
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
553if (associated (qccli%in_macroa)) then
554 deallocate (qccli%in_macroa)
555end if
556
557if (associated(qccli%data_id_out))then
558 deallocate (qccli%data_id_out)
559end if
560
561return
562end subroutine qcclidealloc
563
564
566
567
568subroutine qcclidelete(qccli)
569 ! decostruttore a mezzo
570type(qcclitype),intent(in out) :: qccli
571
572call qcclidealloc(qccli)
573
574call delete(qccli%clima)
575call delete(qccli%extreme)
576
577!delete logger
578call l4f_category_delete(qccli%category)
579
580return
581end subroutine qcclidelete
582
583
584
597SUBROUTINE vol7d_normalize_data(qccli)
598
599TYPE(qcclitype),INTENT(inout) :: qccli
600!character (len=10) ,intent(in),optional :: battrinv !< attributo invalidated in input/output
601
602real :: datoqui, perc25, perc50,perc75
603integer :: indana , indtime ,indlevel ,indtimerange ,inddativarr, indnetwork
604integer :: indcana, indvar,indctime,indclevel,indctimerange,indcdativarr,indcnetwork
605!integer :: indbattrinv
606integer :: iclv(size(qccli%v7d%ana))
607real :: height
608character(len=1) :: type
609TYPE(vol7d_var) :: var
610TYPE(vol7d_ana) :: ana
611TYPE(datetime) :: time, nintime
612TYPE(vol7d_level):: level
613integer :: mese, ora, desc, iarea, k
614
615integer :: clev
616character(len=1) :: mycanc, canc = "#"
617
618CHARACTER(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
631if (.not. 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
636end if
637
638
639if (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 iclv(indana)=firsttrue(cli_level1 <= height .and. height <= cli_level2 )
671 else
672 iclv(indana)=imiss
673 endif
Index method.

Generated with Doxygen.