libsim Versione 7.2.4
|
◆ vol7d_var_features_delete()
Deallocate the global table of variable features. This subroutine deallocates the table of variable features allocated in the Definizione alla linea 532 del file vol7d_var_class.F90. 533! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
534! authors:
535! Davide Cesari <dcesari@arpa.emr.it>
536! Paolo Patruno <ppatruno@arpa.emr.it>
537
538! This program is free software; you can redistribute it and/or
539! modify it under the terms of the GNU General Public License as
540! published by the Free Software Foundation; either version 2 of
541! the License, or (at your option) any later version.
542
543! This program is distributed in the hope that it will be useful,
544! but WITHOUT ANY WARRANTY; without even the implied warranty of
545! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
546! GNU General Public License for more details.
547
548! You should have received a copy of the GNU General Public License
549! along with this program. If not, see <http://www.gnu.org/licenses/>.
550#include "config.h"
551
560IMPLICIT NONE
561
571 CHARACTER(len=10) :: btable=cmiss
572 CHARACTER(len=65) :: description=cmiss
573 CHARACTER(len=24) :: unit=cmiss
574 INTEGER :: scalefactor=imiss
575
576 INTEGER :: r=imiss
577 INTEGER :: d=imiss
578 INTEGER :: i=imiss
579 INTEGER :: b=imiss
580 INTEGER :: c=imiss
581 INTEGER :: gribhint(4)=imiss
583
585TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
586 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
587 (/imiss,imiss,imiss,imiss/))
588
593 MODULE PROCEDURE vol7d_var_init
594END INTERFACE
595
599 MODULE PROCEDURE vol7d_var_delete
600END INTERFACE
601
607INTERFACE OPERATOR (==)
608 MODULE PROCEDURE vol7d_var_eq
609END INTERFACE
610
616INTERFACE OPERATOR (/=)
617 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
618END INTERFACE
619
622 MODULE PROCEDURE vol7d_var_c_e
623END INTERFACE
624
625#define VOL7D_POLY_TYPE TYPE(vol7d_var)
626#define VOL7D_POLY_TYPES _var
627#include "array_utilities_pre.F90"
628
631 MODULE PROCEDURE display_var, display_var_vect
632END INTERFACE
633
634
635TYPE vol7d_var_features
636 TYPE(vol7d_var) :: var
637 REAL :: posdef
638 INTEGER :: vartype
639END TYPE vol7d_var_features
640
641TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
642
643! constants for vol7d_vartype
644INTEGER,PARAMETER :: var_ord=0
645INTEGER,PARAMETER :: var_dir360=1
646INTEGER,PARAMETER :: var_press=2
647INTEGER,PARAMETER :: var_ucomp=3
648INTEGER,PARAMETER :: var_vcomp=4
649INTEGER,PARAMETER :: var_wcomp=5
650
651
652CONTAINS
653
659elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
660TYPE(vol7d_var),INTENT(INOUT) :: this
661CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
662CHARACTER(len=*),INTENT(in),OPTIONAL :: description
663CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
664INTEGER,INTENT(in),OPTIONAL :: scalefactor
665
666IF (PRESENT(btable)) THEN
667 this%btable = btable
668ELSE
669 this%btable = cmiss
670 this%description = cmiss
671 this%unit = cmiss
672 this%scalefactor = imiss
673 RETURN
674ENDIF
675IF (PRESENT(description)) THEN
676 this%description = description
677ELSE
678 this%description = cmiss
679ENDIF
680IF (PRESENT(unit)) THEN
681 this%unit = unit
682ELSE
683 this%unit = cmiss
684ENDIF
685if (present(scalefactor)) then
686 this%scalefactor = scalefactor
687else
688 this%scalefactor = imiss
689endif
690
691this%r = -1
692this%d = -1
693this%i = -1
694this%b = -1
695this%c = -1
696
697END SUBROUTINE vol7d_var_init
698
699
700ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
701CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
702CHARACTER(len=*),INTENT(in),OPTIONAL :: description
703CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
704INTEGER,INTENT(in),OPTIONAL :: scalefactor
705
706TYPE(vol7d_var) :: this
707
709
710END FUNCTION vol7d_var_new
711
712
714elemental SUBROUTINE vol7d_var_delete(this)
715TYPE(vol7d_var),INTENT(INOUT) :: this
716
717this%btable = cmiss
718this%description = cmiss
719this%unit = cmiss
720this%scalefactor = imiss
721
722END SUBROUTINE vol7d_var_delete
723
724
725ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
726TYPE(vol7d_var),INTENT(IN) :: this, that
727LOGICAL :: res
728
729res = this%btable == that%btable
730
731END FUNCTION vol7d_var_eq
732
733
734ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
735TYPE(vol7d_var),INTENT(IN) :: this, that
736LOGICAL :: res
737
738res = .NOT.(this == that)
739
740END FUNCTION vol7d_var_ne
741
742
743FUNCTION vol7d_var_nesv(this, that) RESULT(res)
744TYPE(vol7d_var),INTENT(IN) :: this, that(:)
745LOGICAL :: res(SIZE(that))
746
747INTEGER :: i
748
749DO i = 1, SIZE(that)
750 res(i) = .NOT.(this == that(i))
751ENDDO
752
753END FUNCTION vol7d_var_nesv
754
755
756
758subroutine display_var(this)
759
760TYPE(vol7d_var),INTENT(in) :: this
761
762print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
763 " scale factor",this%scalefactor
764
765end subroutine display_var
766
767
769subroutine display_var_vect(this)
770
771TYPE(vol7d_var),INTENT(in) :: this(:)
772integer :: i
773
774do i=1,size(this)
775 call display_var(this(i))
776end do
777
778end subroutine display_var_vect
779
780FUNCTION vol7d_var_c_e(this) RESULT(c_e)
781TYPE(vol7d_var),INTENT(IN) :: this
782LOGICAL :: c_e
783c_e = this /= vol7d_var_miss
784END FUNCTION vol7d_var_c_e
785
786
795SUBROUTINE vol7d_var_features_init()
796INTEGER :: un, i, n
797TYPE(csv_record) :: csv
798CHARACTER(len=1024) :: line
799
800IF (ALLOCATED(var_features)) RETURN
801
802un = open_package_file('varbufr.csv', filetype_data)
803n=0
804DO WHILE(.true.)
805 READ(un,*,END=100)
806 n = n + 1
807ENDDO
808
809100 CONTINUE
810
811rewind(un)
812ALLOCATE(var_features(n))
813
814DO i = 1, n
815 READ(un,'(A)',END=200)line
817 CALL csv_record_getfield(csv, var_features(i)%var%btable)
818 CALL csv_record_getfield(csv)
819 CALL csv_record_getfield(csv)
820 CALL csv_record_getfield(csv, var_features(i)%posdef)
821 CALL csv_record_getfield(csv, var_features(i)%vartype)
823ENDDO
824
825200 CONTINUE
826CLOSE(un)
827
828END SUBROUTINE vol7d_var_features_init
829
830
834SUBROUTINE vol7d_var_features_delete()
835IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
836END SUBROUTINE vol7d_var_features_delete
837
838
845ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
846TYPE(vol7d_var),INTENT(in) :: this
847INTEGER :: vartype
848
849INTEGER :: i
850
851vartype = imiss
852
853IF (ALLOCATED(var_features)) THEN
854 DO i = 1, SIZE(var_features)
855 IF (this == var_features(i)%var) THEN
856 vartype = var_features(i)%vartype
857 RETURN
858 ENDIF
859 ENDDO
860ENDIF
861
862END FUNCTION vol7d_var_features_vartype
863
864
875ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
876TYPE(vol7d_var),INTENT(in) :: this
877REAL,INTENT(inout) :: val
878
879INTEGER :: i
880
881IF (ALLOCATED(var_features)) THEN
882 DO i = 1, SIZE(var_features)
883 IF (this == var_features(i)%var) THEN
885 RETURN
886 ENDIF
887 ENDDO
888ENDIF
889
890END SUBROUTINE vol7d_var_features_posdef_apply
891
892
897ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
898TYPE(vol7d_var),INTENT(in) :: this
899
900INTEGER :: vartype
901
902vartype = var_ord
903SELECT CASE(this%btable)
904CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
905 vartype = var_dir360
906CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
907 vartype = var_press
908CASE('B11003', 'B11200') ! u-component
909 vartype = var_ucomp
910CASE('B11004', 'B11201') ! v-component
911 vartype = var_vcomp
912CASE('B11005', 'B11006') ! w-component
913 vartype = var_wcomp
914END SELECT
915
916END FUNCTION vol7d_vartype
917
918
919#include "array_utilities_inc.F90"
920
921
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 |