libsim Versione 7.2.1

◆ vol7d_var_new()

elemental type(vol7d_var) function vol7d_var_new ( character(len=*), intent(in), optional  btable,
character(len=*), intent(in), optional  description,
character(len=*), intent(in), optional  unit,
integer, intent(in), optional  scalefactor 
)
Parametri
[in]btablecodice della variabile
[in]descriptiondescrizione della variabile
[in]unitunità di misura
[in]scalefactordecimali nella rappresentazione intera e character

Definizione alla linea 398 del file vol7d_var_class.F90.

399! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
400! authors:
401! Davide Cesari <dcesari@arpa.emr.it>
402! Paolo Patruno <ppatruno@arpa.emr.it>
403
404! This program is free software; you can redistribute it and/or
405! modify it under the terms of the GNU General Public License as
406! published by the Free Software Foundation; either version 2 of
407! the License, or (at your option) any later version.
408
409! This program is distributed in the hope that it will be useful,
410! but WITHOUT ANY WARRANTY; without even the implied warranty of
411! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
412! GNU General Public License for more details.
413
414! You should have received a copy of the GNU General Public License
415! along with this program. If not, see <http://www.gnu.org/licenses/>.
416#include "config.h"
417
422MODULE vol7d_var_class
423USE kinds
426IMPLICIT NONE
427
436TYPE vol7d_var
437 CHARACTER(len=10) :: btable=cmiss
438 CHARACTER(len=65) :: description=cmiss
439 CHARACTER(len=24) :: unit=cmiss
440 INTEGER :: scalefactor=imiss
441
442 INTEGER :: r=imiss
443 INTEGER :: d=imiss
444 INTEGER :: i=imiss
445 INTEGER :: b=imiss
446 INTEGER :: c=imiss
447 INTEGER :: gribhint(4)=imiss
448END TYPE vol7d_var
449
451TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
452 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
453 (/imiss,imiss,imiss,imiss/))
454
458INTERFACE init
459 MODULE PROCEDURE vol7d_var_init
460END INTERFACE
461
464INTERFACE delete
465 MODULE PROCEDURE vol7d_var_delete
466END INTERFACE
467
473INTERFACE OPERATOR (==)
474 MODULE PROCEDURE vol7d_var_eq
475END INTERFACE
476
482INTERFACE OPERATOR (/=)
483 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
484END INTERFACE
485
487INTERFACE c_e
488 MODULE PROCEDURE vol7d_var_c_e
489END INTERFACE
490
491#define VOL7D_POLY_TYPE TYPE(vol7d_var)
492#define VOL7D_POLY_TYPES _var
493#include "array_utilities_pre.F90"
494
496INTERFACE display
497 MODULE PROCEDURE display_var, display_var_vect
498END INTERFACE
499
500
501TYPE vol7d_var_features
502 TYPE(vol7d_var) :: var
503 REAL :: posdef
504 INTEGER :: vartype
505END TYPE vol7d_var_features
506
507TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
508
509! constants for vol7d_vartype
510INTEGER,PARAMETER :: var_ord=0
511INTEGER,PARAMETER :: var_dir360=1
512INTEGER,PARAMETER :: var_press=2
513INTEGER,PARAMETER :: var_ucomp=3
514INTEGER,PARAMETER :: var_vcomp=4
515INTEGER,PARAMETER :: var_wcomp=5
516
517
518CONTAINS
519
525elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
526TYPE(vol7d_var),INTENT(INOUT) :: this
527CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
528CHARACTER(len=*),INTENT(in),OPTIONAL :: description
529CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
530INTEGER,INTENT(in),OPTIONAL :: scalefactor
531
532IF (PRESENT(btable)) THEN
533 this%btable = btable
534ELSE
535 this%btable = cmiss
536 this%description = cmiss
537 this%unit = cmiss
538 this%scalefactor = imiss
539 RETURN
540ENDIF
541IF (PRESENT(description)) THEN
542 this%description = description
543ELSE
544 this%description = cmiss
545ENDIF
546IF (PRESENT(unit)) THEN
547 this%unit = unit
548ELSE
549 this%unit = cmiss
550ENDIF
551if (present(scalefactor)) then
552 this%scalefactor = scalefactor
553else
554 this%scalefactor = imiss
555endif
556
557this%r = -1
558this%d = -1
559this%i = -1
560this%b = -1
561this%c = -1
562
563END SUBROUTINE vol7d_var_init
564
565
566ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
567CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
568CHARACTER(len=*),INTENT(in),OPTIONAL :: description
569CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
570INTEGER,INTENT(in),OPTIONAL :: scalefactor
571
572TYPE(vol7d_var) :: this
573
574CALL init(this, btable, description, unit, scalefactor)
575
576END FUNCTION vol7d_var_new
577
578
580elemental SUBROUTINE vol7d_var_delete(this)
581TYPE(vol7d_var),INTENT(INOUT) :: this
582
583this%btable = cmiss
584this%description = cmiss
585this%unit = cmiss
586this%scalefactor = imiss
587
588END SUBROUTINE vol7d_var_delete
589
590
591ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
592TYPE(vol7d_var),INTENT(IN) :: this, that
593LOGICAL :: res
594
595res = this%btable == that%btable
596
597END FUNCTION vol7d_var_eq
598
599
600ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
601TYPE(vol7d_var),INTENT(IN) :: this, that
602LOGICAL :: res
603
604res = .NOT.(this == that)
605
606END FUNCTION vol7d_var_ne
607
608
609FUNCTION vol7d_var_nesv(this, that) RESULT(res)
610TYPE(vol7d_var),INTENT(IN) :: this, that(:)
611LOGICAL :: res(SIZE(that))
612
613INTEGER :: i
614
615DO i = 1, SIZE(that)
616 res(i) = .NOT.(this == that(i))
617ENDDO
618
619END FUNCTION vol7d_var_nesv
620
621
622
624subroutine display_var(this)
625
626TYPE(vol7d_var),INTENT(in) :: this
627
628print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
629 " scale factor",this%scalefactor
630
631end subroutine display_var
632
633
635subroutine display_var_vect(this)
636
637TYPE(vol7d_var),INTENT(in) :: this(:)
638integer :: i
639
640do i=1,size(this)
641 call display_var(this(i))
642end do
643
644end subroutine display_var_vect
645
646FUNCTION vol7d_var_c_e(this) RESULT(c_e)
647TYPE(vol7d_var),INTENT(IN) :: this
648LOGICAL :: c_e
649c_e = this /= vol7d_var_miss
650END FUNCTION vol7d_var_c_e
651
652
661SUBROUTINE vol7d_var_features_init()
662INTEGER :: un, i, n
663TYPE(csv_record) :: csv
664CHARACTER(len=1024) :: line
665
666IF (ALLOCATED(var_features)) RETURN
667
668un = open_package_file('varbufr.csv', filetype_data)
669n=0
670DO WHILE(.true.)
671 READ(un,*,END=100)
672 n = n + 1
673ENDDO
674
675100 CONTINUE
676
677rewind(un)
678ALLOCATE(var_features(n))
679
680DO i = 1, n
681 READ(un,'(A)',END=200)line
682 CALL init(csv, line)
683 CALL csv_record_getfield(csv, var_features(i)%var%btable)
684 CALL csv_record_getfield(csv)
685 CALL csv_record_getfield(csv)
686 CALL csv_record_getfield(csv, var_features(i)%posdef)
687 CALL csv_record_getfield(csv, var_features(i)%vartype)
688 CALL delete(csv)
689ENDDO
690
691200 CONTINUE
692CLOSE(un)
693
694END SUBROUTINE vol7d_var_features_init
695
696
700SUBROUTINE vol7d_var_features_delete()
701IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
702END SUBROUTINE vol7d_var_features_delete
703
704
711ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
712TYPE(vol7d_var),INTENT(in) :: this
713INTEGER :: vartype
714
715INTEGER :: i
716
717vartype = imiss
718
719IF (ALLOCATED(var_features)) THEN
720 DO i = 1, SIZE(var_features)
721 IF (this == var_features(i)%var) THEN
722 vartype = var_features(i)%vartype
723 RETURN
724 ENDIF
725 ENDDO
726ENDIF
727
728END FUNCTION vol7d_var_features_vartype
729
730
741ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
742TYPE(vol7d_var),INTENT(in) :: this
743REAL,INTENT(inout) :: val
744
745INTEGER :: i
746
747IF (ALLOCATED(var_features)) THEN
748 DO i = 1, SIZE(var_features)
749 IF (this == var_features(i)%var) THEN
750 IF (c_e(var_features(i)%posdef)) val = max(var_features(i)%posdef, val)
751 RETURN
752 ENDIF
753 ENDDO
754ENDIF
755
756END SUBROUTINE vol7d_var_features_posdef_apply
757
758
763ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
764TYPE(vol7d_var),INTENT(in) :: this
765
766INTEGER :: vartype
767
768vartype = var_ord
769SELECT CASE(this%btable)
770CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
771 vartype = var_dir360
772CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
773 vartype = var_press
774CASE('B11003', 'B11200') ! u-component
775 vartype = var_ucomp
776CASE('B11004', 'B11201') ! v-component
777 vartype = var_vcomp
778CASE('B11005', 'B11006') ! w-component
779 vartype = var_wcomp
780END SELECT
781
782END FUNCTION vol7d_vartype
783
784
785#include "array_utilities_inc.F90"
786
787
788END 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:245
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.