102 INTEGER,
PARAMETER :: vol7d_maxdim_a = 3, vol7d_maxdim_aa = 4, &
103 vol7d_maxdim_d = 6, vol7d_maxdim_ad = 7
105 INTEGER,
PARAMETER :: vol7d_ana_a=1
106 INTEGER,
PARAMETER :: vol7d_var_a=2
107 INTEGER,
PARAMETER :: vol7d_network_a=3
108 INTEGER,
PARAMETER :: vol7d_attr_a=4
109 INTEGER,
PARAMETER :: vol7d_ana_d=1
110 INTEGER,
PARAMETER :: vol7d_time_d=2
111 INTEGER,
PARAMETER :: vol7d_level_d=3
112 INTEGER,
PARAMETER :: vol7d_timerange_d=4
113 INTEGER,
PARAMETER :: vol7d_var_d=5
114 INTEGER,
PARAMETER :: vol7d_network_d=6
115 INTEGER,
PARAMETER :: vol7d_attr_d=7
116 INTEGER,
PARAMETER :: vol7d_cdatalen=32
119 INTEGER :: r, d, i, b, c
120 END TYPE vol7d_varmap
126 TYPE(vol7d_ana
),
POINTER :: ana(:)
128 TYPE(datetime
),
POINTER :: time(:)
130 TYPE(vol7d_level
),
POINTER :: level(:)
132 TYPE(vol7d_timerange
),
POINTER :: timerange(:)
134 TYPE(vol7d_network
),
POINTER :: network(:)
149 REAL,
POINTER :: volanar(:,:,:)
151 DOUBLE PRECISION,
POINTER :: volanad(:,:,:)
153 INTEGER,
POINTER :: volanai(:,:,:)
155 INTEGER(kind=int_b),
POINTER :: volanab(:,:,:)
157 CHARACTER(len=vol7d_cdatalen),
POINTER :: volanac(:,:,:)
160 REAL,
POINTER :: volanaattrr(:,:,:,:)
162 DOUBLE PRECISION,
POINTER :: volanaattrd(:,:,:,:)
164 INTEGER,
POINTER :: volanaattri(:,:,:,:)
166 INTEGER(kind=int_b),
POINTER :: volanaattrb(:,:,:,:)
168 CHARACTER(len=vol7d_cdatalen),
POINTER :: volanaattrc(:,:,:,:)
171 REAL,
POINTER :: voldatir(:,:,:,:,:,:)
173 DOUBLE PRECISION,
POINTER :: voldatid(:,:,:,:,:,:)
175 INTEGER,
POINTER :: voldatii(:,:,:,:,:,:)
177 INTEGER(kind=int_b),
POINTER :: voldatib(:,:,:,:,:,:)
179 CHARACTER(len=vol7d_cdatalen),
POINTER :: voldatic(:,:,:,:,:,:)
182 REAL,
POINTER :: voldatiattrr(:,:,:,:,:,:,:)
184 DOUBLE PRECISION,
POINTER :: voldatiattrd(:,:,:,:,:,:,:)
186 INTEGER,
POINTER :: voldatiattri(:,:,:,:,:,:,:)
188 INTEGER(kind=int_b),
POINTER :: voldatiattrb(:,:,:,:,:,:,:)
190 CHARACTER(len=vol7d_cdatalen),
POINTER :: voldatiattrc(:,:,:,:,:,:,:)
193 integer :: time_definition
201 MODULE PROCEDURE vol7d_init
206 MODULE PROCEDURE vol7d_delete
211 MODULE PROCEDURE vol7d_write_on_file
216 MODULE PROCEDURE vol7d_read_from_file
221 MODULE PROCEDURE vol7d_display, dat_display, dat_vect_display
226 MODULE PROCEDURE to_char_dat
231 MODULE PROCEDURE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
236 MODULE PROCEDURE realdatd,realdatr,realdati,realdatb,realdatc
241 MODULE PROCEDURE integerdatd,integerdatr,integerdati,integerdatb,integerdatc
246 MODULE PROCEDURE vol7d_copy
251 MODULE PROCEDURE vol7d_c_e
258 MODULE PROCEDURE vol7d_check
275 MODULE PROCEDURE v7d_rounding
298 PRIVATE vol7d_get_volr, vol7d_get_vold, vol7d_get_voli, vol7d_get_volb, &
300 volptr1dr, volptr2dr, volptr3dr, volptr4dr, volptr5dr, volptr6dr, volptr7dr, &
301 volptr1dd, volptr2dd, volptr3dd, volptr4dd, volptr5dd, volptr6dd, volptr7dd, &
302 volptr1di, volptr2di, volptr3di, volptr4di, volptr5di, volptr6di, volptr7di, &
303 volptr1db, volptr2db, volptr3db, volptr4db, volptr5db, volptr6db, volptr7db, &
304 volptr1dc, volptr2dc, volptr3dc, volptr4dc, volptr5dc, volptr6dc, volptr7dc, &
305 vol7d_nullifyr, vol7d_nullifyd, vol7d_nullifyi, vol7d_nullifyb, vol7d_nullifyc, &
306 vol7d_init, vol7d_delete, vol7d_write_on_file, vol7d_read_from_file, &
307 vol7d_check_alloc_ana, vol7d_force_alloc_ana, &
308 vol7d_check_alloc_dati, vol7d_force_alloc_dati, vol7d_force_alloc, &
309 vol7d_display, dat_display, dat_vect_display, &
310 to_char_dat, vol7d_check
312 PRIVATE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
323 SUBROUTINE vol7d_init(this,time_definition)
324 TYPE(vol7d),
intent(out) :: this
325 integer,
INTENT(IN),
OPTIONAL :: time_definition
328 CALL
init(this%anaattr)
330 CALL
init(this%dativar)
332 CALL
init(this%dativarattr)
333 CALL vol7d_var_features_init()
335 nullify(this%ana, this%time, this%level, this%timerange, this%network)
337 nullify(this%volanar, this%volanaattrr, this%voldatir, this%voldatiattrr)
338 nullify(this%volanad, this%volanaattrd, this%voldatid, this%voldatiattrd)
339 nullify(this%volanai, this%volanaattri, this%voldatii, this%voldatiattri)
340 nullify(this%volanab, this%volanaattrb, this%voldatib, this%voldatiattrb)
341 nullify(this%volanac, this%volanaattrc, this%voldatic, this%voldatiattrc)
343 if(present(time_definition))
then
344 this%time_definition=time_definition
346 this%time_definition=1
349 END SUBROUTINE vol7d_init
355 ELEMENTAL SUBROUTINE vol7d_delete(this, dataonly)
357 LOGICAL,
INTENT(in),
OPTIONAL :: dataonly
360 IF (.NOT. optio_log(dataonly))
THEN
361 IF (
ASSOCIATED(this%volanar))
DEALLOCATE(this%volanar)
362 IF (
ASSOCIATED(this%volanad))
DEALLOCATE(this%volanad)
363 IF (
ASSOCIATED(this%volanai))
DEALLOCATE(this%volanai)
364 IF (
ASSOCIATED(this%volanab))
DEALLOCATE(this%volanab)
365 IF (
ASSOCIATED(this%volanac))
DEALLOCATE(this%volanac)
366 IF (
ASSOCIATED(this%volanaattrr))
DEALLOCATE(this%volanaattrr)
367 IF (
ASSOCIATED(this%volanaattrd))
DEALLOCATE(this%volanaattrd)
368 IF (
ASSOCIATED(this%volanaattri))
DEALLOCATE(this%volanaattri)
369 IF (
ASSOCIATED(this%volanaattrb))
DEALLOCATE(this%volanaattrb)
370 IF (
ASSOCIATED(this%volanaattrc))
DEALLOCATE(this%volanaattrc)
372 IF (
ASSOCIATED(this%voldatir))
DEALLOCATE(this%voldatir)
373 IF (
ASSOCIATED(this%voldatid))
DEALLOCATE(this%voldatid)
374 IF (
ASSOCIATED(this%voldatii))
DEALLOCATE(this%voldatii)
375 IF (
ASSOCIATED(this%voldatib))
DEALLOCATE(this%voldatib)
376 IF (
ASSOCIATED(this%voldatic))
DEALLOCATE(this%voldatic)
377 IF (
ASSOCIATED(this%voldatiattrr))
DEALLOCATE(this%voldatiattrr)
378 IF (
ASSOCIATED(this%voldatiattrd))
DEALLOCATE(this%voldatiattrd)
379 IF (
ASSOCIATED(this%voldatiattri))
DEALLOCATE(this%voldatiattri)
380 IF (
ASSOCIATED(this%voldatiattrb))
DEALLOCATE(this%voldatiattrb)
381 IF (
ASSOCIATED(this%voldatiattrc))
DEALLOCATE(this%voldatiattrc)
383 IF (.NOT. optio_log(dataonly))
THEN
384 IF (
ASSOCIATED(this%ana))
DEALLOCATE(this%ana)
385 IF (
ASSOCIATED(this%network))
DEALLOCATE(this%network)
387 IF (
ASSOCIATED(this%time))
DEALLOCATE(this%time)
388 IF (
ASSOCIATED(this%level))
DEALLOCATE(this%level)
389 IF (
ASSOCIATED(this%timerange))
DEALLOCATE(this%timerange)
391 IF (.NOT. optio_log(dataonly))
THEN
394 CALL
delete(this%anavarattr)
397 CALL
delete(this%datiattr)
398 CALL
delete(this%dativarattr)
400 END SUBROUTINE vol7d_delete
404 integer function vol7d_check(this)
406 integer :: i,j,k,l,m,n
410 if (
associated(this%voldatii))
then
411 do i = 1,
size(this%voldatii,1)
412 do j = 1,
size(this%voldatii,2)
413 do k = 1,
size(this%voldatii,3)
414 do l = 1,
size(this%voldatii,4)
415 do m = 1,
size(this%voldatii,5)
416 do n = 1,
size(this%voldatii,6)
417 if (this%voldatii(i,j,k,l,m,n) /= this%voldatii(i,j,k,l,m,n) )
then
418 CALL l4f_log(l4f_warn,
"check: abnormal value at voldatii("&
431 if (
associated(this%voldatir))
then
432 do i = 1,
size(this%voldatir,1)
433 do j = 1,
size(this%voldatir,2)
434 do k = 1,
size(this%voldatir,3)
435 do l = 1,
size(this%voldatir,4)
436 do m = 1,
size(this%voldatir,5)
437 do n = 1,
size(this%voldatir,6)
438 if (this%voldatir(i,j,k,l,m,n) /= this%voldatir(i,j,k,l,m,n) )
then
439 CALL l4f_log(l4f_warn,
"check: abnormal value at voldatir("&
451 if (
associated(this%voldatid))
then
452 do i = 1,
size(this%voldatid,1)
453 do j = 1,
size(this%voldatid,2)
454 do k = 1,
size(this%voldatid,3)
455 do l = 1,
size(this%voldatid,4)
456 do m = 1,
size(this%voldatid,5)
457 do n = 1,
size(this%voldatid,6)
458 if (this%voldatid(i,j,k,l,m,n) /= this%voldatid(i,j,k,l,m,n) )
then
459 CALL l4f_log(l4f_warn,
"check: abnormal value at voldatid("&
471 if (
associated(this%voldatib))
then
472 do i = 1,
size(this%voldatib,1)
473 do j = 1,
size(this%voldatib,2)
474 do k = 1,
size(this%voldatib,3)
475 do l = 1,
size(this%voldatib,4)
476 do m = 1,
size(this%voldatib,5)
477 do n = 1,
size(this%voldatib,6)
478 if (this%voldatib(i,j,k,l,m,n) /= this%voldatib(i,j,k,l,m,n) )
then
479 CALL l4f_log(l4f_warn,
"check: abnormal value at voldatib("&
491 end function vol7d_check
497 SUBROUTINE vol7d_display(this)
498 TYPE(vol7d),
intent(in) :: this
502 DOUBLE PRECISION :: ddat
504 INTEGER(kind=int_b) :: bdat
505 CHARACTER(len=vol7d_cdatalen) :: cdat
508 print*,
"<<<<<<<<<<<<<<<<<<< vol7d object >>>>>>>>>>>>>>>>>>>>"
509 if (this%time_definition == 0)
then
510 print*,
"TIME DEFINITION: time is reference time"
511 else if (this%time_definition == 1)
then
512 print*,
"TIME DEFINITION: time is validity time"
514 print*,
"Time definition have a wrong walue:", this%time_definition
517 IF (
ASSOCIATED(this%network))
then
518 print*,
"---- network vector ----"
519 print*,
"elements=",
size(this%network)
520 do i=1,
size(this%network)
525 IF (
ASSOCIATED(this%ana))
then
526 print*,
"---- ana vector ----"
527 print*,
"elements=",
size(this%ana)
528 do i=1,
size(this%ana)
533 IF (
ASSOCIATED(this%time))
then
534 print*,
"---- time vector ----"
535 print*,
"elements=",
size(this%time)
536 do i=1,
size(this%time)
541 IF (
ASSOCIATED(this%level))
then
542 print*,
"---- level vector ----"
543 print*,
"elements=",
size(this%level)
544 do i =1,
size(this%level)
549 IF (
ASSOCIATED(this%timerange))
then
550 print*,
"---- timerange vector ----"
551 print*,
"elements=",
size(this%timerange)
552 do i =1,
size(this%timerange)
553 call
display(this%timerange(i))
558 print*,
"---- ana vector ----"
560 print*,
"->>>>>>>>> anavar -"
563 print*,
"->>>>>>>>> anaattr -"
566 print*,
"->>>>>>>>> anavarattr -"
569 print*,
"-- ana data section (first point) --"
583 IF (
SIZE(this%ana) > 0 .AND.
SIZE(this%network) > 0)
THEN
584 if (
associated(this%volanai))
then
585 do i=1,
size(this%anavar%i)
586 idat=this%volanai(1,i,1)
587 if (
associated(this%anavar%i)) call
display(this%anavar%i(i),idat,rdat,ddat,bdat,cdat)
592 if (
associated(this%volanar))
then
593 do i=1,
size(this%anavar%r)
594 rdat=this%volanar(1,i,1)
595 if (
associated(this%anavar%r)) call
display(this%anavar%r(i),idat,rdat,ddat,bdat,cdat)
600 if (
associated(this%volanad))
then
601 do i=1,
size(this%anavar%d)
602 ddat=this%volanad(1,i,1)
603 if (
associated(this%anavar%d)) call
display(this%anavar%d(i),idat,rdat,ddat,bdat,cdat)
608 if (
associated(this%volanab))
then
609 do i=1,
size(this%anavar%b)
610 bdat=this%volanab(1,i,1)
611 if (
associated(this%anavar%b)) call
display(this%anavar%b(i),idat,rdat,ddat,bdat,cdat)
616 if (
associated(this%volanac))
then
617 do i=1,
size(this%anavar%c)
618 cdat=this%volanac(1,i,1)
619 if (
associated(this%anavar%c)) call
display(this%anavar%c(i),idat,rdat,ddat,bdat,cdat)
625 print*,
"---- data vector ----"
627 print*,
"->>>>>>>>> dativar -"
630 print*,
"->>>>>>>>> datiattr -"
633 print*,
"->>>>>>>>> dativarattr -"
636 print*,
"-- data data section (first point) --"
644 IF (
SIZE(this%ana) > 0 .AND.
SIZE(this%network) > 0 .AND.
size(this%time) > 0 &
645 .AND.
size(this%level) > 0 .AND.
size(this%timerange) > 0)
THEN
646 if (
associated(this%voldatii))
then
647 do i=1,
size(this%dativar%i)
648 idat=this%voldatii(1,1,1,1,i,1)
649 if (
associated(this%dativar%i)) call
display(this%dativar%i(i),idat,rdat,ddat,bdat,cdat)
654 if (
associated(this%voldatir))
then
655 do i=1,
size(this%dativar%r)
656 rdat=this%voldatir(1,1,1,1,i,1)
657 if (
associated(this%dativar%r)) call
display(this%dativar%r(i),idat,rdat,ddat,bdat,cdat)
662 if (
associated(this%voldatid))
then
663 do i=1,
size(this%dativar%d)
664 ddat=this%voldatid(1,1,1,1,i,1)
665 if (
associated(this%dativar%d)) call
display(this%dativar%d(i),idat,rdat,ddat,bdat,cdat)
670 if (
associated(this%voldatib))
then
671 do i=1,
size(this%dativar%b)
672 bdat=this%voldatib(1,1,1,1,i,1)
673 if (
associated(this%dativar%b)) call
display(this%dativar%b(i),idat,rdat,ddat,bdat,cdat)
678 if (
associated(this%voldatic))
then
679 do i=1,
size(this%dativar%c)
680 cdat=this%voldatic(1,1,1,1,i,1)
681 if (
associated(this%dativar%c)) call
display(this%dativar%c(i),idat,rdat,ddat,bdat,cdat)
687 print*,
"<<<<<<<<<<<<<<<<<<< END vol7d object >>>>>>>>>>>>>>>>>>>>"
689 END SUBROUTINE vol7d_display
693 SUBROUTINE dat_display(this,idat,rdat,ddat,bdat,cdat)
694 TYPE(vol7d_var
),
intent(in) :: this
698 DOUBLE PRECISION :: ddat
702 INTEGER(kind=int_b) :: bdat
704 CHARACTER(len=*) :: cdat
706 print *, to_char_dat(this,idat,rdat,ddat,bdat,cdat)
708 end SUBROUTINE dat_display
711 SUBROUTINE dat_vect_display(this,idat,rdat,ddat,bdat,cdat)
713 TYPE(vol7d_var
),
intent(in) :: this(:)
717 DOUBLE PRECISION :: ddat(:)
721 INTEGER(kind=int_b) :: bdat(:)
723 CHARACTER(len=*):: cdat(:)
728 call
display(this(i),idat(i),rdat(i),ddat(i),bdat(i),cdat(i))
731 end SUBROUTINE dat_vect_display
734 FUNCTION to_char_dat(this,idat,rdat,ddat,bdat,cdat)
738 TYPE(vol7d_var
),
INTENT(in) :: this
742 DOUBLE PRECISION :: ddat
746 INTEGER(kind=int_b) :: bdat
748 CHARACTER(len=*) :: cdat
749 CHARACTER(len=80) :: to_char_dat
751 CHARACTER(len=LEN(to_char_dat)) :: to_char_tmp
755 INTEGER :: handle, ier
758 to_char_dat=
"VALUE: "
760 if (
c_e(idat)) to_char_dat=trim(to_char_dat)//
" ;int> "//trim(
to_char(idat))
761 if (
c_e(rdat)) to_char_dat=trim(to_char_dat)//
" ;real> "//trim(
to_char(rdat))
762 if (
c_e(ddat)) to_char_dat=trim(to_char_dat)//
" ;double> "//trim(
to_char(ddat))
763 if (
c_e(bdat)) to_char_dat=trim(to_char_dat)//
" ;byte> "//trim(
to_char(bdat))
766 ier = idba_messaggi(handle,
"/dev/null",
"w",
"BUFR")
767 ier = idba_spiegab(handle,this%btable,cdat,to_char_tmp)
768 ier = idba_fatto(handle)
769 to_char_dat=trim(to_char_dat)//
" ;char> "//trim(to_char_tmp)
774 to_char_dat=
"VALUE: "
775 if (
c_e(idat)) to_char_dat=trim(to_char_dat)//
" ;int> "//trim(
to_char(idat))
776 if (
c_e(rdat)) to_char_dat=trim(to_char_dat)//
" ;real> "//trim(
to_char(rdat))
777 if (
c_e(ddat)) to_char_dat=trim(to_char_dat)//
" ;double> "//trim(
to_char(ddat))
778 if (
c_e(bdat)) to_char_dat=trim(to_char_dat)//
" ;byte> "//trim(
to_char(bdat))
779 if (
c_e(cdat)) to_char_dat=trim(to_char_dat)//
" ;char> "//trim(cdat)
783 END FUNCTION to_char_dat
788 FUNCTION vol7d_c_e(this) RESULT(c_e)
789 TYPE(vol7d),
INTENT(in) :: this
793 c_e =
ASSOCIATED(this%ana) .OR.
ASSOCIATED(this%time) .OR. &
794 ASSOCIATED(this%level) .OR.
ASSOCIATED(this%timerange) .OR. &
795 ASSOCIATED(this%network) .OR. &
796 ASSOCIATED(this%anavar%r) .OR.
ASSOCIATED(this%anavar%d) .OR. &
797 ASSOCIATED(this%anavar%i) .OR.
ASSOCIATED(this%anavar%b) .OR. &
798 ASSOCIATED(this%anavar%c) .OR. &
799 ASSOCIATED(this%anaattr%r) .OR.
ASSOCIATED(this%anaattr%d) .OR. &
800 ASSOCIATED(this%anaattr%i) .OR.
ASSOCIATED(this%anaattr%b) .OR. &
801 ASSOCIATED(this%anaattr%c) .OR. &
802 ASSOCIATED(this%dativar%r) .OR.
ASSOCIATED(this%dativar%d) .OR. &
803 ASSOCIATED(this%dativar%i) .OR.
ASSOCIATED(this%dativar%b) .OR. &
804 ASSOCIATED(this%dativar%c) .OR. &
805 ASSOCIATED(this%datiattr%r) .OR.
ASSOCIATED(this%datiattr%d) .OR. &
806 ASSOCIATED(this%datiattr%i) .OR.
ASSOCIATED(this%datiattr%b) .OR. &
807 ASSOCIATED(this%datiattr%c)
809 END FUNCTION vol7d_c_e
850 SUBROUTINE vol7d_alloc(this, nana, ntime, nlevel, ntimerange, nnetwork, &
851 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
852 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
853 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
854 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
855 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
856 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc, &
858 TYPE(vol7d),
INTENT(inout) :: this
859 INTEGER,
INTENT(in),
OPTIONAL :: nana
860 INTEGER,
INTENT(in),
OPTIONAL :: ntime
861 INTEGER,
INTENT(in),
OPTIONAL :: nlevel
862 INTEGER,
INTENT(in),
OPTIONAL :: ntimerange
863 INTEGER,
INTENT(in),
OPTIONAL :: nnetwork
865 INTEGER,
INTENT(in),
OPTIONAL :: &
866 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
867 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
868 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
869 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
870 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
871 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc
872 LOGICAL,
INTENT(in),
OPTIONAL :: ini
877 IF (present(ini))
THEN
884 IF (present(nana))
THEN
886 IF (
ASSOCIATED(this%ana))
DEALLOCATE(this%ana)
887 ALLOCATE(this%ana(nana))
890 CALL
init(this%ana(i))
895 IF (present(ntime))
THEN
897 IF (
ASSOCIATED(this%time))
DEALLOCATE(this%time)
898 ALLOCATE(this%time(ntime))
901 CALL
init(this%time(i))
906 IF (present(nlevel))
THEN
907 IF (nlevel >= 0)
THEN
908 IF (
ASSOCIATED(this%level))
DEALLOCATE(this%level)
909 ALLOCATE(this%level(nlevel))
912 CALL
init(this%level(i))
917 IF (present(ntimerange))
THEN
918 IF (ntimerange >= 0)
THEN
919 IF (
ASSOCIATED(this%timerange))
DEALLOCATE(this%timerange)
920 ALLOCATE(this%timerange(ntimerange))
923 CALL
init(this%timerange(i))
928 IF (present(nnetwork))
THEN
929 IF (nnetwork >= 0)
THEN
930 IF (
ASSOCIATED(this%network))
DEALLOCATE(this%network)
931 ALLOCATE(this%network(nnetwork))
934 CALL
init(this%network(i))
940 CALL vol7d_varvect_alloc(this%anavar, nanavarr, nanavard, &
941 nanavari, nanavarb, nanavarc, ini)
942 CALL vol7d_varvect_alloc(this%anaattr, nanaattrr, nanaattrd, &
943 nanaattri, nanaattrb, nanaattrc, ini)
944 CALL vol7d_varvect_alloc(this%anavarattr, nanavarattrr, nanavarattrd, &
945 nanavarattri, nanavarattrb, nanavarattrc, ini)
946 CALL vol7d_varvect_alloc(this%dativar, ndativarr, ndativard, &
947 ndativari, ndativarb, ndativarc, ini)
948 CALL vol7d_varvect_alloc(this%datiattr, ndatiattrr, ndatiattrd, &
949 ndatiattri, ndatiattrb, ndatiattrc, ini)
950 CALL vol7d_varvect_alloc(this%dativarattr, ndativarattrr, ndativarattrd, &
951 ndativarattri, ndativarattrb, ndativarattrc, ini)
953 END SUBROUTINE vol7d_alloc
956 FUNCTION vol7d_check_alloc_ana(this)
957 TYPE(vol7d),
INTENT(in) :: this
958 LOGICAL :: vol7d_check_alloc_ana
960 vol7d_check_alloc_ana =
ASSOCIATED(this%ana) .AND.
ASSOCIATED(this%network)
962 END FUNCTION vol7d_check_alloc_ana
964 SUBROUTINE vol7d_force_alloc_ana(this, ini)
965 TYPE(vol7d),
INTENT(inout) :: this
966 LOGICAL,
INTENT(in),
OPTIONAL :: ini
969 IF (.NOT.
ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=1, ini=ini)
970 IF (.NOT.
ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=1, ini=ini)
972 END SUBROUTINE vol7d_force_alloc_ana
975 FUNCTION vol7d_check_alloc_dati(this)
976 TYPE(vol7d),
INTENT(in) :: this
977 LOGICAL :: vol7d_check_alloc_dati
979 vol7d_check_alloc_dati = vol7d_check_alloc_ana(this) .AND. &
980 ASSOCIATED(this%time) .AND.
ASSOCIATED(this%level) .AND. &
981 ASSOCIATED(this%timerange)
983 END FUNCTION vol7d_check_alloc_dati
985 SUBROUTINE vol7d_force_alloc_dati(this, ini)
986 TYPE(vol7d),
INTENT(inout) :: this
987 LOGICAL,
INTENT(in),
OPTIONAL :: ini
990 CALL vol7d_force_alloc_ana(this, ini)
991 IF (.NOT.
ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=1, ini=ini)
992 IF (.NOT.
ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=1, ini=ini)
993 IF (.NOT.
ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=1, ini=ini)
995 END SUBROUTINE vol7d_force_alloc_dati
998 SUBROUTINE vol7d_force_alloc(this)
999 TYPE(vol7d),
INTENT(inout) :: this
1002 IF (.NOT.
ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=0)
1003 IF (.NOT.
ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=0)
1004 IF (.NOT.
ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=0)
1005 IF (.NOT.
ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=0)
1006 IF (.NOT.
ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=0)
1008 END SUBROUTINE vol7d_force_alloc
1011 FUNCTION vol7d_check_vol(this)
1012 TYPE(vol7d),
INTENT(in) :: this
1013 LOGICAL :: vol7d_check_vol
1015 vol7d_check_vol =
c_e(this)
1018 IF (
ASSOCIATED(this%anavar%r) .AND. .NOT.
ASSOCIATED(this%volanar))
THEN
1019 vol7d_check_vol = .false.
1022 IF (
ASSOCIATED(this%anavar%d) .AND. .NOT.
ASSOCIATED(this%volanad))
THEN
1023 vol7d_check_vol = .false.
1026 IF (
ASSOCIATED(this%anavar%i) .AND. .NOT.
ASSOCIATED(this%volanai))
THEN
1027 vol7d_check_vol = .false.
1030 IF (
ASSOCIATED(this%anavar%b) .AND. .NOT.
ASSOCIATED(this%volanab))
THEN
1031 vol7d_check_vol = .false.
1034 IF (
ASSOCIATED(this%anavar%c) .AND. .NOT.
ASSOCIATED(this%volanac))
THEN
1035 vol7d_check_vol = .false.
1037 IF (
ASSOCIATED(this%anavar%r) .OR.
ASSOCIATED(this%anavar%d) .OR. &
1038 ASSOCIATED(this%anavar%i) .OR.
ASSOCIATED(this%anavar%b) .OR. &
1039 ASSOCIATED(this%anavar%c))
THEN
1040 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_ana(this)
1044 IF (
ASSOCIATED(this%anaattr%r) .AND.
ASSOCIATED(this%anavarattr%r) .AND. &
1045 .NOT.
ASSOCIATED(this%volanaattrr))
THEN
1046 vol7d_check_vol = .false.
1049 IF (
ASSOCIATED(this%anaattr%d) .AND.
ASSOCIATED(this%anavarattr%d) .AND. &
1050 .NOT.
ASSOCIATED(this%volanaattrd))
THEN
1051 vol7d_check_vol = .false.
1054 IF (
ASSOCIATED(this%anaattr%i) .AND.
ASSOCIATED(this%anavarattr%i) .AND. &
1055 .NOT.
ASSOCIATED(this%volanaattri))
THEN
1056 vol7d_check_vol = .false.
1059 IF (
ASSOCIATED(this%anaattr%b) .AND.
ASSOCIATED(this%anavarattr%b) .AND. &
1060 .NOT.
ASSOCIATED(this%volanaattrb))
THEN
1061 vol7d_check_vol = .false.
1064 IF (
ASSOCIATED(this%anaattr%c) .AND.
ASSOCIATED(this%anavarattr%c) .AND. &
1065 .NOT.
ASSOCIATED(this%volanaattrc))
THEN
1066 vol7d_check_vol = .false.
1070 IF (
ASSOCIATED(this%dativar%r) .AND. .NOT.
ASSOCIATED(this%voldatir))
THEN
1071 vol7d_check_vol = .false.
1074 IF (
ASSOCIATED(this%dativar%d) .AND. .NOT.
ASSOCIATED(this%voldatid))
THEN
1075 vol7d_check_vol = .false.
1078 IF (
ASSOCIATED(this%dativar%i) .AND. .NOT.
ASSOCIATED(this%voldatii))
THEN
1079 vol7d_check_vol = .false.
1082 IF (
ASSOCIATED(this%dativar%b) .AND. .NOT.
ASSOCIATED(this%voldatib))
THEN
1083 vol7d_check_vol = .false.
1086 IF (
ASSOCIATED(this%dativar%c) .AND. .NOT.
ASSOCIATED(this%voldatic))
THEN
1087 vol7d_check_vol = .false.
1091 IF (
ASSOCIATED(this%datiattr%r) .AND.
ASSOCIATED(this%dativarattr%r) .AND. &
1092 .NOT.
ASSOCIATED(this%voldatiattrr))
THEN
1093 vol7d_check_vol = .false.
1096 IF (
ASSOCIATED(this%datiattr%d) .AND.
ASSOCIATED(this%dativarattr%d) .AND. &
1097 .NOT.
ASSOCIATED(this%voldatiattrd))
THEN
1098 vol7d_check_vol = .false.
1101 IF (
ASSOCIATED(this%datiattr%i) .AND.
ASSOCIATED(this%dativarattr%i) .AND. &
1102 .NOT.
ASSOCIATED(this%voldatiattri))
THEN
1103 vol7d_check_vol = .false.
1106 IF (
ASSOCIATED(this%datiattr%b) .AND.
ASSOCIATED(this%dativarattr%b) .AND. &
1107 .NOT.
ASSOCIATED(this%voldatiattrb))
THEN
1108 vol7d_check_vol = .false.
1111 IF (
ASSOCIATED(this%datiattr%c) .AND.
ASSOCIATED(this%dativarattr%c) .AND. &
1112 .NOT.
ASSOCIATED(this%voldatiattrc))
THEN
1113 vol7d_check_vol = .false.
1115 IF (
ASSOCIATED(this%dativar%r) .OR.
ASSOCIATED(this%dativar%d) .OR. &
1116 ASSOCIATED(this%dativar%i) .OR.
ASSOCIATED(this%dativar%b) .OR. &
1117 ASSOCIATED(this%dativar%c))
THEN
1118 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_dati(this)
1121 END FUNCTION vol7d_check_vol
1138 SUBROUTINE vol7d_alloc_vol(this, ini, inivol)
1139 TYPE(vol7d),
INTENT(inout) :: this
1140 LOGICAL,
INTENT(in),
OPTIONAL :: ini
1141 LOGICAL,
INTENT(in),
OPTIONAL :: inivol
1145 IF (present(inivol))
THEN
1152 IF (
ASSOCIATED(this%anavar%r) .AND. .NOT.
ASSOCIATED(this%volanar))
THEN
1153 CALL vol7d_force_alloc_ana(this, ini)
1154 ALLOCATE(this%volanar(
SIZE(this%ana),
SIZE(this%anavar%r),
SIZE(this%network)))
1155 IF (linivol) this%volanar(:,:,:) = rmiss
1158 IF (
ASSOCIATED(this%anavar%d) .AND. .NOT.
ASSOCIATED(this%volanad))
THEN
1159 CALL vol7d_force_alloc_ana(this, ini)
1160 ALLOCATE(this%volanad(
SIZE(this%ana),
SIZE(this%anavar%d),
SIZE(this%network)))
1161 IF (linivol) this%volanad(:,:,:) = rdmiss
1164 IF (
ASSOCIATED(this%anavar%i) .AND. .NOT.
ASSOCIATED(this%volanai))
THEN
1165 CALL vol7d_force_alloc_ana(this, ini)
1166 ALLOCATE(this%volanai(
SIZE(this%ana),
SIZE(this%anavar%i),
SIZE(this%network)))
1167 IF (linivol) this%volanai(:,:,:) = imiss
1170 IF (
ASSOCIATED(this%anavar%b) .AND. .NOT.
ASSOCIATED(this%volanab))
THEN
1171 CALL vol7d_force_alloc_ana(this, ini)
1172 ALLOCATE(this%volanab(
SIZE(this%ana),
SIZE(this%anavar%b),
SIZE(this%network)))
1173 IF (linivol) this%volanab(:,:,:) = ibmiss
1176 IF (
ASSOCIATED(this%anavar%c) .AND. .NOT.
ASSOCIATED(this%volanac))
THEN
1177 CALL vol7d_force_alloc_ana(this, ini)
1178 ALLOCATE(this%volanac(
SIZE(this%ana),
SIZE(this%anavar%c),
SIZE(this%network)))
1179 IF (linivol) this%volanac(:,:,:) = cmiss
1183 IF (
ASSOCIATED(this%anaattr%r) .AND.
ASSOCIATED(this%anavarattr%r) .AND. &
1184 .NOT.
ASSOCIATED(this%volanaattrr))
THEN
1185 CALL vol7d_force_alloc_ana(this, ini)
1186 ALLOCATE(this%volanaattrr(
SIZE(this%ana),
SIZE(this%anavarattr%r), &
1187 SIZE(this%network),
SIZE(this%anaattr%r)))
1188 IF (linivol) this%volanaattrr(:,:,:,:) = rmiss
1191 IF (
ASSOCIATED(this%anaattr%d) .AND.
ASSOCIATED(this%anavarattr%d) .AND. &
1192 .NOT.
ASSOCIATED(this%volanaattrd))
THEN
1193 CALL vol7d_force_alloc_ana(this, ini)
1194 ALLOCATE(this%volanaattrd(
SIZE(this%ana),
SIZE(this%anavarattr%d), &
1195 SIZE(this%network),
SIZE(this%anaattr%d)))
1196 IF (linivol) this%volanaattrd(:,:,:,:) = rdmiss
1199 IF (
ASSOCIATED(this%anaattr%i) .AND.
ASSOCIATED(this%anavarattr%i) .AND. &
1200 .NOT.
ASSOCIATED(this%volanaattri))
THEN
1201 CALL vol7d_force_alloc_ana(this, ini)
1202 ALLOCATE(this%volanaattri(
SIZE(this%ana),
SIZE(this%anavarattr%i), &
1203 SIZE(this%network),
SIZE(this%anaattr%i)))
1204 IF (linivol) this%volanaattri(:,:,:,:) = imiss
1207 IF (
ASSOCIATED(this%anaattr%b) .AND.
ASSOCIATED(this%anavarattr%b) .AND. &
1208 .NOT.
ASSOCIATED(this%volanaattrb))
THEN
1209 CALL vol7d_force_alloc_ana(this, ini)
1210 ALLOCATE(this%volanaattrb(
SIZE(this%ana),
SIZE(this%anavarattr%b), &
1211 SIZE(this%network),
SIZE(this%anaattr%b)))
1212 IF (linivol) this%volanaattrb(:,:,:,:) = ibmiss
1215 IF (
ASSOCIATED(this%anaattr%c) .AND.
ASSOCIATED(this%anavarattr%c) .AND. &
1216 .NOT.
ASSOCIATED(this%volanaattrc))
THEN
1217 CALL vol7d_force_alloc_ana(this, ini)
1218 ALLOCATE(this%volanaattrc(
SIZE(this%ana),
SIZE(this%anavarattr%c), &
1219 SIZE(this%network),
SIZE(this%anaattr%c)))
1220 IF (linivol) this%volanaattrc(:,:,:,:) = cmiss
1224 IF (
ASSOCIATED(this%dativar%r) .AND. .NOT.
ASSOCIATED(this%voldatir))
THEN
1225 CALL vol7d_force_alloc_dati(this, ini)
1226 ALLOCATE(this%voldatir(
SIZE(this%ana),
SIZE(this%time),
SIZE(this%level), &
1227 SIZE(this%timerange),
SIZE(this%dativar%r),
SIZE(this%network)))
1228 IF (linivol) this%voldatir(:,:,:,:,:,:) = rmiss
1231 IF (
ASSOCIATED(this%dativar%d) .AND. .NOT.
ASSOCIATED(this%voldatid))
THEN
1232 CALL vol7d_force_alloc_dati(this, ini)
1233 ALLOCATE(this%voldatid(
SIZE(this%ana),
SIZE(this%time),
SIZE(this%level), &
1234 SIZE(this%timerange),
SIZE(this%dativar%d),
SIZE(this%network)))
1235 IF (linivol) this%voldatid(:,:,:,:,:,:) = rdmiss
1238 IF (
ASSOCIATED(this%dativar%i) .AND. .NOT.
ASSOCIATED(this%voldatii))
THEN
1239 CALL vol7d_force_alloc_dati(this, ini)
1240 ALLOCATE(this%voldatii(
SIZE(this%ana),
SIZE(this%time),
SIZE(this%level), &
1241 SIZE(this%timerange),
SIZE(this%dativar%i),
SIZE(this%network)))
1242 IF (linivol) this%voldatii(:,:,:,:,:,:) = imiss
1245 IF (
ASSOCIATED(this%dativar%b) .AND. .NOT.
ASSOCIATED(this%voldatib))
THEN
1246 CALL vol7d_force_alloc_dati(this, ini)
1247 ALLOCATE(this%voldatib(
SIZE(this%ana),
SIZE(this%time),
SIZE(this%level), &
1248 SIZE(this%timerange),
SIZE(this%dativar%b),
SIZE(this%network)))
1249 IF (linivol) this%voldatib(:,:,:,:,:,:) = ibmiss
1252 IF (
ASSOCIATED(this%dativar%c) .AND. .NOT.
ASSOCIATED(this%voldatic))
THEN
1253 CALL vol7d_force_alloc_dati(this, ini)
1254 ALLOCATE(this%voldatic(
SIZE(this%ana),
SIZE(this%time),
SIZE(this%level), &
1255 SIZE(this%timerange),
SIZE(this%dativar%c),
SIZE(this%network)))
1256 IF (linivol) this%voldatic(:,:,:,:,:,:) = cmiss
1260 IF (
ASSOCIATED(this%datiattr%r) .AND.
ASSOCIATED(this%dativarattr%r) .AND. &
1261 .NOT.
ASSOCIATED(this%voldatiattrr))
THEN
1262 CALL vol7d_force_alloc_dati(this, ini)
1263 ALLOCATE(this%voldatiattrr(
SIZE(this%ana),
SIZE(this%time),
SIZE(this%level), &
1264 SIZE(this%timerange),
SIZE(this%dativarattr%r),
SIZE(this%network), &
1265 SIZE(this%datiattr%r)))
1266 IF (linivol) this%voldatiattrr(:,:,:,:,:,:,:) = rmiss
1269 IF (
ASSOCIATED(this%datiattr%d) .AND.
ASSOCIATED(this%dativarattr%d) .AND. &
1270 .NOT.
ASSOCIATED(this%voldatiattrd))
THEN
1271 CALL vol7d_force_alloc_dati(this, ini)
1272 ALLOCATE(this%voldatiattrd(
SIZE(this%ana),
SIZE(this%time),
SIZE(this%level), &
1273 SIZE(this%timerange),
SIZE(this%dativarattr%d),
SIZE(this%network), &
1274 SIZE(this%datiattr%d)))
1275 IF (linivol) this%voldatiattrd(:,:,:,:,:,:,:) = rdmiss
1278 IF (
ASSOCIATED(this%datiattr%i) .AND.
ASSOCIATED(this%dativarattr%i) .AND. &
1279 .NOT.
ASSOCIATED(this%voldatiattri))
THEN
1280 CALL vol7d_force_alloc_dati(this, ini)
1281 ALLOCATE(this%voldatiattri(
SIZE(this%ana),
SIZE(this%time),
SIZE(this%level), &
1282 SIZE(this%timerange),
SIZE(this%dativarattr%i),
SIZE(this%network), &
1283 SIZE(this%datiattr%i)))
1284 IF (linivol) this%voldatiattri(:,:,:,:,:,:,:) = imiss
1287 IF (
ASSOCIATED(this%datiattr%b) .AND.
ASSOCIATED(this%dativarattr%b) .AND. &
1288 .NOT.
ASSOCIATED(this%voldatiattrb))
THEN
1289 CALL vol7d_force_alloc_dati(this, ini)
1290 ALLOCATE(this%voldatiattrb(
SIZE(this%ana),
SIZE(this%time),
SIZE(this%level), &
1291 SIZE(this%timerange),
SIZE(this%dativarattr%b),
SIZE(this%network), &
1292 SIZE(this%datiattr%b)))
1293 IF (linivol) this%voldatiattrb(:,:,:,:,:,:,:) = ibmiss
1296 IF (
ASSOCIATED(this%datiattr%c) .AND.
ASSOCIATED(this%dativarattr%c) .AND. &
1297 .NOT.
ASSOCIATED(this%voldatiattrc))
THEN
1298 CALL vol7d_force_alloc_dati(this, ini)
1299 ALLOCATE(this%voldatiattrc(
SIZE(this%ana),
SIZE(this%time),
SIZE(this%level), &
1300 SIZE(this%timerange),
SIZE(this%dativarattr%c),
SIZE(this%network), &
1301 SIZE(this%datiattr%c)))
1302 IF (linivol) this%voldatiattrc(:,:,:,:,:,:,:) = cmiss
1306 CALL vol7d_force_alloc(this)
1311 CALL l4f_log(l4f_debug,
"calling: vol7d_set_attr_ind")
1314 CALL vol7d_set_attr_ind(this)
1318 END SUBROUTINE vol7d_alloc_vol
1327 SUBROUTINE vol7d_set_attr_ind(this)
1328 TYPE(vol7d),
INTENT(inout) :: this
1333 IF (
ASSOCIATED(this%dativar%r))
THEN
1334 IF (
ASSOCIATED(this%dativarattr%r))
THEN
1335 DO i = 1,
SIZE(this%dativar%r)
1336 this%dativar%r(i)%r = &
1337 firsttrue(this%dativar%r(i)%btable == this%dativarattr%r(:)%btable)
1341 IF (
ASSOCIATED(this%dativarattr%d))
THEN
1342 DO i = 1,
SIZE(this%dativar%r)
1343 this%dativar%r(i)%d = &
1344 firsttrue(this%dativar%r(i)%btable == this%dativarattr%d(:)%btable)
1348 IF (
ASSOCIATED(this%dativarattr%i))
THEN
1349 DO i = 1,
SIZE(this%dativar%r)
1350 this%dativar%r(i)%i = &
1351 firsttrue(this%dativar%r(i)%btable == this%dativarattr%i(:)%btable)
1355 IF (
ASSOCIATED(this%dativarattr%b))
THEN
1356 DO i = 1,
SIZE(this%dativar%r)
1357 this%dativar%r(i)%b = &
1358 firsttrue(this%dativar%r(i)%btable == this%dativarattr%b(:)%btable)
1362 IF (
ASSOCIATED(this%dativarattr%c))
THEN
1363 DO i = 1,
SIZE(this%dativar%r)
1364 this%dativar%r(i)%c = &
1365 firsttrue(this%dativar%r(i)%btable == this%dativarattr%c(:)%btable)
1370 IF (
ASSOCIATED(this%dativar%d))
THEN
1371 IF (
ASSOCIATED(this%dativarattr%r))
THEN
1372 DO i = 1,
SIZE(this%dativar%d)
1373 this%dativar%d(i)%r = &
1374 firsttrue(this%dativar%d(i)%btable == this%dativarattr%r(:)%btable)
1378 IF (
ASSOCIATED(this%dativarattr%d))
THEN
1379 DO i = 1,
SIZE(this%dativar%d)
1380 this%dativar%d(i)%d = &
1381 firsttrue(this%dativar%d(i)%btable == this%dativarattr%d(:)%btable)
1385 IF (
ASSOCIATED(this%dativarattr%i))
THEN
1386 DO i = 1,
SIZE(this%dativar%d)
1387 this%dativar%d(i)%i = &
1388 firsttrue(this%dativar%d(i)%btable == this%dativarattr%i(:)%btable)
1392 IF (
ASSOCIATED(this%dativarattr%b))
THEN
1393 DO i = 1,
SIZE(this%dativar%d)
1394 this%dativar%d(i)%b = &
1395 firsttrue(this%dativar%d(i)%btable == this%dativarattr%b(:)%btable)
1399 IF (
ASSOCIATED(this%dativarattr%c))
THEN
1400 DO i = 1,
SIZE(this%dativar%d)
1401 this%dativar%d(i)%c = &
1402 firsttrue(this%dativar%d(i)%btable == this%dativarattr%c(:)%btable)
1407 IF (
ASSOCIATED(this%dativar%i))
THEN
1408 IF (
ASSOCIATED(this%dativarattr%r))
THEN
1409 DO i = 1,
SIZE(this%dativar%i)
1410 this%dativar%i(i)%r = &
1411 firsttrue(this%dativar%i(i)%btable == this%dativarattr%r(:)%btable)
1415 IF (
ASSOCIATED(this%dativarattr%d))
THEN
1416 DO i = 1,
SIZE(this%dativar%i)
1417 this%dativar%i(i)%d = &
1418 firsttrue(this%dativar%i(i)%btable == this%dativarattr%d(:)%btable)
1422 IF (
ASSOCIATED(this%dativarattr%i))
THEN
1423 DO i = 1,
SIZE(this%dativar%i)
1424 this%dativar%i(i)%i = &
1425 firsttrue(this%dativar%i(i)%btable == this%dativarattr%i(:)%btable)
1429 IF (
ASSOCIATED(this%dativarattr%b))
THEN
1430 DO i = 1,
SIZE(this%dativar%i)
1431 this%dativar%i(i)%b = &
1432 firsttrue(this%dativar%i(i)%btable == this%dativarattr%b(:)%btable)
1436 IF (
ASSOCIATED(this%dativarattr%c))
THEN
1437 DO i = 1,
SIZE(this%dativar%i)
1438 this%dativar%i(i)%c = &
1439 firsttrue(this%dativar%i(i)%btable == this%dativarattr%c(:)%btable)
1444 IF (
ASSOCIATED(this%dativar%b))
THEN
1445 IF (
ASSOCIATED(this%dativarattr%r))
THEN
1446 DO i = 1,
SIZE(this%dativar%b)
1447 this%dativar%b(i)%r = &
1448 firsttrue(this%dativar%b(i)%btable == this%dativarattr%r(:)%btable)
1452 IF (
ASSOCIATED(this%dativarattr%d))
THEN
1453 DO i = 1,
SIZE(this%dativar%b)
1454 this%dativar%b(i)%d = &
1455 firsttrue(this%dativar%b(i)%btable == this%dativarattr%d(:)%btable)
1459 IF (
ASSOCIATED(this%dativarattr%i))
THEN
1460 DO i = 1,
SIZE(this%dativar%b)
1461 this%dativar%b(i)%i = &
1462 firsttrue(this%dativar%b(i)%btable == this%dativarattr%i(:)%btable)
1466 IF (
ASSOCIATED(this%dativarattr%b))
THEN
1467 DO i = 1,
SIZE(this%dativar%b)
1468 this%dativar%b(i)%b = &
1469 firsttrue(this%dativar%b(i)%btable == this%dativarattr%b(:)%btable)
1473 IF (
ASSOCIATED(this%dativarattr%c))
THEN
1474 DO i = 1,
SIZE(this%dativar%b)
1475 this%dativar%b(i)%c = &
1476 firsttrue(this%dativar%b(i)%btable == this%dativarattr%c(:)%btable)
1481 IF (
ASSOCIATED(this%dativar%c))
THEN
1482 IF (
ASSOCIATED(this%dativarattr%r))
THEN
1483 DO i = 1,
SIZE(this%dativar%c)
1484 this%dativar%c(i)%r = &
1485 firsttrue(this%dativar%c(i)%btable == this%dativarattr%r(:)%btable)
1489 IF (
ASSOCIATED(this%dativarattr%d))
THEN
1490 DO i = 1,
SIZE(this%dativar%c)
1491 this%dativar%c(i)%d = &
1492 firsttrue(this%dativar%c(i)%btable == this%dativarattr%d(:)%btable)
1496 IF (
ASSOCIATED(this%dativarattr%i))
THEN
1497 DO i = 1,
SIZE(this%dativar%c)
1498 this%dativar%c(i)%i = &
1499 firsttrue(this%dativar%c(i)%btable == this%dativarattr%i(:)%btable)
1503 IF (
ASSOCIATED(this%dativarattr%b))
THEN
1504 DO i = 1,
SIZE(this%dativar%c)
1505 this%dativar%c(i)%b = &
1506 firsttrue(this%dativar%c(i)%btable == this%dativarattr%b(:)%btable)
1510 IF (
ASSOCIATED(this%dativarattr%c))
THEN
1511 DO i = 1,
SIZE(this%dativar%c)
1512 this%dativar%c(i)%c = &
1513 firsttrue(this%dativar%c(i)%btable == this%dativarattr%c(:)%btable)
1518 END SUBROUTINE vol7d_set_attr_ind
1525 SUBROUTINE vol7d_merge(this, that, sort, bestdata, &
1526 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
1527 TYPE(vol7d),
INTENT(INOUT) :: this
1528 type(
vol7d),
INTENT(INOUT) :: that
1529 LOGICAL,
INTENT(IN),
OPTIONAL ::
sort
1530 LOGICAL,
INTENT(in),
OPTIONAL :: bestdata
1531 LOGICAL,
INTENT(IN),
OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple
1533 TYPE(vol7d) :: v7d_clean
1536 IF (.NOT.
c_e(this))
THEN
1538 CALL
init(v7d_clean)
1541 CALL vol7d_append(this, that,
sort, bestdata, &
1542 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
1546 END SUBROUTINE vol7d_merge
1577 SUBROUTINE vol7d_append(this, that, sort, bestdata, &
1578 ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple)
1579 TYPE(vol7d),
INTENT(INOUT) :: this
1580 type(
vol7d),
INTENT(IN) :: that
1581 LOGICAL,
INTENT(IN),
OPTIONAL ::
sort
1585 LOGICAL,
INTENT(in),
OPTIONAL :: bestdata
1586 LOGICAL,
INTENT(IN),
OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple
1589 TYPE(vol7d) :: v7dtmp
1590 LOGICAL :: lsort, lbestdata
1591 INTEGER,
POINTER :: remapt1(:), remapt2(:), remaptr1(:), remaptr2(:), &
1592 remapl1(:), remapl2(:), remapa1(:), remapa2(:), remapn1(:), remapn2(:)
1594 IF (.NOT.
c_e(that))
RETURN
1595 IF (.NOT.vol7d_check_vol(that))
RETURN
1596 IF (.NOT.
c_e(this))
THEN
1597 CALL vol7d_copy(that, this,
sort=
sort)
1601 IF (this%time_definition /= that%time_definition)
THEN
1602 CALL l4f_log(l4f_fatal, &
1603 'in vol7d_append, cannot append volumes with different &
1605 CALL raise_fatal_error()
1609 CALL vol7d_alloc_vol(this)
1611 CALL
init(v7dtmp, time_definition=this%time_definition)
1613 CALL
optio(bestdata, lbestdata)
1617 IF (optio_log(ltimesimple))
THEN
1618 CALL vol7d_remap2simple_datetime(this%time, that%time, v7dtmp%time, &
1619 lsort, remapt1, remapt2)
1621 CALL vol7d_remap2_datetime(this%time, that%time, v7dtmp%time, &
1622 lsort, remapt1, remapt2)
1624 IF (optio_log(ltimerangesimple))
THEN
1625 CALL vol7d_remap2simple_vol7d_timerange(this%timerange, that%timerange, &
1626 v7dtmp%timerange, lsort, remaptr1, remaptr2)
1628 CALL vol7d_remap2_vol7d_timerange(this%timerange, that%timerange, &
1629 v7dtmp%timerange, lsort, remaptr1, remaptr2)
1631 IF (optio_log(llevelsimple))
THEN
1632 CALL vol7d_remap2simple_vol7d_level(this%level, that%level, v7dtmp%level, &
1633 lsort, remapl1, remapl2)
1635 CALL vol7d_remap2_vol7d_level(this%level, that%level, v7dtmp%level, &
1636 lsort, remapl1, remapl2)
1638 IF (optio_log(lanasimple))
THEN
1639 CALL vol7d_remap2simple_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
1640 .false., remapa1, remapa2)
1642 CALL vol7d_remap2_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
1643 .false., remapa1, remapa2)
1645 IF (optio_log(lnetworksimple))
THEN
1646 CALL vol7d_remap2simple_vol7d_network(this%network, that%network, v7dtmp%network, &
1647 .false., remapn1, remapn2)
1649 CALL vol7d_remap2_vol7d_network(this%network, that%network, v7dtmp%network, &
1650 .false., remapn1, remapn2)
1654 CALL vol7d_merge_finalr(this, that, v7dtmp, &
1655 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
1656 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
1657 CALL vol7d_merge_finald(this, that, v7dtmp, &
1658 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
1659 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
1660 CALL vol7d_merge_finali(this, that, v7dtmp, &
1661 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
1662 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
1663 CALL vol7d_merge_finalb(this, that, v7dtmp, &
1664 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
1665 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
1666 CALL vol7d_merge_finalc(this, that, v7dtmp, &
1667 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
1668 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
1671 IF (
ASSOCIATED(remapt1))
DEALLOCATE(remapt1)
1672 IF (
ASSOCIATED(remapt2))
DEALLOCATE(remapt2)
1673 IF (
ASSOCIATED(remaptr1))
DEALLOCATE(remaptr1)
1674 IF (
ASSOCIATED(remaptr2))
DEALLOCATE(remaptr2)
1675 IF (
ASSOCIATED(remapl1))
DEALLOCATE(remapl1)
1676 IF (
ASSOCIATED(remapl2))
DEALLOCATE(remapl2)
1677 IF (
ASSOCIATED(remapa1))
DEALLOCATE(remapa1)
1678 IF (
ASSOCIATED(remapa2))
DEALLOCATE(remapa2)
1679 IF (
ASSOCIATED(remapn1))
DEALLOCATE(remapn1)
1680 IF (
ASSOCIATED(remapn2))
DEALLOCATE(remapn2)
1686 CALL vol7d_set_attr_ind(this)
1688 END SUBROUTINE vol7d_append
1723 SUBROUTINE vol7d_copy(this, that, sort, unique, miss, &
1724 lsort_time, lsort_timerange, lsort_level, &
1725 ltime, ltimerange, llevel, lana, lnetwork, &
1726 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
1727 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
1728 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
1729 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
1730 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
1731 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
1732 TYPE(vol7d),
INTENT(IN) :: this
1733 type(
vol7d),
INTENT(INOUT) :: that
1734 LOGICAL,
INTENT(IN),
OPTIONAL ::
sort
1735 LOGICAL,
INTENT(IN),
OPTIONAL :: unique
1736 LOGICAL,
INTENT(IN),
OPTIONAL :: miss
1737 LOGICAL,
INTENT(IN),
OPTIONAL :: lsort_time
1738 LOGICAL,
INTENT(IN),
OPTIONAL :: lsort_timerange
1739 LOGICAL,
INTENT(IN),
OPTIONAL :: lsort_level
1747 LOGICAL,
INTENT(IN),
OPTIONAL :: ltime(:)
1749 LOGICAL,
INTENT(IN),
OPTIONAL :: ltimerange(:)
1751 LOGICAL,
INTENT(IN),
OPTIONAL :: llevel(:)
1753 LOGICAL,
INTENT(IN),
OPTIONAL :: lana(:)
1755 LOGICAL,
INTENT(IN),
OPTIONAL :: lnetwork(:)
1757 LOGICAL,
INTENT(in),
OPTIONAL :: &
1758 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
1759 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
1760 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
1761 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
1762 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
1763 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
1765 LOGICAL :: lsort, lunique, lmiss
1766 INTEGER,
POINTER :: remapt(:), remaptr(:), remapl(:), remapa(:), remapn(:)
1769 IF (.NOT.
c_e(this))
RETURN
1770 IF (.NOT.vol7d_check_vol(this))
RETURN
1773 CALL
optio(unique, lunique)
1774 CALL
optio(miss, lmiss)
1778 CALL vol7d_remap1_datetime(this%time, that%time, &
1779 lsort.OR.optio_log(lsort_time), lunique, lmiss, remapt, ltime)
1780 CALL vol7d_remap1_vol7d_timerange(this%timerange, that%timerange, &
1781 lsort.OR.optio_log(lsort_timerange), lunique, lmiss, remaptr, ltimerange)
1782 CALL vol7d_remap1_vol7d_level(this%level, that%level, &
1783 lsort.OR.optio_log(lsort_level), lunique, lmiss, remapl, llevel)
1784 CALL vol7d_remap1_vol7d_ana(this%ana, that%ana, &
1785 lsort, lunique, lmiss, remapa, lana)
1786 CALL vol7d_remap1_vol7d_network(this%network, that%network, &
1787 lsort, lunique, lmiss, remapn, lnetwork)
1796 CALL vol7d_reform_finalr(this, that, &
1797 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
1798 lanavarr, lanaattrr, lanavarattrr, ldativarr, ldatiattrr, ldativarattrr)
1799 CALL vol7d_reform_finald(this, that, &
1800 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
1801 lanavard, lanaattrd, lanavarattrd, ldativard, ldatiattrd, ldativarattrd)
1802 CALL vol7d_reform_finali(this, that, &
1803 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
1804 lanavari, lanaattri, lanavarattri, ldativari, ldatiattri, ldativarattri)
1805 CALL vol7d_reform_finalb(this, that, &
1806 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
1807 lanavarb, lanaattrb, lanavarattrb, ldativarb, ldatiattrb, ldativarattrb)
1808 CALL vol7d_reform_finalc(this, that, &
1809 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
1810 lanavarc, lanaattrc, lanavarattrc, ldativarc, ldatiattrc, ldativarattrc)
1813 IF (
ASSOCIATED(remapt))
DEALLOCATE(remapt)
1814 IF (
ASSOCIATED(remaptr))
DEALLOCATE(remaptr)
1815 IF (
ASSOCIATED(remapl))
DEALLOCATE(remapl)
1816 IF (
ASSOCIATED(remapa))
DEALLOCATE(remapa)
1817 IF (
ASSOCIATED(remapn))
DEALLOCATE(remapn)
1820 CALL vol7d_set_attr_ind(that)
1821 that%time_definition = this%time_definition
1823 END SUBROUTINE vol7d_copy
1836 SUBROUTINE vol7d_reform(this, sort, unique, miss, &
1837 lsort_time, lsort_timerange, lsort_level, &
1838 ltime, ltimerange, llevel, lana, lnetwork, &
1839 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
1840 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
1841 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
1842 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
1843 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
1844 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc&
1846 TYPE(vol7d),
INTENT(INOUT) :: this
1847 LOGICAL,
INTENT(IN),
OPTIONAL ::
sort
1848 LOGICAL,
INTENT(IN),
OPTIONAL :: unique
1849 LOGICAL,
INTENT(IN),
OPTIONAL :: miss
1850 LOGICAL,
INTENT(IN),
OPTIONAL :: lsort_time
1851 LOGICAL,
INTENT(IN),
OPTIONAL :: lsort_timerange
1852 LOGICAL,
INTENT(IN),
OPTIONAL :: lsort_level
1860 LOGICAL,
INTENT(IN),
OPTIONAL :: ltime(:)
1861 LOGICAL,
INTENT(IN),
OPTIONAL :: ltimerange(:)
1862 LOGICAL,
INTENT(IN),
OPTIONAL :: llevel(:)
1863 LOGICAL,
INTENT(IN),
OPTIONAL :: lana(:)
1864 LOGICAL,
INTENT(IN),
OPTIONAL :: lnetwork(:)
1866 LOGICAL,
INTENT(in),
OPTIONAL :: &
1867 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
1868 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
1869 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
1870 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
1871 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
1872 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
1873 LOGICAL,
INTENT(IN),
OPTIONAL :: purgeana
1875 TYPE(vol7d) :: v7dtmp
1876 logical,
allocatable :: llana(:)
1879 CALL vol7d_copy(this, v7dtmp,
sort, unique, miss, &
1880 lsort_time, lsort_timerange, lsort_level, &
1881 ltime, ltimerange, llevel, lana, lnetwork, &
1882 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
1883 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
1884 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
1885 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
1886 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
1887 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
1892 if (optio_log(purgeana))
then
1893 allocate(llana(
size(v7dtmp%ana)))
1895 do i =1,
size(v7dtmp%ana)
1896 if (
associated(v7dtmp%voldatii)) llana(i)= llana(i) .or. any(
c_e(v7dtmp%voldatii(i,:,:,:,:,:)))
1897 if (
associated(v7dtmp%voldatir)) llana(i)= llana(i) .or. any(
c_e(v7dtmp%voldatir(i,:,:,:,:,:)))
1898 if (
associated(v7dtmp%voldatid)) llana(i)= llana(i) .or. any(
c_e(v7dtmp%voldatid(i,:,:,:,:,:)))
1899 if (
associated(v7dtmp%voldatib)) llana(i)= llana(i) .or. any(
c_e(v7dtmp%voldatib(i,:,:,:,:,:)))
1900 if (
associated(v7dtmp%voldatic)) llana(i)= llana(i) .or. any(
c_e(v7dtmp%voldatic(i,:,:,:,:,:)))
1902 CALL vol7d_copy(v7dtmp, this,lana=llana)
1909 END SUBROUTINE vol7d_reform
1919 SUBROUTINE vol7d_smart_sort(this, lsort_time, lsort_timerange, lsort_level)
1920 TYPE(vol7d),
INTENT(INOUT) :: this
1921 LOGICAL,
OPTIONAL,
INTENT(in) :: lsort_time
1922 LOGICAL,
OPTIONAL,
INTENT(in) :: lsort_timerange
1923 LOGICAL,
OPTIONAL,
INTENT(in) :: lsort_level
1926 LOGICAL :: to_be_sorted
1928 to_be_sorted = .false.
1929 CALL vol7d_alloc_vol(this)
1931 IF (optio_log(lsort_time))
THEN
1932 DO i = 2,
SIZE(this%time)
1933 IF (this%time(i) < this%time(i-1))
THEN
1934 to_be_sorted = .true.
1939 IF (optio_log(lsort_timerange))
THEN
1940 DO i = 2,
SIZE(this%timerange)
1941 IF (this%timerange(i) < this%timerange(i-1))
THEN
1942 to_be_sorted = .true.
1947 IF (optio_log(lsort_level))
THEN
1948 DO i = 2,
SIZE(this%level)
1949 IF (this%level(i) < this%level(i-1))
THEN
1950 to_be_sorted = .true.
1956 IF (to_be_sorted) CALL vol7d_reform(this, &
1957 lsort_time=lsort_time, lsort_timerange=lsort_timerange, lsort_level=lsort_level )
1959 END SUBROUTINE vol7d_smart_sort
1968 SUBROUTINE vol7d_filter(this, avl, vl, nl, s_d, e_d)
1969 TYPE(vol7d),
INTENT(inout) :: this
1970 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: avl(:)
1971 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: vl(:)
1972 type(vol7d_network),
OPTIONAL :: nl(:)
1973 type(datetime),
INTENT(in),
OPTIONAL :: s_d
1974 type(datetime),
INTENT(in),
OPTIONAL :: e_d
1978 IF (present(avl))
THEN
1979 IF (
SIZE(avl) > 0)
THEN
1981 IF (
ASSOCIATED(this%anavar%r))
THEN
1982 DO i = 1,
SIZE(this%anavar%r)
1983 IF (all(this%anavar%r(i)%btable /= avl)) this%anavar%r(i) = vol7d_var_miss
1987 IF (
ASSOCIATED(this%anavar%i))
THEN
1988 DO i = 1,
SIZE(this%anavar%i)
1989 IF (all(this%anavar%i(i)%btable /= avl)) this%anavar%i(i) = vol7d_var_miss
1993 IF (
ASSOCIATED(this%anavar%b))
THEN
1994 DO i = 1,
SIZE(this%anavar%b)
1995 IF (all(this%anavar%b(i)%btable /= avl)) this%anavar%b(i) = vol7d_var_miss
1999 IF (
ASSOCIATED(this%anavar%d))
THEN
2000 DO i = 1,
SIZE(this%anavar%d)
2001 IF (all(this%anavar%d(i)%btable /= avl)) this%anavar%d(i) = vol7d_var_miss
2005 IF (
ASSOCIATED(this%anavar%c))
THEN
2006 DO i = 1,
SIZE(this%anavar%c)
2007 IF (all(this%anavar%c(i)%btable /= avl)) this%anavar%c(i) = vol7d_var_miss
2015 IF (present(vl))
THEN
2016 IF (
size(vl) > 0)
THEN
2017 IF (
ASSOCIATED(this%dativar%r))
THEN
2018 DO i = 1,
SIZE(this%dativar%r)
2019 IF (all(this%dativar%r(i)%btable /= vl)) this%dativar%r(i) = vol7d_var_miss
2023 IF (
ASSOCIATED(this%dativar%i))
THEN
2024 DO i = 1,
SIZE(this%dativar%i)
2025 IF (all(this%dativar%i(i)%btable /= vl)) this%dativar%i(i) = vol7d_var_miss
2029 IF (
ASSOCIATED(this%dativar%b))
THEN
2030 DO i = 1,
SIZE(this%dativar%b)
2031 IF (all(this%dativar%b(i)%btable /= vl)) this%dativar%b(i) = vol7d_var_miss
2035 IF (
ASSOCIATED(this%dativar%d))
THEN
2036 DO i = 1,
SIZE(this%dativar%d)
2037 IF (all(this%dativar%d(i)%btable /= vl)) this%dativar%d(i) = vol7d_var_miss
2041 IF (
ASSOCIATED(this%dativar%c))
THEN
2042 DO i = 1,
SIZE(this%dativar%c)
2043 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
2047 IF (
ASSOCIATED(this%dativar%c))
THEN
2048 DO i = 1,
SIZE(this%dativar%c)
2049 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
2056 IF (present(nl))
THEN
2057 IF (
SIZE(nl) > 0)
THEN
2058 DO i = 1,
SIZE(this%network)
2059 IF (all(this%network(i) /= nl)) this%network(i) = vol7d_network_miss
2064 IF (present(s_d))
THEN
2066 WHERE (this%time < s_d)
2067 this%time = datetime_miss
2072 IF (present(e_d))
THEN
2074 WHERE (this%time > e_d)
2075 this%time = datetime_miss
2080 CALL vol7d_reform(this, miss=.true.)
2082 END SUBROUTINE vol7d_filter
2091 SUBROUTINE vol7d_convr(this, that, anaconv)
2092 TYPE(vol7d),
INTENT(IN) :: this
2093 type(
vol7d),
INTENT(INOUT) :: that
2094 LOGICAL,
OPTIONAL,
INTENT(in) :: anaconv
2096 LOGICAL :: fv(1)=(/.false./), tv(1)=(/.true./), acp(1), acn(1)
2097 TYPE(vol7d) :: v7d_tmp
2099 IF (optio_log(anaconv))
THEN
2109 CALL vol7d_copy(this, that, &
2110 lanavarr=tv, lanavard=acp, lanavari=acp, lanavarb=acp, lanavarc=acp, &
2111 ldativarr=tv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=fv)
2114 CALL vol7d_copy(this, v7d_tmp, &
2115 lanavarr=fv, lanavard=acn, lanavari=fv, lanavarb=fv, lanavarc=fv, &
2116 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
2117 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
2118 ldativarr=fv, ldativard=tv, ldativari=fv, ldativarb=fv, ldativarc=fv, &
2119 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
2120 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
2123 IF (
ASSOCIATED(v7d_tmp%anavar%d) .OR.
ASSOCIATED(v7d_tmp%dativar%d))
THEN
2125 IF (
ASSOCIATED(v7d_tmp%anavar%d))
THEN
2127 ALLOCATE(v7d_tmp%volanar(
SIZE(v7d_tmp%volanad, 1),
SIZE(v7d_tmp%volanad, 2), &
2128 SIZE(v7d_tmp%volanad, 3)))
2129 DO i = 1,
SIZE(v7d_tmp%anavar%d)
2130 v7d_tmp%volanar(:,i,:) = &
2131 realdat(v7d_tmp%volanad(:,i,:), v7d_tmp%anavar%d(i))
2133 DEALLOCATE(v7d_tmp%volanad)
2135 v7d_tmp%anavar%r => v7d_tmp%anavar%d
2136 nullify(v7d_tmp%anavar%d)
2139 IF (
ASSOCIATED(v7d_tmp%dativar%d))
THEN
2141 ALLOCATE(v7d_tmp%voldatir(
SIZE(v7d_tmp%voldatid, 1),
SIZE(v7d_tmp%voldatid, 2), &
2142 SIZE(v7d_tmp%voldatid, 3),
SIZE(v7d_tmp%voldatid, 4),
SIZE(v7d_tmp%voldatid, 5), &
2143 SIZE(v7d_tmp%voldatid, 6)))
2144 DO i = 1,
SIZE(v7d_tmp%dativar%d)
2145 v7d_tmp%voldatir(:,:,:,:,i,:) = &
2146 realdat(v7d_tmp%voldatid(:,:,:,:,i,:), v7d_tmp%dativar%d(i))
2148 DEALLOCATE(v7d_tmp%voldatid)
2150 v7d_tmp%dativar%r => v7d_tmp%dativar%d
2151 nullify(v7d_tmp%dativar%d)
2155 CALL vol7d_merge(that, v7d_tmp)
2162 CALL vol7d_copy(this, v7d_tmp, &
2163 lanavarr=fv, lanavard=fv, lanavari=acn, lanavarb=fv, lanavarc=fv, &
2164 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
2165 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
2166 ldativarr=fv, ldativard=fv, ldativari=tv, ldativarb=fv, ldativarc=fv, &
2167 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
2168 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
2171 IF (
ASSOCIATED(v7d_tmp%anavar%i) .OR.
ASSOCIATED(v7d_tmp%dativar%i))
THEN
2173 IF (
ASSOCIATED(v7d_tmp%anavar%i))
THEN
2175 ALLOCATE(v7d_tmp%volanar(
SIZE(v7d_tmp%volanai, 1),
SIZE(v7d_tmp%volanai, 2), &
2176 SIZE(v7d_tmp%volanai, 3)))
2177 DO i = 1,
SIZE(v7d_tmp%anavar%i)
2178 v7d_tmp%volanar(:,i,:) = &
2179 realdat(v7d_tmp%volanai(:,i,:), v7d_tmp%anavar%i(i))
2181 DEALLOCATE(v7d_tmp%volanai)
2183 v7d_tmp%anavar%r => v7d_tmp%anavar%i
2184 nullify(v7d_tmp%anavar%i)
2187 IF (
ASSOCIATED(v7d_tmp%dativar%i))
THEN
2189 ALLOCATE(v7d_tmp%voldatir(
SIZE(v7d_tmp%voldatii, 1),
SIZE(v7d_tmp%voldatii, 2), &
2190 SIZE(v7d_tmp%voldatii, 3),
SIZE(v7d_tmp%voldatii, 4),
SIZE(v7d_tmp%voldatii, 5), &
2191 SIZE(v7d_tmp%voldatii, 6)))
2192 DO i = 1,
SIZE(v7d_tmp%dativar%i)
2193 v7d_tmp%voldatir(:,:,:,:,i,:) = &
2194 realdat(v7d_tmp%voldatii(:,:,:,:,i,:), v7d_tmp%dativar%i(i))
2196 DEALLOCATE(v7d_tmp%voldatii)
2198 v7d_tmp%dativar%r => v7d_tmp%dativar%i
2199 nullify(v7d_tmp%dativar%i)
2203 CALL vol7d_merge(that, v7d_tmp)
2210 CALL vol7d_copy(this, v7d_tmp, &
2211 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=acn, lanavarc=fv, &
2212 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
2213 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
2214 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=tv, ldativarc=fv, &
2215 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
2216 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
2219 IF (
ASSOCIATED(v7d_tmp%anavar%b) .OR.
ASSOCIATED(v7d_tmp%dativar%b))
THEN
2221 IF (
ASSOCIATED(v7d_tmp%anavar%b))
THEN
2223 ALLOCATE(v7d_tmp%volanar(
SIZE(v7d_tmp%volanab, 1),
SIZE(v7d_tmp%volanab, 2), &
2224 SIZE(v7d_tmp%volanab, 3)))
2225 DO i = 1,
SIZE(v7d_tmp%anavar%b)
2226 v7d_tmp%volanar(:,i,:) = &
2227 realdat(v7d_tmp%volanab(:,i,:), v7d_tmp%anavar%b(i))
2229 DEALLOCATE(v7d_tmp%volanab)
2231 v7d_tmp%anavar%r => v7d_tmp%anavar%b
2232 nullify(v7d_tmp%anavar%b)
2235 IF (
ASSOCIATED(v7d_tmp%dativar%b))
THEN
2237 ALLOCATE(v7d_tmp%voldatir(
SIZE(v7d_tmp%voldatib, 1),
SIZE(v7d_tmp%voldatib, 2), &
2238 SIZE(v7d_tmp%voldatib, 3),
SIZE(v7d_tmp%voldatib, 4),
SIZE(v7d_tmp%voldatib, 5), &
2239 SIZE(v7d_tmp%voldatib, 6)))
2240 DO i = 1,
SIZE(v7d_tmp%dativar%b)
2241 v7d_tmp%voldatir(:,:,:,:,i,:) = &
2242 realdat(v7d_tmp%voldatib(:,:,:,:,i,:), v7d_tmp%dativar%b(i))
2244 DEALLOCATE(v7d_tmp%voldatib)
2246 v7d_tmp%dativar%r => v7d_tmp%dativar%b
2247 nullify(v7d_tmp%dativar%b)
2251 CALL vol7d_merge(that, v7d_tmp)
2258 CALL vol7d_copy(this, v7d_tmp, &
2259 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=fv, lanavarc=acn, &
2260 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
2261 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
2262 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=tv, &
2263 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
2264 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
2267 IF (
ASSOCIATED(v7d_tmp%anavar%c) .OR.
ASSOCIATED(v7d_tmp%dativar%c))
THEN
2269 IF (
ASSOCIATED(v7d_tmp%anavar%c))
THEN
2271 ALLOCATE(v7d_tmp%volanar(
SIZE(v7d_tmp%volanac, 1),
SIZE(v7d_tmp%volanac, 2), &
2272 SIZE(v7d_tmp%volanac, 3)))
2273 DO i = 1,
SIZE(v7d_tmp%anavar%c)
2274 v7d_tmp%volanar(:,i,:) = &
2275 realdat(v7d_tmp%volanac(:,i,:), v7d_tmp%anavar%c(i))
2277 DEALLOCATE(v7d_tmp%volanac)
2279 v7d_tmp%anavar%r => v7d_tmp%anavar%c
2280 nullify(v7d_tmp%anavar%c)
2283 IF (
ASSOCIATED(v7d_tmp%dativar%c))
THEN
2285 ALLOCATE(v7d_tmp%voldatir(
SIZE(v7d_tmp%voldatic, 1),
SIZE(v7d_tmp%voldatic, 2), &
2286 SIZE(v7d_tmp%voldatic, 3),
SIZE(v7d_tmp%voldatic, 4),
SIZE(v7d_tmp%voldatic, 5), &
2287 SIZE(v7d_tmp%voldatic, 6)))
2288 DO i = 1,
SIZE(v7d_tmp%dativar%c)
2289 v7d_tmp%voldatir(:,:,:,:,i,:) = &
2290 realdat(v7d_tmp%voldatic(:,:,:,:,i,:), v7d_tmp%dativar%c(i))
2292 DEALLOCATE(v7d_tmp%voldatic)
2294 v7d_tmp%dativar%r => v7d_tmp%dativar%c
2295 nullify(v7d_tmp%dativar%c)
2299 CALL vol7d_merge(that, v7d_tmp)
2304 END SUBROUTINE vol7d_convr
2310 SUBROUTINE vol7d_diff_only (this, that, data_only,ana)
2311 TYPE(vol7d),
INTENT(IN) :: this
2312 type(
vol7d),
INTENT(OUT) :: that
2313 logical ,
optional,
intent(in) :: data_only
2314 logical ,
optional,
intent(in) :: ana
2315 logical :: ldata_only,lana
2317 IF (present(data_only))
THEN
2318 ldata_only = data_only
2320 ldata_only = .false.
2323 IF (present(ana))
THEN
2330 #undef VOL7D_POLY_ARRAY
2331 #define VOL7D_POLY_ARRAY voldati
2332 #include "vol7d_class_diff.F90"
2333 #undef VOL7D_POLY_ARRAY
2334 #define VOL7D_POLY_ARRAY voldatiattr
2335 #include "vol7d_class_diff.F90"
2336 #undef VOL7D_POLY_ARRAY
2338 if ( .not. ldata_only)
then
2340 #define VOL7D_POLY_ARRAY volana
2341 #include "vol7d_class_diff.F90"
2342 #undef VOL7D_POLY_ARRAY
2343 #define VOL7D_POLY_ARRAY volanaattr
2344 #include "vol7d_class_diff.F90"
2345 #undef VOL7D_POLY_ARRAY
2348 where ( this%ana == that%ana )
2349 that%ana = vol7d_ana_miss
2357 END SUBROUTINE vol7d_diff_only
2363 #undef VOL7D_POLY_TYPE
2364 #undef VOL7D_POLY_TYPES
2365 #define VOL7D_POLY_TYPE REAL
2366 #define VOL7D_POLY_TYPES r
2367 #include "vol7d_class_type_templ.F90"
2368 #undef VOL7D_POLY_TYPE
2369 #undef VOL7D_POLY_TYPES
2370 #define VOL7D_POLY_TYPE DOUBLE PRECISION
2371 #define VOL7D_POLY_TYPES d
2372 #include "vol7d_class_type_templ.F90"
2373 #undef VOL7D_POLY_TYPE
2374 #undef VOL7D_POLY_TYPES
2375 #define VOL7D_POLY_TYPE INTEGER
2376 #define VOL7D_POLY_TYPES i
2377 #include "vol7d_class_type_templ.F90"
2378 #undef VOL7D_POLY_TYPE
2379 #undef VOL7D_POLY_TYPES
2380 #define VOL7D_POLY_TYPE INTEGER(kind=int_b)
2381 #define VOL7D_POLY_TYPES b
2382 #include "vol7d_class_type_templ.F90"
2383 #undef VOL7D_POLY_TYPE
2384 #undef VOL7D_POLY_TYPES
2385 #define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
2386 #define VOL7D_POLY_TYPES c
2387 #include "vol7d_class_type_templ.F90"
2392 #undef VOL7D_NO_ZERO_ALLOC
2393 #undef VOL7D_POLY_TYPE
2394 #define VOL7D_POLY_TYPE datetime
2395 #include "vol7d_class_desc_templ.F90"
2396 #undef VOL7D_POLY_TYPE
2397 #define VOL7D_POLY_TYPE vol7d_timerange
2398 #include "vol7d_class_desc_templ.F90"
2399 #undef VOL7D_POLY_TYPE
2400 #define VOL7D_POLY_TYPE vol7d_level
2401 #include "vol7d_class_desc_templ.F90"
2403 #undef VOL7D_POLY_TYPE
2404 #define VOL7D_POLY_TYPE vol7d_network
2405 #include "vol7d_class_desc_templ.F90"
2406 #undef VOL7D_POLY_TYPE
2407 #define VOL7D_POLY_TYPE vol7d_ana
2408 #include "vol7d_class_desc_templ.F90"
2409 #define VOL7D_NO_ZERO_ALLOC
2410 #undef VOL7D_POLY_TYPE
2411 #define VOL7D_POLY_TYPE vol7d_var
2412 #include "vol7d_class_desc_templ.F90"
2423 subroutine vol7d_write_on_file (this,unit,description,filename,filename_auto)
2425 TYPE(vol7d),
INTENT(IN) :: this
2426 integer,
optional,
intent(inout) :: unit
2427 character(len=*),
intent(in),
optional :: filename
2428 character(len=*),
intent(out),
optional :: filename_auto
2429 character(len=*),
INTENT(IN),
optional :: description
2432 character(len=254) :: ldescription,arg,lfilename
2433 integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
2434 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
2435 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
2436 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
2437 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
2438 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
2439 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
2441 integer :: tarray(8)
2442 logical :: opened,exist
2482 call date_and_time(values=tarray)
2485 if (present(description))
then
2486 ldescription=description
2488 ldescription=
"Vol7d generated by: "//trim(arg)
2491 if (.not. present(unit))
then
2502 lfilename=trim(arg)//
".v7d"
2503 if (
index(arg,
'/',back=.true.) > 0) lfilename=lfilename(
index(arg,
'/',back=.true.)+1 : )
2505 if (present(filename))
then
2506 if (filename /=
"")
then
2511 if (present(filename_auto))filename_auto=lfilename
2514 inquire(unit=lunit,opened=opened)
2515 if (.not. opened)
then
2522 OPEN(unit=lunit, file=lfilename, form=
'UNFORMATTED', access=
'STREAM')
2523 CALL l4f_log(l4f_info,
'opened: '//trim(lfilename))
2526 if (
associated(this%ana)) nana=
size(this%ana)
2527 if (
associated(this%time)) ntime=
size(this%time)
2528 if (
associated(this%timerange)) ntimerange=
size(this%timerange)
2529 if (
associated(this%level)) nlevel=
size(this%level)
2530 if (
associated(this%network)) nnetwork=
size(this%network)
2532 if (
associated(this%dativar%r)) ndativarr=
size(this%dativar%r)
2533 if (
associated(this%dativar%i)) ndativari=
size(this%dativar%i)
2534 if (
associated(this%dativar%b)) ndativarb=
size(this%dativar%b)
2535 if (
associated(this%dativar%d)) ndativard=
size(this%dativar%d)
2536 if (
associated(this%dativar%c)) ndativarc=
size(this%dativar%c)
2538 if (
associated(this%datiattr%r)) ndatiattrr=
size(this%datiattr%r)
2539 if (
associated(this%datiattr%i)) ndatiattri=
size(this%datiattr%i)
2540 if (
associated(this%datiattr%b)) ndatiattrb=
size(this%datiattr%b)
2541 if (
associated(this%datiattr%d)) ndatiattrd=
size(this%datiattr%d)
2542 if (
associated(this%datiattr%c)) ndatiattrc=
size(this%datiattr%c)
2544 if (
associated(this%dativarattr%r)) ndativarattrr=
size(this%dativarattr%r)
2545 if (
associated(this%dativarattr%i)) ndativarattri=
size(this%dativarattr%i)
2546 if (
associated(this%dativarattr%b)) ndativarattrb=
size(this%dativarattr%b)
2547 if (
associated(this%dativarattr%d)) ndativarattrd=
size(this%dativarattr%d)
2548 if (
associated(this%dativarattr%c)) ndativarattrc=
size(this%dativarattr%c)
2550 if (
associated(this%anavar%r)) nanavarr=
size(this%anavar%r)
2551 if (
associated(this%anavar%i)) nanavari=
size(this%anavar%i)
2552 if (
associated(this%anavar%b)) nanavarb=
size(this%anavar%b)
2553 if (
associated(this%anavar%d)) nanavard=
size(this%anavar%d)
2554 if (
associated(this%anavar%c)) nanavarc=
size(this%anavar%c)
2556 if (
associated(this%anaattr%r)) nanaattrr=
size(this%anaattr%r)
2557 if (
associated(this%anaattr%i)) nanaattri=
size(this%anaattr%i)
2558 if (
associated(this%anaattr%b)) nanaattrb=
size(this%anaattr%b)
2559 if (
associated(this%anaattr%d)) nanaattrd=
size(this%anaattr%d)
2560 if (
associated(this%anaattr%c)) nanaattrc=
size(this%anaattr%c)
2562 if (
associated(this%anavarattr%r)) nanavarattrr=
size(this%anavarattr%r)
2563 if (
associated(this%anavarattr%i)) nanavarattri=
size(this%anavarattr%i)
2564 if (
associated(this%anavarattr%b)) nanavarattrb=
size(this%anavarattr%b)
2565 if (
associated(this%anavarattr%d)) nanavarattrd=
size(this%anavarattr%d)
2566 if (
associated(this%anavarattr%c)) nanavarattrc=
size(this%anavarattr%c)
2568 write(unit=lunit)ldescription
2569 write(unit=lunit)tarray
2572 nana, ntime, ntimerange, nlevel, nnetwork, &
2573 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
2574 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
2575 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
2576 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
2577 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
2578 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
2579 this%time_definition
2586 if (
associated(this%ana)) call
write_unit(this%ana, lunit)
2587 if (
associated(this%time)) call
write_unit(this%time, lunit)
2588 if (
associated(this%level))
write(unit=lunit)this%level
2589 if (
associated(this%timerange))
write(unit=lunit)this%timerange
2590 if (
associated(this%network))
write(unit=lunit)this%network
2595 if (
associated(this%anavar%r))
write(unit=lunit)this%anavar%r
2596 if (
associated(this%anavar%i))
write(unit=lunit)this%anavar%i
2597 if (
associated(this%anavar%b))
write(unit=lunit)this%anavar%b
2598 if (
associated(this%anavar%d))
write(unit=lunit)this%anavar%d
2599 if (
associated(this%anavar%c))
write(unit=lunit)this%anavar%c
2601 if (
associated(this%anaattr%r))
write(unit=lunit)this%anaattr%r
2602 if (
associated(this%anaattr%i))
write(unit=lunit)this%anaattr%i
2603 if (
associated(this%anaattr%b))
write(unit=lunit)this%anaattr%b
2604 if (
associated(this%anaattr%d))
write(unit=lunit)this%anaattr%d
2605 if (
associated(this%anaattr%c))
write(unit=lunit)this%anaattr%c
2607 if (
associated(this%anavarattr%r))
write(unit=lunit)this%anavarattr%r
2608 if (
associated(this%anavarattr%i))
write(unit=lunit)this%anavarattr%i
2609 if (
associated(this%anavarattr%b))
write(unit=lunit)this%anavarattr%b
2610 if (
associated(this%anavarattr%d))
write(unit=lunit)this%anavarattr%d
2611 if (
associated(this%anavarattr%c))
write(unit=lunit)this%anavarattr%c
2613 if (
associated(this%dativar%r))
write(unit=lunit)this%dativar%r
2614 if (
associated(this%dativar%i))
write(unit=lunit)this%dativar%i
2615 if (
associated(this%dativar%b))
write(unit=lunit)this%dativar%b
2616 if (
associated(this%dativar%d))
write(unit=lunit)this%dativar%d
2617 if (
associated(this%dativar%c))
write(unit=lunit)this%dativar%c
2619 if (
associated(this%datiattr%r))
write(unit=lunit)this%datiattr%r
2620 if (
associated(this%datiattr%i))
write(unit=lunit)this%datiattr%i
2621 if (
associated(this%datiattr%b))
write(unit=lunit)this%datiattr%b
2622 if (
associated(this%datiattr%d))
write(unit=lunit)this%datiattr%d
2623 if (
associated(this%datiattr%c))
write(unit=lunit)this%datiattr%c
2625 if (
associated(this%dativarattr%r))
write(unit=lunit)this%dativarattr%r
2626 if (
associated(this%dativarattr%i))
write(unit=lunit)this%dativarattr%i
2627 if (
associated(this%dativarattr%b))
write(unit=lunit)this%dativarattr%b
2628 if (
associated(this%dativarattr%d))
write(unit=lunit)this%dativarattr%d
2629 if (
associated(this%dativarattr%c))
write(unit=lunit)this%dativarattr%c
2633 if (
associated(this%volanar))
write(unit=lunit)this%volanar
2634 if (
associated(this%volanaattrr))
write(unit=lunit)this%volanaattrr
2635 if (
associated(this%voldatir))
write(unit=lunit)this%voldatir
2636 if (
associated(this%voldatiattrr))
write(unit=lunit)this%voldatiattrr
2638 if (
associated(this%volanai))
write(unit=lunit)this%volanai
2639 if (
associated(this%volanaattri))
write(unit=lunit)this%volanaattri
2640 if (
associated(this%voldatii))
write(unit=lunit)this%voldatii
2641 if (
associated(this%voldatiattri))
write(unit=lunit)this%voldatiattri
2643 if (
associated(this%volanab))
write(unit=lunit)this%volanab
2644 if (
associated(this%volanaattrb))
write(unit=lunit)this%volanaattrb
2645 if (
associated(this%voldatib))
write(unit=lunit)this%voldatib
2646 if (
associated(this%voldatiattrb))
write(unit=lunit)this%voldatiattrb
2648 if (
associated(this%volanad))
write(unit=lunit)this%volanad
2649 if (
associated(this%volanaattrd))
write(unit=lunit)this%volanaattrd
2650 if (
associated(this%voldatid))
write(unit=lunit)this%voldatid
2651 if (
associated(this%voldatiattrd))
write(unit=lunit)this%voldatiattrd
2653 if (
associated(this%volanac))
write(unit=lunit)this%volanac
2654 if (
associated(this%volanaattrc))
write(unit=lunit)this%volanaattrc
2655 if (
associated(this%voldatic))
write(unit=lunit)this%voldatic
2656 if (
associated(this%voldatiattrc))
write(unit=lunit)this%voldatiattrc
2658 if (.not. present(unit))
close(unit=lunit)
2660 end subroutine vol7d_write_on_file
2671 subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)
2673 TYPE(vol7d),
INTENT(OUT) :: this
2674 integer,
intent(inout),
optional :: unit
2675 character(len=*),
INTENT(in),
optional :: filename
2676 character(len=*),
intent(out),
optional :: filename_auto
2677 character(len=*),
INTENT(out),
optional :: description
2678 integer,
intent(out),
optional :: tarray(8)
2681 integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
2682 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
2683 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
2684 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
2685 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
2686 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
2687 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
2689 character(len=254) :: ldescription,lfilename,arg
2690 integer :: ltarray(8),lunit,ios
2691 logical :: opened,exist
2696 if (.not. present(unit))
then
2707 lfilename=trim(arg)//
".v7d"
2708 if (
index(arg,
'/',back=.true.) > 0) lfilename=lfilename(
index(arg,
'/',back=.true.)+1 : )
2710 if (present(filename))
then
2711 if (filename /=
"")
then
2716 if (present(filename_auto))filename_auto=lfilename
2719 inquire(unit=lunit,opened=opened)
2720 IF (.NOT. opened)
THEN
2721 inquire(file=lfilename,exist=exist)
2722 IF (.NOT.exist)
THEN
2723 CALL l4f_log(l4f_fatal, &
2724 'in vol7d_read_from_file, file does not exists, cannot open')
2725 CALL raise_fatal_error()
2727 OPEN(unit=lunit, file=lfilename, form=
'UNFORMATTED', access=
'STREAM', &
2728 status=
'OLD', action=
'READ')
2729 CALL l4f_log(l4f_info,
'opened: '//trim(lfilename))
2734 read(unit=lunit,iostat=ios)ldescription
2737 call vol7d_alloc(this)
2738 call vol7d_alloc_vol(this)
2739 if (present(description))description=ldescription
2740 if (present(tarray))tarray=ltarray
2741 if (.not. present(unit))
close(unit=lunit)
2744 read(unit=lunit)ltarray
2746 CALL l4f_log(l4f_info,
'Reading vol7d from file')
2747 CALL l4f_log(l4f_info,
'description: '//trim(ldescription))
2748 CALL l4f_log(l4f_info,
'written on '//trim(
to_char(ltarray(1)))//
' '// &
2751 if (present(description))description=ldescription
2752 if (present(tarray))tarray=ltarray
2755 nana, ntime, ntimerange, nlevel, nnetwork, &
2756 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
2757 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
2758 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
2759 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
2760 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
2761 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
2762 this%time_definition
2764 call vol7d_alloc(this, &
2765 nana=nana, ntime=ntime, ntimerange=ntimerange, nlevel=nlevel, nnetwork=nnetwork,&
2766 ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb,&
2767 ndativard=ndativard, ndativarc=ndativarc,&
2768 ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb,&
2769 ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
2770 ndativarattrr=ndativarattrr, ndativarattri=ndativarattri, ndativarattrb=ndativarattrb, &
2771 ndativarattrd=ndativarattrd, ndativarattrc=ndativarattrc,&
2772 nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, &
2773 nanavard=nanavard, nanavarc=nanavarc,&
2774 nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb,&
2775 nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
2776 nanavarattrr=nanavarattrr, nanavarattri=nanavarattri, nanavarattrb=nanavarattrb, &
2777 nanavarattrd=nanavarattrd, nanavarattrc=nanavarattrc)
2780 if (
associated(this%ana)) call
read_unit(this%ana, lunit)
2781 if (
associated(this%time)) call
read_unit(this%time, lunit)
2782 if (
associated(this%level))
read(unit=lunit)this%level
2783 if (
associated(this%timerange))
read(unit=lunit)this%timerange
2784 if (
associated(this%network))
read(unit=lunit)this%network
2786 if (
associated(this%anavar%r))
read(unit=lunit)this%anavar%r
2787 if (
associated(this%anavar%i))
read(unit=lunit)this%anavar%i
2788 if (
associated(this%anavar%b))
read(unit=lunit)this%anavar%b
2789 if (
associated(this%anavar%d))
read(unit=lunit)this%anavar%d
2790 if (
associated(this%anavar%c))
read(unit=lunit)this%anavar%c
2792 if (
associated(this%anaattr%r))
read(unit=lunit)this%anaattr%r
2793 if (
associated(this%anaattr%i))
read(unit=lunit)this%anaattr%i
2794 if (
associated(this%anaattr%b))
read(unit=lunit)this%anaattr%b
2795 if (
associated(this%anaattr%d))
read(unit=lunit)this%anaattr%d
2796 if (
associated(this%anaattr%c))
read(unit=lunit)this%anaattr%c
2798 if (
associated(this%anavarattr%r))
read(unit=lunit)this%anavarattr%r
2799 if (
associated(this%anavarattr%i))
read(unit=lunit)this%anavarattr%i
2800 if (
associated(this%anavarattr%b))
read(unit=lunit)this%anavarattr%b
2801 if (
associated(this%anavarattr%d))
read(unit=lunit)this%anavarattr%d
2802 if (
associated(this%anavarattr%c))
read(unit=lunit)this%anavarattr%c
2804 if (
associated(this%dativar%r))
read(unit=lunit)this%dativar%r
2805 if (
associated(this%dativar%i))
read(unit=lunit)this%dativar%i
2806 if (
associated(this%dativar%b))
read(unit=lunit)this%dativar%b
2807 if (
associated(this%dativar%d))
read(unit=lunit)this%dativar%d
2808 if (
associated(this%dativar%c))
read(unit=lunit)this%dativar%c
2810 if (
associated(this%datiattr%r))
read(unit=lunit)this%datiattr%r
2811 if (
associated(this%datiattr%i))
read(unit=lunit)this%datiattr%i
2812 if (
associated(this%datiattr%b))
read(unit=lunit)this%datiattr%b
2813 if (
associated(this%datiattr%d))
read(unit=lunit)this%datiattr%d
2814 if (
associated(this%datiattr%c))
read(unit=lunit)this%datiattr%c
2816 if (
associated(this%dativarattr%r))
read(unit=lunit)this%dativarattr%r
2817 if (
associated(this%dativarattr%i))
read(unit=lunit)this%dativarattr%i
2818 if (
associated(this%dativarattr%b))
read(unit=lunit)this%dativarattr%b
2819 if (
associated(this%dativarattr%d))
read(unit=lunit)this%dativarattr%d
2820 if (
associated(this%dativarattr%c))
read(unit=lunit)this%dativarattr%c
2822 call vol7d_alloc_vol(this)
2826 if (
associated(this%volanar))
read(unit=lunit)this%volanar
2827 if (
associated(this%volanaattrr))
read(unit=lunit)this%volanaattrr
2828 if (
associated(this%voldatir))
read(unit=lunit)this%voldatir
2829 if (
associated(this%voldatiattrr))
read(unit=lunit)this%voldatiattrr
2831 if (
associated(this%volanai))
read(unit=lunit)this%volanai
2832 if (
associated(this%volanaattri))
read(unit=lunit)this%volanaattri
2833 if (
associated(this%voldatii))
read(unit=lunit)this%voldatii
2834 if (
associated(this%voldatiattri))
read(unit=lunit)this%voldatiattri
2836 if (
associated(this%volanab))
read(unit=lunit)this%volanab
2837 if (
associated(this%volanaattrb))
read(unit=lunit)this%volanaattrb
2838 if (
associated(this%voldatib))
read(unit=lunit)this%voldatib
2839 if (
associated(this%voldatiattrb))
read(unit=lunit)this%voldatiattrb
2841 if (
associated(this%volanad))
read(unit=lunit)this%volanad
2842 if (
associated(this%volanaattrd))
read(unit=lunit)this%volanaattrd
2843 if (
associated(this%voldatid))
read(unit=lunit)this%voldatid
2844 if (
associated(this%voldatiattrd))
read(unit=lunit)this%voldatiattrd
2846 if (
associated(this%volanac))
read(unit=lunit)this%volanac
2847 if (
associated(this%volanaattrc))
read(unit=lunit)this%volanaattrc
2848 if (
associated(this%voldatic))
read(unit=lunit)this%voldatic
2849 if (
associated(this%voldatiattrc))
read(unit=lunit)this%voldatiattrc
2851 if (.not. present(unit))
close(unit=lunit)
2853 end subroutine vol7d_read_from_file
2857 elemental doubleprecision
function doubledatd(voldat,var)
2858 doubleprecision,
intent(in) :: voldat
2859 type(vol7d_var
),
intent(in) :: var
2863 end function doubledatd
2866 elemental doubleprecision
function doubledatr(voldat,var)
2867 real,
intent(in) :: voldat
2868 type(vol7d_var
),
intent(in) :: var
2870 if (
c_e(voldat))
then
2871 doubledatr=dble(voldat)
2876 end function doubledatr
2879 elemental doubleprecision
function doubledati(voldat,var)
2880 integer,
intent(in) :: voldat
2881 type(vol7d_var
),
intent(in) :: var
2883 if (
c_e(voldat))
then
2884 if (
c_e(var%scalefactor))
then
2885 doubledati=dble(voldat)/10.d0**var%scalefactor
2887 doubledati=dble(voldat)
2893 end function doubledati
2896 elemental doubleprecision
function doubledatb(voldat,var)
2897 integer(kind=int_b),
intent(in) :: voldat
2898 type(vol7d_var
),
intent(in) :: var
2900 if (
c_e(voldat))
then
2901 if (
c_e(var%scalefactor))
then
2902 doubledatb=dble(voldat)/10.d0**var%scalefactor
2904 doubledatb=dble(voldat)
2910 end function doubledatb
2913 elemental doubleprecision
function doubledatc(voldat,var)
2914 CHARACTER(len=vol7d_cdatalen),
intent(in) :: voldat
2915 type(vol7d_var
),
intent(in) :: var
2917 doubledatc = c2d(voldat)
2918 if (
c_e(doubledatc) .and.
c_e(var%scalefactor))
then
2919 doubledatc=doubledatc/10.d0**var%scalefactor
2922 end function doubledatc
2926 elemental integer function integerdatd(voldat,var)
2927 doubleprecision,
intent(in) :: voldat
2928 type(vol7d_var
),
intent(in) :: var
2930 if (
c_e(voldat))
then
2931 if (
c_e(var%scalefactor))
then
2932 integerdatd=nint(voldat*10d0**var%scalefactor)
2934 integerdatd=nint(voldat)
2940 end function integerdatd
2943 elemental integer function integerdatr(voldat,var)
2944 real,
intent(in) :: voldat
2945 type(vol7d_var
),
intent(in) :: var
2947 if (
c_e(voldat))
then
2948 if (
c_e(var%scalefactor))
then
2949 integerdatr=nint(voldat*10d0**var%scalefactor)
2951 integerdatr=nint(voldat)
2957 end function integerdatr
2960 elemental integer function integerdati(voldat,var)
2961 integer,
intent(in) :: voldat
2962 type(vol7d_var
),
intent(in) :: var
2966 end function integerdati
2969 elemental integer function integerdatb(voldat,var)
2970 integer(kind=int_b),
intent(in) :: voldat
2971 type(vol7d_var
),
intent(in) :: var
2973 if (
c_e(voldat))
then
2979 end function integerdatb
2982 elemental integer function integerdatc(voldat,var)
2983 CHARACTER(len=vol7d_cdatalen),
intent(in) :: voldat
2984 type(vol7d_var
),
intent(in) :: var
2986 integerdatc=c2i(voldat)
2988 end function integerdatc
2992 elemental real function realdatd(voldat,var)
2993 doubleprecision,
intent(in) :: voldat
2994 type(vol7d_var
),
intent(in) :: var
2996 if (
c_e(voldat))
then
2997 realdatd=
real(voldat)
3002 end function realdatd
3005 elemental real function realdatr(voldat,var)
3006 real,
intent(in) :: voldat
3007 type(vol7d_var
),
intent(in) :: var
3011 end function realdatr
3014 elemental real function realdati(voldat,var)
3015 integer,
intent(in) :: voldat
3016 type(vol7d_var
),
intent(in) :: var
3018 if (
c_e(voldat))
then
3019 if (
c_e(var%scalefactor))
then
3020 realdati=float(voldat)/10.**var%scalefactor
3022 realdati=float(voldat)
3028 end function realdati
3031 elemental real function realdatb(voldat,var)
3032 integer(kind=int_b),
intent(in) :: voldat
3033 type(vol7d_var
),
intent(in) :: var
3035 if (
c_e(voldat))
then
3036 if (
c_e(var%scalefactor))
then
3037 realdatb=float(voldat)/10**var%scalefactor
3039 realdatb=float(voldat)
3045 end function realdatb
3048 elemental real function realdatc(voldat,var)
3049 CHARACTER(len=vol7d_cdatalen),
intent(in) :: voldat
3050 type(vol7d_var
),
intent(in) :: var
3052 realdatc=c2r(voldat)
3053 if (
c_e(realdatc) .and.
c_e(var%scalefactor))
then
3054 realdatc=realdatc/10.**var%scalefactor
3057 end function realdatc
3065 FUNCTION realanavol(this, var) RESULT(vol)
3066 TYPE(vol7d),
INTENT(in) :: this
3067 type(vol7d_var),
INTENT(in) :: var
3068 REAL :: vol(size(this%ana),size(this%network))
3070 CHARACTER(len=1) :: dtype
3074 indvar =
index(this%anavar, var, type=dtype)
3076 IF (indvar > 0)
THEN
3079 vol =
realdat(this%volanad(:,indvar,:), var)
3081 vol = this%volanar(:,indvar,:)
3083 vol =
realdat(this%volanai(:,indvar,:), var)
3085 vol =
realdat(this%volanab(:,indvar,:), var)
3087 vol =
realdat(this%volanac(:,indvar,:), var)
3095 END FUNCTION realanavol
3103 FUNCTION integeranavol(this, var) RESULT(vol)
3104 TYPE(vol7d),
INTENT(in) :: this
3105 type(vol7d_var),
INTENT(in) :: var
3106 INTEGER :: vol(size(this%ana),size(this%network))
3108 CHARACTER(len=1) :: dtype
3112 indvar =
index(this%anavar, var, type=dtype)
3114 IF (indvar > 0)
THEN
3117 vol =
integerdat(this%volanad(:,indvar,:), var)
3119 vol =
integerdat(this%volanar(:,indvar,:), var)
3121 vol = this%volanai(:,indvar,:)
3123 vol =
integerdat(this%volanab(:,indvar,:), var)
3125 vol =
integerdat(this%volanac(:,indvar,:), var)
3133 END FUNCTION integeranavol
3141 subroutine move_datac (v7d,&
3142 indana,indtime,indlevel,indtimerange,indnetwork,&
3143 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
3145 TYPE(vol7d),
intent(inout) :: v7d
3147 integer,
intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
3148 integer,
intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
3149 integer :: inddativar,inddativarattr
3152 do inddativar=1,
size(v7d%dativar%c)
3154 if (
c_e(v7d%voldatic(indana,indtime,indlevel,indtimerange,inddativar,indnetwork)) .and. &
3155 .not.
c_e(v7d%voldatic(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
3160 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
3162 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
3166 if (
associated (v7d%dativarattr%i))
then
3167 inddativarattr =
index(v7d%dativarattr%i,v7d%dativar%c(inddativar))
3168 if (inddativarattr > 0 )
then
3170 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3172 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3176 if (
associated (v7d%dativarattr%r))
then
3177 inddativarattr =
index(v7d%dativarattr%r,v7d%dativar%c(inddativar))
3178 if (inddativarattr > 0 )
then
3180 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3182 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3186 if (
associated (v7d%dativarattr%d))
then
3187 inddativarattr =
index(v7d%dativarattr%d,v7d%dativar%c(inddativar))
3188 if (inddativarattr > 0 )
then
3190 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3192 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3196 if (
associated (v7d%dativarattr%b))
then
3197 inddativarattr =
index(v7d%dativarattr%b,v7d%dativar%c(inddativar))
3198 if (inddativarattr > 0 )
then
3200 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3202 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3206 if (
associated (v7d%dativarattr%c))
then
3207 inddativarattr =
index(v7d%dativarattr%c,v7d%dativar%c(inddativar))
3208 if (inddativarattr > 0 )
then
3210 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3212 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3220 end subroutine move_datac
3227 subroutine move_datar (v7d,&
3228 indana,indtime,indlevel,indtimerange,indnetwork,&
3229 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
3231 TYPE(vol7d),
intent(inout) :: v7d
3233 integer,
intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
3234 integer,
intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
3235 integer :: inddativar,inddativarattr
3238 do inddativar=1,
size(v7d%dativar%r)
3240 if (
c_e(v7d%voldatir(indana,indtime,indlevel,indtimerange,inddativar,indnetwork)) .and. &
3241 .not.
c_e(v7d%voldatir(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
3246 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
3248 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
3252 if (
associated (v7d%dativarattr%i))
then
3253 inddativarattr =
index(v7d%dativarattr%i,v7d%dativar%r(inddativar))
3254 if (inddativarattr > 0 )
then
3256 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3258 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3262 if (
associated (v7d%dativarattr%r))
then
3263 inddativarattr =
index(v7d%dativarattr%r,v7d%dativar%r(inddativar))
3264 if (inddativarattr > 0 )
then
3266 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3268 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3272 if (
associated (v7d%dativarattr%d))
then
3273 inddativarattr =
index(v7d%dativarattr%d,v7d%dativar%r(inddativar))
3274 if (inddativarattr > 0 )
then
3276 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3278 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3282 if (
associated (v7d%dativarattr%b))
then
3283 inddativarattr =
index(v7d%dativarattr%b,v7d%dativar%r(inddativar))
3284 if (inddativarattr > 0 )
then
3286 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3288 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3292 if (
associated (v7d%dativarattr%c))
then
3293 inddativarattr =
index(v7d%dativarattr%c,v7d%dativar%r(inddativar))
3294 if (inddativarattr > 0 )
then
3296 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3298 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3306 end subroutine move_datar
3322 subroutine v7d_rounding(v7din,v7dout,level,timerange,nostatproc)
3323 type(vol7d),
intent(inout) :: v7din
3324 type(
vol7d),
intent(out) :: v7dout !> output volume
3325 type(vol7d_level
),
intent(in),
optional :: level(:)
3326 type(vol7d_timerange),
intent(in),
optional :: timerange(:)
3329 logical,
intent(in),
optional :: nostatproc
3331 integer :: nana,nlevel,ntime,ntimerange,nnetwork,nbin
3332 integer :: iana,ilevel,itimerange,indl,indt,itime,inetwork
3333 type(vol7d_level
) :: roundlevel(size(v7din%level))
3334 type(vol7d_timerange
) :: roundtimerange(size(v7din%timerange))
3335 type(vol7d) :: v7d_tmp
3340 if (
associated(v7din%dativar%r)) nbin = nbin +
size(v7din%dativar%r)
3341 if (
associated(v7din%dativar%i)) nbin = nbin +
size(v7din%dativar%i)
3342 if (
associated(v7din%dativar%d)) nbin = nbin +
size(v7din%dativar%d)
3343 if (
associated(v7din%dativar%b)) nbin = nbin +
size(v7din%dativar%b)
3347 roundlevel=v7din%level
3349 if (present(level))
then
3350 do ilevel = 1,
size(v7din%level)
3351 if ((any(v7din%level(ilevel) .almosteq. level)))
then
3352 roundlevel(ilevel)=level(1)
3357 roundtimerange=v7din%timerange
3359 if (present(timerange))
then
3360 do itimerange = 1,
size(v7din%timerange)
3361 if ((any(v7din%timerange(itimerange) .almosteq. timerange)))
then
3362 roundtimerange(itimerange)=timerange(1)
3369 if (optio_log(nostatproc))
then
3370 roundtimerange(:)%timerange=254
3371 roundtimerange(:)%p2=0
3375 nana=
size(v7din%ana)
3376 nlevel=count_distinct(roundlevel,back=.true.)
3377 ntime=
size(v7din%time)
3378 ntimerange=count_distinct(roundtimerange,back=.true.)
3379 nnetwork=
size(v7din%network)
3384 call
copy(v7din,v7d_tmp)
3386 call vol7d_convr(v7din,v7d_tmp)
3389 v7d_tmp%level=roundlevel
3390 v7d_tmp%timerange=roundtimerange
3392 do ilevel=1,
size(v7d_tmp%level)
3393 indl=
index(v7d_tmp%level,roundlevel(ilevel))
3394 do itimerange=1,
size(v7d_tmp%timerange)
3395 indt=
index(v7d_tmp%timerange,roundtimerange(itimerange))
3397 if (indl /= ilevel .or. indt /= itimerange)
then
3401 do inetwork=1,nnetwork
3404 call move_datar(v7d_tmp,&
3405 iana,itime,ilevel,itimerange,inetwork,&
3406 iana,itime,indl,indt,inetwork)
3408 call move_datac(v7d_tmp,&
3409 iana,itime,ilevel,itimerange,inetwork,&
3410 iana,itime,indl,indt,inetwork)
3423 do ilevel=nlevel+1,
size(v7d_tmp%level)
3424 call
init(v7d_tmp%level(ilevel))
3427 do itimerange=ntimerange+1,
size(v7d_tmp%timerange)
3428 call
init(v7d_tmp%timerange(itimerange))
3432 CALL
copy(v7d_tmp,v7dout,miss=.true.,lsort_timerange=.true.,lsort_level=.true.)
3437 end subroutine v7d_rounding
Classi per la gestione delle coordinate temporali.
Functions that return a trimmed CHARACTER representation of the input variable.
Legge un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta da un file FORMATTED o...
Distruttore per la classe vol7d.
Represent data in a pretty string.
Definition of constants related to I/O units.
doubleprecision data conversion
Classe per la gestione delle reti di stazioni per osservazioni meteo e affini.
Definisce un vettore di vol7d_var_class::vol7d_var per ogni tipo di dato supportato.
Costruttore per la classe vol7d.
Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
Reduce some dimensions (level and timerage) for semplification (rounding).
Scrive un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta su un file FORMATTED ...
Generic subroutine for checking OPTIONAL parameters.
Classe per gestire un vettore di oggetti di tipo vol7d_var_class::vol7d_var.
Classe per la gestione di un volume completo di dati osservati.
Test for a missing volume.
Classe per la gestione degli intervalli temporali di osservazioni meteo e affini. ...
Definisce un oggetto contenente i volumi anagrafica e dati e tutti i descrittori delle loro dimension...
Classe per la gestione dell'anagrafica di stazioni meteo e affini.
classe per la gestione del logging
Utilities for CHARACTER variables.
Definition of constants to be used for declaring variables of a desired type.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Check for problems return 0 if all check passed print diagnostics with log4f.
This module defines usefull general purpose function and subroutine.