libsim Versione 7.1.11
|
◆ display_var()
display on the screen a brief content of vol7d_var object
Definizione alla linea 462 del file vol7d_var_class.F90. 463! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
464! authors:
465! Davide Cesari <dcesari@arpa.emr.it>
466! Paolo Patruno <ppatruno@arpa.emr.it>
467
468! This program is free software; you can redistribute it and/or
469! modify it under the terms of the GNU General Public License as
470! published by the Free Software Foundation; either version 2 of
471! the License, or (at your option) any later version.
472
473! This program is distributed in the hope that it will be useful,
474! but WITHOUT ANY WARRANTY; without even the implied warranty of
475! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
476! GNU General Public License for more details.
477
478! You should have received a copy of the GNU General Public License
479! along with this program. If not, see <http://www.gnu.org/licenses/>.
480#include "config.h"
481
490IMPLICIT NONE
491
501 CHARACTER(len=10) :: btable=cmiss
502 CHARACTER(len=65) :: description=cmiss
503 CHARACTER(len=24) :: unit=cmiss
504 INTEGER :: scalefactor=imiss
505
506 INTEGER :: r=imiss
507 INTEGER :: d=imiss
508 INTEGER :: i=imiss
509 INTEGER :: b=imiss
510 INTEGER :: c=imiss
511 INTEGER :: gribhint(4)=imiss
513
515TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
516 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
517 (/imiss,imiss,imiss,imiss/))
518
523 MODULE PROCEDURE vol7d_var_init
524END INTERFACE
525
529 MODULE PROCEDURE vol7d_var_delete
530END INTERFACE
531
537INTERFACE OPERATOR (==)
538 MODULE PROCEDURE vol7d_var_eq
539END INTERFACE
540
546INTERFACE OPERATOR (/=)
547 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
548END INTERFACE
549
552 MODULE PROCEDURE vol7d_var_c_e
553END INTERFACE
554
555#define VOL7D_POLY_TYPE TYPE(vol7d_var)
556#define VOL7D_POLY_TYPES _var
557#include "array_utilities_pre.F90"
558
561 MODULE PROCEDURE display_var, display_var_vect
562END INTERFACE
563
564
565TYPE vol7d_var_features
566 TYPE(vol7d_var) :: var
567 REAL :: posdef
568 INTEGER :: vartype
569END TYPE vol7d_var_features
570
571TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
572
573! constants for vol7d_vartype
574INTEGER,PARAMETER :: var_ord=0
575INTEGER,PARAMETER :: var_dir360=1
576INTEGER,PARAMETER :: var_press=2
577INTEGER,PARAMETER :: var_ucomp=3
578INTEGER,PARAMETER :: var_vcomp=4
579INTEGER,PARAMETER :: var_wcomp=5
580
581
582CONTAINS
583
589elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
590TYPE(vol7d_var),INTENT(INOUT) :: this
591CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
592CHARACTER(len=*),INTENT(in),OPTIONAL :: description
593CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
594INTEGER,INTENT(in),OPTIONAL :: scalefactor
595
596IF (PRESENT(btable)) THEN
597 this%btable = btable
598ELSE
599 this%btable = cmiss
600 this%description = cmiss
601 this%unit = cmiss
602 this%scalefactor = imiss
603 RETURN
604ENDIF
605IF (PRESENT(description)) THEN
606 this%description = description
607ELSE
608 this%description = cmiss
609ENDIF
610IF (PRESENT(unit)) THEN
611 this%unit = unit
612ELSE
613 this%unit = cmiss
614ENDIF
615if (present(scalefactor)) then
616 this%scalefactor = scalefactor
617else
618 this%scalefactor = imiss
619endif
620
621this%r = -1
622this%d = -1
623this%i = -1
624this%b = -1
625this%c = -1
626
627END SUBROUTINE vol7d_var_init
628
629
630ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
631CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
632CHARACTER(len=*),INTENT(in),OPTIONAL :: description
633CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
634INTEGER,INTENT(in),OPTIONAL :: scalefactor
635
636TYPE(vol7d_var) :: this
637
639
640END FUNCTION vol7d_var_new
641
642
644elemental SUBROUTINE vol7d_var_delete(this)
645TYPE(vol7d_var),INTENT(INOUT) :: this
646
647this%btable = cmiss
648this%description = cmiss
649this%unit = cmiss
650this%scalefactor = imiss
651
652END SUBROUTINE vol7d_var_delete
653
654
655ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
656TYPE(vol7d_var),INTENT(IN) :: this, that
657LOGICAL :: res
658
659res = this%btable == that%btable
660
661END FUNCTION vol7d_var_eq
662
663
664ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
665TYPE(vol7d_var),INTENT(IN) :: this, that
666LOGICAL :: res
667
668res = .NOT.(this == that)
669
670END FUNCTION vol7d_var_ne
671
672
673FUNCTION vol7d_var_nesv(this, that) RESULT(res)
674TYPE(vol7d_var),INTENT(IN) :: this, that(:)
675LOGICAL :: res(SIZE(that))
676
677INTEGER :: i
678
679DO i = 1, SIZE(that)
680 res(i) = .NOT.(this == that(i))
681ENDDO
682
683END FUNCTION vol7d_var_nesv
684
685
686
688subroutine display_var(this)
689
690TYPE(vol7d_var),INTENT(in) :: this
691
692print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
693 " scale factor",this%scalefactor
694
695end subroutine display_var
696
697
699subroutine display_var_vect(this)
700
701TYPE(vol7d_var),INTENT(in) :: this(:)
702integer :: i
703
704do i=1,size(this)
705 call display_var(this(i))
706end do
707
708end subroutine display_var_vect
709
710FUNCTION vol7d_var_c_e(this) RESULT(c_e)
711TYPE(vol7d_var),INTENT(IN) :: this
712LOGICAL :: c_e
713c_e = this /= vol7d_var_miss
714END FUNCTION vol7d_var_c_e
715
716
725SUBROUTINE vol7d_var_features_init()
726INTEGER :: un, i, n
727TYPE(csv_record) :: csv
728CHARACTER(len=1024) :: line
729
730IF (ALLOCATED(var_features)) RETURN
731
732un = open_package_file('varbufr.csv', filetype_data)
733n=0
734DO WHILE(.true.)
735 READ(un,*,END=100)
736 n = n + 1
737ENDDO
738
739100 CONTINUE
740
741rewind(un)
742ALLOCATE(var_features(n))
743
744DO i = 1, n
745 READ(un,'(A)',END=200)line
747 CALL csv_record_getfield(csv, var_features(i)%var%btable)
748 CALL csv_record_getfield(csv)
749 CALL csv_record_getfield(csv)
750 CALL csv_record_getfield(csv, var_features(i)%posdef)
751 CALL csv_record_getfield(csv, var_features(i)%vartype)
753ENDDO
754
755200 CONTINUE
756CLOSE(un)
757
758END SUBROUTINE vol7d_var_features_init
759
760
764SUBROUTINE vol7d_var_features_delete()
765IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
766END SUBROUTINE vol7d_var_features_delete
767
768
775ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
776TYPE(vol7d_var),INTENT(in) :: this
777INTEGER :: vartype
778
779INTEGER :: i
780
781vartype = imiss
782
783IF (ALLOCATED(var_features)) THEN
784 DO i = 1, SIZE(var_features)
785 IF (this == var_features(i)%var) THEN
786 vartype = var_features(i)%vartype
787 RETURN
788 ENDIF
789 ENDDO
790ENDIF
791
792END FUNCTION vol7d_var_features_vartype
793
794
805ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
806TYPE(vol7d_var),INTENT(in) :: this
807REAL,INTENT(inout) :: val
808
809INTEGER :: i
810
811IF (ALLOCATED(var_features)) THEN
812 DO i = 1, SIZE(var_features)
813 IF (this == var_features(i)%var) THEN
815 RETURN
816 ENDIF
817 ENDDO
818ENDIF
819
820END SUBROUTINE vol7d_var_features_posdef_apply
821
822
827ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
828TYPE(vol7d_var),INTENT(in) :: this
829
830INTEGER :: vartype
831
832vartype = var_ord
833SELECT CASE(this%btable)
834CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
835 vartype = var_dir360
836CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
837 vartype = var_press
838CASE('B11003', 'B11200') ! u-component
839 vartype = var_ucomp
840CASE('B11004', 'B11201') ! v-component
841 vartype = var_vcomp
842CASE('B11005', 'B11006') ! w-component
843 vartype = var_wcomp
844END SELECT
845
846END FUNCTION vol7d_vartype
847
848
849#include "array_utilities_inc.F90"
850
851
display on the screen a brief content of object Definition: vol7d_var_class.F90:334 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. Definition: missing_values.f90:50 Classe per la gestione delle variabili osservate da stazioni meteo e affini. Definition: vol7d_var_class.F90:218 Definisce una variabile meteorologica osservata o un suo attributo. Definition: vol7d_var_class.F90:232 |