libsim Versione 7.2.6
|
◆ vol7d_vartype()
Return the physical type of the variable. Returns a rough classification of the variable depending on the physical parameter it represents. The result is one of the constants vartype_* defined in the module. To be extended.
Definizione alla linea 595 del file vol7d_var_class.F90. 596! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
597! authors:
598! Davide Cesari <dcesari@arpa.emr.it>
599! Paolo Patruno <ppatruno@arpa.emr.it>
600
601! This program is free software; you can redistribute it and/or
602! modify it under the terms of the GNU General Public License as
603! published by the Free Software Foundation; either version 2 of
604! the License, or (at your option) any later version.
605
606! This program is distributed in the hope that it will be useful,
607! but WITHOUT ANY WARRANTY; without even the implied warranty of
608! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
609! GNU General Public License for more details.
610
611! You should have received a copy of the GNU General Public License
612! along with this program. If not, see <http://www.gnu.org/licenses/>.
613#include "config.h"
614
615!> Classe per la gestione delle variabili osservate da stazioni meteo e affini.
616!! Questo modulo definisce una classe per rappresentare variabili meteorologiche
617!! osservate, o attributi, aventi diversi tipi numerici o carattere.
618!! \ingroup vol7d
623IMPLICIT NONE
624
625!> Definisce una variabile meteorologica osservata o un suo attributo.
626!! I membri \a r, \a d, \a i, \a b, \a c servono, internamente a vol7d,
627!! per associare le variabili agli attributi, e indicano
628!! a quale variabile, nel descrittore delle variabili, coincide
629!! la variabile corrente nel descrittore delle "variabili aventi attributo".
630!! I membri di \a vol7d_var sono pubblici e quindi liberamente
631!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
632!! il costruttore ::init.
634 CHARACTER(len=10) :: btable=cmiss !< codice della variabile secondo la tabella B del WMO.
635 CHARACTER(len=65) :: description=cmiss !< descrizione testuale della variabile (opzionale)
636 CHARACTER(len=24) :: unit=cmiss !< descrizione testuale dell'unità di misura (opzionale)
637 INTEGER :: scalefactor=imiss !< numero di decimali nella rappresentazione intera o character (opzionale)
638
639 INTEGER :: r=imiss !< indice della variabile nel volume degli attributi reali
640 INTEGER :: d=imiss !< indice della variabile nel volume degli attributi double precision
641 INTEGER :: i=imiss !< indice della variabile nel volume degli attributi integer
642 INTEGER :: b=imiss !< indice della variabile nel volume degli attributi byte
643 INTEGER :: c=imiss !< indice della variabile nel volume degli attributi character
644 INTEGER :: gribhint(4)=imiss !< hint for conversion from/to grib when btable is not found
646
647!> Valore mancante per vol7d_var.
648TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
649 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
650 (/imiss,imiss,imiss,imiss/))
651
652!> Costruttore per la classe vol7d_var.
653!! Deve essere richiamato
654!! per tutti gli oggetti di questo tipo definiti in un programma.
656 MODULE PROCEDURE vol7d_var_init
657END INTERFACE
658
659!> Distruttore per la classe vol7d_var.
660!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
662 MODULE PROCEDURE vol7d_var_delete
663END INTERFACE
664
665!> Operatore logico di uguaglianza tra oggetti della classe vol7d_var.
666!! Funziona anche per
667!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
668!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
669!! di 1 dimensione e scalari).
670INTERFACE OPERATOR (==)
671 MODULE PROCEDURE vol7d_var_eq
672END INTERFACE
673
674!> Operatore logico di disuguaglianza tra oggetti della classe vol7d_var.
675!! Funziona anche per
676!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
677!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
678!! di 1 dimensione e scalari).
679INTERFACE OPERATOR (/=)
680 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
681END INTERFACE
682
683!> to be documented
685 MODULE PROCEDURE vol7d_var_c_e
686END INTERFACE
687
688#define VOL7D_POLY_TYPE TYPE(vol7d_var)
689#define VOL7D_POLY_TYPES _var
690#include "array_utilities_pre.F90"
691
692!> \brief display on the screen a brief content of object
694 MODULE PROCEDURE display_var, display_var_vect
695END INTERFACE
696
697
698TYPE vol7d_var_features
699 TYPE(vol7d_var) :: var !< the variable (only btable is relevant)
700 REAL :: posdef !< if not missing, minimum physically reasonable value for the variable
701 INTEGER :: vartype !< type of variable, one of the var_* constants
702END TYPE vol7d_var_features
703
704TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
705
706! constants for vol7d_vartype
707INTEGER,PARAMETER :: var_ord=0 !< unclassified variable (vol7d_vartype function)
708INTEGER,PARAMETER :: var_dir360=1 !< direction in degrees (vol7d_vartype function)
709INTEGER,PARAMETER :: var_press=2 !< pressure in Pa (vol7d_vartype function)
710INTEGER,PARAMETER :: var_ucomp=3 !< u component of a vector field (vol7d_vartype function)
711INTEGER,PARAMETER :: var_vcomp=4 !< v component of a vector field (vol7d_vartype function)
712INTEGER,PARAMETER :: var_wcomp=5 !< w component of a vector field (vol7d_vartype function)
713
714
715CONTAINS
716
717!> Inizializza un oggetto \a vol7d_var con i parametri opzionali forniti.
718!! Se non viene passato nessun parametro opzionale l'oggetto è
719!! inizializzato a valore mancante.
720!! I membri \a r, \a d, \a i, \a b, \a c non possono essere assegnati
721!! tramite costruttore, ma solo direttamente.
722elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
723TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da inizializzare
724CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
725CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
726CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
727INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
728
729IF (PRESENT(btable)) THEN
730 this%btable = btable
731ELSE
732 this%btable = cmiss
733 this%description = cmiss
734 this%unit = cmiss
735 this%scalefactor = imiss
736 RETURN
737ENDIF
738IF (PRESENT(description)) THEN
739 this%description = description
740ELSE
741 this%description = cmiss
742ENDIF
743IF (PRESENT(unit)) THEN
744 this%unit = unit
745ELSE
746 this%unit = cmiss
747ENDIF
748if (present(scalefactor)) then
749 this%scalefactor = scalefactor
750else
751 this%scalefactor = imiss
752endif
753
754this%r = -1
755this%d = -1
756this%i = -1
757this%b = -1
758this%c = -1
759
760END SUBROUTINE vol7d_var_init
761
762
763ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
764CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
765CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
766CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
767INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
768
769TYPE(vol7d_var) :: this
770
772
773END FUNCTION vol7d_var_new
774
775
776!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
777elemental SUBROUTINE vol7d_var_delete(this)
778TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da distruggre
779
780this%btable = cmiss
781this%description = cmiss
782this%unit = cmiss
783this%scalefactor = imiss
784
785END SUBROUTINE vol7d_var_delete
786
787
788ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
789TYPE(vol7d_var),INTENT(IN) :: this, that
790LOGICAL :: res
791
792res = this%btable == that%btable
793
794END FUNCTION vol7d_var_eq
795
796
797ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
798TYPE(vol7d_var),INTENT(IN) :: this, that
799LOGICAL :: res
800
801res = .NOT.(this == that)
802
803END FUNCTION vol7d_var_ne
804
805
806FUNCTION vol7d_var_nesv(this, that) RESULT(res)
807TYPE(vol7d_var),INTENT(IN) :: this, that(:)
808LOGICAL :: res(SIZE(that))
809
810INTEGER :: i
811
812DO i = 1, SIZE(that)
813 res(i) = .NOT.(this == that(i))
814ENDDO
815
816END FUNCTION vol7d_var_nesv
817
818
819
820!> \brief display on the screen a brief content of vol7d_var object
821subroutine display_var(this)
822
823TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to display
824
825print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
826 " scale factor",this%scalefactor
827
828end subroutine display_var
829
830
831!> \brief display on the screen a brief content of vector of vol7d_var object
832subroutine display_var_vect(this)
833
834TYPE(vol7d_var),INTENT(in) :: this(:) !< vol7d_var vector object to display
835integer :: i
836
837do i=1,size(this)
838 call display_var(this(i))
839end do
840
841end subroutine display_var_vect
842
843FUNCTION vol7d_var_c_e(this) RESULT(c_e)
844TYPE(vol7d_var),INTENT(IN) :: this
845LOGICAL :: c_e
846c_e = this /= vol7d_var_miss
847END FUNCTION vol7d_var_c_e
848
849
850!> Initialise the global table of variable features.
851!! This subroutine reads the table of variable features from an
852!! external file and stores it in a global array. It has to be called
853!! once at the beginning of the program. At the moment it gives access
854!! to the information about type of variable and positive
855!! definitness. The table is based on the unique bufr-like variable
856!! table. The table is contained in the csv file `vargrib.csv`.
857!! It is not harmful to call this subroutine multiple times.
858SUBROUTINE vol7d_var_features_init()
859INTEGER :: un, i, n
860TYPE(csv_record) :: csv
861CHARACTER(len=1024) :: line
862
863IF (ALLOCATED(var_features)) RETURN
864
865un = open_package_file('varbufr.csv', filetype_data)
866n=0
867DO WHILE(.true.)
868 READ(un,*,END=100)
869 n = n + 1
870ENDDO
871
872100 CONTINUE
873
874rewind(un)
875ALLOCATE(var_features(n))
876
877DO i = 1, n
878 READ(un,'(A)',END=200)line
880 CALL csv_record_getfield(csv, var_features(i)%var%btable)
881 CALL csv_record_getfield(csv)
882 CALL csv_record_getfield(csv)
883 CALL csv_record_getfield(csv, var_features(i)%posdef)
884 CALL csv_record_getfield(csv, var_features(i)%vartype)
886ENDDO
887
888200 CONTINUE
889CLOSE(un)
890
891END SUBROUTINE vol7d_var_features_init
892
893
894!> Deallocate the global table of variable features.
895!! This subroutine deallocates the table of variable features
896!! allocated in the `vol7d_var_features_init` subroutine.
897SUBROUTINE vol7d_var_features_delete()
898IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
899END SUBROUTINE vol7d_var_features_delete
900
901
902!> Return the physical type of the variable.
903!! Returns a rough classification of the variable depending on the
904!! physical parameter it represents. The result is one of the
905!! constants vartype_* defined in the module. To be extended.
906!! In order for this to work, the subroutine \a
907!! vol7d_var_features_init has to be preliminary called.
908ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
909TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
910INTEGER :: vartype
911
912INTEGER :: i
913
914vartype = imiss
915
916IF (ALLOCATED(var_features)) THEN
917 DO i = 1, SIZE(var_features)
918 IF (this == var_features(i)%var) THEN
919 vartype = var_features(i)%vartype
920 RETURN
921 ENDIF
922 ENDDO
923ENDIF
924
925END FUNCTION vol7d_var_features_vartype
926
927
928!> Apply a positive definite flag to a variable.
929!! This subroutine resets the value of a variable depending on its
930!! positive definite flag defined in the associated \a c_func object.
931!! The \a c_func object can be obtained for example by the \a convert
932!! (interfaced to vargrib2varbufr_convert) function. The value is
933!! reset to the maximum between the value itsel and and 0 (or the
934!! value set in \a c_func%posdef. These values are set from the
935!! vargrib2bufr.csv file.
936!! In order for this to work, the subroutine \a
937!! vol7d_var_features_init has to be preliminary called.
938ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
939TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be reset
940REAL,INTENT(inout) :: val !< value to be reset, it is reset in place
941
942INTEGER :: i
943
944IF (ALLOCATED(var_features)) THEN
945 DO i = 1, SIZE(var_features)
946 IF (this == var_features(i)%var) THEN
948 RETURN
949 ENDIF
950 ENDDO
951ENDIF
952
953END SUBROUTINE vol7d_var_features_posdef_apply
954
955
956!> Return the physical type of the variable.
957!! Returns a rough classification of the variable depending on the
958!! physical parameter it represents. The result is one of the
959!! constants vartype_* defined in the module. To be extended.
960ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
961TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
962
963INTEGER :: vartype
964
965vartype = var_ord
966SELECT CASE(this%btable)
967CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
968 vartype = var_dir360
969CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
970 vartype = var_press
971CASE('B11003', 'B11200') ! u-component
972 vartype = var_ucomp
973CASE('B11004', 'B11201') ! v-component
974 vartype = var_vcomp
975CASE('B11005', 'B11006') ! w-component
976 vartype = var_wcomp
977END SELECT
978
979END FUNCTION vol7d_vartype
980
981
982#include "array_utilities_inc.F90"
983
984
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 |