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