libsim Versione 7.1.11

◆ vol7d_var_features_init()

subroutine vol7d_var_features_init

Initialise the global table of variable features.

This subroutine reads the table of variable features from an external file and stores it in a global array. It has to be called once at the beginning of the program. At the moment it gives access to the information about type of variable and positive definitness. The table is based on the unique bufr-like variable table. The table is contained in the csv file vargrib.csv. It is not harmful to call this subroutine multiple times.

Definizione alla linea 499 del file vol7d_var_class.F90.

500! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
501! authors:
502! Davide Cesari <dcesari@arpa.emr.it>
503! Paolo Patruno <ppatruno@arpa.emr.it>
504
505! This program is free software; you can redistribute it and/or
506! modify it under the terms of the GNU General Public License as
507! published by the Free Software Foundation; either version 2 of
508! the License, or (at your option) any later version.
509
510! This program is distributed in the hope that it will be useful,
511! but WITHOUT ANY WARRANTY; without even the implied warranty of
512! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
513! GNU General Public License for more details.
514
515! You should have received a copy of the GNU General Public License
516! along with this program. If not, see <http://www.gnu.org/licenses/>.
517#include "config.h"
518
523MODULE vol7d_var_class
524USE kinds
527IMPLICIT NONE
528
537TYPE vol7d_var
538 CHARACTER(len=10) :: btable=cmiss
539 CHARACTER(len=65) :: description=cmiss
540 CHARACTER(len=24) :: unit=cmiss
541 INTEGER :: scalefactor=imiss
542
543 INTEGER :: r=imiss
544 INTEGER :: d=imiss
545 INTEGER :: i=imiss
546 INTEGER :: b=imiss
547 INTEGER :: c=imiss
548 INTEGER :: gribhint(4)=imiss
549END TYPE vol7d_var
550
552TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
553 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
554 (/imiss,imiss,imiss,imiss/))
555
559INTERFACE init
560 MODULE PROCEDURE vol7d_var_init
561END INTERFACE
562
565INTERFACE delete
566 MODULE PROCEDURE vol7d_var_delete
567END INTERFACE
568
574INTERFACE OPERATOR (==)
575 MODULE PROCEDURE vol7d_var_eq
576END INTERFACE
577
583INTERFACE OPERATOR (/=)
584 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
585END INTERFACE
586
588INTERFACE c_e
589 MODULE PROCEDURE vol7d_var_c_e
590END INTERFACE
591
592#define VOL7D_POLY_TYPE TYPE(vol7d_var)
593#define VOL7D_POLY_TYPES _var
594#include "array_utilities_pre.F90"
595
597INTERFACE display
598 MODULE PROCEDURE display_var, display_var_vect
599END INTERFACE
600
601
602TYPE vol7d_var_features
603 TYPE(vol7d_var) :: var
604 REAL :: posdef
605 INTEGER :: vartype
606END TYPE vol7d_var_features
607
608TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
609
610! constants for vol7d_vartype
611INTEGER,PARAMETER :: var_ord=0
612INTEGER,PARAMETER :: var_dir360=1
613INTEGER,PARAMETER :: var_press=2
614INTEGER,PARAMETER :: var_ucomp=3
615INTEGER,PARAMETER :: var_vcomp=4
616INTEGER,PARAMETER :: var_wcomp=5
617
618
619CONTAINS
620
626elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
627TYPE(vol7d_var),INTENT(INOUT) :: this
628CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
629CHARACTER(len=*),INTENT(in),OPTIONAL :: description
630CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
631INTEGER,INTENT(in),OPTIONAL :: scalefactor
632
633IF (PRESENT(btable)) THEN
634 this%btable = btable
635ELSE
636 this%btable = cmiss
637 this%description = cmiss
638 this%unit = cmiss
639 this%scalefactor = imiss
640 RETURN
641ENDIF
642IF (PRESENT(description)) THEN
643 this%description = description
644ELSE
645 this%description = cmiss
646ENDIF
647IF (PRESENT(unit)) THEN
648 this%unit = unit
649ELSE
650 this%unit = cmiss
651ENDIF
652if (present(scalefactor)) then
653 this%scalefactor = scalefactor
654else
655 this%scalefactor = imiss
656endif
657
658this%r = -1
659this%d = -1
660this%i = -1
661this%b = -1
662this%c = -1
663
664END SUBROUTINE vol7d_var_init
665
666
667ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
668CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
669CHARACTER(len=*),INTENT(in),OPTIONAL :: description
670CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
671INTEGER,INTENT(in),OPTIONAL :: scalefactor
672
673TYPE(vol7d_var) :: this
674
675CALL init(this, btable, description, unit, scalefactor)
676
677END FUNCTION vol7d_var_new
678
679
681elemental SUBROUTINE vol7d_var_delete(this)
682TYPE(vol7d_var),INTENT(INOUT) :: this
683
684this%btable = cmiss
685this%description = cmiss
686this%unit = cmiss
687this%scalefactor = imiss
688
689END SUBROUTINE vol7d_var_delete
690
691
692ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
693TYPE(vol7d_var),INTENT(IN) :: this, that
694LOGICAL :: res
695
696res = this%btable == that%btable
697
698END FUNCTION vol7d_var_eq
699
700
701ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
702TYPE(vol7d_var),INTENT(IN) :: this, that
703LOGICAL :: res
704
705res = .NOT.(this == that)
706
707END FUNCTION vol7d_var_ne
708
709
710FUNCTION vol7d_var_nesv(this, that) RESULT(res)
711TYPE(vol7d_var),INTENT(IN) :: this, that(:)
712LOGICAL :: res(SIZE(that))
713
714INTEGER :: i
715
716DO i = 1, SIZE(that)
717 res(i) = .NOT.(this == that(i))
718ENDDO
719
720END FUNCTION vol7d_var_nesv
721
722
723
725subroutine display_var(this)
726
727TYPE(vol7d_var),INTENT(in) :: this
728
729print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
730 " scale factor",this%scalefactor
731
732end subroutine display_var
733
734
736subroutine display_var_vect(this)
737
738TYPE(vol7d_var),INTENT(in) :: this(:)
739integer :: i
740
741do i=1,size(this)
742 call display_var(this(i))
743end do
744
745end subroutine display_var_vect
746
747FUNCTION vol7d_var_c_e(this) RESULT(c_e)
748TYPE(vol7d_var),INTENT(IN) :: this
749LOGICAL :: c_e
750c_e = this /= vol7d_var_miss
751END FUNCTION vol7d_var_c_e
752
753
762SUBROUTINE vol7d_var_features_init()
763INTEGER :: un, i, n
764TYPE(csv_record) :: csv
765CHARACTER(len=1024) :: line
766
767IF (ALLOCATED(var_features)) RETURN
768
769un = open_package_file('varbufr.csv', filetype_data)
770n=0
771DO WHILE(.true.)
772 READ(un,*,END=100)
773 n = n + 1
774ENDDO
775
776100 CONTINUE
777
778rewind(un)
779ALLOCATE(var_features(n))
780
781DO i = 1, n
782 READ(un,'(A)',END=200)line
783 CALL init(csv, line)
784 CALL csv_record_getfield(csv, var_features(i)%var%btable)
785 CALL csv_record_getfield(csv)
786 CALL csv_record_getfield(csv)
787 CALL csv_record_getfield(csv, var_features(i)%posdef)
788 CALL csv_record_getfield(csv, var_features(i)%vartype)
789 CALL delete(csv)
790ENDDO
791
792200 CONTINUE
793CLOSE(un)
794
795END SUBROUTINE vol7d_var_features_init
796
797
801SUBROUTINE vol7d_var_features_delete()
802IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
803END SUBROUTINE vol7d_var_features_delete
804
805
812ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
813TYPE(vol7d_var),INTENT(in) :: this
814INTEGER :: vartype
815
816INTEGER :: i
817
818vartype = imiss
819
820IF (ALLOCATED(var_features)) THEN
821 DO i = 1, SIZE(var_features)
822 IF (this == var_features(i)%var) THEN
823 vartype = var_features(i)%vartype
824 RETURN
825 ENDIF
826 ENDDO
827ENDIF
828
829END FUNCTION vol7d_var_features_vartype
830
831
842ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
843TYPE(vol7d_var),INTENT(in) :: this
844REAL,INTENT(inout) :: val
845
846INTEGER :: i
847
848IF (ALLOCATED(var_features)) THEN
849 DO i = 1, SIZE(var_features)
850 IF (this == var_features(i)%var) THEN
851 IF (c_e(var_features(i)%posdef)) val = max(var_features(i)%posdef, val)
852 RETURN
853 ENDIF
854 ENDDO
855ENDIF
856
857END SUBROUTINE vol7d_var_features_posdef_apply
858
859
864ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
865TYPE(vol7d_var),INTENT(in) :: this
866
867INTEGER :: vartype
868
869vartype = var_ord
870SELECT CASE(this%btable)
871CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
872 vartype = var_dir360
873CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
874 vartype = var_press
875CASE('B11003', 'B11200') ! u-component
876 vartype = var_ucomp
877CASE('B11004', 'B11201') ! v-component
878 vartype = var_vcomp
879CASE('B11005', 'B11006') ! w-component
880 vartype = var_wcomp
881END SELECT
882
883END FUNCTION vol7d_vartype
884
885
886#include "array_utilities_inc.F90"
887
888
889END 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:251
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.