libsim Versione 7.2.6

◆ display_var_vect()

subroutine display_var_vect ( type(vol7d_var), dimension(:), intent(in) this)

display on the screen a brief content of vector of vol7d_var object

Parametri
[in]thisvol7d_var vector object to display

Definizione alla linea 467 del file vol7d_var_class.F90.

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

Generated with Doxygen.