Changeset 6009 for branches/2015/dev_MetOffice_merge_2015/NEMOGCM
- Timestamp:
- 2015-12-07T10:59:13+01:00 (9 years ago)
- 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 475 475 IF ( ln_altbias ) CALL obs_rea_altbias ( surfdataqc(jtype), nn_2dint, cn_altbiasfile ) 476 476 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 478 485 END DO 479 480 !Read in bias field and correct SST.481 IF ( ln_sstbias ) THEN482 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 ENDIF488 489 486 490 487 DEALLOCATE( ifilessurf, clsurffiles ) -
branches/2015/dev_MetOffice_merge_2015/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sstbias.F90
r6003 r6009 37 37 PUBLIC obs_app_sstbias ! Read the altimeter bias 38 38 CONTAINS 39 SUBROUTINE obs_app_sstbias( ksstno,sstdata, k2dint, knumtypes, &39 SUBROUTINE obs_app_sstbias( sstdata, k2dint, knumtypes, & 40 40 cl_bias_files ) 41 41 !!--------------------------------------------------------------------- 42 42 !! 43 !! *** ROUTINE obs_ rea_sstbias ***43 !! *** ROUTINE obs_app_sstbias *** 44 44 !! 45 45 !! ** Purpose : Read SST bias data from files and apply correction to … … 60 60 USE netcdf 61 61 !! * 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 65 64 INTEGER, INTENT(IN) :: k2dint 66 65 INTEGER, INTENT(IN) :: knumtypes !number of bias types to read in … … 68 67 cl_bias_files !List of files to read 69 68 !! * Local declarations 70 INTEGER :: jslano ! Data set loop variable71 69 INTEGER :: jobs ! Obs loop variable 72 70 INTEGER :: jpisstbias ! Number of grid point in latitude for the bias … … 125 123 IF(lwp)WRITE(numout,*) 'Opening ',cl_bias_files(jtype) 126 124 CALL iom_open( cl_bias_files(jtype), numsstbias, ldstop=.FALSE. ) 127 IF (numsstbias .GT.0) THEN125 IF (numsstbias > 0) THEN 128 126 129 127 !Read the bias type from the file … … 152 150 153 151 ! 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) ) 155 179 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)%nsurf163 igrdi(1,1,jobs) = sstdata(jslano)%mi(jobs)-1164 igrdj(1,1,jobs) = sstdata(jslano)%mj(jobs)-1165 igrdi(1,2,jobs) = sstdata(jslano)%mi(jobs)-1166 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)-1169 igrdi(2,2,jobs) = sstdata(jslano)%mi(jobs)170 igrdj(2,2,jobs) = sstdata(jslano)%mj(jobs)171 END DO172 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, knumtypes179 180 !Find the number observations of type181 !and alllocate tempory arrays182 inumtype = COUNT( sstdata(jslano)%ntyp(:) == ibiastypes(jtype) )183 ALLOCATE( &184 180 & igrdi_tmp(2,2,inumtype), & 185 181 & igrdj_tmp(2,2,inumtype), & … … 188 184 & zmask_tmp(2,2,inumtype), & 189 185 & zbias( 2,2,inumtype ) ) 190 191 DO jobs = 1, sstdata(jslano)%nsurf192 IF ( sstdata(jslano)%ntyp(jobs) == ibiastypes(jtype) ) THEN193 194 195 196 197 198 199 200 201 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 202 198 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 225 219 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 235 221 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 ) 241 228 END DO 229 DEALLOCATE( & 230 & igrdi, & 231 & igrdj, & 232 & zglam, & 233 & zgphi, & 234 & zmask ) 235 242 236 IF(lwp) THEN 243 237 WRITE(numout,*) " "
Note: See TracChangeset
for help on using the changeset viewer.