Changeset 5704 for branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
- Timestamp:
- 2015-08-21T15:00:38+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
r5682 r5704 27 27 USE obs_conv ! Conversion between units 28 28 USE obs_const 29 USE obs_rot_vel ! Rotation of velocities30 29 USE obs_mpp ! MPP support routines for observation diagnostics 31 30 USE lib_mpp ! MPP routines … … 55 54 CONTAINS 56 55 57 SUBROUTINE obs_wri_prof( profdata, k2dint,padd, pext )56 SUBROUTINE obs_wri_prof( profdata, padd, pext ) 58 57 !!----------------------------------------------------------------------- 59 58 !! … … 78 77 !! * Arguments 79 78 TYPE(obs_prof), INTENT(INOUT) :: profdata ! Full set of profile data 80 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation method81 79 TYPE(obswriinfo), OPTIONAL :: padd ! Additional info for each variable 82 80 TYPE(obswriinfo), OPTIONAL :: pext ! Extra info … … 96 94 INTEGER :: iext 97 95 REAL(wp) :: zpres 98 REAL(wp), DIMENSION(:), ALLOCATABLE :: &99 & zu, &100 & zv101 96 102 97 IF ( PRESENT( padd ) ) THEN … … 156 151 157 152 clfiletype='velfb' 158 CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 2, 0, .TRUE. )153 CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 1, 0, .TRUE. ) 159 154 fbdata%cname(1) = profdata%cvars(1) 160 155 fbdata%cname(2) = profdata%cvars(2) … … 172 167 fbdata%caddunit(1,1) = 'm/s' 173 168 fbdata%caddunit(1,2) = 'm/s' 174 fbdata%caddname(2) = 'HxG'175 fbdata%caddlong(2,1) = 'Model interpolated zonal velocity (model grid)'176 fbdata%caddlong(2,2) = 'Model interpolated meridional velocity (model grid)'177 fbdata%caddunit(2,1) = 'm/s'178 fbdata%caddunit(2,2) = 'm/s'179 169 fbdata%cgrid(1) = 'U' 180 170 fbdata%cgrid(2) = 'V' 181 171 DO ja = 1, iadd 182 fbdata%caddname(2+ja) = padd%cdname(ja) 183 fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 184 fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1) 185 END DO 186 ALLOCATE( & 187 & zu(profdata%nvprot(1)), & 188 & zv(profdata%nvprot(2)) & 189 & ) 190 CALL obs_rotvel( profdata, k2dint, zu, zv ) 172 fbdata%caddname(1+ja) = padd%cdname(ja) 173 fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 174 fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 175 END DO 191 176 192 177 END SELECT … … 203 188 ENDIF 204 189 205 ! Transform obs_prof data structure into obfb data structure190 ! Transform obs_prof data structure into obfb data structure 206 191 fbdata%cdjuldref = '19500101000000' 207 192 DO jo = 1, profdata%nprof … … 246 231 DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar) 247 232 ik = profdata%var(jvar)%nvlidx(jk) 248 IF ( TRIM(profdata%cvars(1)) == 'POTM' ) THEN 249 fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk) 250 ELSE IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 251 IF ( jvar == 1 ) THEN 252 fbdata%padd(ik,jo,1,jvar) = zu(jk) 253 ELSE 254 fbdata%padd(ik,jo,1,jvar) = zv(jk) 255 ENDIF 256 fbdata%padd(ik,jo,2,jvar) = profdata%var(jvar)%vmod(jk) 257 ENDIF 233 fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk) 258 234 fbdata%pob(ik,jo,jvar) = profdata%var(jvar)%vobs(jk) 259 235 fbdata%pdep(ik,jo) = profdata%var(jvar)%vdep(jk) … … 277 253 & profdata%var(jvar)%vext(jk,pext%ipoint(je)) 278 254 END DO 279 IF ( jvar == 1 ) THEN 255 IF ( ( jvar == 1 ) .AND. & 256 & ( TRIM(profdata%cvars(1)) == 'POTM' ) ) THEN 280 257 fbdata%pext(ik,jo,1) = profdata%var(jvar)%vext(jk,1) 281 258 ENDIF … … 365 342 CALL init_obfbdata( fbdata ) 366 343 367 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, &368 & 2 + iadd, 1 + iext, .TRUE. )369 370 344 SELECT CASE ( TRIM(surfdata%cvars(1)) ) 371 345 CASE('SLA') 346 347 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 348 & 2 + iadd, 1 + iext, .TRUE. ) 372 349 373 350 clfiletype = 'slafb' … … 397 374 CASE('SST') 398 375 376 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 377 & 1 + iadd, iext, .TRUE. ) 378 399 379 clfiletype = 'sstfb' 400 380 fbdata%cname(1) = surfdata%cvars(1) … … 415 395 END DO 416 396 417 CASE('SEAICE') 397 CASE('ICECON') 398 399 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 400 & 1 + iadd, iext, .TRUE. ) 418 401 419 402 clfiletype = 'sicfb' … … 448 431 ENDIF 449 432 450 ! Transform obs_prof data structure into obfbdata structure433 ! Transform surf data structure into obfbdata structure 451 434 fbdata%cdjuldref = '19500101000000' 452 435 DO jo = 1, surfdata%nsurf … … 549 532 REAL(wp) :: zsumx2 550 533 REAL(wp) :: zomb 534 551 535 552 536 IF (lwp) THEN
Note: See TracChangeset
for help on using the changeset viewer.