- Timestamp:
- 2022-04-25T17:15:21+02:00 (2 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_surf_def.F90
r14075 r15799 23 23 USE obs_mpp, ONLY : & ! MPP tools 24 24 obs_mpp_sum_integer 25 USE obs_fbm ! Obs feedback format 25 26 26 27 IMPLICIT NONE … … 45 46 INTEGER :: nsurfmpp !: Global number of surface data within window 46 47 INTEGER :: nvar !: Number of variables at observation points 48 INTEGER :: nadd !: Number of additional fields at observation points 47 49 INTEGER :: nextra !: Number of extra fields at observation points 48 50 INTEGER :: nstp !: Number of time steps … … 55 57 56 58 INTEGER, POINTER, DIMENSION(:) :: & 57 & mi, & !: i-th grid coord. for interpolating to surface observation58 & mj, & !: j-th grid coord. for interpolating to surface observation59 59 & mt, & !: time record number for gridded data 60 60 & nsidx,& !: Surface observation number … … 69 69 & ntyp !: Type of surface observation product 70 70 71 CHARACTER(len=8), POINTER, DIMENSION(:) :: & 72 & cvars !: Variable names 73 74 CHARACTER(LEN=8), POINTER, DIMENSION(:) :: & 71 INTEGER, POINTER, DIMENSION(:,:) :: & 72 & mi, & !: i-th grid coord. for interpolating to surface observation 73 & mj !: j-th grid coord. for interpolating to surface observation 74 75 CHARACTER(len=ilenname), POINTER, DIMENSION(:) :: & 76 & cvars, & !: Variable names 77 & cextvars, & !: Extra variable names 78 & caddvars !: Additional variable names 79 80 CHARACTER(len=ilenlong), POINTER, DIMENSION(:) :: & 81 & clong, & !: Variable long names 82 & cextlong !: Extra variable long names 83 84 CHARACTER(len=ilenlong), POINTER, DIMENSION(:,:) :: & 85 & caddlong !: Additional variable long names 86 87 CHARACTER(len=ilenunit), POINTER, DIMENSION(:) :: & 88 & cunit, & !: Variable units 89 & cextunit !: Extra variable units 90 91 CHARACTER(len=ilenunit), POINTER, DIMENSION(:,:) :: & 92 & caddunit !: Additional variable units 93 94 CHARACTER(len=ilengrid), POINTER, DIMENSION(:) :: & 95 & cgrid !: Variable grids 96 97 CHARACTER(LEN=ilenwmo), POINTER, DIMENSION(:) :: & 75 98 & cwmo !: WMO indentifier 76 99 … … 86 109 & rext !: Extra fields interpolated to observation points 87 110 88 REAL(KIND=wp), POINTER, DIMENSION(:,:) :: & 111 REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: & 112 & radd !: Additional fields interpolated to observation points 113 114 REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: & 89 115 & vdmean !: Time averaged of model field 90 116 … … 121 147 CONTAINS 122 148 123 SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, k extra, kstp, kpi, kpj )149 SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kadd, kextra, kstp, kpi, kpj ) 124 150 !!---------------------------------------------------------------------- 125 151 !! *** ROUTINE obs_surf_alloc *** … … 136 162 INTEGER, INTENT(IN) :: ksurf ! Number of surface observations 137 163 INTEGER, INTENT(IN) :: kvar ! Number of surface variables 164 INTEGER, INTENT(IN) :: kadd ! Number of additional fields at observation points 138 165 INTEGER, INTENT(IN) :: kextra ! Number of extra fields at observation points 139 166 INTEGER, INTENT(IN) :: kstp ! Number of time steps … … 143 170 !!* Local variables 144 171 INTEGER :: ji 145 INTEGER :: jvar 172 INTEGER :: jvar, jadd, jext 146 173 147 174 ! Set bookkeeping variables … … 149 176 surf%nsurf = ksurf 150 177 surf%nsurfmpp = 0 178 surf%nadd = kadd 151 179 surf%nextra = kextra 152 180 surf%nvar = kvar … … 158 186 159 187 ALLOCATE( & 160 & surf%cvars(kvar) & 188 & surf%cvars(kvar), & 189 & surf%clong(kvar), & 190 & surf%cunit(kvar), & 191 & surf%cgrid(kvar) & 161 192 & ) 162 193 163 194 DO jvar = 1, kvar 164 195 surf%cvars(jvar) = "NotSet" 196 surf%clong(jvar) = "NotSet" 197 surf%cunit(jvar) = "NotSet" 198 surf%cgrid(jvar) = "" 199 END DO 200 201 ! Allocate additional/extra variable metadata 202 203 ALLOCATE( & 204 & surf%caddvars(kadd), & 205 & surf%caddlong(kadd,kvar), & 206 & surf%caddunit(kadd,kvar), & 207 & surf%cextvars(kextra), & 208 & surf%cextlong(kextra), & 209 & surf%cextunit(kextra) & 210 ) 211 212 DO jadd = 1, kadd 213 surf%caddvars(jadd) = "NotSet" 214 DO jvar = 1, kvar 215 surf%caddlong(jadd,jvar) = "NotSet" 216 surf%caddunit(jadd,jvar) = "NotSet" 217 END DO 218 END DO 219 220 DO jext = 1, kextra 221 surf%cextvars(jext) = "NotSet" 222 surf%cextlong(jext) = "NotSet" 223 surf%cextunit(jext) = "NotSet" 165 224 END DO 166 225 … … 168 227 169 228 ALLOCATE( & 170 & surf%mi(ksurf), &171 & surf%mj(ksurf), &172 229 & surf%mt(ksurf), & 173 230 & surf%nsidx(ksurf), & … … 187 244 & ) 188 245 246 ALLOCATE( & 247 & surf%mi(ksurf,kvar), & 248 & surf%mj(ksurf,kvar) & 249 & ) 250 189 251 surf%mt(:) = -1 190 252 … … 205 267 surf%rext(:,:) = 0.0_wp 206 268 269 ! Allocate arrays of number of additional fields at observation points 270 271 ALLOCATE( & 272 & surf%radd(ksurf,kadd,kvar) & 273 & ) 274 275 surf%radd(:,:,:) = 0.0_wp 276 207 277 ! Allocate arrays of number of time step size 208 278 … … 215 285 216 286 ALLOCATE( & 217 & surf%vdmean(kpi,kpj ) &287 & surf%vdmean(kpi,kpj,kvar) & 218 288 & ) 219 289 … … 291 361 & ) 292 362 363 ! Deallocate arrays of number of additional fields at observation points 364 365 DEALLOCATE( & 366 & surf%radd & 367 & ) 368 293 369 ! Deallocate arrays of size number of grid points size times 294 370 ! number of variables … … 308 384 309 385 DEALLOCATE( & 310 & surf%cvars & 311 & ) 386 & surf%cvars, & 387 & surf%clong, & 388 & surf%cunit, & 389 & surf%cgrid & 390 & ) 391 392 ! Dellocate additional/extra variables metadata 393 394 DEALLOCATE( & 395 & surf%caddvars, & 396 & surf%caddlong, & 397 & surf%caddunit, & 398 & surf%cextvars, & 399 & surf%cextlong, & 400 & surf%cextunit & 401 ) 312 402 313 403 END SUBROUTINE obs_surf_dealloc … … 343 433 INTEGER :: ji 344 434 INTEGER :: jk 435 INTEGER :: jadd 345 436 LOGICAL, DIMENSION(:), ALLOCATABLE :: llvalid 346 437 … … 361 452 362 453 IF ( lallocate ) THEN 363 CALL obs_surf_alloc( newsurf, insurf, surf%nvar, &454 CALL obs_surf_alloc( newsurf, insurf, surf%nvar, surf%nadd, & 364 455 & surf%nextra, surf%nstp, surf%npi, surf%npj ) 365 456 ENDIF … … 388 479 insurf = insurf + 1 389 480 390 newsurf%mi(insurf ) = surf%mi(ji)391 newsurf%mj(insurf ) = surf%mj(ji)481 newsurf%mi(insurf,:) = surf%mi(ji,:) 482 newsurf%mj(insurf,:) = surf%mj(ji,:) 392 483 newsurf%mt(insurf) = surf%mt(ji) 393 484 newsurf%nsidx(insurf) = surf%nsidx(ji) … … 410 501 newsurf%rmod(insurf,jk) = surf%rmod(ji,jk) 411 502 503 DO jadd = 1, surf%nadd 504 newsurf%radd(insurf,jadd,jk) = surf%radd(ji,jadd,jk) 505 END DO 506 412 507 END DO 413 508 … … 433 528 ! Set book keeping variables which do not depend on number of obs. 434 529 435 newsurf%nstp = surf%nstp 436 newsurf%cvars(:) = surf%cvars(:) 530 newsurf%nstp = surf%nstp 531 newsurf%cvars(:) = surf%cvars(:) 532 newsurf%clong(:) = surf%clong(:) 533 newsurf%cunit(:) = surf%cunit(:) 534 newsurf%cgrid(:) = surf%cgrid(:) 535 newsurf%caddvars(:) = surf%caddvars(:) 536 newsurf%caddlong(:,:) = surf%caddlong(:,:) 537 newsurf%caddunit(:,:) = surf%caddunit(:,:) 538 newsurf%cextvars(:) = surf%cextvars(:) 539 newsurf%cextlong(:) = surf%cextlong(:) 540 newsurf%cextunit(:) = surf%cextunit(:) 437 541 438 542 ! Set gridded stuff … … 470 574 INTEGER :: jj 471 575 INTEGER :: jk 576 INTEGER :: jadd 472 577 473 578 ! Copy data from surf to old surf … … 475 580 DO ji = 1, surf%nsurf 476 581 477 jj =surf%nsind(ji)478 479 oldsurf%mi(jj ) = surf%mi(ji)480 oldsurf%mj(jj ) = surf%mj(ji)582 jj = surf%nsind(ji) 583 584 oldsurf%mi(jj,:) = surf%mi(ji,:) 585 oldsurf%mj(jj,:) = surf%mj(ji,:) 481 586 oldsurf%mt(jj) = surf%mt(ji) 482 587 oldsurf%nsidx(jj) = surf%nsidx(ji) … … 500 605 DO ji = 1, surf%nsurf 501 606 502 jj =surf%nsind(ji)607 jj = surf%nsind(ji) 503 608 504 609 oldsurf%robs(jj,jk) = surf%robs(ji,jk) 505 610 oldsurf%rmod(jj,jk) = surf%rmod(ji,jk) 611 612 DO jadd = 1, surf%nadd 613 oldsurf%radd(jj,jadd,jk) = surf%radd(ji,jadd,jk) 614 END DO 506 615 507 616 END DO … … 513 622 DO ji = 1, surf%nsurf 514 623 515 jj =surf%nsind(ji)624 jj = surf%nsind(ji) 516 625 517 626 oldsurf%rext(jj,jk) = surf%rext(ji,jk)
Note: See TracChangeset
for help on using the changeset viewer.
