Changeset 9191
- Timestamp:
- 2018-01-08T12:38:27+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_bgc3d/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r9186 r9191 445 445 IF (ln_t3d .OR. ln_s3d) THEN 446 446 jtype = jtype + 1 447 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'prof', &448 & cn_profbfiles, ifilesprof, cobstypesprof, clproffiles )447 cobstypesprof(jtype) = 'prof' 448 clproffiles(jtype,:) = cn_profbfiles 449 449 ENDIF 450 450 IF (ln_vel3d) THEN 451 451 jtype = jtype + 1 452 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'vel', &453 & cn_velfbfiles, ifilesprof, cobstypesprof, clproffiles )452 cobstypesprof(jtype) = 'vel' 453 clproffiles(jtype,:) = cn_velfbfiles 454 454 ENDIF 455 455 IF (ln_plchltot) THEN 456 456 jtype = jtype + 1 457 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'plchltot', &458 & cn_plchltotfbfiles, ifilesprof, cobstypesprof, clproffiles )457 cobstypesprof(jtype) = 'plchltot' 458 clproffiles(jtype,:) = cn_plchltotfbfiles 459 459 ENDIF 460 460 IF (ln_pchltot) THEN 461 461 jtype = jtype + 1 462 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'pchltot', &463 & cn_pchltotfbfiles, ifilesprof, cobstypesprof, clproffiles )462 cobstypesprof(jtype) = 'pchltot' 463 clproffiles(jtype,:) = cn_pchltotfbfiles 464 464 ENDIF 465 465 IF (ln_pno3) THEN 466 466 jtype = jtype + 1 467 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'pno3', &468 & cn_pno3fbfiles, ifilesprof, cobstypesprof, clproffiles )467 cobstypesprof(jtype) = 'pno3' 468 clproffiles(jtype,:) = cn_pno3fbfiles 469 469 ENDIF 470 470 IF (ln_psi4) THEN 471 471 jtype = jtype + 1 472 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'psi4', &473 & cn_psi4fbfiles, ifilesprof, cobstypesprof, clproffiles )472 cobstypesprof(jtype) = 'psi4' 473 clproffiles(jtype,:) = cn_psi4fbfiles 474 474 ENDIF 475 475 IF (ln_ppo4) THEN 476 476 jtype = jtype + 1 477 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'ppo4', &478 & cn_ppo4fbfiles, ifilesprof, cobstypesprof, clproffiles )477 cobstypesprof(jtype) = 'ppo4' 478 clproffiles(jtype,:) = cn_ppo4fbfiles 479 479 ENDIF 480 480 IF (ln_pdic) THEN 481 481 jtype = jtype + 1 482 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'pdic', &483 & cn_pdicfbfiles, ifilesprof, cobstypesprof, clproffiles )482 cobstypesprof(jtype) = 'pdic' 483 clproffiles(jtype,:) = cn_pdicfbfiles 484 484 ENDIF 485 485 IF (ln_palk) THEN 486 486 jtype = jtype + 1 487 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'palk', &488 & cn_palkfbfiles, ifilesprof, cobstypesprof, clproffiles )487 cobstypesprof(jtype) = 'palk' 488 clproffiles(jtype,:) = cn_palkfbfiles 489 489 ENDIF 490 490 IF (ln_pph) THEN 491 491 jtype = jtype + 1 492 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'pph', &493 & cn_pphfbfiles, ifilesprof, cobstypesprof, clproffiles )492 cobstypesprof(jtype) = 'pph' 493 clproffiles(jtype,:) = cn_pphfbfiles 494 494 ENDIF 495 495 IF (ln_po2) THEN 496 496 jtype = jtype + 1 497 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'po2', & 498 & cn_po2fbfiles, ifilesprof, cobstypesprof, clproffiles ) 499 ENDIF 497 cobstypesprof(jtype) = 'po2' 498 clproffiles(jtype,:) = cn_po2fbfiles 499 ENDIF 500 501 CALL obs_settypefiles( nproftypes, jpmaxnfiles, ifilesprof, cobstypesprof, clproffiles ) 500 502 501 503 ENDIF … … 516 518 IF (ln_sla) THEN 517 519 jtype = jtype + 1 518 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sla', &519 & cn_slafbfiles, ifilessurf, cobstypessurf, clsurffiles )520 cobstypessurf(jtype) = 'sla' 521 clsurffiles(jtype,:) = cn_slafbfiles 520 522 ENDIF 521 523 IF (ln_sst) THEN 522 524 jtype = jtype + 1 523 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sst', & 524 & cn_sstfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 525 ENDIF 526 #if defined key_lim2 || defined key_lim3 || defined key_cice 525 cobstypessurf(jtype) = 'sst' 526 clsurffiles(jtype,:) = cn_sstfbfiles 527 ENDIF 527 528 IF (ln_sic) THEN 528 529 jtype = jtype + 1 529 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sic', & 530 & cn_sicfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 531 ENDIF 532 #endif 530 cobstypessurf(jtype) = 'sic' 531 clsurffiles(jtype,:) = cn_sicfbfiles 532 ENDIF 533 533 IF (ln_sss) THEN 534 534 jtype = jtype + 1 535 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sss', & 536 & cn_sssfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 537 ENDIF 538 535 cobstypessurf(jtype) = 'sss' 536 clsurffiles(jtype,:) = cn_sssfbfiles 537 ENDIF 539 538 IF (ln_slchltot) THEN 540 539 jtype = jtype + 1 541 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'slchltot', & 542 & cn_slchltotfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 543 ENDIF 544 540 cobstypessurf(jtype) = 'slchltot' 541 clsurffiles(jtype,:) = cn_slchltotfbfiles 542 ENDIF 545 543 IF (ln_slchldia) THEN 546 544 jtype = jtype + 1 547 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'slchldia', & 548 & cn_slchldiafbfiles, ifilessurf, cobstypessurf, clsurffiles ) 549 ENDIF 550 545 cobstypessurf(jtype) = 'slchldia' 546 clsurffiles(jtype,:) = cn_slchldiafbfiles 547 ENDIF 551 548 IF (ln_slchlnon) THEN 552 549 jtype = jtype + 1 553 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'slchlnon', & 554 & cn_slchlnonfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 555 ENDIF 556 550 cobstypessurf(jtype) = 'slchlnon' 551 clsurffiles(jtype,:) = cn_slchlnonfbfiles 552 ENDIF 557 553 IF (ln_slchldin) THEN 558 554 jtype = jtype + 1 559 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'slchldin', & 560 & cn_slchldinfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 561 ENDIF 562 555 cobstypessurf(jtype) = 'slchldin' 556 clsurffiles(jtype,:) = cn_slchldinfbfiles 557 ENDIF 563 558 IF (ln_slchlmic) THEN 564 559 jtype = jtype + 1 565 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'slchlmic', & 566 & cn_slchlmicfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 567 ENDIF 568 560 cobstypessurf(jtype) = 'slchlmic' 561 clsurffiles(jtype,:) = cn_slchlmicfbfiles 562 ENDIF 569 563 IF (ln_slchlnan) THEN 570 564 jtype = jtype + 1 571 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'slchlnan', & 572 & cn_slchlnanfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 573 ENDIF 574 565 cobstypessurf(jtype) = 'slchlnan' 566 clsurffiles(jtype,:) = cn_slchlnanfbfiles 567 ENDIF 575 568 IF (ln_slchlpic) THEN 576 569 jtype = jtype + 1 577 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'slchlpic', & 578 & cn_slchlpicfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 579 ENDIF 580 570 cobstypessurf(jtype) = 'slchlpic' 571 clsurffiles(jtype,:) = cn_slchlpicfbfiles 572 ENDIF 581 573 IF (ln_schltot) THEN 582 574 jtype = jtype + 1 583 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'schltot', & 584 & cn_schltotfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 585 ENDIF 586 575 cobstypessurf(jtype) = 'schltot' 576 clsurffiles(jtype,:) = cn_schltotfbfiles 577 ENDIF 587 578 IF (ln_sspm) THEN 588 579 jtype = jtype + 1 589 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sspm', & 590 & cn_sspmfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 591 ENDIF 592 580 cobstypessurf(jtype) = 'sspm' 581 clsurffiles(jtype,:) = cn_sspmfbfiles 582 ENDIF 593 583 IF (ln_sfco2) THEN 594 584 jtype = jtype + 1 595 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sfco2', & 596 & cn_sfco2fbfiles, ifilessurf, cobstypessurf, clsurffiles ) 597 ENDIF 598 585 cobstypessurf(jtype) = 'sfco2' 586 clsurffiles(jtype,:) = cn_sfco2fbfiles 587 ENDIF 599 588 IF (ln_spco2) THEN 600 589 jtype = jtype + 1 601 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'spco2', & 602 & cn_spco2fbfiles, ifilessurf, cobstypessurf, clsurffiles ) 603 ENDIF 590 cobstypessurf(jtype) = 'spco2' 591 clsurffiles(jtype,:) = cn_spco2fbfiles 592 ENDIF 593 594 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, ifilessurf, cobstypessurf, clsurffiles ) 604 595 605 596 DO jtype = 1, nsurftypes … … 1766 1757 END SUBROUTINE fin_date 1767 1758 1768 SUBROUTINE obs_settypefiles( ntypes, jpmaxnfiles, jtype, ctypein, & 1769 & cfilestype, ifiles, cobstypes, cfiles ) 1759 SUBROUTINE obs_settypefiles( ntypes, jpmaxnfiles, ifiles, cobstypes, cfiles ) 1770 1760 1771 1761 INTEGER, INTENT(IN) :: ntypes ! Total number of obs types 1772 1762 INTEGER, INTENT(IN) :: jpmaxnfiles ! Maximum number of files allowed for each type 1773 INTEGER, INTENT(IN) :: jtype ! Index of the current type of obs 1774 INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: & 1775 & ifiles ! Out appended number of files for this type 1776 1777 CHARACTER(len=8), INTENT(IN) :: ctypein 1778 CHARACTER(len=128), DIMENSION(jpmaxnfiles), INTENT(IN) :: & 1779 & cfilestype ! In list of files for this obs type 1780 CHARACTER(len=8), DIMENSION(ntypes), INTENT(INOUT) :: & 1781 & cobstypes ! Out appended list of obs types 1782 CHARACTER(len=128), DIMENSION(ntypes, jpmaxnfiles), INTENT(INOUT) :: & 1783 & cfiles ! Out appended list of files for all types 1763 INTEGER, DIMENSION(ntypes), INTENT(OUT) :: & 1764 & ifiles ! Out number of files for each type 1765 CHARACTER(len=8), DIMENSION(ntypes), INTENT(IN) :: & 1766 & cobstypes ! List of obs types 1767 CHARACTER(len=128), DIMENSION(ntypes, jpmaxnfiles), INTENT(IN) :: & 1768 & cfiles ! List of files for all types 1784 1769 1785 1770 !Local variables 1786 1771 INTEGER :: jfile 1787 1788 cfiles(jtype,:) = cfilestype(:) 1789 cobstypes(jtype) = ctypein 1790 ifiles(jtype) = 0 1791 DO jfile = 1, jpmaxnfiles 1792 IF ( trim(cfiles(jtype,jfile)) /= '' ) & 1793 ifiles(jtype) = ifiles(jtype) + 1 1772 INTEGER :: jtype 1773 1774 DO jtype = 1, ntypes 1775 1776 ifiles(jtype) = 0 1777 DO jfile = 1, jpmaxnfiles 1778 IF ( trim(cfiles(jtype,jfile)) /= '' ) & 1779 ifiles(jtype) = ifiles(jtype) + 1 1780 END DO 1781 1782 IF ( ifiles(jtype) == 0 ) THEN 1783 CALL ctl_stop( 'Logical for observation type '//TRIM(cobstypes(jtype))// & 1784 & ' set to true but no files available to read' ) 1785 ENDIF 1786 1787 IF(lwp) THEN 1788 WRITE(numout,*) ' '//cobstypes(jtype)//' input observation file names:' 1789 DO jfile = 1, ifiles(jtype) 1790 WRITE(numout,*) ' '//TRIM(cfiles(jtype,jfile)) 1791 END DO 1792 ENDIF 1793 1794 1794 END DO 1795 1796 IF ( ifiles(jtype) == 0 ) THEN1797 CALL ctl_stop( 'Logical for observation type '//TRIM(ctypein)// &1798 & ' set to true but no files available to read' )1799 ENDIF1800 1801 IF(lwp) THEN1802 WRITE(numout,*) ' '//cobstypes(jtype)//' input observation file names:'1803 DO jfile = 1, ifiles(jtype)1804 WRITE(numout,*) ' '//TRIM(cfiles(jtype,jfile))1805 END DO1806 ENDIF1807 1795 1808 1796 END SUBROUTINE obs_settypefiles
Note: See TracChangeset
for help on using the changeset viewer.