New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 9191 – NEMO

Changeset 9191


Ignore:
Timestamp:
2018-01-08T12:38:27+01:00 (6 years ago)
Author:
dford
Message:

Reduce duplication in setting of obs types.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_obs_oper_update_bgc3d/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r9186 r9191  
    445445         IF (ln_t3d .OR. ln_s3d) THEN 
    446446            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 
    449449         ENDIF 
    450450         IF (ln_vel3d) THEN 
    451451            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 
    454454         ENDIF 
    455455         IF (ln_plchltot) THEN 
    456456            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 
    459459         ENDIF 
    460460         IF (ln_pchltot) THEN 
    461461            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 
    464464         ENDIF 
    465465         IF (ln_pno3) THEN 
    466466            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 
    469469         ENDIF 
    470470         IF (ln_psi4) THEN 
    471471            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 
    474474         ENDIF 
    475475         IF (ln_ppo4) THEN 
    476476            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 
    479479         ENDIF 
    480480         IF (ln_pdic) THEN 
    481481            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 
    484484         ENDIF 
    485485         IF (ln_palk) THEN 
    486486            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 
    489489         ENDIF 
    490490         IF (ln_pph) THEN 
    491491            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 
    494494         ENDIF 
    495495         IF (ln_po2) THEN 
    496496            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 ) 
    500502 
    501503      ENDIF 
     
    516518         IF (ln_sla) THEN 
    517519            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 
    520522         ENDIF 
    521523         IF (ln_sst) THEN 
    522524            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 
    527528         IF (ln_sic) THEN 
    528529            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 
    533533         IF (ln_sss) THEN 
    534534            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 
    539538         IF (ln_slchltot) THEN 
    540539            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 
    545543         IF (ln_slchldia) THEN 
    546544            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 
    551548         IF (ln_slchlnon) THEN 
    552549            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 
    557553         IF (ln_slchldin) THEN 
    558554            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 
    563558         IF (ln_slchlmic) THEN 
    564559            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 
    569563         IF (ln_slchlnan) THEN 
    570564            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 
    575568         IF (ln_slchlpic) THEN 
    576569            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 
    581573         IF (ln_schltot) THEN 
    582574            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 
    587578         IF (ln_sspm) THEN 
    588579            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 
    593583         IF (ln_sfco2) THEN 
    594584            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 
    599588         IF (ln_spco2) THEN 
    600589            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 ) 
    604595 
    605596         DO jtype = 1, nsurftypes 
     
    17661757    END SUBROUTINE fin_date 
    17671758 
    1768     SUBROUTINE obs_settypefiles( ntypes, jpmaxnfiles, jtype, ctypein, & 
    1769        &                         cfilestype, ifiles, cobstypes, cfiles ) 
     1759    SUBROUTINE obs_settypefiles( ntypes, jpmaxnfiles, ifiles, cobstypes, cfiles ) 
    17701760 
    17711761       INTEGER, INTENT(IN) :: ntypes      ! Total number of obs types 
    17721762       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 
    17841769 
    17851770       !Local variables 
    17861771       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 
    17941794       END DO 
    1795  
    1796        IF ( ifiles(jtype) == 0 ) THEN 
    1797             CALL ctl_stop( 'Logical for observation type '//TRIM(ctypein)//   & 
    1798                &           ' set to true but no files available to read' ) 
    1799        ENDIF 
    1800  
    1801        IF(lwp) THEN     
    1802           WRITE(numout,*) '             '//cobstypes(jtype)//' input observation file names:' 
    1803           DO jfile = 1, ifiles(jtype) 
    1804              WRITE(numout,*) '                '//TRIM(cfiles(jtype,jfile)) 
    1805           END DO 
    1806        ENDIF 
    18071795 
    18081796    END SUBROUTINE obs_settypefiles 
Note: See TracChangeset for help on using the changeset viewer.