- Timestamp:
- 2021-08-13T11:34:58+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/diaobs.F90
r15180 r15187 249 249 & sobsgroups(jgroup)%cobstypes ) 250 250 ! 251 IF( sobsgroups(jgroup)%lsla ) THEN 252 sobsgroups(jgroup)%ssurfdata%cextvars(sobsgroups(jgroup)%next_mdt) = 'MDT' 253 sobsgroups(jgroup)%ssurfdata%cextlong(sobsgroups(jgroup)%next_mdt) = 'Mean dynamic topography' 254 sobsgroups(jgroup)%ssurfdata%cextunit(sobsgroups(jgroup)%next_mdt) = 'Metres' 255 sobsgroups(jgroup)%ssurfdata%caddvars(sobsgroups(jgroup)%nadd_ssh) = 'SSH' 256 DO jvar = 1, sobsgroups(jgroup)%nobstypes 257 sobsgroups(jgroup)%ssurfdata%caddlong(sobsgroups(jgroup)%nadd_ssh,jvar) = 'Model Sea surface height' 258 sobsgroups(jgroup)%ssurfdata%caddunit(sobsgroups(jgroup)%nadd_ssh,jvar) = 'Metres' 259 END DO 260 ENDIF 251 261 252 262 CALL obs_pre_surf( sobsgroups(jgroup)%ssurfdata, & … … 261 271 IF( sobsgroups(jgroup)%lsla ) THEN 262 272 CALL obs_rea_mdt( sobsgroups(jgroup)%ssurfdataqc, & 263 & sobsgroups(jgroup)%n2dint ) 273 & sobsgroups(jgroup)%n2dint, & 274 & sobsgroups(jgroup)%next_mdt ) 264 275 IF( sobsgroups(jgroup)%laltbias ) THEN 265 CALL obs_rea_altbias( sobsgroups(jgroup)%ssurfdataqc, & 266 & sobsgroups(jgroup)%n2dint, & 267 & sobsgroups(jgroup)%caltbiasfile ) 276 !CALL obs_rea_altbias( sobsgroups(jgroup)%ssurfdataqc, & 277 ! & sobsgroups(jgroup)%n2dint, & 278 ! & sobsgroups(jgroup)%caltbiasfile ) 279 CALL obs_app_bias( sobsgroups(jgroup)%ssurfdataqc, & 280 & sobsgroups(jgroup)%next_mdt, & 281 & sobsgroups(jgroup)%n2dint, & 282 & 1, & 283 & sobsgroups(jgroup)%caltbiasfile, & 284 & 'altbias', & 285 & ld_extvar=.TRUE. ) 268 286 ENDIF 269 287 ENDIF … … 423 441 & sobsgroups(jgroup)%ravglamscl, & 424 442 & sobsgroups(jgroup)%ravgphiscl, & 425 & sobsgroups(jgroup)%lfp_indegs ) 443 & sobsgroups(jgroup)%lfp_indegs, & 444 & kssh=sobsgroups(jgroup)%nadd_ssh, & 445 & kmdt=sobsgroups(jgroup)%next_mdt ) 426 446 427 447 END DO … … 463 483 !! * Local declarations 464 484 INTEGER :: jgroup ! Data set loop variable 465 INTEGER :: jo, jvar, jk, jadd, jext 485 INTEGER :: jo, jvar, jk, jadd, jext, jadd2, jext2 466 486 REAL(wp), DIMENSION(:), ALLOCATABLE :: & 467 487 & zu, & 468 488 & zv 489 LOGICAL, DIMENSION(:), ALLOCATABLE :: ll_write 469 490 TYPE(obswriinfo) :: sladd, slext 470 491 … … 513 534 & sobsgroups(jgroup)%sprofdata, .TRUE., numout ) 514 535 536 ! Put additional and extra variable information into obswriinfo structure 537 ! used by obs_write. 538 ! add/ext variables generated by the OBS code (1...sobsgroups(jgroup)%naddvars) 539 ! may duplicate ones read in (%naddvars+1...sobsgroups(jgroup)%sprofdata%nadd) 540 ! Check for this, and if so only write out the version generated by the OBS code 515 541 sladd%inum = sobsgroups(jgroup)%sprofdata%nadd 542 ALLOCATE( ll_write(sobsgroups(jgroup)%sprofdata%nadd) ) 543 ll_write(:) = .TRUE. 544 IF ( (sobsgroups(jgroup)%naddvars > 0) .AND. & 545 & (sobsgroups(jgroup)%sprofdata%nadd > sobsgroups(jgroup)%naddvars) ) THEN 546 DO jadd = sobsgroups(jgroup)%naddvars + 1, sobsgroups(jgroup)%sprofdata%nadd 547 DO jadd2 = 1, sobsgroups(jgroup)%naddvars 548 IF ( TRIM(sobsgroups(jgroup)%sprofdata%caddvars(jadd )) == & 549 & TRIM(sobsgroups(jgroup)%sprofdata%caddvars(jadd2)) ) THEN 550 sladd%inum = sladd%inum - 1 551 ll_write(jadd) = .FALSE. 552 ENDIF 553 END DO 554 END DO 555 ENDIF 516 556 IF ( sladd%inum > 0 ) THEN 517 557 ALLOCATE( sladd%ipoint(sladd%inum), & … … 519 559 & sladd%cdlong(sladd%inum,sobsgroups(jgroup)%sprofdata%nvar), & 520 560 & sladd%cdunit(sladd%inum,sobsgroups(jgroup)%sprofdata%nvar) ) 521 DO jadd = 1, sladd%inum 522 sladd%ipoint(jadd) = jadd 523 sladd%cdname(jadd) = sobsgroups(jgroup)%sprofdata%caddvars(jadd) 524 DO jvar = 1, sobsgroups(jgroup)%sprofdata%nvar 525 sladd%cdlong(jadd,jvar) = sobsgroups(jgroup)%sprofdata%caddlong(jadd,jvar) 526 sladd%cdunit(jadd,jvar) = sobsgroups(jgroup)%sprofdata%caddunit(jadd,jvar) 561 jadd2 = 0 562 DO jadd = 1, sobsgroups(jgroup)%sprofdata%nadd 563 IF ( ll_write(jadd) ) THEN 564 jadd2 = jadd2 + 1 565 sladd%ipoint(jadd2) = jadd 566 sladd%cdname(jadd2) = sobsgroups(jgroup)%sprofdata%caddvars(jadd) 567 DO jvar = 1, sobsgroups(jgroup)%sprofdata%nvar 568 sladd%cdlong(jadd2,jvar) = sobsgroups(jgroup)%sprofdata%caddlong(jadd,jvar) 569 sladd%cdunit(jadd2,jvar) = sobsgroups(jgroup)%sprofdata%caddunit(jadd,jvar) 570 END DO 571 ENDIF 572 END DO 573 ENDIF 574 DEALLOCATE( ll_write ) 575 576 slext%inum = sobsgroups(jgroup)%sprofdata%next 577 ALLOCATE( ll_write(sobsgroups(jgroup)%sprofdata%next) ) 578 ll_write(:) = .TRUE. 579 IF ( (sobsgroups(jgroup)%nextvars > 0) .AND. & 580 & (sobsgroups(jgroup)%sprofdata%next > sobsgroups(jgroup)%nextvars) ) THEN 581 DO jext = sobsgroups(jgroup)%nextvars + 1, sobsgroups(jgroup)%sprofdata%next 582 DO jext2 = 1, sobsgroups(jgroup)%nextvars 583 IF ( TRIM(sobsgroups(jgroup)%sprofdata%cextvars(jext )) == & 584 & TRIM(sobsgroups(jgroup)%sprofdata%cextvars(jext2)) ) THEN 585 slext%inum = slext%inum - 1 586 ll_write(jext) = .FALSE. 587 ENDIF 527 588 END DO 528 589 END DO 529 590 ENDIF 530 slext%inum = sobsgroups(jgroup)%sprofdata%next531 591 IF ( slext%inum > 0 ) THEN 532 592 ALLOCATE( slext%ipoint(slext%inum), & … … 534 594 & slext%cdlong(slext%inum,1), & 535 595 & slext%cdunit(slext%inum,1) ) 536 DO jext = 1, slext%inum 537 slext%ipoint(jext) = jext 538 slext%cdname(jext) = sobsgroups(jgroup)%sprofdata%cextvars(jext) 539 slext%cdlong(jext,1) = sobsgroups(jgroup)%sprofdata%cextlong(jext) 540 slext%cdunit(jext,1) = sobsgroups(jgroup)%sprofdata%cextunit(jext) 541 END DO 542 ENDIF 596 jext2 = 0 597 DO jext = 1, sobsgroups(jgroup)%sprofdata%next 598 IF ( ll_write(jext) ) THEN 599 jext2 = jext2 + 1 600 slext%ipoint(jext2) = jext 601 slext%cdname(jext2) = sobsgroups(jgroup)%sprofdata%cextvars(jext) 602 slext%cdlong(jext2,1) = sobsgroups(jgroup)%sprofdata%cextlong(jext) 603 slext%cdunit(jext2,1) = sobsgroups(jgroup)%sprofdata%cextunit(jext) 604 ENDIF 605 END DO 606 ENDIF 607 DEALLOCATE( ll_write ) 543 608 544 609 CALL obs_wri_prof( sobsgroups(jgroup)%sprofdata, sobsgroups(jgroup)%cgroupname, sladd, slext ) … … 556 621 & sobsgroups(jgroup)%ssurfdata, .TRUE., numout ) 557 622 623 ! Put additional and extra variable information into obswriinfo structure 624 ! used by obs_write. 625 ! add/ext variables generated by the OBS code (1...sobsgroups(jgroup)%naddvars) 626 ! may duplicate ones read in (%naddvars+1...sobsgroups(jgroup)%ssurfdata%nadd) 627 ! Check for this, and if so only write out the version generated by the OBS code 558 628 sladd%inum = sobsgroups(jgroup)%ssurfdata%nadd 629 ALLOCATE( ll_write(sobsgroups(jgroup)%ssurfdata%nadd) ) 630 ll_write(:) = .TRUE. 631 IF ( (sobsgroups(jgroup)%naddvars > 0) .AND. & 632 & (sobsgroups(jgroup)%ssurfdata%nadd > sobsgroups(jgroup)%naddvars) ) THEN 633 DO jadd = sobsgroups(jgroup)%naddvars + 1, sobsgroups(jgroup)%ssurfdata%nadd 634 DO jadd2 = 1, sobsgroups(jgroup)%naddvars 635 IF ( TRIM(sobsgroups(jgroup)%ssurfdata%caddvars(jadd )) == & 636 & TRIM(sobsgroups(jgroup)%ssurfdata%caddvars(jadd2)) ) THEN 637 sladd%inum = sladd%inum - 1 638 ll_write(jadd) = .FALSE. 639 ENDIF 640 END DO 641 END DO 642 ENDIF 559 643 IF ( sladd%inum > 0 ) THEN 560 644 ALLOCATE( sladd%ipoint(sladd%inum), & … … 562 646 & sladd%cdlong(sladd%inum,sobsgroups(jgroup)%ssurfdata%nvar), & 563 647 & sladd%cdunit(sladd%inum,sobsgroups(jgroup)%ssurfdata%nvar) ) 564 DO jadd = 1, sladd%inum 565 sladd%ipoint(jadd) = jadd 566 sladd%cdname(jadd) = sobsgroups(jgroup)%ssurfdata%caddvars(jadd) 567 DO jvar = 1, sobsgroups(jgroup)%ssurfdata%nvar 568 sladd%cdlong(jadd,jvar) = sobsgroups(jgroup)%ssurfdata%caddlong(jadd,jvar) 569 sladd%cdunit(jadd,jvar) = sobsgroups(jgroup)%ssurfdata%caddunit(jadd,jvar) 648 jadd2 = 0 649 DO jadd = 1, sobsgroups(jgroup)%ssurfdata%nadd 650 IF ( ll_write(jadd) ) THEN 651 jadd2 = jadd2 + 1 652 sladd%ipoint(jadd2) = jadd 653 sladd%cdname(jadd2) = sobsgroups(jgroup)%ssurfdata%caddvars(jadd) 654 DO jvar = 1, sobsgroups(jgroup)%ssurfdata%nvar 655 sladd%cdlong(jadd2,jvar) = sobsgroups(jgroup)%ssurfdata%caddlong(jadd,jvar) 656 sladd%cdunit(jadd2,jvar) = sobsgroups(jgroup)%ssurfdata%caddunit(jadd,jvar) 657 END DO 658 ENDIF 659 END DO 660 ENDIF 661 DEALLOCATE( ll_write ) 662 663 slext%inum = sobsgroups(jgroup)%ssurfdata%nextra 664 ALLOCATE( ll_write(sobsgroups(jgroup)%ssurfdata%nextra) ) 665 ll_write(:) = .TRUE. 666 IF ( (sobsgroups(jgroup)%nextvars > 0) .AND. & 667 & (sobsgroups(jgroup)%ssurfdata%nextra > sobsgroups(jgroup)%nextvars) ) THEN 668 DO jext = sobsgroups(jgroup)%nextvars + 1, sobsgroups(jgroup)%ssurfdata%nextra 669 DO jext2 = 1, sobsgroups(jgroup)%nextvars 670 IF ( TRIM(sobsgroups(jgroup)%ssurfdata%cextvars(jext )) == & 671 & TRIM(sobsgroups(jgroup)%ssurfdata%cextvars(jext2)) ) THEN 672 slext%inum = slext%inum - 1 673 ll_write(jext) = .FALSE. 674 ENDIF 570 675 END DO 571 676 END DO 572 677 ENDIF 573 slext%inum = sobsgroups(jgroup)%ssurfdata%nextra574 678 IF ( slext%inum > 0 ) THEN 575 679 ALLOCATE( slext%ipoint(slext%inum), & … … 577 681 & slext%cdlong(slext%inum,1), & 578 682 & slext%cdunit(slext%inum,1) ) 579 DO jext = 1, slext%inum 580 slext%ipoint(jext) = jext 581 slext%cdname(jext) = sobsgroups(jgroup)%ssurfdata%cextvars(jext) 582 slext%cdlong(jext,1) = sobsgroups(jgroup)%ssurfdata%cextlong(jext) 583 slext%cdunit(jext,1) = sobsgroups(jgroup)%ssurfdata%cextunit(jext) 584 END DO 585 ENDIF 683 jext2 = 0 684 DO jext = 1, sobsgroups(jgroup)%ssurfdata%nextra 685 IF ( ll_write(jext) ) THEN 686 jext2 = jext2 + 1 687 slext%ipoint(jext2) = jext 688 slext%cdname(jext2) = sobsgroups(jgroup)%ssurfdata%cextvars(jext) 689 slext%cdlong(jext2,1) = sobsgroups(jgroup)%ssurfdata%cextlong(jext) 690 slext%cdunit(jext2,1) = sobsgroups(jgroup)%ssurfdata%cextunit(jext) 691 ENDIF 692 END DO 693 ENDIF 694 DEALLOCATE( ll_write ) 586 695 587 696 CALL obs_wri_surf( sobsgroups(jgroup)%ssurfdata, sobsgroups(jgroup)%cgroupname, sladd, slext )
Note: See TracChangeset
for help on using the changeset viewer.
