libsim Versione 7.1.11
|
◆ display_var_vect()
display on the screen a brief content of vector of vol7d_var object
Definizione alla linea 473 del file vol7d_var_class.F90. 474! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
475! authors:
476! Davide Cesari <dcesari@arpa.emr.it>
477! Paolo Patruno <ppatruno@arpa.emr.it>
478
479! This program is free software; you can redistribute it and/or
480! modify it under the terms of the GNU General Public License as
481! published by the Free Software Foundation; either version 2 of
482! the License, or (at your option) any later version.
483
484! This program is distributed in the hope that it will be useful,
485! but WITHOUT ANY WARRANTY; without even the implied warranty of
486! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
487! GNU General Public License for more details.
488
489! You should have received a copy of the GNU General Public License
490! along with this program. If not, see <http://www.gnu.org/licenses/>.
491#include "config.h"
492
501IMPLICIT NONE
502
512 CHARACTER(len=10) :: btable=cmiss
513 CHARACTER(len=65) :: description=cmiss
514 CHARACTER(len=24) :: unit=cmiss
515 INTEGER :: scalefactor=imiss
516
517 INTEGER :: r=imiss
518 INTEGER :: d=imiss
519 INTEGER :: i=imiss
520 INTEGER :: b=imiss
521 INTEGER :: c=imiss
522 INTEGER :: gribhint(4)=imiss
524
526TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
527 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
528 (/imiss,imiss,imiss,imiss/))
529
534 MODULE PROCEDURE vol7d_var_init
535END INTERFACE
536
540 MODULE PROCEDURE vol7d_var_delete
541END INTERFACE
542
548INTERFACE OPERATOR (==)
549 MODULE PROCEDURE vol7d_var_eq
550END INTERFACE
551
557INTERFACE OPERATOR (/=)
558 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
559END INTERFACE
560
563 MODULE PROCEDURE vol7d_var_c_e
564END INTERFACE
565
566#define VOL7D_POLY_TYPE TYPE(vol7d_var)
567#define VOL7D_POLY_TYPES _var
568#include "array_utilities_pre.F90"
569
572 MODULE PROCEDURE display_var, display_var_vect
573END INTERFACE
574
575
576TYPE vol7d_var_features
577 TYPE(vol7d_var) :: var
578 REAL :: posdef
579 INTEGER :: vartype
580END TYPE vol7d_var_features
581
582TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
583
584! constants for vol7d_vartype
585INTEGER,PARAMETER :: var_ord=0
586INTEGER,PARAMETER :: var_dir360=1
587INTEGER,PARAMETER :: var_press=2
588INTEGER,PARAMETER :: var_ucomp=3
589INTEGER,PARAMETER :: var_vcomp=4
590INTEGER,PARAMETER :: var_wcomp=5
591
592
593CONTAINS
594
600elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
601TYPE(vol7d_var),INTENT(INOUT) :: this
602CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
603CHARACTER(len=*),INTENT(in),OPTIONAL :: description
604CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
605INTEGER,INTENT(in),OPTIONAL :: scalefactor
606
607IF (PRESENT(btable)) THEN
608 this%btable = btable
609ELSE
610 this%btable = cmiss
611 this%description = cmiss
612 this%unit = cmiss
613 this%scalefactor = imiss
614 RETURN
615ENDIF
616IF (PRESENT(description)) THEN
617 this%description = description
618ELSE
619 this%description = cmiss
620ENDIF
621IF (PRESENT(unit)) THEN
622 this%unit = unit
623ELSE
624 this%unit = cmiss
625ENDIF
626if (present(scalefactor)) then
627 this%scalefactor = scalefactor
628else
629 this%scalefactor = imiss
630endif
631
632this%r = -1
633this%d = -1
634this%i = -1
635this%b = -1
636this%c = -1
637
638END SUBROUTINE vol7d_var_init
639
640
641ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
642CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
643CHARACTER(len=*),INTENT(in),OPTIONAL :: description
644CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
645INTEGER,INTENT(in),OPTIONAL :: scalefactor
646
647TYPE(vol7d_var) :: this
648
650
651END FUNCTION vol7d_var_new
652
653
655elemental SUBROUTINE vol7d_var_delete(this)
656TYPE(vol7d_var),INTENT(INOUT) :: this
657
658this%btable = cmiss
659this%description = cmiss
660this%unit = cmiss
661this%scalefactor = imiss
662
663END SUBROUTINE vol7d_var_delete
664
665
666ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
667TYPE(vol7d_var),INTENT(IN) :: this, that
668LOGICAL :: res
669
670res = this%btable == that%btable
671
672END FUNCTION vol7d_var_eq
673
674
675ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
676TYPE(vol7d_var),INTENT(IN) :: this, that
677LOGICAL :: res
678
679res = .NOT.(this == that)
680
681END FUNCTION vol7d_var_ne
682
683
684FUNCTION vol7d_var_nesv(this, that) RESULT(res)
685TYPE(vol7d_var),INTENT(IN) :: this, that(:)
686LOGICAL :: res(SIZE(that))
687
688INTEGER :: i
689
690DO i = 1, SIZE(that)
691 res(i) = .NOT.(this == that(i))
692ENDDO
693
694END FUNCTION vol7d_var_nesv
695
696
697
699subroutine display_var(this)
700
701TYPE(vol7d_var),INTENT(in) :: this
702
703print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
704 " scale factor",this%scalefactor
705
706end subroutine display_var
707
708
710subroutine display_var_vect(this)
711
712TYPE(vol7d_var),INTENT(in) :: this(:)
713integer :: i
714
715do i=1,size(this)
716 call display_var(this(i))
717end do
718
719end subroutine display_var_vect
720
721FUNCTION vol7d_var_c_e(this) RESULT(c_e)
722TYPE(vol7d_var),INTENT(IN) :: this
723LOGICAL :: c_e
724c_e = this /= vol7d_var_miss
725END FUNCTION vol7d_var_c_e
726
727
736SUBROUTINE vol7d_var_features_init()
737INTEGER :: un, i, n
738TYPE(csv_record) :: csv
739CHARACTER(len=1024) :: line
740
741IF (ALLOCATED(var_features)) RETURN
742
743un = open_package_file('varbufr.csv', filetype_data)
744n=0
745DO WHILE(.true.)
746 READ(un,*,END=100)
747 n = n + 1
748ENDDO
749
750100 CONTINUE
751
752rewind(un)
753ALLOCATE(var_features(n))
754
755DO i = 1, n
756 READ(un,'(A)',END=200)line
758 CALL csv_record_getfield(csv, var_features(i)%var%btable)
759 CALL csv_record_getfield(csv)
760 CALL csv_record_getfield(csv)
761 CALL csv_record_getfield(csv, var_features(i)%posdef)
762 CALL csv_record_getfield(csv, var_features(i)%vartype)
764ENDDO
765
766200 CONTINUE
767CLOSE(un)
768
769END SUBROUTINE vol7d_var_features_init
770
771
775SUBROUTINE vol7d_var_features_delete()
776IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
777END SUBROUTINE vol7d_var_features_delete
778
779
786ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
787TYPE(vol7d_var),INTENT(in) :: this
788INTEGER :: vartype
789
790INTEGER :: i
791
792vartype = imiss
793
794IF (ALLOCATED(var_features)) THEN
795 DO i = 1, SIZE(var_features)
796 IF (this == var_features(i)%var) THEN
797 vartype = var_features(i)%vartype
798 RETURN
799 ENDIF
800 ENDDO
801ENDIF
802
803END FUNCTION vol7d_var_features_vartype
804
805
816ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
817TYPE(vol7d_var),INTENT(in) :: this
818REAL,INTENT(inout) :: val
819
820INTEGER :: i
821
822IF (ALLOCATED(var_features)) THEN
823 DO i = 1, SIZE(var_features)
824 IF (this == var_features(i)%var) THEN
826 RETURN
827 ENDIF
828 ENDDO
829ENDIF
830
831END SUBROUTINE vol7d_var_features_posdef_apply
832
833
838ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
839TYPE(vol7d_var),INTENT(in) :: this
840
841INTEGER :: vartype
842
843vartype = var_ord
844SELECT CASE(this%btable)
845CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
846 vartype = var_dir360
847CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
848 vartype = var_press
849CASE('B11003', 'B11200') ! u-component
850 vartype = var_ucomp
851CASE('B11004', 'B11201') ! v-component
852 vartype = var_vcomp
853CASE('B11005', 'B11006') ! w-component
854 vartype = var_wcomp
855END SELECT
856
857END FUNCTION vol7d_vartype
858
859
860#include "array_utilities_inc.F90"
861
862
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 |