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(:)
136 TYPE(vol7d_varvect) :: anavar
138 TYPE(vol7d_varvect) :: anaattr
140 TYPE(vol7d_varvect) :: anavarattr
142 TYPE(vol7d_varvect) :: dativar
144 TYPE(vol7d_varvect) :: datiattr
146 TYPE(vol7d_varvect) :: dativarattr
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)
325 integer,
INTENT(IN),
OPTIONAL :: time_definition
327 CALL init(this%anavar)
329 CALL init(this%anavarattr)
331 CALL init(this%datiattr)
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
397 CALL delete(this%datiattr)
398 CALL delete(this%dativarattr)
400 END SUBROUTINE vol7d_delete
404 integer function vol7d_check(this)
405 TYPE(vol7d),
intent(in) :: 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(:)
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
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))
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
Set of 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...
Scrive un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta su un file FORMATTED ...
Generic subroutine for checking OPTIONAL parameters.
Test for a missing volume.
Check for problems return 0 if all check passed print diagnostics with log4f.
Distruttore per la classe vol7d.
doubleprecision data conversion
Costruttore per la classe vol7d.
Reduce some dimensions (level and timerage) for semplification (rounding).
Represent data in a pretty string.
This module defines usefull general purpose function and subroutine.
Utilities for CHARACTER variables.
Classi per la gestione delle coordinate temporali.
Definition of constants related to I/O units.
Definition of constants to be used for declaring variables of a desired type.
classe per la gestione del logging
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Classe per la gestione dell'anagrafica di stazioni meteo e affini.
Classe per la gestione di un volume completo di dati osservati.
Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
Classe per la gestione delle reti di stazioni per osservazioni meteo e affini.
Classe per la gestione degli intervalli temporali di osservazioni meteo e affini.
Classe per gestire un vettore di oggetti di tipo vol7d_var_class::vol7d_var.
Class for expressing an absolute time value.
Definisce un oggetto contenente i volumi anagrafica e dati e tutti i descrittori delle loro dimension...
Definisce il livello verticale di un'osservazione.
Definisce la rete a cui appartiene una stazione.
Definisce l'intervallo temporale di un'osservazione meteo.