libsim Versione 7.2.6
|
◆ vol7d_var_new()
Definizione alla linea 398 del file vol7d_var_class.F90. 399! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
400! authors:
401! Davide Cesari <dcesari@arpa.emr.it>
402! Paolo Patruno <ppatruno@arpa.emr.it>
403
404! This program is free software; you can redistribute it and/or
405! modify it under the terms of the GNU General Public License as
406! published by the Free Software Foundation; either version 2 of
407! the License, or (at your option) any later version.
408
409! This program is distributed in the hope that it will be useful,
410! but WITHOUT ANY WARRANTY; without even the implied warranty of
411! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
412! GNU General Public License for more details.
413
414! You should have received a copy of the GNU General Public License
415! along with this program. If not, see <http://www.gnu.org/licenses/>.
416#include "config.h"
417
418!> Classe per la gestione delle variabili osservate da stazioni meteo e affini.
419!! Questo modulo definisce una classe per rappresentare variabili meteorologiche
420!! osservate, o attributi, aventi diversi tipi numerici o carattere.
421!! \ingroup vol7d
426IMPLICIT NONE
427
428!> Definisce una variabile meteorologica osservata o un suo attributo.
429!! I membri \a r, \a d, \a i, \a b, \a c servono, internamente a vol7d,
430!! per associare le variabili agli attributi, e indicano
431!! a quale variabile, nel descrittore delle variabili, coincide
432!! la variabile corrente nel descrittore delle "variabili aventi attributo".
433!! I membri di \a vol7d_var sono pubblici e quindi liberamente
434!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
435!! il costruttore ::init.
437 CHARACTER(len=10) :: btable=cmiss !< codice della variabile secondo la tabella B del WMO.
438 CHARACTER(len=65) :: description=cmiss !< descrizione testuale della variabile (opzionale)
439 CHARACTER(len=24) :: unit=cmiss !< descrizione testuale dell'unità di misura (opzionale)
440 INTEGER :: scalefactor=imiss !< numero di decimali nella rappresentazione intera o character (opzionale)
441
442 INTEGER :: r=imiss !< indice della variabile nel volume degli attributi reali
443 INTEGER :: d=imiss !< indice della variabile nel volume degli attributi double precision
444 INTEGER :: i=imiss !< indice della variabile nel volume degli attributi integer
445 INTEGER :: b=imiss !< indice della variabile nel volume degli attributi byte
446 INTEGER :: c=imiss !< indice della variabile nel volume degli attributi character
447 INTEGER :: gribhint(4)=imiss !< hint for conversion from/to grib when btable is not found
449
450!> Valore mancante per vol7d_var.
451TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
452 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
453 (/imiss,imiss,imiss,imiss/))
454
455!> Costruttore per la classe vol7d_var.
456!! Deve essere richiamato
457!! per tutti gli oggetti di questo tipo definiti in un programma.
459 MODULE PROCEDURE vol7d_var_init
460END INTERFACE
461
462!> Distruttore per la classe vol7d_var.
463!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
465 MODULE PROCEDURE vol7d_var_delete
466END INTERFACE
467
468!> Operatore logico di uguaglianza tra oggetti della classe vol7d_var.
469!! Funziona anche per
470!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
471!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
472!! di 1 dimensione e scalari).
473INTERFACE OPERATOR (==)
474 MODULE PROCEDURE vol7d_var_eq
475END INTERFACE
476
477!> Operatore logico di disuguaglianza tra oggetti della classe vol7d_var.
478!! Funziona anche per
479!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
480!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
481!! di 1 dimensione e scalari).
482INTERFACE OPERATOR (/=)
483 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
484END INTERFACE
485
486!> to be documented
488 MODULE PROCEDURE vol7d_var_c_e
489END INTERFACE
490
491#define VOL7D_POLY_TYPE TYPE(vol7d_var)
492#define VOL7D_POLY_TYPES _var
493#include "array_utilities_pre.F90"
494
495!> \brief display on the screen a brief content of object
497 MODULE PROCEDURE display_var, display_var_vect
498END INTERFACE
499
500
501TYPE vol7d_var_features
502 TYPE(vol7d_var) :: var !< the variable (only btable is relevant)
503 REAL :: posdef !< if not missing, minimum physically reasonable value for the variable
504 INTEGER :: vartype !< type of variable, one of the var_* constants
505END TYPE vol7d_var_features
506
507TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
508
509! constants for vol7d_vartype
510INTEGER,PARAMETER :: var_ord=0 !< unclassified variable (vol7d_vartype function)
511INTEGER,PARAMETER :: var_dir360=1 !< direction in degrees (vol7d_vartype function)
512INTEGER,PARAMETER :: var_press=2 !< pressure in Pa (vol7d_vartype function)
513INTEGER,PARAMETER :: var_ucomp=3 !< u component of a vector field (vol7d_vartype function)
514INTEGER,PARAMETER :: var_vcomp=4 !< v component of a vector field (vol7d_vartype function)
515INTEGER,PARAMETER :: var_wcomp=5 !< w component of a vector field (vol7d_vartype function)
516
517
518CONTAINS
519
520!> Inizializza un oggetto \a vol7d_var con i parametri opzionali forniti.
521!! Se non viene passato nessun parametro opzionale l'oggetto è
522!! inizializzato a valore mancante.
523!! I membri \a r, \a d, \a i, \a b, \a c non possono essere assegnati
524!! tramite costruttore, ma solo direttamente.
525elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
526TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da inizializzare
527CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
528CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
529CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
530INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
531
532IF (PRESENT(btable)) THEN
533 this%btable = btable
534ELSE
535 this%btable = cmiss
536 this%description = cmiss
537 this%unit = cmiss
538 this%scalefactor = imiss
539 RETURN
540ENDIF
541IF (PRESENT(description)) THEN
542 this%description = description
543ELSE
544 this%description = cmiss
545ENDIF
546IF (PRESENT(unit)) THEN
547 this%unit = unit
548ELSE
549 this%unit = cmiss
550ENDIF
551if (present(scalefactor)) then
552 this%scalefactor = scalefactor
553else
554 this%scalefactor = imiss
555endif
556
557this%r = -1
558this%d = -1
559this%i = -1
560this%b = -1
561this%c = -1
562
563END SUBROUTINE vol7d_var_init
564
565
566ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
567CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
568CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
569CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
570INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
571
572TYPE(vol7d_var) :: this
573
575
576END FUNCTION vol7d_var_new
577
578
579!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
580elemental SUBROUTINE vol7d_var_delete(this)
581TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da distruggre
582
583this%btable = cmiss
584this%description = cmiss
585this%unit = cmiss
586this%scalefactor = imiss
587
588END SUBROUTINE vol7d_var_delete
589
590
591ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
592TYPE(vol7d_var),INTENT(IN) :: this, that
593LOGICAL :: res
594
595res = this%btable == that%btable
596
597END FUNCTION vol7d_var_eq
598
599
600ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
601TYPE(vol7d_var),INTENT(IN) :: this, that
602LOGICAL :: res
603
604res = .NOT.(this == that)
605
606END FUNCTION vol7d_var_ne
607
608
609FUNCTION vol7d_var_nesv(this, that) RESULT(res)
610TYPE(vol7d_var),INTENT(IN) :: this, that(:)
611LOGICAL :: res(SIZE(that))
612
613INTEGER :: i
614
615DO i = 1, SIZE(that)
616 res(i) = .NOT.(this == that(i))
617ENDDO
618
619END FUNCTION vol7d_var_nesv
620
621
622
623!> \brief display on the screen a brief content of vol7d_var object
624subroutine display_var(this)
625
626TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to display
627
628print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
629 " scale factor",this%scalefactor
630
631end subroutine display_var
632
633
634!> \brief display on the screen a brief content of vector of vol7d_var object
635subroutine display_var_vect(this)
636
637TYPE(vol7d_var),INTENT(in) :: this(:) !< vol7d_var vector object to display
638integer :: i
639
640do i=1,size(this)
641 call display_var(this(i))
642end do
643
644end subroutine display_var_vect
645
646FUNCTION vol7d_var_c_e(this) RESULT(c_e)
647TYPE(vol7d_var),INTENT(IN) :: this
648LOGICAL :: c_e
649c_e = this /= vol7d_var_miss
650END FUNCTION vol7d_var_c_e
651
652
653!> Initialise the global table of variable features.
654!! This subroutine reads the table of variable features from an
655!! external file and stores it in a global array. It has to be called
656!! once at the beginning of the program. At the moment it gives access
657!! to the information about type of variable and positive
658!! definitness. The table is based on the unique bufr-like variable
659!! table. The table is contained in the csv file `vargrib.csv`.
660!! It is not harmful to call this subroutine multiple times.
661SUBROUTINE vol7d_var_features_init()
662INTEGER :: un, i, n
663TYPE(csv_record) :: csv
664CHARACTER(len=1024) :: line
665
666IF (ALLOCATED(var_features)) RETURN
667
668un = open_package_file('varbufr.csv', filetype_data)
669n=0
670DO WHILE(.true.)
671 READ(un,*,END=100)
672 n = n + 1
673ENDDO
674
675100 CONTINUE
676
677rewind(un)
678ALLOCATE(var_features(n))
679
680DO i = 1, n
681 READ(un,'(A)',END=200)line
683 CALL csv_record_getfield(csv, var_features(i)%var%btable)
684 CALL csv_record_getfield(csv)
685 CALL csv_record_getfield(csv)
686 CALL csv_record_getfield(csv, var_features(i)%posdef)
687 CALL csv_record_getfield(csv, var_features(i)%vartype)
689ENDDO
690
691200 CONTINUE
692CLOSE(un)
693
694END SUBROUTINE vol7d_var_features_init
695
696
697!> Deallocate the global table of variable features.
698!! This subroutine deallocates the table of variable features
699!! allocated in the `vol7d_var_features_init` subroutine.
700SUBROUTINE vol7d_var_features_delete()
701IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
702END SUBROUTINE vol7d_var_features_delete
703
704
705!> Return the physical type of the variable.
706!! Returns a rough classification of the variable depending on the
707!! physical parameter it represents. The result is one of the
708!! constants vartype_* defined in the module. To be extended.
709!! In order for this to work, the subroutine \a
710!! vol7d_var_features_init has to be preliminary called.
711ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
712TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
713INTEGER :: vartype
714
715INTEGER :: i
716
717vartype = imiss
718
719IF (ALLOCATED(var_features)) THEN
720 DO i = 1, SIZE(var_features)
721 IF (this == var_features(i)%var) THEN
722 vartype = var_features(i)%vartype
723 RETURN
724 ENDIF
725 ENDDO
726ENDIF
727
728END FUNCTION vol7d_var_features_vartype
729
730
731!> Apply a positive definite flag to a variable.
732!! This subroutine resets the value of a variable depending on its
733!! positive definite flag defined in the associated \a c_func object.
734!! The \a c_func object can be obtained for example by the \a convert
735!! (interfaced to vargrib2varbufr_convert) function. The value is
736!! reset to the maximum between the value itsel and and 0 (or the
737!! value set in \a c_func%posdef. These values are set from the
738!! vargrib2bufr.csv file.
739!! In order for this to work, the subroutine \a
740!! vol7d_var_features_init has to be preliminary called.
741ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
742TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be reset
743REAL,INTENT(inout) :: val !< value to be reset, it is reset in place
744
745INTEGER :: i
746
747IF (ALLOCATED(var_features)) THEN
748 DO i = 1, SIZE(var_features)
749 IF (this == var_features(i)%var) THEN
751 RETURN
752 ENDIF
753 ENDDO
754ENDIF
755
756END SUBROUTINE vol7d_var_features_posdef_apply
757
758
759!> Return the physical type of the variable.
760!! Returns a rough classification of the variable depending on the
761!! physical parameter it represents. The result is one of the
762!! constants vartype_* defined in the module. To be extended.
763ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
764TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
765
766INTEGER :: vartype
767
768vartype = var_ord
769SELECT CASE(this%btable)
770CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
771 vartype = var_dir360
772CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
773 vartype = var_press
774CASE('B11003', 'B11200') ! u-component
775 vartype = var_ucomp
776CASE('B11004', 'B11201') ! v-component
777 vartype = var_vcomp
778CASE('B11005', 'B11006') ! w-component
779 vartype = var_wcomp
780END SELECT
781
782END FUNCTION vol7d_vartype
783
784
785#include "array_utilities_inc.F90"
786
787
display on the screen a brief content of object Definition vol7d_var_class.F90:328 Definition of constants to be used for declaring variables of a desired type. Definition kinds.F90:245 Definitions of constants and functions for working with missing values. Definition missing_values.f90:50 Classe per la gestione delle variabili osservate da stazioni meteo e affini. Definition vol7d_var_class.F90:212 Definisce una variabile meteorologica osservata o un suo attributo. Definition vol7d_var_class.F90:226 |