libsim Versione 7.2.1
|
◆ display_var_vect()
display on the screen a brief content of vector of vol7d_var object
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
495IMPLICIT NONE
496
506 CHARACTER(len=10) :: btable=cmiss
507 CHARACTER(len=65) :: description=cmiss
508 CHARACTER(len=24) :: unit=cmiss
509 INTEGER :: scalefactor=imiss
510
511 INTEGER :: r=imiss
512 INTEGER :: d=imiss
513 INTEGER :: i=imiss
514 INTEGER :: b=imiss
515 INTEGER :: c=imiss
516 INTEGER :: gribhint(4)=imiss
518
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
528 MODULE PROCEDURE vol7d_var_init
529END INTERFACE
530
534 MODULE PROCEDURE vol7d_var_delete
535END INTERFACE
536
542INTERFACE OPERATOR (==)
543 MODULE PROCEDURE vol7d_var_eq
544END INTERFACE
545
551INTERFACE OPERATOR (/=)
552 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
553END INTERFACE
554
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
566 MODULE PROCEDURE display_var, display_var_vect
567END INTERFACE
568
569
570TYPE vol7d_var_features
571 TYPE(vol7d_var) :: var
572 REAL :: posdef
573 INTEGER :: vartype
574END TYPE vol7d_var_features
575
576TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
577
578! constants for vol7d_vartype
579INTEGER,PARAMETER :: var_ord=0
580INTEGER,PARAMETER :: var_dir360=1
581INTEGER,PARAMETER :: var_press=2
582INTEGER,PARAMETER :: var_ucomp=3
583INTEGER,PARAMETER :: var_vcomp=4
584INTEGER,PARAMETER :: var_wcomp=5
585
586
587CONTAINS
588
594elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
595TYPE(vol7d_var),INTENT(INOUT) :: this
596CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
597CHARACTER(len=*),INTENT(in),OPTIONAL :: description
598CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
599INTEGER,INTENT(in),OPTIONAL :: scalefactor
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
637CHARACTER(len=*),INTENT(in),OPTIONAL :: description
638CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
639INTEGER,INTENT(in),OPTIONAL :: scalefactor
640
641TYPE(vol7d_var) :: this
642
644
645END FUNCTION vol7d_var_new
646
647
649elemental SUBROUTINE vol7d_var_delete(this)
650TYPE(vol7d_var),INTENT(INOUT) :: this
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
693subroutine display_var(this)
694
695TYPE(vol7d_var),INTENT(in) :: this
696
697print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
698 " scale factor",this%scalefactor
699
700end subroutine display_var
701
702
704subroutine display_var_vect(this)
705
706TYPE(vol7d_var),INTENT(in) :: this(:)
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
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
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)
758ENDDO
759
760200 CONTINUE
761CLOSE(un)
762
763END SUBROUTINE vol7d_var_features_init
764
765
769SUBROUTINE vol7d_var_features_delete()
770IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
771END SUBROUTINE vol7d_var_features_delete
772
773
780ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
781TYPE(vol7d_var),INTENT(in) :: this
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
810ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
811TYPE(vol7d_var),INTENT(in) :: this
812REAL,INTENT(inout) :: val
813
814INTEGER :: i
815
816IF (ALLOCATED(var_features)) THEN
817 DO i = 1, SIZE(var_features)
818 IF (this == var_features(i)%var) THEN
820 RETURN
821 ENDIF
822 ENDDO
823ENDIF
824
825END SUBROUTINE vol7d_var_features_posdef_apply
826
827
832ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
833TYPE(vol7d_var),INTENT(in) :: this
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
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 |