libsim Versione 7.1.11
|
◆ vol7d_var_new()
Definizione alla linea 404 del file vol7d_var_class.F90. 405! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
406! authors:
407! Davide Cesari <dcesari@arpa.emr.it>
408! Paolo Patruno <ppatruno@arpa.emr.it>
409
410! This program is free software; you can redistribute it and/or
411! modify it under the terms of the GNU General Public License as
412! published by the Free Software Foundation; either version 2 of
413! the License, or (at your option) any later version.
414
415! This program is distributed in the hope that it will be useful,
416! but WITHOUT ANY WARRANTY; without even the implied warranty of
417! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
418! GNU General Public License for more details.
419
420! You should have received a copy of the GNU General Public License
421! along with this program. If not, see <http://www.gnu.org/licenses/>.
422#include "config.h"
423
432IMPLICIT NONE
433
443 CHARACTER(len=10) :: btable=cmiss
444 CHARACTER(len=65) :: description=cmiss
445 CHARACTER(len=24) :: unit=cmiss
446 INTEGER :: scalefactor=imiss
447
448 INTEGER :: r=imiss
449 INTEGER :: d=imiss
450 INTEGER :: i=imiss
451 INTEGER :: b=imiss
452 INTEGER :: c=imiss
453 INTEGER :: gribhint(4)=imiss
455
457TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
458 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
459 (/imiss,imiss,imiss,imiss/))
460
465 MODULE PROCEDURE vol7d_var_init
466END INTERFACE
467
471 MODULE PROCEDURE vol7d_var_delete
472END INTERFACE
473
479INTERFACE OPERATOR (==)
480 MODULE PROCEDURE vol7d_var_eq
481END INTERFACE
482
488INTERFACE OPERATOR (/=)
489 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
490END INTERFACE
491
494 MODULE PROCEDURE vol7d_var_c_e
495END INTERFACE
496
497#define VOL7D_POLY_TYPE TYPE(vol7d_var)
498#define VOL7D_POLY_TYPES _var
499#include "array_utilities_pre.F90"
500
503 MODULE PROCEDURE display_var, display_var_vect
504END INTERFACE
505
506
507TYPE vol7d_var_features
508 TYPE(vol7d_var) :: var
509 REAL :: posdef
510 INTEGER :: vartype
511END TYPE vol7d_var_features
512
513TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
514
515! constants for vol7d_vartype
516INTEGER,PARAMETER :: var_ord=0
517INTEGER,PARAMETER :: var_dir360=1
518INTEGER,PARAMETER :: var_press=2
519INTEGER,PARAMETER :: var_ucomp=3
520INTEGER,PARAMETER :: var_vcomp=4
521INTEGER,PARAMETER :: var_wcomp=5
522
523
524CONTAINS
525
531elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
532TYPE(vol7d_var),INTENT(INOUT) :: this
533CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
534CHARACTER(len=*),INTENT(in),OPTIONAL :: description
535CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
536INTEGER,INTENT(in),OPTIONAL :: scalefactor
537
538IF (PRESENT(btable)) THEN
539 this%btable = btable
540ELSE
541 this%btable = cmiss
542 this%description = cmiss
543 this%unit = cmiss
544 this%scalefactor = imiss
545 RETURN
546ENDIF
547IF (PRESENT(description)) THEN
548 this%description = description
549ELSE
550 this%description = cmiss
551ENDIF
552IF (PRESENT(unit)) THEN
553 this%unit = unit
554ELSE
555 this%unit = cmiss
556ENDIF
557if (present(scalefactor)) then
558 this%scalefactor = scalefactor
559else
560 this%scalefactor = imiss
561endif
562
563this%r = -1
564this%d = -1
565this%i = -1
566this%b = -1
567this%c = -1
568
569END SUBROUTINE vol7d_var_init
570
571
572ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
573CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
574CHARACTER(len=*),INTENT(in),OPTIONAL :: description
575CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
576INTEGER,INTENT(in),OPTIONAL :: scalefactor
577
578TYPE(vol7d_var) :: this
579
581
582END FUNCTION vol7d_var_new
583
584
586elemental SUBROUTINE vol7d_var_delete(this)
587TYPE(vol7d_var),INTENT(INOUT) :: this
588
589this%btable = cmiss
590this%description = cmiss
591this%unit = cmiss
592this%scalefactor = imiss
593
594END SUBROUTINE vol7d_var_delete
595
596
597ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
598TYPE(vol7d_var),INTENT(IN) :: this, that
599LOGICAL :: res
600
601res = this%btable == that%btable
602
603END FUNCTION vol7d_var_eq
604
605
606ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
607TYPE(vol7d_var),INTENT(IN) :: this, that
608LOGICAL :: res
609
610res = .NOT.(this == that)
611
612END FUNCTION vol7d_var_ne
613
614
615FUNCTION vol7d_var_nesv(this, that) RESULT(res)
616TYPE(vol7d_var),INTENT(IN) :: this, that(:)
617LOGICAL :: res(SIZE(that))
618
619INTEGER :: i
620
621DO i = 1, SIZE(that)
622 res(i) = .NOT.(this == that(i))
623ENDDO
624
625END FUNCTION vol7d_var_nesv
626
627
628
630subroutine display_var(this)
631
632TYPE(vol7d_var),INTENT(in) :: this
633
634print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
635 " scale factor",this%scalefactor
636
637end subroutine display_var
638
639
641subroutine display_var_vect(this)
642
643TYPE(vol7d_var),INTENT(in) :: this(:)
644integer :: i
645
646do i=1,size(this)
647 call display_var(this(i))
648end do
649
650end subroutine display_var_vect
651
652FUNCTION vol7d_var_c_e(this) RESULT(c_e)
653TYPE(vol7d_var),INTENT(IN) :: this
654LOGICAL :: c_e
655c_e = this /= vol7d_var_miss
656END FUNCTION vol7d_var_c_e
657
658
667SUBROUTINE vol7d_var_features_init()
668INTEGER :: un, i, n
669TYPE(csv_record) :: csv
670CHARACTER(len=1024) :: line
671
672IF (ALLOCATED(var_features)) RETURN
673
674un = open_package_file('varbufr.csv', filetype_data)
675n=0
676DO WHILE(.true.)
677 READ(un,*,END=100)
678 n = n + 1
679ENDDO
680
681100 CONTINUE
682
683rewind(un)
684ALLOCATE(var_features(n))
685
686DO i = 1, n
687 READ(un,'(A)',END=200)line
689 CALL csv_record_getfield(csv, var_features(i)%var%btable)
690 CALL csv_record_getfield(csv)
691 CALL csv_record_getfield(csv)
692 CALL csv_record_getfield(csv, var_features(i)%posdef)
693 CALL csv_record_getfield(csv, var_features(i)%vartype)
695ENDDO
696
697200 CONTINUE
698CLOSE(un)
699
700END SUBROUTINE vol7d_var_features_init
701
702
706SUBROUTINE vol7d_var_features_delete()
707IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
708END SUBROUTINE vol7d_var_features_delete
709
710
717ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
718TYPE(vol7d_var),INTENT(in) :: this
719INTEGER :: vartype
720
721INTEGER :: i
722
723vartype = imiss
724
725IF (ALLOCATED(var_features)) THEN
726 DO i = 1, SIZE(var_features)
727 IF (this == var_features(i)%var) THEN
728 vartype = var_features(i)%vartype
729 RETURN
730 ENDIF
731 ENDDO
732ENDIF
733
734END FUNCTION vol7d_var_features_vartype
735
736
747ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
748TYPE(vol7d_var),INTENT(in) :: this
749REAL,INTENT(inout) :: val
750
751INTEGER :: i
752
753IF (ALLOCATED(var_features)) THEN
754 DO i = 1, SIZE(var_features)
755 IF (this == var_features(i)%var) THEN
757 RETURN
758 ENDIF
759 ENDDO
760ENDIF
761
762END SUBROUTINE vol7d_var_features_posdef_apply
763
764
769ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
770TYPE(vol7d_var),INTENT(in) :: this
771
772INTEGER :: vartype
773
774vartype = var_ord
775SELECT CASE(this%btable)
776CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
777 vartype = var_dir360
778CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
779 vartype = var_press
780CASE('B11003', 'B11200') ! u-component
781 vartype = var_ucomp
782CASE('B11004', 'B11201') ! v-component
783 vartype = var_vcomp
784CASE('B11005', 'B11006') ! w-component
785 vartype = var_wcomp
786END SELECT
787
788END FUNCTION vol7d_vartype
789
790
791#include "array_utilities_inc.F90"
792
793
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 |