Changeset 6009


Ignore:
Timestamp:
2015-12-07T10:59:13+01:00 (5 years ago)
Author:
timgraham
Message:

Fix for sstbias correction and OBS simplification merge to work together correctly

Location:
branches/2015/dev_MetOffice_merge_2015/NEMOGCM/NEMO/OPA_SRC/OBS
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_MetOffice_merge_2015/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r6003 r6009  
    475475               IF ( ln_altbias ) CALL obs_rea_altbias ( surfdataqc(jtype), nn_2dint, cn_altbiasfile ) 
    476476            ENDIF 
    477  
     477            IF ( TRIM(cobstypessurf(jtype)) == 'sst' .AND. ln_sstbias ) THEN 
     478               !Read in bias field and correct SST. 
     479               IF ( jnumsstbias == 0 ) CALL ctl_stop("ln_sstbias set,"// & 
     480                                                     "  but no bias"// & 
     481                                                     " files to read in")    
     482                  CALL obs_app_sstbias( surfdataqc(jtype), nn_2dint, & 
     483                                        jnumsstbias, cn_sstbias_files(1:jnumsstbias) ) 
     484            ENDIF 
    478485         END DO 
    479  
    480          !Read in bias field and correct SST. 
    481          IF ( ln_sstbias ) THEN 
    482             IF ( jnumsstbias == 0 ) CALL ctl_stop("ln_sstbias set,"// & 
    483                                              "  but no bias"// & 
    484                                              " files to read in")    
    485 !            CALL obs_app_sstbias( nsstsets, sstdatqc, nn_2dint, & 
    486 !                                  jnumsstbias, cn_sstbias_files(1:jnumsstbias) ) 
    487          ENDIF 
    488  
    489486 
    490487         DEALLOCATE( ifilessurf, clsurffiles ) 
  • branches/2015/dev_MetOffice_merge_2015/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sstbias.F90

    r6003 r6009  
    3737   PUBLIC obs_app_sstbias     ! Read the altimeter bias 
    3838CONTAINS 
    39    SUBROUTINE obs_app_sstbias( ksstno, sstdata, k2dint, knumtypes, & 
     39   SUBROUTINE obs_app_sstbias( sstdata, k2dint, knumtypes, & 
    4040                               cl_bias_files ) 
    4141      !!--------------------------------------------------------------------- 
    4242      !! 
    43       !!                   *** ROUTINE obs_rea_sstbias *** 
     43      !!                   *** ROUTINE obs_app_sstbias *** 
    4444      !! 
    4545      !! ** Purpose : Read SST bias data from files and apply correction to 
     
    6060      USE netcdf 
    6161      !! * Arguments 
    62       INTEGER, INTENT(IN) :: ksstno      ! Number of SST obs sets 
    63       TYPE(obs_surf), DIMENSION(ksstno), INTENT(INOUT) :: & 
    64          & sstdata       ! SST data 
     62 
     63      TYPE(obs_surf), INTENT(INOUT) :: sstdata       ! SST data 
    6564      INTEGER, INTENT(IN) :: k2dint 
    6665      INTEGER, INTENT(IN) :: knumtypes !number of bias types to read in 
     
    6867                          cl_bias_files !List of files to read 
    6968      !! * Local declarations 
    70       INTEGER :: jslano       ! Data set loop variable 
    7169      INTEGER :: jobs         ! Obs loop variable 
    7270      INTEGER :: jpisstbias   ! Number of grid point in latitude for the bias 
     
    125123         IF(lwp)WRITE(numout,*) 'Opening ',cl_bias_files(jtype) 
    126124         CALL iom_open( cl_bias_files(jtype), numsstbias, ldstop=.FALSE. )        
    127          IF (numsstbias .GT. 0) THEN 
     125         IF (numsstbias > 0) THEN 
    128126      
    129127            !Read the bias type from the file 
     
    152150            
    153151      ! Interpolate the bias already on the model grid at the observation point 
    154       DO jslano = 1, ksstno 
     152      ALLOCATE( & 
     153         & igrdi(2,2,sstdata%nsurf), & 
     154         & igrdj(2,2,sstdata%nsurf), & 
     155         & zglam(2,2,sstdata%nsurf), & 
     156         & zgphi(2,2,sstdata%nsurf), & 
     157         & zmask(2,2,sstdata%nsurf)  ) 
     158        
     159      DO jobs = 1, sstdata%nsurf  
     160         igrdi(1,1,jobs) = sstdata%mi(jobs)-1 
     161         igrdj(1,1,jobs) = sstdata%mj(jobs)-1 
     162         igrdi(1,2,jobs) = sstdata%mi(jobs)-1 
     163         igrdj(1,2,jobs) = sstdata%mj(jobs) 
     164         igrdi(2,1,jobs) = sstdata%mi(jobs) 
     165         igrdj(2,1,jobs) = sstdata%mj(jobs)-1 
     166         igrdi(2,2,jobs) = sstdata%mi(jobs) 
     167         igrdj(2,2,jobs) = sstdata%mj(jobs) 
     168      END DO 
     169      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, & 
     170         &                  igrdi, igrdj, glamt, zglam ) 
     171      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, & 
     172         &                  igrdi, igrdj, gphit, zgphi ) 
     173      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, & 
     174         &                  igrdi, igrdj, tmask(:,:,1), zmask ) 
     175      DO jtype = 1, knumtypes 
     176          
     177         !Find the number observations of type and allocate tempory arrays 
     178         inumtype = COUNT( sstdata%ntyp(:) == ibiastypes(jtype) ) 
    155179         ALLOCATE( & 
    156             & igrdi(2,2,sstdata(jslano)%nsurf), & 
    157             & igrdj(2,2,sstdata(jslano)%nsurf), & 
    158             & zglam(2,2,sstdata(jslano)%nsurf), & 
    159             & zgphi(2,2,sstdata(jslano)%nsurf), & 
    160             & zmask(2,2,sstdata(jslano)%nsurf)  ) 
    161         
    162          DO jobs = 1, sstdata(jslano)%nsurf  
    163             igrdi(1,1,jobs) = sstdata(jslano)%mi(jobs)-1 
    164             igrdj(1,1,jobs) = sstdata(jslano)%mj(jobs)-1 
    165             igrdi(1,2,jobs) = sstdata(jslano)%mi(jobs)-1 
    166             igrdj(1,2,jobs) = sstdata(jslano)%mj(jobs) 
    167             igrdi(2,1,jobs) = sstdata(jslano)%mi(jobs) 
    168             igrdj(2,1,jobs) = sstdata(jslano)%mj(jobs)-1 
    169             igrdi(2,2,jobs) = sstdata(jslano)%mi(jobs) 
    170             igrdj(2,2,jobs) = sstdata(jslano)%mj(jobs) 
    171          END DO 
    172          CALL obs_int_comm_2d( 2, 2, sstdata(jslano)%nsurf, jpi, jpj, & 
    173             &                  igrdi, igrdj, glamt, zglam ) 
    174          CALL obs_int_comm_2d( 2, 2, sstdata(jslano)%nsurf, jpi, jpj, & 
    175             &                  igrdi, igrdj, gphit, zgphi ) 
    176          CALL obs_int_comm_2d( 2, 2, sstdata(jslano)%nsurf, jpi, jpj, & 
    177             &                  igrdi, igrdj, tmask(:,:,1), zmask ) 
    178          DO jtype = 1, knumtypes 
    179           
    180             !Find the number observations of type 
    181             !and alllocate tempory arrays 
    182             inumtype = COUNT( sstdata(jslano)%ntyp(:) == ibiastypes(jtype) ) 
    183             ALLOCATE( & 
    184180            & igrdi_tmp(2,2,inumtype), & 
    185181            & igrdj_tmp(2,2,inumtype), & 
     
    188184            & zmask_tmp(2,2,inumtype), & 
    189185            & zbias( 2,2,inumtype ) ) 
    190             jt=1 
    191             DO jobs = 1, sstdata(jslano)%nsurf  
    192                IF ( sstdata(jslano)%ntyp(jobs) == ibiastypes(jtype) ) THEN 
    193                   igrdi_tmp(:,:,jt) = igrdi(:,:,jobs)  
    194                   igrdj_tmp(:,:,jt) = igrdj(:,:,jobs) 
    195                   zglam_tmp(:,:,jt) = zglam(:,:,jobs) 
    196                   zgphi_tmp(:,:,jt) = zgphi(:,:,jobs) 
    197                   zgphi_tmp(:,:,jt) = zgphi(:,:,jobs) 
    198                   zmask_tmp(:,:,jt) = zmask(:,:,jobs) 
    199                   jt = jt +1 
    200                ENDIF 
    201             END DO 
     186         jt=1 
     187         DO jobs = 1, sstdata%nsurf  
     188            IF ( sstdata%ntyp(jobs) == ibiastypes(jtype) ) THEN 
     189               igrdi_tmp(:,:,jt) = igrdi(:,:,jobs)  
     190               igrdj_tmp(:,:,jt) = igrdj(:,:,jobs) 
     191               zglam_tmp(:,:,jt) = zglam(:,:,jobs) 
     192               zgphi_tmp(:,:,jt) = zgphi(:,:,jobs) 
     193               zgphi_tmp(:,:,jt) = zgphi(:,:,jobs) 
     194               zmask_tmp(:,:,jt) = zmask(:,:,jobs) 
     195               jt = jt +1 
     196            ENDIF 
     197         END DO 
    202198                          
    203             CALL obs_int_comm_2d( 2, 2, inumtype, jpi, jpj, & 
    204                   &           igrdi_tmp(:,:,:), igrdj_tmp(:,:,:), & 
    205                   &           z_sstbias(:,:,jtype), zbias(:,:,:) ) 
    206             jt=1 
    207             DO jobs = 1, sstdata(jslano)%nsurf 
    208                IF ( sstdata(jslano)%ntyp(jobs) == ibiastypes(jtype) ) THEN 
    209                   zlam = sstdata(jslano)%rlam(jobs) 
    210                   zphi = sstdata(jslano)%rphi(jobs) 
    211                   iico = sstdata(jslano)%mi(jobs) 
    212                   ijco = sstdata(jslano)%mj(jobs)          
    213                   CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
    214                      &                   zglam_tmp(:,:,jt), & 
    215                      &                   zgphi_tmp(:,:,jt), & 
    216                      &                   zmask_tmp(:,:,jt), zweig, zobsmask ) 
    217                   CALL obs_int_h2d( 1, 1,      & 
    218                      &              zweig, zbias(:,:,jt),  zext ) 
    219                   ! adjust sst with bias field 
    220                   sstdata(jslano)%robs(jobs,1) = & 
    221                      sstdata(jslano)%robs(jobs,1) - zext(1) 
    222                   jt=jt+1 
    223                ENDIF 
    224             END DO  
     199         CALL obs_int_comm_2d( 2, 2, inumtype, jpi, jpj, & 
     200               &           igrdi_tmp(:,:,:), igrdj_tmp(:,:,:), & 
     201               &           z_sstbias(:,:,jtype), zbias(:,:,:) ) 
     202         jt=1 
     203         DO jobs = 1, sstdata%nsurf 
     204            IF ( sstdata%ntyp(jobs) == ibiastypes(jtype) ) THEN 
     205               zlam = sstdata%rlam(jobs) 
     206               zphi = sstdata%rphi(jobs) 
     207               iico = sstdata%mi(jobs) 
     208               ijco = sstdata%mj(jobs)          
     209               CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
     210                  &                   zglam_tmp(:,:,jt), & 
     211                  &                   zgphi_tmp(:,:,jt), & 
     212                  &                   zmask_tmp(:,:,jt), zweig, zobsmask ) 
     213               CALL obs_int_h2d( 1, 1, zweig, zbias(:,:,jt),  zext ) 
     214               ! adjust sst with bias field 
     215               sstdata%robs(jobs,1) = sstdata%robs(jobs,1) - zext(1) 
     216               jt=jt+1 
     217            ENDIF 
     218         END DO  
    225219                
    226             !Deallocate arrays 
    227             DEALLOCATE( & 
    228             & igrdi_tmp, & 
    229             & igrdj_tmp, & 
    230             & zglam_tmp, & 
    231             & zgphi_tmp, & 
    232             & zmask_tmp, & 
    233             & zbias )            
    234          END DO 
     220         !Deallocate arrays 
    235221         DEALLOCATE( & 
    236             & igrdi, & 
    237             & igrdj, & 
    238             & zglam, & 
    239             & zgphi, & 
    240             & zmask ) 
     222         & igrdi_tmp, & 
     223         & igrdj_tmp, & 
     224         & zglam_tmp, & 
     225         & zgphi_tmp, & 
     226         & zmask_tmp, & 
     227         & zbias )            
    241228      END DO 
     229      DEALLOCATE( & 
     230         & igrdi, & 
     231         & igrdj, & 
     232         & zglam, & 
     233         & zgphi, & 
     234         & zmask ) 
     235 
    242236      IF(lwp) THEN 
    243237         WRITE(numout,*) " " 
Note: See TracChangeset for help on using the changeset viewer.