libsim  Versione6.3.0

◆ vol7d_diff_only()

subroutine vol7d_class::vol7d_diff_only ( type(vol7d), intent(in)  this,
type(vol7d), intent(out)  that,
logical, intent(in), optional  data_only,
logical, intent(in), optional  ana 
)

Metodo per ottenere solo le differenze tra due oggetti vol7d.

Il primo volume viene confrontato col secondo; nel secondo volume ovunque i dati confrontati siano coincidenti viene impostato valore mancante.

Parametri
[in]thisprimo volume da confrontare
[out]thatsecondo volume da confrontare in cui eliminare i dati coincidenti
[in]data_onlyattiva l'elaborazione dei soli dati e non dell'anagrafica (default: .false.)
[in]anaattiva l'elaborazione dell'anagrafica (coordinate e ident) (default: .false.)

Definizione alla linea 2331 del file vol7d_class.F90.

2331 if (.not. opened) then
2332 ! inquire(file=lfilename, EXIST=exist)
2333 ! IF (exist) THEN
2334 ! CALL l4f_log(L4F_FATAL, &
2335 ! 'in vol7d_write_on_file, file exists, cannot open file '//TRIM(lfilename))
2336 ! CALL raise_fatal_error()
2337 ! ENDIF
2338  OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access=stream_if_possible)
2339  CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
2340 end if
2341 
2342 if (associated(this%ana)) nana=size(this%ana)
2343 if (associated(this%time)) ntime=size(this%time)
2344 if (associated(this%timerange)) ntimerange=size(this%timerange)
2345 if (associated(this%level)) nlevel=size(this%level)
2346 if (associated(this%network)) nnetwork=size(this%network)
2347 
2348 if (associated(this%dativar%r)) ndativarr=size(this%dativar%r)
2349 if (associated(this%dativar%i)) ndativari=size(this%dativar%i)
2350 if (associated(this%dativar%b)) ndativarb=size(this%dativar%b)
2351 if (associated(this%dativar%d)) ndativard=size(this%dativar%d)
2352 if (associated(this%dativar%c)) ndativarc=size(this%dativar%c)
2353 
2354 if (associated(this%datiattr%r)) ndatiattrr=size(this%datiattr%r)
2355 if (associated(this%datiattr%i)) ndatiattri=size(this%datiattr%i)
2356 if (associated(this%datiattr%b)) ndatiattrb=size(this%datiattr%b)
2357 if (associated(this%datiattr%d)) ndatiattrd=size(this%datiattr%d)
2358 if (associated(this%datiattr%c)) ndatiattrc=size(this%datiattr%c)
2359 
2360 if (associated(this%dativarattr%r)) ndativarattrr=size(this%dativarattr%r)
2361 if (associated(this%dativarattr%i)) ndativarattri=size(this%dativarattr%i)
2362 if (associated(this%dativarattr%b)) ndativarattrb=size(this%dativarattr%b)
2363 if (associated(this%dativarattr%d)) ndativarattrd=size(this%dativarattr%d)
2364 if (associated(this%dativarattr%c)) ndativarattrc=size(this%dativarattr%c)
2365 
2366 if (associated(this%anavar%r)) nanavarr=size(this%anavar%r)
2367 if (associated(this%anavar%i)) nanavari=size(this%anavar%i)
2368 if (associated(this%anavar%b)) nanavarb=size(this%anavar%b)
2369 if (associated(this%anavar%d)) nanavard=size(this%anavar%d)
2370 if (associated(this%anavar%c)) nanavarc=size(this%anavar%c)
2371 
2372 if (associated(this%anaattr%r)) nanaattrr=size(this%anaattr%r)
2373 if (associated(this%anaattr%i)) nanaattri=size(this%anaattr%i)
2374 if (associated(this%anaattr%b)) nanaattrb=size(this%anaattr%b)
2375 if (associated(this%anaattr%d)) nanaattrd=size(this%anaattr%d)
2376 if (associated(this%anaattr%c)) nanaattrc=size(this%anaattr%c)
2377 
2378 if (associated(this%anavarattr%r)) nanavarattrr=size(this%anavarattr%r)
2379 if (associated(this%anavarattr%i)) nanavarattri=size(this%anavarattr%i)
2380 if (associated(this%anavarattr%b)) nanavarattrb=size(this%anavarattr%b)
2381 if (associated(this%anavarattr%d)) nanavarattrd=size(this%anavarattr%d)
2382 if (associated(this%anavarattr%c)) nanavarattrc=size(this%anavarattr%c)
2383 
2384 write(unit=lunit)ldescription
2385 write(unit=lunit)tarray
2386 
2387 write(unit=lunit)&
2388  nana, ntime, ntimerange, nlevel, nnetwork, &
2389  ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
2390  ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
2391  ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
2392  nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
2393  nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
2394  nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
2395  this%time_definition
2396 
2397 
2398 !write(unit=lunit)this
2399 
2400 
2401 !! prime 5 dimensioni
2402 if (associated(this%ana)) call write_unit(this%ana, lunit)
2403 if (associated(this%time)) call write_unit(this%time, lunit)
2404 if (associated(this%level)) write(unit=lunit)this%level
2405 if (associated(this%timerange)) write(unit=lunit)this%timerange
2406 if (associated(this%network)) write(unit=lunit)this%network
2407 
2408  !! 6a dimensione: variabile dell'anagrafica e dei dati
2409  !! con relativi attributi e in 5 tipi diversi
2410 
2411 if (associated(this%anavar%r)) write(unit=lunit)this%anavar%r
2412 if (associated(this%anavar%i)) write(unit=lunit)this%anavar%i
2413 if (associated(this%anavar%b)) write(unit=lunit)this%anavar%b
2414 if (associated(this%anavar%d)) write(unit=lunit)this%anavar%d
2415 if (associated(this%anavar%c)) write(unit=lunit)this%anavar%c
2416 
2417 if (associated(this%anaattr%r)) write(unit=lunit)this%anaattr%r
2418 if (associated(this%anaattr%i)) write(unit=lunit)this%anaattr%i
2419 if (associated(this%anaattr%b)) write(unit=lunit)this%anaattr%b
2420 if (associated(this%anaattr%d)) write(unit=lunit)this%anaattr%d
2421 if (associated(this%anaattr%c)) write(unit=lunit)this%anaattr%c
2422 
2423 if (associated(this%anavarattr%r)) write(unit=lunit)this%anavarattr%r
2424 if (associated(this%anavarattr%i)) write(unit=lunit)this%anavarattr%i
2425 if (associated(this%anavarattr%b)) write(unit=lunit)this%anavarattr%b
2426 if (associated(this%anavarattr%d)) write(unit=lunit)this%anavarattr%d
2427 if (associated(this%anavarattr%c)) write(unit=lunit)this%anavarattr%c
2428 
2429 if (associated(this%dativar%r)) write(unit=lunit)this%dativar%r
2430 if (associated(this%dativar%i)) write(unit=lunit)this%dativar%i
2431 if (associated(this%dativar%b)) write(unit=lunit)this%dativar%b
2432 if (associated(this%dativar%d)) write(unit=lunit)this%dativar%d
2433 if (associated(this%dativar%c)) write(unit=lunit)this%dativar%c
2434 
2435 if (associated(this%datiattr%r)) write(unit=lunit)this%datiattr%r
2436 if (associated(this%datiattr%i)) write(unit=lunit)this%datiattr%i
2437 if (associated(this%datiattr%b)) write(unit=lunit)this%datiattr%b
2438 if (associated(this%datiattr%d)) write(unit=lunit)this%datiattr%d
2439 if (associated(this%datiattr%c)) write(unit=lunit)this%datiattr%c
2440 
2441 if (associated(this%dativarattr%r)) write(unit=lunit)this%dativarattr%r
2442 if (associated(this%dativarattr%i)) write(unit=lunit)this%dativarattr%i
2443 if (associated(this%dativarattr%b)) write(unit=lunit)this%dativarattr%b
2444 if (associated(this%dativarattr%d)) write(unit=lunit)this%dativarattr%d
2445 if (associated(this%dativarattr%c)) write(unit=lunit)this%dativarattr%c
2446 
2447 !! Volumi di valori e attributi per anagrafica e dati
2448 
2449 if (associated(this%volanar)) write(unit=lunit)this%volanar
2450 if (associated(this%volanaattrr)) write(unit=lunit)this%volanaattrr
2451 if (associated(this%voldatir)) write(unit=lunit)this%voldatir
2452 if (associated(this%voldatiattrr)) write(unit=lunit)this%voldatiattrr
2453 
2454 if (associated(this%volanai)) write(unit=lunit)this%volanai
2455 if (associated(this%volanaattri)) write(unit=lunit)this%volanaattri
2456 if (associated(this%voldatii)) write(unit=lunit)this%voldatii
2457 if (associated(this%voldatiattri)) write(unit=lunit)this%voldatiattri
2458 
2459 if (associated(this%volanab)) write(unit=lunit)this%volanab
2460 if (associated(this%volanaattrb)) write(unit=lunit)this%volanaattrb
2461 if (associated(this%voldatib)) write(unit=lunit)this%voldatib
2462 if (associated(this%voldatiattrb)) write(unit=lunit)this%voldatiattrb
2463 
2464 if (associated(this%volanad)) write(unit=lunit)this%volanad
2465 if (associated(this%volanaattrd)) write(unit=lunit)this%volanaattrd
2466 if (associated(this%voldatid)) write(unit=lunit)this%voldatid
2467 if (associated(this%voldatiattrd)) write(unit=lunit)this%voldatiattrd
2468 
2469 if (associated(this%volanac)) write(unit=lunit)this%volanac
2470 if (associated(this%volanaattrc)) write(unit=lunit)this%volanaattrc
2471 if (associated(this%voldatic)) write(unit=lunit)this%voldatic
2472 if (associated(this%voldatiattrc)) write(unit=lunit)this%voldatiattrc
2473 
2474 if (.not. present(unit)) close(unit=lunit)
2475 
2476 end subroutine vol7d_write_on_file
2477 
2478 
2485 
2486 
2487 subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)
2488 
2489 TYPE(vol7d),INTENT(OUT) :: this
2490 integer,intent(inout),optional :: unit
2491 character(len=*),INTENT(in),optional :: filename
2492 character(len=*),intent(out),optional :: filename_auto
2493 character(len=*),INTENT(out),optional :: description
2494 integer,intent(out),optional :: tarray(8)
2495 
2496 
2497 integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
2498  ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
2499  ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
2500  ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
2501  nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
2502  nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
2503  nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
2504 
2505 character(len=254) :: ldescription,lfilename,arg
2506 integer :: ltarray(8),lunit,ios
2507 logical :: opened,exist
2508 
2509 
2510 call getarg(0,arg)
2511 
2512 if (.not. present(unit))then
2513  lunit=getunit()
2514 else
2515  if (unit==0)then
2516  lunit=getunit()
2517  unit=lunit
2518  else
2519  lunit=unit
2520  end if
2521 end if
2522 
2523 lfilename=trim(arg)//".v7d"
2524 if (index(arg,'/',back=.true.) > 0) lfilename=lfilename(index(arg,'/',back=.true.)+1 : )
2525 
2526 if (present(filename))then
2527  if (filename /= "")then
2528  lfilename=filename
2529  end if
2530 end if
2531 
2532 if (present(filename_auto))filename_auto=lfilename
2533 
2534 
2535 inquire(unit=lunit,opened=opened)
2536 IF (.NOT. opened) THEN
2537  inquire(file=lfilename,exist=exist)
2538  IF (.NOT.exist) THEN
2539  CALL l4f_log(l4f_fatal, &
2540  'in vol7d_read_from_file, file does not exists, cannot open')
2541  CALL raise_fatal_error()
2542  ENDIF
2543  OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access=stream_if_possible, &
2544  status='OLD', action='READ')
2545  CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
2546 end if
2547 
2548 
2549 call init(this)
2550 read(unit=lunit,iostat=ios)ldescription
2551 
2552 if (ios < 0) then ! A negative value indicates that the End of File or End of Record
2553  call vol7d_alloc (this)
2554  call vol7d_alloc_vol (this)
2555  if (present(description))description=ldescription
2556  if (present(tarray))tarray=ltarray
2557  if (.not. present(unit)) close(unit=lunit)
2558 end if
2559 
2560 read(unit=lunit)ltarray
2561 
2562 CALL l4f_log(l4f_info, 'Reading vol7d from file')
2563 CALL l4f_log(l4f_info, 'description: '//trim(ldescription))
2564 CALL l4f_log(l4f_info, 'written on '//trim(to_char(ltarray(1)))//' '// &
2565  trim(to_char(ltarray(2)))//' '//trim(to_char(ltarray(3))))
2566 
2567 if (present(description))description=ldescription
2568 if (present(tarray))tarray=ltarray
2569 
2570 read(unit=lunit)&
2571  nana, ntime, ntimerange, nlevel, nnetwork, &
2572  ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
2573  ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
2574  ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
2575  nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
2576  nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
2577  nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
2578  this%time_definition
2579 
2580 call vol7d_alloc (this, &
2581  nana=nana, ntime=ntime, ntimerange=ntimerange, nlevel=nlevel, nnetwork=nnetwork,&
2582  ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb,&
2583  ndativard=ndativard, ndativarc=ndativarc,&
2584  ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb,&
2585  ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
2586  ndativarattrr=ndativarattrr, ndativarattri=ndativarattri, ndativarattrb=ndativarattrb, &
2587  ndativarattrd=ndativarattrd, ndativarattrc=ndativarattrc,&
2588  nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, &
2589  nanavard=nanavard, nanavarc=nanavarc,&
2590  nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb,&
2591  nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
2592  nanavarattrr=nanavarattrr, nanavarattri=nanavarattri, nanavarattrb=nanavarattrb, &
2593  nanavarattrd=nanavarattrd, nanavarattrc=nanavarattrc)
2594 
2595 
2596 if (associated(this%ana)) call read_unit(this%ana, lunit)
2597 if (associated(this%time)) call read_unit(this%time, lunit)
2598 if (associated(this%level)) read(unit=lunit)this%level
2599 if (associated(this%timerange)) read(unit=lunit)this%timerange
2600 if (associated(this%network)) read(unit=lunit)this%network
2601 
2602 if (associated(this%anavar%r)) read(unit=lunit)this%anavar%r
2603 if (associated(this%anavar%i)) read(unit=lunit)this%anavar%i
2604 if (associated(this%anavar%b)) read(unit=lunit)this%anavar%b
2605 if (associated(this%anavar%d)) read(unit=lunit)this%anavar%d
2606 if (associated(this%anavar%c)) read(unit=lunit)this%anavar%c
2607 
2608 if (associated(this%anaattr%r)) read(unit=lunit)this%anaattr%r
2609 if (associated(this%anaattr%i)) read(unit=lunit)this%anaattr%i
2610 if (associated(this%anaattr%b)) read(unit=lunit)this%anaattr%b
2611 if (associated(this%anaattr%d)) read(unit=lunit)this%anaattr%d
2612 if (associated(this%anaattr%c)) read(unit=lunit)this%anaattr%c
2613 
2614 if (associated(this%anavarattr%r)) read(unit=lunit)this%anavarattr%r
2615 if (associated(this%anavarattr%i)) read(unit=lunit)this%anavarattr%i
2616 if (associated(this%anavarattr%b)) read(unit=lunit)this%anavarattr%b
2617 if (associated(this%anavarattr%d)) read(unit=lunit)this%anavarattr%d
2618 if (associated(this%anavarattr%c)) read(unit=lunit)this%anavarattr%c
2619 
2620 if (associated(this%dativar%r)) read(unit=lunit)this%dativar%r
2621 if (associated(this%dativar%i)) read(unit=lunit)this%dativar%i
2622 if (associated(this%dativar%b)) read(unit=lunit)this%dativar%b
2623 if (associated(this%dativar%d)) read(unit=lunit)this%dativar%d
2624 if (associated(this%dativar%c)) read(unit=lunit)this%dativar%c
2625 
2626 if (associated(this%datiattr%r)) read(unit=lunit)this%datiattr%r
2627 if (associated(this%datiattr%i)) read(unit=lunit)this%datiattr%i
2628 if (associated(this%datiattr%b)) read(unit=lunit)this%datiattr%b
2629 if (associated(this%datiattr%d)) read(unit=lunit)this%datiattr%d
2630 if (associated(this%datiattr%c)) read(unit=lunit)this%datiattr%c
2631 
2632 if (associated(this%dativarattr%r)) read(unit=lunit)this%dativarattr%r
2633 if (associated(this%dativarattr%i)) read(unit=lunit)this%dativarattr%i
2634 if (associated(this%dativarattr%b)) read(unit=lunit)this%dativarattr%b
2635 if (associated(this%dativarattr%d)) read(unit=lunit)this%dativarattr%d
2636 if (associated(this%dativarattr%c)) read(unit=lunit)this%dativarattr%c
2637 
2638 call vol7d_alloc_vol (this)
2639 
2640 !! Volumi di valori e attributi per anagrafica e dati
2641 
2642 if (associated(this%volanar)) read(unit=lunit)this%volanar
2643 if (associated(this%volanaattrr)) read(unit=lunit)this%volanaattrr
2644 if (associated(this%voldatir)) read(unit=lunit)this%voldatir
2645 if (associated(this%voldatiattrr)) read(unit=lunit)this%voldatiattrr
2646 
2647 if (associated(this%volanai)) read(unit=lunit)this%volanai
2648 if (associated(this%volanaattri)) read(unit=lunit)this%volanaattri
2649 if (associated(this%voldatii)) read(unit=lunit)this%voldatii
2650 if (associated(this%voldatiattri)) read(unit=lunit)this%voldatiattri
2651 
2652 if (associated(this%volanab)) read(unit=lunit)this%volanab
2653 if (associated(this%volanaattrb)) read(unit=lunit)this%volanaattrb
2654 if (associated(this%voldatib)) read(unit=lunit)this%voldatib
2655 if (associated(this%voldatiattrb)) read(unit=lunit)this%voldatiattrb
2656 
2657 if (associated(this%volanad)) read(unit=lunit)this%volanad
2658 if (associated(this%volanaattrd)) read(unit=lunit)this%volanaattrd
2659 if (associated(this%voldatid)) read(unit=lunit)this%voldatid
2660 if (associated(this%voldatiattrd)) read(unit=lunit)this%voldatiattrd
2661 
2662 if (associated(this%volanac)) read(unit=lunit)this%volanac
2663 if (associated(this%volanaattrc)) read(unit=lunit)this%volanaattrc
2664 if (associated(this%voldatic)) read(unit=lunit)this%voldatic
2665 if (associated(this%voldatiattrc)) read(unit=lunit)this%voldatiattrc
2666 
2667 if (.not. present(unit)) close(unit=lunit)
2668 
2669 end subroutine vol7d_read_from_file
2670 
2671 
2672 ! to double precision
2673 elemental doubleprecision function doubledatd(voldat,var)
2674 doubleprecision,intent(in) :: voldat
2675 type(vol7d_var),intent(in) :: var
2676 
2677 doubledatd=voldat
2678 
2679 end function doubledatd
2680 
2681 
2682 elemental doubleprecision function doubledatr(voldat,var)
2683 real,intent(in) :: voldat
2684 type(vol7d_var),intent(in) :: var
2685 
2686 if (c_e(voldat))then
2687  doubledatr=dble(voldat)
2688 else
2689  doubledatr=dmiss
2690 end if
2691 
2692 end function doubledatr
2693 
2694 
2695 elemental doubleprecision function doubledati(voldat,var)
2696 integer,intent(in) :: voldat
2697 type(vol7d_var),intent(in) :: var
2698 
2699 if (c_e(voldat)) then
2700  if (c_e(var%scalefactor))then
2701  doubledati=dble(voldat)/10.d0**var%scalefactor
2702  else
2703  doubledati=dble(voldat)
2704  endif
2705 else
2706  doubledati=dmiss
2707 end if
2708 
2709 end function doubledati
2710 
2711 
2712 elemental doubleprecision function doubledatb(voldat,var)
2713 integer(kind=int_b),intent(in) :: voldat
2714 type(vol7d_var),intent(in) :: var
2715 
2716 if (c_e(voldat)) then
2717  if (c_e(var%scalefactor))then
2718  doubledatb=dble(voldat)/10.d0**var%scalefactor
2719  else
2720  doubledatb=dble(voldat)
2721  endif
2722 else
2723  doubledatb=dmiss
2724 end if
2725 
2726 end function doubledatb
2727 
2728 
2729 elemental doubleprecision function doubledatc(voldat,var)
2730 CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
2731 type(vol7d_var),intent(in) :: var
2732 
2733 doubledatc = c2d(voldat)
2734 if (c_e(doubledatc) .and. c_e(var%scalefactor))then
2735  doubledatc=doubledatc/10.d0**var%scalefactor
2736 end if
2737 
2738 end function doubledatc
2739 
2740 
2741 ! to integer
2742 elemental integer function integerdatd(voldat,var)
2743 doubleprecision,intent(in) :: voldat
2744 type(vol7d_var),intent(in) :: var
2745 
2746 if (c_e(voldat))then
2747  if (c_e(var%scalefactor)) then
2748  integerdatd=nint(voldat*10d0**var%scalefactor)
2749  else
2750  integerdatd=nint(voldat)
2751  endif
2752 else
2753  integerdatd=imiss
2754 end if
2755 
2756 end function integerdatd
2757 
2758 
2759 elemental integer function integerdatr(voldat,var)
2760 real,intent(in) :: voldat
2761 type(vol7d_var),intent(in) :: var
2762 
2763 if (c_e(voldat))then
2764  if (c_e(var%scalefactor)) then
2765  integerdatr=nint(voldat*10d0**var%scalefactor)
2766  else
2767  integerdatr=nint(voldat)
2768  endif
2769 else
2770  integerdatr=imiss
2771 end if
2772 
2773 end function integerdatr
2774 
2775 
2776 elemental integer function integerdati(voldat,var)
2777 integer,intent(in) :: voldat
2778 type(vol7d_var),intent(in) :: var
2779 
2780 integerdati=voldat
2781 
2782 end function integerdati
2783 
2784 
2785 elemental integer function integerdatb(voldat,var)
2786 integer(kind=int_b),intent(in) :: voldat
2787 type(vol7d_var),intent(in) :: var
2788 
2789 if (c_e(voldat))then
2790  integerdatb=voldat
2791 else
2792  integerdatb=imiss
2793 end if
2794 
2795 end function integerdatb
2796 
2797 
2798 elemental integer function integerdatc(voldat,var)
2799 CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
2800 type(vol7d_var),intent(in) :: var
2801 
2802 integerdatc=c2i(voldat)
2803 
2804 end function integerdatc
2805 
2806 
2807 ! to real
2808 elemental real function realdatd(voldat,var)
2809 doubleprecision,intent(in) :: voldat
2810 type(vol7d_var),intent(in) :: var
2811 
2812 if (c_e(voldat))then
2813  realdatd=real(voldat)
2814 else
2815  realdatd=rmiss
2816 end if
2817 
2818 end function realdatd
2819 
2820 
2821 elemental real function realdatr(voldat,var)
2822 real,intent(in) :: voldat
2823 type(vol7d_var),intent(in) :: var
2824 
2825 realdatr=voldat
2826 
2827 end function realdatr
2828 
2829 
2830 elemental real function realdati(voldat,var)
2831 integer,intent(in) :: voldat
2832 type(vol7d_var),intent(in) :: var
2833 
2834 if (c_e(voldat)) then
2835  if (c_e(var%scalefactor))then
2836  realdati=float(voldat)/10.**var%scalefactor
2837  else
2838  realdati=float(voldat)
2839  endif
2840 else
2841  realdati=rmiss
2842 end if
2843 
2844 end function realdati
2845 
2846 
2847 elemental real function realdatb(voldat,var)
2848 integer(kind=int_b),intent(in) :: voldat
2849 type(vol7d_var),intent(in) :: var
2850 
2851 if (c_e(voldat)) then
2852  if (c_e(var%scalefactor))then
2853  realdatb=float(voldat)/10**var%scalefactor
2854  else
2855  realdatb=float(voldat)
2856  endif
2857 else
2858  realdatb=rmiss
2859 end if
2860 
2861 end function realdatb
2862 
2863 
2864 elemental real function realdatc(voldat,var)
2865 CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
2866 type(vol7d_var),intent(in) :: var
2867 
2868 realdatc=c2r(voldat)
2869 if (c_e(realdatc) .and. c_e(var%scalefactor))then
2870  realdatc=realdatc/10.**var%scalefactor
2871 end if
2872 
2873 end function realdatc
2874 
2875 
2881 FUNCTION realanavol(this, var) RESULT(vol)
2882 TYPE(vol7d),INTENT(in) :: this
2883 TYPE(vol7d_var),INTENT(in) :: var
2884 REAL :: vol(SIZE(this%ana),size(this%network))
2885 
2886 CHARACTER(len=1) :: dtype
2887 INTEGER :: indvar
2888 
2889 dtype = cmiss
2890 indvar = index(this%anavar, var, type=dtype)
2891 
2892 IF (indvar > 0) THEN
2893  SELECT CASE (dtype)
2894  CASE("d")
2895  vol = realdat(this%volanad(:,indvar,:), var)
2896  CASE("r")
2897  vol = this%volanar(:,indvar,:)
2898  CASE("i")
2899  vol = realdat(this%volanai(:,indvar,:), var)
2900  CASE("b")
2901  vol = realdat(this%volanab(:,indvar,:), var)
2902  CASE("c")
2903  vol = realdat(this%volanac(:,indvar,:), var)
2904  CASE default
2905  vol = rmiss
2906  END SELECT
2907 ELSE
2908  vol = rmiss
2909 ENDIF
2910 
2911 END FUNCTION realanavol
2912 
2913 
2919 FUNCTION integeranavol(this, var) RESULT(vol)
2920 TYPE(vol7d),INTENT(in) :: this
2921 TYPE(vol7d_var),INTENT(in) :: var
2922 INTEGER :: vol(SIZE(this%ana),size(this%network))
2923 
2924 CHARACTER(len=1) :: dtype
2925 INTEGER :: indvar
2926 
2927 dtype = cmiss
2928 indvar = index(this%anavar, var, type=dtype)
2929 
2930 IF (indvar > 0) THEN
2931  SELECT CASE (dtype)
2932  CASE("d")
2933  vol = integerdat(this%volanad(:,indvar,:), var)
2934  CASE("r")
2935  vol = integerdat(this%volanar(:,indvar,:), var)
2936  CASE("i")
2937  vol = this%volanai(:,indvar,:)
2938  CASE("b")
2939  vol = integerdat(this%volanab(:,indvar,:), var)
2940  CASE("c")
2941  vol = integerdat(this%volanac(:,indvar,:), var)
2942  CASE default
2943  vol = imiss
2944  END SELECT
2945 ELSE
2946  vol = imiss
2947 ENDIF
2948 
2949 END FUNCTION integeranavol
2950 
2951 
2957 subroutine move_datac (v7d,&
2958  indana,indtime,indlevel,indtimerange,indnetwork,&
2959  indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
2960 
2961 TYPE(vol7d),intent(inout) :: v7d
2962 
2963 integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
2964 integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
2965 integer :: inddativar,inddativarattr
2966 
2967 
2968 do inddativar=1,size(v7d%dativar%c)
2969 
2970  if (c_e(v7d%voldatic(indana,indtime,indlevel,indtimerange,inddativar,indnetwork)) .and. &
2971  .not. c_e(v7d%voldatic(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
2972  ) then
2973 
2974  ! dati
2975  v7d%voldatic &
2976  (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
2977  v7d%voldatic &
2978  (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
2979 
2980 
2981  ! attributi
2982  if (associated (v7d%dativarattr%i)) then
2983  inddativarattr = index(v7d%dativarattr%i,v7d%dativar%c(inddativar))
2984  if (inddativarattr > 0 ) then
2985  v7d%voldatiattri &
2986  (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
2987  v7d%voldatiattri &
2988  (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
2989  end if
2990  end if
2991 
2992  if (associated (v7d%dativarattr%r)) then
2993  inddativarattr = index(v7d%dativarattr%r,v7d%dativar%c(inddativar))
2994  if (inddativarattr > 0 ) then
2995  v7d%voldatiattrr &
2996  (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
2997  v7d%voldatiattrr &
2998  (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
2999  end if
3000  end if
3001 
3002  if (associated (v7d%dativarattr%d)) then
3003  inddativarattr = index(v7d%dativarattr%d,v7d%dativar%c(inddativar))
3004  if (inddativarattr > 0 ) then
3005  v7d%voldatiattrd &
3006  (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3007  v7d%voldatiattrd &
3008  (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3009  end if
3010  end if
3011 
3012  if (associated (v7d%dativarattr%b)) then
3013  inddativarattr = index(v7d%dativarattr%b,v7d%dativar%c(inddativar))
3014  if (inddativarattr > 0 ) then
3015  v7d%voldatiattrb &
3016  (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3017  v7d%voldatiattrb &
3018  (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3019  end if
3020  end if
3021 
3022  if (associated (v7d%dativarattr%c)) then
3023  inddativarattr = index(v7d%dativarattr%c,v7d%dativar%c(inddativar))
3024  if (inddativarattr > 0 ) then
3025  v7d%voldatiattrc &
3026  (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3027  v7d%voldatiattrc &
3028  (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3029  end if
3030  end if
3031 
3032  end if
3033 
3034 end do
3035 
3036 end subroutine move_datac
3037 
3043 subroutine move_datar (v7d,&
3044  indana,indtime,indlevel,indtimerange,indnetwork,&
3045  indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
3046 
3047 TYPE(vol7d),intent(inout) :: v7d
3048 
3049 integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
3050 integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
3051 integer :: inddativar,inddativarattr
3052 
3053 
3054 do inddativar=1,size(v7d%dativar%r)
3055 
3056  if (c_e(v7d%voldatir(indana,indtime,indlevel,indtimerange,inddativar,indnetwork)) .and. &
3057  .not. c_e(v7d%voldatir(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
3058  ) then
3059 
3060  ! dati
3061  v7d%voldatir &
3062  (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
3063  v7d%voldatir &
3064  (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
3065 
3066 
3067  ! attributi
3068  if (associated (v7d%dativarattr%i)) then
3069  inddativarattr = index(v7d%dativarattr%i,v7d%dativar%r(inddativar))
3070  if (inddativarattr > 0 ) then
3071  v7d%voldatiattri &
3072  (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3073  v7d%voldatiattri &
3074  (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3075  end if
3076  end if
3077 
3078  if (associated (v7d%dativarattr%r)) then
3079  inddativarattr = index(v7d%dativarattr%r,v7d%dativar%r(inddativar))
3080  if (inddativarattr > 0 ) then
3081  v7d%voldatiattrr &
3082  (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3083  v7d%voldatiattrr &
3084  (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3085  end if
3086  end if
3087 
3088  if (associated (v7d%dativarattr%d)) then
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 ...
Index method.
Restituiscono il valore dell&#39;oggetto in forma di stringa stampabile.
Costruttori per le classi datetime e timedelta.

Generated with Doxygen.