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 5682 for branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90 – NEMO

Ignore:
Timestamp:
2015-08-12T17:46:45+02:00 (9 years ago)
Author:
mattmartin
Message:

OBS simplification changes committed to branch after running SETTE tests to make sure we get the same results as the trunk for ORCA2_LIM_OBS.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90

    r5659 r5682  
    5555CONTAINS 
    5656 
    57    SUBROUTINE obs_wri_prof( cobstype, profdata, padd, pext ) 
     57   SUBROUTINE obs_wri_prof( profdata, k2dint, padd, pext ) 
    5858      !!----------------------------------------------------------------------- 
    5959      !! 
    … …  
    7676      !!----------------------------------------------------------------------- 
    7777 
    78       !! * Modules used 
    79  
    8078      !! * Arguments 
    81       CHARACTER(LEN=*), INTENT(IN) :: cobstype        ! Prefix for output files 
    8279      TYPE(obs_prof), INTENT(INOUT) :: profdata      ! Full set of profile data 
     80      INTEGER, INTENT(IN)        :: k2dint           ! Horizontal interpolation method 
    8381      TYPE(obswriinfo), OPTIONAL :: padd             ! Additional info for each variable 
    8482      TYPE(obswriinfo), OPTIONAL :: pext             ! Extra info 
    85        
     83 
    8684      !! * Local declarations 
    8785      TYPE(obfbdata) :: fbdata 
    88       CHARACTER(LEN=40) :: cfname 
     86      CHARACTER(LEN=40) :: clfname 
     87      CHARACTER(LEN=6) :: clfiletype 
    8988      INTEGER :: ilevel 
    9089      INTEGER :: jvar 
    … …  
    9493      INTEGER :: ja 
    9594      INTEGER :: je 
     95      INTEGER :: iadd 
     96      INTEGER :: iext 
    9697      REAL(wp) :: zpres 
    97       INTEGER :: nadd 
    98       INTEGER :: next 
     98      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
     99         & zu, & 
     100         & zv 
    99101 
    100102      IF ( PRESENT( padd ) ) THEN 
    101          nadd = padd%inum 
     103         iadd = padd%inum 
    102104      ELSE 
    103          nadd = 0 
     105         iadd = 0 
    104106      ENDIF 
    105107 
    106108      IF ( PRESENT( pext ) ) THEN 
    107          next = pext%inum 
     109         iext = pext%inum 
    108110      ELSE 
    109          next = 0 
    110       ENDIF 
    111        
     111         iext = 0 
     112      ENDIF 
     113 
    112114      CALL init_obfbdata( fbdata ) 
    113115 
    … …  
    118120      END DO 
    119121 
    120       SELECT CASE ( TRIM(cobstype) ) 
    121       CASE('prof') 
    122  
     122      SELECT CASE ( TRIM(profdata%cvars(1)) ) 
     123      CASE('POTM') 
     124 
     125         clfiletype='profb' 
    123126         CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, & 
    124             &                 1 + nadd, 1 + next, .TRUE. ) 
    125          fbdata%cname(1)      = 'POTM' 
    126          fbdata%cname(2)      = 'PSAL' 
     127            &                 1 + iadd, 1 + iext, .TRUE. ) 
     128         fbdata%cname(1)      = profdata%cvars(1) 
     129         fbdata%cname(2)      = profdata%cvars(2) 
    127130         fbdata%coblong(1)    = 'Potential temperature' 
    128131         fbdata%coblong(2)    = 'Practical salinity' 
    … …  
    137140         fbdata%caddunit(1,2) = 'PSU' 
    138141         fbdata%cgrid(:)      = 'T' 
    139          DO je = 1, next 
     142         DO je = 1, iext 
    140143            fbdata%cextname(1+je) = pext%cdname(je) 
    141144            fbdata%cextlong(1+je) = pext%cdlong(je,1) 
    142145            fbdata%cextunit(1+je) = pext%cdunit(je,1) 
    143146         END DO 
    144          DO ja = 1, nadd 
     147         DO ja = 1, iadd 
    145148            fbdata%caddname(1+ja) = padd%cdname(ja) 
    146149            DO jvar = 1, 2 
    … …  
    149152            END DO 
    150153         END DO 
    151        
    152       CASE('vel') 
    153        
     154 
     155      CASE('UVEL') 
     156 
     157         clfiletype='velfb' 
    154158         CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 2, 0, .TRUE. ) 
    155          fbdata%cname(1)      = 'UVEL' 
    156          fbdata%cname(2)      = 'VVEL' 
     159         fbdata%cname(1)      = profdata%cvars(1) 
     160         fbdata%cname(2)      = profdata%cvars(2) 
    157161         fbdata%coblong(1)    = 'Zonal velocity' 
    158162         fbdata%coblong(2)    = 'Meridional velocity' 
    159163         fbdata%cobunit(1)    = 'm/s' 
    160164         fbdata%cobunit(2)    = 'm/s' 
    161          DO je = 1, next 
     165         DO je = 1, iext 
    162166            fbdata%cextname(je) = pext%cdname(je) 
    163167            fbdata%cextlong(je) = pext%cdlong(je,1) 
    … …  
    175179         fbdata%cgrid(1)      = 'U'  
    176180         fbdata%cgrid(2)      = 'V' 
    177          DO ja = 1, nadd 
     181         DO ja = 1, iadd 
    178182            fbdata%caddname(2+ja) = padd%cdname(ja) 
    179183            fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 
    … …  
    187191 
    188192      END SELECT 
    189           
     193 
    190194      fbdata%caddname(1)   = 'Hx' 
    191           
    192       WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cobstype), nproc 
     195 
     196      WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
    193197 
    194198      IF(lwp) THEN 
    … …  
    196200         WRITE(numout,*)'obs_wri_prof :' 
    197201         WRITE(numout,*)'~~~~~~~~~~~~~' 
    198          WRITE(numout,*)'Writing profile feedback file : ',TRIM(cfname) 
     202         WRITE(numout,*)'Writing '//TRIM(clfiletype)//' feedback file : ',TRIM(clfname) 
    199203      ENDIF 
    200204 
    … …  
    242246            DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar) 
    243247               ik = profdata%var(jvar)%nvlidx(jk) 
    244                IF ( TRIM(cobstype) == 'prof' ) THEN 
     248               IF ( TRIM(profdata%cvars(1)) == 'POTM' ) THEN 
    245249                  fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk) 
    246                ELSE IF ( TRIM(cobstype) == 'vel' ) THEN 
     250               ELSE IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
    247251                  IF ( jvar == 1 ) THEN 
    248252                     fbdata%padd(ik,jo,1,jvar) = zu(jk) 
    … …  
    265269               ENDIF 
    266270               fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk) 
    267                DO ja = 1, nadd 
     271               DO ja = 1, iadd 
    268272                  fbdata%padd(ik,jo,1+ja,jvar) = & 
    269273                     & profdata%var(jvar)%vext(jk,padd%ipoint(ja)) 
    270274               END DO 
    271                DO je = 1, next 
     275               DO je = 1, iext 
    272276                  fbdata%pext(ik,jo,1+je) = & 
    273277                     & profdata%var(jvar)%vext(jk,pext%ipoint(je)) 
    … …  
    280284      END DO 
    281285 
    282       IF ( TRIM(cobstype) == 'prof' ) THEN 
     286      IF ( TRIM(profdata%cvars(1)) == 'POTM' ) THEN 
    283287         ! Convert insitu temperature to potential temperature using the model 
    284288         ! salinity if no potential temperature 
    … …  
    301305         END DO 
    302306      ENDIF 
    303        
     307 
    304308      ! Write the obfbdata structure 
    305       CALL write_obfbdata( cfname, fbdata ) 
     309      CALL write_obfbdata( clfname, fbdata ) 
    306310 
    307311      ! Output some basic statistics 
    … …  
    309313 
    310314      CALL dealloc_obfbdata( fbdata ) 
    311       
     315 
    312316   END SUBROUTINE obs_wri_prof 
    313317 
    314    SUBROUTINE obs_wri_surf( cobstype, surfdata, padd, pext ) 
     318   SUBROUTINE obs_wri_surf( surfdata, padd, pext ) 
    315319      !!----------------------------------------------------------------------- 
    316320      !! 
    … …  
    332336 
    333337      !! * Arguments 
    334       CHARACTER(LEN=*), INTENT(IN) :: cobstype          ! Prefix for output files 
    335338      TYPE(obs_surf), INTENT(INOUT) :: surfdata         ! Full set of surface data 
    336339      TYPE(obswriinfo), OPTIONAL :: padd               ! Additional info for each variable 
    … …  
    339342      !! * Local declarations 
    340343      TYPE(obfbdata) :: fbdata 
    341       CHARACTER(LEN=40) :: cfname         ! netCDF filename 
     344      CHARACTER(LEN=40) :: clfname         ! netCDF filename 
     345      CHARACTER(LEN=6)  :: clfiletype 
    342346      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_surf' 
    343347      INTEGER :: jo 
    344348      INTEGER :: ja 
    345349      INTEGER :: je 
    346       INTEGER :: nadd 
    347       INTEGER :: next 
     350      INTEGER :: iadd 
     351      INTEGER :: iext 
    348352 
    349353      IF ( PRESENT( padd ) ) THEN 
    350          nadd = padd%inum 
     354         iadd = padd%inum 
    351355      ELSE 
    352          nadd = 0 
     356         iadd = 0 
    353357      ENDIF 
    354358 
    355359      IF ( PRESENT( pext ) ) THEN 
    356          next = pext%inum 
     360         iext = pext%inum 
    357361      ELSE 
    358          next = 0 
     362         iext = 0 
    359363      ENDIF 
    360364 
    … …  
    362366 
    363367      CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
    364          &                 2 + nadd, 1 + next, .TRUE. ) 
    365  
    366       SELECT CASE ( TRIM(cobstype) ) 
    367       CASE('sla') 
    368  
    369          fbdata%cname(1)      = 'SLA' 
     368         &                 2 + iadd, 1 + iext, .TRUE. ) 
     369 
     370      SELECT CASE ( TRIM(surfdata%cvars(1)) ) 
     371      CASE('SLA') 
     372 
     373         clfiletype = 'slafb' 
     374         fbdata%cname(1)      = surfdata%cvars(1) 
    370375         fbdata%coblong(1)    = 'Sea level anomaly' 
    371376         fbdata%cobunit(1)    = 'Metres' 
    … …  
    373378         fbdata%cextlong(1)   = 'Mean dynamic topography' 
    374379         fbdata%cextunit(1)   = 'Metres' 
    375          DO je = 1, next 
     380         DO je = 1, iext 
    376381            fbdata%cextname(je) = pext%cdname(je) 
    377382            fbdata%cextlong(je) = pext%cdlong(je,1) 
    … …  
    384389         fbdata%caddunit(2,1) = 'Metres' 
    385390         fbdata%cgrid(1)      = 'T' 
    386          DO ja = 1, nadd 
     391         DO ja = 1, iadd 
    387392            fbdata%caddname(2+ja) = padd%cdname(ja) 
    388393            fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 
    … …  
    390395         END DO 
    391396 
    392       CASE('sst') 
    393  
    394          fbdata%cname(1)      = 'SST' 
     397      CASE('SST') 
     398 
     399         clfiletype = 'sstfb' 
     400         fbdata%cname(1)      = surfdata%cvars(1) 
    395401         fbdata%coblong(1)    = 'Sea surface temperature' 
    396402         fbdata%cobunit(1)    = 'Degree centigrade' 
    397          DO je = 1, next 
     403         DO je = 1, iext 
    398404            fbdata%cextname(je) = pext%cdname(je) 
    399405            fbdata%cextlong(je) = pext%cdlong(je,1) 
    … …  
    403409         fbdata%caddunit(1,1) = 'Degree centigrade' 
    404410         fbdata%cgrid(1)      = 'T' 
    405          DO ja = 1, nadd 
     411         DO ja = 1, iadd 
    406412            fbdata%caddname(1+ja) = padd%cdname(ja) 
    407413            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
    … …  
    409415         END DO 
    410416 
    411       CASE('sss') 
    412  
    413          fbdata%cname(1)      = 'SSS' 
    414          fbdata%coblong(1)    = 'Sea surface salinity' 
    415          fbdata%cobunit(1)    = 'PSU' 
    416          DO je = 1, next 
     417      CASE('SEAICE') 
     418 
     419         clfiletype = 'sicfb' 
     420         fbdata%cname(1)      = surfdata%cvars(1) 
     421         fbdata%coblong(1)    = 'Sea ice' 
     422         fbdata%cobunit(1)    = 'Fraction' 
     423         DO je = 1, iext 
    417424            fbdata%cextname(je) = pext%cdname(je) 
    418425            fbdata%cextlong(je) = pext%cdlong(je,1) 
    419426            fbdata%cextunit(je) = pext%cdunit(je,1) 
    420427         END DO 
    421          fbdata%caddlong(1,1) = 'Model interpolated SSS' 
    422          fbdata%caddunit(1,1) = 'PSU' 
     428         fbdata%caddlong(1,1) = 'Model interpolated ICE' 
     429         fbdata%caddunit(1,1) = 'Fraction' 
    423430         fbdata%cgrid(1)      = 'T' 
    424          DO ja = 1, nadd 
     431         DO ja = 1, iadd 
    425432            fbdata%caddname(1+ja) = padd%cdname(ja) 
    426433            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
    … …  
    428435         END DO 
    429436 
    430       CASE('seaice') 
    431  
    432          fbdata%cname(1)      = 'SEAICE' 
    433          fbdata%coblong(1)    = 'Sea ice' 
    434          fbdata%cobunit(1)    = 'Fraction' 
    435          DO je = 1, next 
    436             fbdata%cextname(je) = pext%cdname(je) 
    437             fbdata%cextlong(je) = pext%cdlong(je,1) 
    438             fbdata%cextunit(je) = pext%cdunit(je,1) 
    439          END DO 
    440          fbdata%caddlong(1,1) = 'Model interpolated ICE' 
    441          fbdata%caddunit(1,1) = 'Fraction' 
    442          fbdata%cgrid(1)      = 'T' 
    443          DO ja = 1, nadd 
    444             fbdata%caddname(1+ja) = padd%cdname(ja) 
    445             fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
    446             fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
    447          END DO 
    448  
    449437      END SELECT 
    450438 
    451439      fbdata%caddname(1)   = 'Hx' 
    452440 
    453       WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cobstype), nproc 
     441      WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
    454442 
    455443      IF(lwp) THEN 
    … …  
    457445         WRITE(numout,*)'obs_wri_surf :' 
    458446         WRITE(numout,*)'~~~~~~~~~~~~~' 
    459          WRITE(numout,*)'Writing surface feedback file : ',TRIM(cfname) 
     447         WRITE(numout,*)'Writing '//TRIM(surfdata%cvars(1))//' feedback file : ',TRIM(clfname) 
    460448      ENDIF 
    461449 
    … …  
    498486            &           krefdate = 19500101 ) 
    499487         fbdata%padd(1,jo,1,1) = surfdata%rmod(jo,1) 
    500          IF ( TRIM(cobstype) == 'sla' ) fbdata%padd(1,jo,2,1) = surfdata%rext(jo,1) 
     488         IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%padd(1,jo,2,1) = surfdata%rext(jo,1) 
    501489         fbdata%pob(1,jo,1)    = surfdata%robs(jo,1)  
    502490         fbdata%pdep(1,jo)     = 0.0 
    … …  
    514502         ENDIF 
    515503         fbdata%iobsk(1,jo,1)  = 0 
    516          IF ( TRIM(cobstype) == 'sla' ) fbdata%pext(1,jo,1) = surfdata%rext(jo,2) 
    517          DO ja = 1, nadd 
     504         IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%pext(1,jo,1) = surfdata%rext(jo,2) 
     505         DO ja = 1, iadd 
    518506            fbdata%padd(1,jo,2+ja,1) = & 
    519507               & surfdata%rext(jo,padd%ipoint(ja)) 
    520508         END DO 
    521          DO je = 1, next 
     509         DO je = 1, iext 
    522510            fbdata%pext(1,jo,1+je) = & 
    523511               & surfdata%rext(jo,pext%ipoint(je)) 
    … …  
    526514 
    527515      ! Write the obfbdata structure 
    528       CALL write_obfbdata( cfname, fbdata ) 
     516      CALL write_obfbdata( clfname, fbdata ) 
    529517 
    530518      ! Output some basic statistics 
    … …  
    556544      INTEGER :: jo 
    557545      INTEGER :: jk 
    558  
    559       INTEGER :: numgoodobs 
    560       INTEGER :: numgoodobsmpp 
     546      INTEGER :: inumgoodobs 
     547      INTEGER :: inumgoodobsmpp 
    561548      REAL(wp) :: zsumx 
    562549      REAL(wp) :: zsumx2 
    … …  
    566553         WRITE(numout,*) '' 
    567554         WRITE(numout,*) 'obs_wri_stats :' 
    568          WRITE(numout,*) '~~~~~~~~~~~~~~~'  
     555         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    569556      ENDIF 
    570557 
    … …  
    572559         zsumx=0.0_wp 
    573560         zsumx2=0.0_wp 
    574          numgoodobs=0 
     561         inumgoodobs=0 
    575562         DO jo = 1, fbdata%nobs 
    576563            DO jk = 1, fbdata%nlev 
    … …  
    578565                  & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. & 
    579566                  & ( fbdata%padd(jk,jo,1,jvar) < 9999.0 ) ) THEN 
    580         
    581              zomb=fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar) 
     567 
     568                  zomb=fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar) 
    582569                  zsumx=zsumx+zomb 
    583570                  zsumx2=zsumx2+zomb**2 
    584                   numgoodobs=numgoodobs+1 
    585           ENDIF 
     571                  inumgoodobs=inumgoodobs+1 
     572               ENDIF 
    586573            ENDDO 
    587574         ENDDO 
    588575 
    589          CALL obs_mpp_sum_integer( numgoodobs, numgoodobsmpp ) 
     576         CALL obs_mpp_sum_integer( inumgoodobs, inumgoodobsmpp ) 
    590577         CALL mpp_sum(zsumx) 
    591578         CALL mpp_sum(zsumx2) 
    592579 
    593580         IF (lwp) THEN 
    594        WRITE(numout,*) 'Type: ',fbdata%cname(jvar),'  Total number of good observations: ',numgoodobsmpp  
    595        WRITE(numout,*) 'Overall mean obs minus model of the good observations: ',zsumx/numgoodobsmpp 
    596             WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ',sqrt( zsumx2/numgoodobsmpp ) 
    597        WRITE(numout,*) '' 
     581            WRITE(numout,*) 'Type: ',fbdata%cname(jvar),'  Total number of good observations: ',inumgoodobsmpp  
     582            WRITE(numout,*) 'Overall mean obs minus model of the good observations: ',zsumx/inumgoodobsmpp 
     583            WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ',sqrt( zsumx2/inumgoodobsmpp ) 
     584            WRITE(numout,*) '' 
    598585         ENDIF 
    599   
     586 
    600587      ENDDO 
    601588 
Note: See TracChangeset for help on using the changeset viewer.