181 integer (kind=int_b):: att
182 integer (kind=int_b):: gross_error
189 integer,
parameter :: nqcattrvars=4
190 CHARACTER(len=10),
parameter :: qcattrvarsbtables(nqcattrvars)=(/
"*B33196",
"*B33192",
"*B33193",
"*B33194"/)
193 TYPE(vol7d_var
) :: vars(nqcattrvars)
194 CHARACTER(len=10) :: btables(nqcattrvars)
199 module procedure init_qcattrvars
204 module procedure peeledrb, peeleddb, peeledbb, peeledib, peeledcb &
205 ,peeledri, peeleddi, peeledbi, peeledii, peeledci &
206 ,peeledrr, peeleddr, peeledbr, peeledir, peeledcr &
207 ,peeledrd, peeleddd, peeledbd, peeledid, peeledcd &
208 ,peeledrc, peeleddc, peeledbc, peeledic, peeledcc
214 module procedure vdi,vdb,vdr,vdd,vdc
219 module procedure vdgei,vdgeb,vdger,vdged,vdgec
224 module procedure invalidatedi,invalidatedb,invalidatedr,invalidatedd,invalidatedc
230 public qcattrvars, nqcattrvars, qcattrvarsbtables
237 #undef VOL7D_POLY_SUBTYPE
238 #undef VOL7D_POLY_SUBTYPES
239 #undef VOL7D_POLY_ISC
240 #define VOL7D_POLY_SUBTYPE REAL
241 #define VOL7D_POLY_SUBTYPES r
243 #undef VOL7D_POLY_TYPE
244 #undef VOL7D_POLY_TYPES
245 #undef VOL7D_POLY_ISC
246 #undef VOL7D_POLY_TYPES_SUBTYPES
247 #define VOL7D_POLY_TYPE REAL
248 #define VOL7D_POLY_TYPES r
249 #define VOL7D_POLY_TYPES_SUBTYPES rr
250 #include "modqc_peeled_include.F90"
251 #include "modqc_peel_util_include.F90"
252 #undef VOL7D_POLY_TYPE
253 #undef VOL7D_POLY_TYPES
254 #undef VOL7D_POLY_TYPES_SUBTYPES
255 #define VOL7D_POLY_TYPE DOUBLE PRECISION
256 #define VOL7D_POLY_TYPES d
257 #define VOL7D_POLY_TYPES_SUBTYPES dr
258 #include "modqc_peeled_include.F90"
259 #include "modqc_peel_util_include.F90"
260 #undef VOL7D_POLY_TYPE
261 #undef VOL7D_POLY_TYPES
262 #undef VOL7D_POLY_TYPES_SUBTYPES
263 #define VOL7D_POLY_TYPE INTEGER
264 #define VOL7D_POLY_TYPES i
265 #define VOL7D_POLY_TYPES_SUBTYPES ir
266 #include "modqc_peeled_include.F90"
267 #include "modqc_peel_util_include.F90"
268 #undef VOL7D_POLY_TYPE
269 #undef VOL7D_POLY_TYPES
270 #undef VOL7D_POLY_TYPES_SUBTYPES
271 #define VOL7D_POLY_TYPE INTEGER(kind=int_b)
272 #define VOL7D_POLY_TYPES b
273 #define VOL7D_POLY_TYPES_SUBTYPES br
274 #include "modqc_peeled_include.F90"
275 #include "modqc_peel_util_include.F90"
276 #undef VOL7D_POLY_TYPE
277 #undef VOL7D_POLY_TYPES
278 #undef VOL7D_POLY_TYPES_SUBTYPES
279 #define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
280 #define VOL7D_POLY_TYPES c
281 #define VOL7D_POLY_ISC = 1
282 #define VOL7D_POLY_TYPES_SUBTYPES cr
283 #include "modqc_peeled_include.F90"
284 #include "modqc_peel_util_include.F90"
287 #undef VOL7D_POLY_SUBTYPE
288 #undef VOL7D_POLY_SUBTYPES
289 #undef VOL7D_POLY_ISC
290 #define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
291 #define VOL7D_POLY_SUBTYPES d
293 #undef VOL7D_POLY_TYPE
294 #undef VOL7D_POLY_TYPES
295 #undef VOL7D_POLY_TYPES_SUBTYPES
296 #define VOL7D_POLY_TYPE REAL
297 #define VOL7D_POLY_TYPES r
298 #define VOL7D_POLY_TYPES_SUBTYPES rd
299 #include "modqc_peeled_include.F90"
300 #undef VOL7D_POLY_TYPE
301 #undef VOL7D_POLY_TYPES
302 #undef VOL7D_POLY_TYPES_SUBTYPES
303 #define VOL7D_POLY_TYPE DOUBLE PRECISION
304 #define VOL7D_POLY_TYPES d
305 #define VOL7D_POLY_TYPES_SUBTYPES dd
306 #include "modqc_peeled_include.F90"
307 #undef VOL7D_POLY_TYPE
308 #undef VOL7D_POLY_TYPES
309 #undef VOL7D_POLY_TYPES_SUBTYPES
310 #define VOL7D_POLY_TYPE INTEGER
311 #define VOL7D_POLY_TYPES i
312 #define VOL7D_POLY_TYPES_SUBTYPES id
313 #include "modqc_peeled_include.F90"
314 #undef VOL7D_POLY_TYPE
315 #undef VOL7D_POLY_TYPES
316 #undef VOL7D_POLY_TYPES_SUBTYPES
317 #define VOL7D_POLY_TYPE INTEGER(kind=int_b)
318 #define VOL7D_POLY_TYPES b
319 #define VOL7D_POLY_TYPES_SUBTYPES bd
320 #include "modqc_peeled_include.F90"
321 #undef VOL7D_POLY_TYPE
322 #undef VOL7D_POLY_TYPES
323 #undef VOL7D_POLY_TYPES_SUBTYPES
324 #define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
325 #define VOL7D_POLY_TYPES c
326 #define VOL7D_POLY_TYPES_SUBTYPES cd
327 #include "modqc_peeled_include.F90"
330 #undef VOL7D_POLY_SUBTYPE
331 #undef VOL7D_POLY_SUBTYPES
332 #undef VOL7D_POLY_ISC
333 #define VOL7D_POLY_SUBTYPE INTEGER
334 #define VOL7D_POLY_SUBTYPES i
336 #undef VOL7D_POLY_TYPE
337 #undef VOL7D_POLY_TYPES
338 #undef VOL7D_POLY_TYPES_SUBTYPES
339 #define VOL7D_POLY_TYPE REAL
340 #define VOL7D_POLY_TYPES r
341 #define VOL7D_POLY_TYPES_SUBTYPES ri
342 #include "modqc_peeled_include.F90"
343 #undef VOL7D_POLY_TYPE
344 #undef VOL7D_POLY_TYPES
345 #undef VOL7D_POLY_TYPES_SUBTYPES
346 #define VOL7D_POLY_TYPE DOUBLE PRECISION
347 #define VOL7D_POLY_TYPES d
348 #define VOL7D_POLY_TYPES_SUBTYPES di
349 #include "modqc_peeled_include.F90"
350 #undef VOL7D_POLY_TYPE
351 #undef VOL7D_POLY_TYPES
352 #undef VOL7D_POLY_TYPES_SUBTYPES
353 #define VOL7D_POLY_TYPE INTEGER
354 #define VOL7D_POLY_TYPES i
355 #define VOL7D_POLY_TYPES_SUBTYPES ii
356 #include "modqc_peeled_include.F90"
357 #undef VOL7D_POLY_TYPE
358 #undef VOL7D_POLY_TYPES
359 #undef VOL7D_POLY_TYPES_SUBTYPES
360 #define VOL7D_POLY_TYPE INTEGER(kind=int_b)
361 #define VOL7D_POLY_TYPES b
362 #define VOL7D_POLY_TYPES_SUBTYPES bi
363 #include "modqc_peeled_include.F90"
364 #undef VOL7D_POLY_TYPE
365 #undef VOL7D_POLY_TYPES
366 #undef VOL7D_POLY_TYPES_SUBTYPES
367 #define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
368 #define VOL7D_POLY_TYPES c
369 #define VOL7D_POLY_ISC = 1
370 #define VOL7D_POLY_TYPES_SUBTYPES ci
371 #include "modqc_peeled_include.F90"
374 #undef VOL7D_POLY_SUBTYPE
375 #undef VOL7D_POLY_SUBTYPES
376 #undef VOL7D_POLY_ISC
377 #define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
378 #define VOL7D_POLY_SUBTYPES b
380 #undef VOL7D_POLY_TYPE
381 #undef VOL7D_POLY_TYPES
382 #undef VOL7D_POLY_TYPES_SUBTYPES
383 #define VOL7D_POLY_TYPE REAL
384 #define VOL7D_POLY_TYPES r
385 #define VOL7D_POLY_TYPES_SUBTYPES rb
386 #include "modqc_peeled_include.F90"
387 #undef VOL7D_POLY_TYPE
388 #undef VOL7D_POLY_TYPES
389 #undef VOL7D_POLY_TYPES_SUBTYPES
390 #define VOL7D_POLY_TYPE DOUBLE PRECISION
391 #define VOL7D_POLY_TYPES d
392 #define VOL7D_POLY_TYPES_SUBTYPES db
393 #include "modqc_peeled_include.F90"
394 #undef VOL7D_POLY_TYPE
395 #undef VOL7D_POLY_TYPES
396 #undef VOL7D_POLY_TYPES_SUBTYPES
397 #define VOL7D_POLY_TYPE INTEGER
398 #define VOL7D_POLY_TYPES i
399 #define VOL7D_POLY_TYPES_SUBTYPES ib
400 #include "modqc_peeled_include.F90"
401 #undef VOL7D_POLY_TYPE
402 #undef VOL7D_POLY_TYPES
403 #undef VOL7D_POLY_TYPES_SUBTYPES
404 #define VOL7D_POLY_TYPE INTEGER(kind=int_b)
405 #define VOL7D_POLY_TYPES b
406 #define VOL7D_POLY_TYPES_SUBTYPES bb
407 #include "modqc_peeled_include.F90"
408 #undef VOL7D_POLY_TYPE
409 #undef VOL7D_POLY_TYPES
410 #undef VOL7D_POLY_TYPES_SUBTYPES
411 #define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
412 #define VOL7D_POLY_TYPES c
413 #define VOL7D_POLY_ISC = 1
414 #define VOL7D_POLY_TYPES_SUBTYPES cb
415 #include "modqc_peeled_include.F90"
418 #undef VOL7D_POLY_SUBTYPE
419 #undef VOL7D_POLY_SUBTYPES
420 #undef VOL7D_POLY_ISC
421 #define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
422 #define VOL7D_POLY_SUBTYPES c
424 #undef VOL7D_POLY_TYPE
425 #undef VOL7D_POLY_TYPES
426 #undef VOL7D_POLY_TYPES_SUBTYPES
427 #define VOL7D_POLY_TYPE REAL
428 #define VOL7D_POLY_TYPES r
429 #define VOL7D_POLY_TYPES_SUBTYPES rc
430 #include "modqc_peeled_include.F90"
431 #undef VOL7D_POLY_TYPE
432 #undef VOL7D_POLY_TYPES
433 #undef VOL7D_POLY_TYPES_SUBTYPES
434 #define VOL7D_POLY_TYPE DOUBLE PRECISION
435 #define VOL7D_POLY_TYPES d
436 #define VOL7D_POLY_TYPES_SUBTYPES dc
437 #include "modqc_peeled_include.F90"
438 #undef VOL7D_POLY_TYPE
439 #undef VOL7D_POLY_TYPES
440 #undef VOL7D_POLY_TYPES_SUBTYPES
441 #define VOL7D_POLY_TYPE INTEGER
442 #define VOL7D_POLY_TYPES i
443 #define VOL7D_POLY_TYPES_SUBTYPES ic
444 #include "modqc_peeled_include.F90"
445 #undef VOL7D_POLY_TYPE
446 #undef VOL7D_POLY_TYPES
447 #undef VOL7D_POLY_TYPES_SUBTYPES
448 #define VOL7D_POLY_TYPE INTEGER(kind=int_b)
449 #define VOL7D_POLY_TYPES b
450 #define VOL7D_POLY_TYPES_SUBTYPES bc
451 #include "modqc_peeled_include.F90"
452 #undef VOL7D_POLY_TYPE
453 #undef VOL7D_POLY_TYPES
454 #undef VOL7D_POLY_TYPES_SUBTYPES
455 #define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
456 #define VOL7D_POLY_TYPES c
457 #define VOL7D_POLY_ISC = 1
458 #define VOL7D_POLY_TYPES_SUBTYPES cc
459 #include "modqc_peeled_include.F90"
462 subroutine init_qcattrvars(this)
464 type(qcattrvars
),
intent(inout) :: this
467 this%btables(:) =qcattrvarsbtables
469 call
init(this%vars(i),this%btables(i))
472 end subroutine init_qcattrvars
475 type(qcattrvars
) function qcattrvars_new()
477 call
init(qcattrvars_new)
479 end function qcattrvars_new
489 SUBROUTINE vol7d_peeling(this, data_id, keep_attr, delete_attr, preserve, purgeana)
490 TYPE(vol7d
),
INTENT(INOUT) :: this
491 integer,
INTENT(inout),
pointer,
OPTIONAL :: data_id(:,:,:,:,:)
492 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: keep_attr(:)
493 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: delete_attr(:)
494 logical,
intent(in),
optional :: preserve
495 logical,
intent(in),
optional :: purgeana
497 integer :: inddativar,inddatiattrinv,inddatiattrcli,inddatiattrtem,inddatiattrspa,inddativarattr
498 type(qcattrvars
) :: attrvars
500 INTEGER(kind=int_b),
pointer :: invbb(:,:,:,:,:),clibb(:,:,:,:,:),tembb(:,:,:,:,:),spabb(:,:,:,:,:)
501 INTEGER,
pointer :: invbi(:,:,:,:,:),clibi(:,:,:,:,:),tembi(:,:,:,:,:),spabi(:,:,:,:,:)
502 REAL,
pointer :: invbr(:,:,:,:,:),clibr(:,:,:,:,:),tembr(:,:,:,:,:),spabr(:,:,:,:,:)
503 DOUBLE PRECISION,
pointer :: invbd(:,:,:,:,:),clibd(:,:,:,:,:),tembd(:,:,:,:,:),spabd(:,:,:,:,:)
504 CHARACTER(len=vol7d_cdatalen),
pointer :: invbc(:,:,:,:,:),clibc(:,:,:,:,:),tembc(:,:,:,:,:),spabc(:,:,:,:,:)
506 call l4f_log(l4f_info,
'starting peeling')
514 #undef VOL7D_POLY_SUBTYPE
515 #undef VOL7D_POLY_SUBTYPES
516 #define VOL7D_POLY_SUBTYPE REAL
517 #define VOL7D_POLY_SUBTYPES r
519 #undef VOL7D_POLY_TYPE
520 #undef VOL7D_POLY_TYPES
521 #define VOL7D_POLY_TYPE REAL
522 #define VOL7D_POLY_TYPES r
523 #include "modqc_peeling_include.F90"
524 #undef VOL7D_POLY_TYPE
525 #undef VOL7D_POLY_TYPES
526 #define VOL7D_POLY_TYPE DOUBLE PRECISION
527 #define VOL7D_POLY_TYPES d
528 #include "modqc_peeling_include.F90"
529 #undef VOL7D_POLY_TYPE
530 #undef VOL7D_POLY_TYPES
531 #define VOL7D_POLY_TYPE INTEGER
532 #define VOL7D_POLY_TYPES i
533 #include "modqc_peeling_include.F90"
534 #undef VOL7D_POLY_TYPE
535 #undef VOL7D_POLY_TYPES
536 #define VOL7D_POLY_TYPE INTEGER(kind=int_b)
537 #define VOL7D_POLY_TYPES b
538 #include "modqc_peeling_include.F90"
539 #undef VOL7D_POLY_TYPE
540 #undef VOL7D_POLY_TYPES
541 #define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
542 #define VOL7D_POLY_TYPES c
543 #include "modqc_peeling_include.F90"
546 #undef VOL7D_POLY_SUBTYPE
547 #undef VOL7D_POLY_SUBTYPES
548 #define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
549 #define VOL7D_POLY_SUBTYPES d
551 #undef VOL7D_POLY_TYPE
552 #undef VOL7D_POLY_TYPES
553 #define VOL7D_POLY_TYPE REAL
554 #define VOL7D_POLY_TYPES r
555 #include "modqc_peeling_include.F90"
556 #undef VOL7D_POLY_TYPE
557 #undef VOL7D_POLY_TYPES
558 #define VOL7D_POLY_TYPE DOUBLE PRECISION
559 #define VOL7D_POLY_TYPES d
560 #include "modqc_peeling_include.F90"
561 #undef VOL7D_POLY_TYPE
562 #undef VOL7D_POLY_TYPES
563 #define VOL7D_POLY_TYPE INTEGER
564 #define VOL7D_POLY_TYPES i
565 #include "modqc_peeling_include.F90"
566 #undef VOL7D_POLY_TYPE
567 #undef VOL7D_POLY_TYPES
568 #define VOL7D_POLY_TYPE INTEGER(kind=int_b)
569 #define VOL7D_POLY_TYPES b
570 #include "modqc_peeling_include.F90"
571 #undef VOL7D_POLY_TYPE
572 #undef VOL7D_POLY_TYPES
573 #define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
574 #define VOL7D_POLY_TYPES c
575 #include "modqc_peeling_include.F90"
578 #undef VOL7D_POLY_SUBTYPE
579 #undef VOL7D_POLY_SUBTYPES
580 #define VOL7D_POLY_SUBTYPE INTEGER
581 #define VOL7D_POLY_SUBTYPES i
583 #undef VOL7D_POLY_TYPE
584 #undef VOL7D_POLY_TYPES
585 #define VOL7D_POLY_TYPE REAL
586 #define VOL7D_POLY_TYPES r
587 #include "modqc_peeling_include.F90"
588 #undef VOL7D_POLY_TYPE
589 #undef VOL7D_POLY_TYPES
590 #define VOL7D_POLY_TYPE DOUBLE PRECISION
591 #define VOL7D_POLY_TYPES d
592 #include "modqc_peeling_include.F90"
593 #undef VOL7D_POLY_TYPE
594 #undef VOL7D_POLY_TYPES
595 #define VOL7D_POLY_TYPE INTEGER
596 #define VOL7D_POLY_TYPES i
597 #include "modqc_peeling_include.F90"
598 #undef VOL7D_POLY_TYPE
599 #undef VOL7D_POLY_TYPES
600 #define VOL7D_POLY_TYPE INTEGER(kind=int_b)
601 #define VOL7D_POLY_TYPES b
602 #include "modqc_peeling_include.F90"
603 #undef VOL7D_POLY_TYPE
604 #undef VOL7D_POLY_TYPES
605 #define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
606 #define VOL7D_POLY_TYPES c
607 #include "modqc_peeling_include.F90"
610 #undef VOL7D_POLY_SUBTYPE
611 #undef VOL7D_POLY_SUBTYPES
612 #define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
613 #define VOL7D_POLY_SUBTYPES b
615 #undef VOL7D_POLY_TYPE
616 #undef VOL7D_POLY_TYPES
617 #define VOL7D_POLY_TYPE REAL
618 #define VOL7D_POLY_TYPES r
619 #include "modqc_peeling_include.F90"
620 #undef VOL7D_POLY_TYPE
621 #undef VOL7D_POLY_TYPES
622 #define VOL7D_POLY_TYPE DOUBLE PRECISION
623 #define VOL7D_POLY_TYPES d
624 #include "modqc_peeling_include.F90"
625 #undef VOL7D_POLY_TYPE
626 #undef VOL7D_POLY_TYPES
627 #define VOL7D_POLY_TYPE INTEGER
628 #define VOL7D_POLY_TYPES i
629 #include "modqc_peeling_include.F90"
630 #undef VOL7D_POLY_TYPE
631 #undef VOL7D_POLY_TYPES
632 #define VOL7D_POLY_TYPE INTEGER(kind=int_b)
633 #define VOL7D_POLY_TYPES b
634 #include "modqc_peeling_include.F90"
635 #undef VOL7D_POLY_TYPE
636 #undef VOL7D_POLY_TYPES
637 #define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
638 #define VOL7D_POLY_TYPES c
639 #include "modqc_peeling_include.F90"
643 #undef VOL7D_POLY_SUBTYPE
644 #undef VOL7D_POLY_SUBTYPES
645 #define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
646 #define VOL7D_POLY_SUBTYPES c
648 #undef VOL7D_POLY_TYPE
649 #undef VOL7D_POLY_TYPES
650 #define VOL7D_POLY_TYPE REAL
651 #define VOL7D_POLY_TYPES r
652 #include "modqc_peeling_include.F90"
653 #undef VOL7D_POLY_TYPE
654 #undef VOL7D_POLY_TYPES
655 #define VOL7D_POLY_TYPE DOUBLE PRECISION
656 #define VOL7D_POLY_TYPES d
657 #include "modqc_peeling_include.F90"
658 #undef VOL7D_POLY_TYPE
659 #undef VOL7D_POLY_TYPES
660 #define VOL7D_POLY_TYPE INTEGER
661 #define VOL7D_POLY_TYPES i
662 #include "modqc_peeling_include.F90"
663 #undef VOL7D_POLY_TYPE
664 #undef VOL7D_POLY_TYPES
665 #define VOL7D_POLY_TYPE INTEGER(kind=int_b)
666 #define VOL7D_POLY_TYPES b
667 #include "modqc_peeling_include.F90"
668 #undef VOL7D_POLY_TYPE
669 #undef VOL7D_POLY_TYPES
670 #define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
671 #define VOL7D_POLY_TYPES c
672 #include "modqc_peeling_include.F90"
676 IF (.NOT.present(keep_attr) .AND. .NOT.present(delete_attr) .and. .not. optio_log(preserve))
THEN
677 IF (
ASSOCIATED(this%voldatiattrr))
DEALLOCATE(this%voldatiattrr)
678 IF (
ASSOCIATED(this%voldatiattrd))
DEALLOCATE(this%voldatiattrd)
679 IF (
ASSOCIATED(this%voldatiattri))
DEALLOCATE(this%voldatiattri)
680 IF (
ASSOCIATED(this%voldatiattrb))
DEALLOCATE(this%voldatiattrb)
681 IF (
ASSOCIATED(this%voldatiattrc))
DEALLOCATE(this%voldatiattrc)
683 CALL
delete(this%datiattr)
684 CALL
delete(this%dativarattr)
687 IF (present(keep_attr))
THEN
689 if (optio_log(preserve)) call l4f_log(l4f_warn,
"preserve parameter ignored: keep_attr passed")
690 CALL keep_var(this%datiattr%r)
691 CALL keep_var(this%datiattr%d)
692 CALL keep_var(this%datiattr%i)
693 CALL keep_var(this%datiattr%b)
694 CALL keep_var(this%datiattr%c)
695 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
697 ELSE IF (present(delete_attr))
THEN
699 if (optio_log(preserve)) call l4f_log(l4f_warn,
"preserve parameter ignored: delete_attr passed")
700 CALL delete_var(this%datiattr%r)
701 CALL delete_var(this%datiattr%d)
702 CALL delete_var(this%datiattr%i)
703 CALL delete_var(this%datiattr%b)
704 CALL delete_var(this%datiattr%c)
705 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
707 ELSE IF (present(purgeana))
THEN
709 CALL qc_reform(this,data_id, purgeana=purgeana)
718 subroutine qc_reform(this,data_id,miss, purgeana)
719 TYPE(vol7d
),
INTENT(INOUT) :: this
720 integer,
INTENT(inout),
pointer,
OPTIONAL :: data_id(:,:,:,:,:)
721 logical,
intent(in),
optional :: miss
722 logical,
intent(in),
optional :: purgeana
724 integer,
pointer :: data_idtmp(:,:,:,:,:)
725 logical,
allocatable :: llana(:)
726 integer,
allocatable :: anaind(:)
729 if (optio_log(purgeana))
then
730 allocate(llana(
size(this%ana)))
732 do i =1,
size(this%ana)
733 if (
associated(this%voldatii)) llana(i)= llana(i) .or. any(
c_e(this%voldatii(i,:,:,:,:,:)))
734 if (
associated(this%voldatir)) llana(i)= llana(i) .or. any(
c_e(this%voldatir(i,:,:,:,:,:)))
735 if (
associated(this%voldatid)) llana(i)= llana(i) .or. any(
c_e(this%voldatid(i,:,:,:,:,:)))
736 if (
associated(this%voldatib)) llana(i)= llana(i) .or. any(
c_e(this%voldatib(i,:,:,:,:,:)))
737 if (
associated(this%voldatic)) llana(i)= llana(i) .or. any(
c_e(this%voldatic(i,:,:,:,:,:)))
740 if (.not. llana(i)) call l4f_log(l4f_debug,
"remove station"//
t2c(i))
748 allocate(anaind(nana))
751 do i=1,
size(this%ana)
759 if(present(data_id))
then
760 allocate(data_idtmp(nana,
size(data_id,2),
size(data_id,3),
size(data_id,4),
size(data_id,5)))
761 data_idtmp=data_id(anaind,:,:,:,:)
762 if (
associated(data_id))
deallocate(data_id)
766 call vol7d_reform(this,miss=miss,lana=llana)
768 deallocate(llana,anaind)
772 call vol7d_reform(this,miss=miss)
776 end subroutine qc_reform
779 SUBROUTINE keep_var(var)
780 TYPE(vol7d_var
),
intent(inout),
POINTER :: var(:)
784 IF (
ASSOCIATED(var))
THEN
785 if (
size(var) == 0)
then
786 var%btable = vol7d_var_miss%btable
789 IF (all(var(i)%btable /= keep_attr(:)))
THEN
790 var(i)%btable = vol7d_var_miss%btable
796 END SUBROUTINE keep_var
798 SUBROUTINE delete_var(var)
799 TYPE(vol7d_var
),
intent(inout),
POINTER :: var(:)
803 IF (
ASSOCIATED(var))
THEN
804 if (
size(var) == 0)
then
805 var%btable = vol7d_var_miss%btable
808 IF (any(var(i)%btable == delete_attr(:)))
THEN
809 var(i) = vol7d_var_miss
815 END SUBROUTINE delete_var
817 END SUBROUTINE vol7d_peeling
Definitions of constants and functions for working with missing values.
Functions that return a trimmed CHARACTER representation of the input variable.
Check data validity based on gross error check.
Definisce il livello di attendibilità per i dati validi.
Check data validity based on single confidence.
Classe per la gestione di un volume completo di dati osservati.
Distruttori per le 2 classi.
Utilities and defines for quality control.
Definition of constants to be used for declaring variables of a desired type.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Remove data under a defined grade of confidence.
Variables user in Quality Control.