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.
obs_surf_def.F90 in NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS – NEMO

source: NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_surf_def.F90 @ 15180

Last change on this file since 15180 was 15180, checked in by dford, 3 years ago

Further generification, particularly surrounding additional and extra variables.
File size: 20.2 KB
Line 
1MODULE obs_surf_def
2   !!=====================================================================
3   !!                       ***  MODULE  obs_surf_def  ***
4   !! Observation diagnostics: Storage handling for surface observation
5   !!                          arrays and additional flags etc.
6   !!                          This module only defines the data type and
7   !!                          operations on the data type. There is no
8   !!                          actual data in the module.
9   !!=====================================================================
10
11   !!----------------------------------------------------------------------
12   !!   obs_surf            : F90 type containing the surface information
13   !!   obs_surf_alloc      : Allocates surface data arrays
14   !!   obs_surf_dealloc    : Deallocates surface data arrays
15   !!   obs_surf_compress   : Extract sub-information from a obs_surf type
16   !!                         to a new obs_surf type
17   !!   obs_surf_decompress : Reinsert sub-information from a obs_surf type
18   !!                         into the original obs_surf type
19   !!----------------------------------------------------------------------
20   !! * Modules used
21   USE par_kind, ONLY : & ! Precision variables
22      & wp         
23   USE obs_mpp, ONLY : &  ! MPP tools
24      obs_mpp_sum_integer
25   USE obs_fbm            ! Obs feedback format
26
27   IMPLICIT NONE
28
29   !! * Routine/type accessibility
30   PRIVATE
31
32   PUBLIC &
33      & obs_surf,           &
34      & obs_surf_alloc,     &
35      & obs_surf_dealloc,   &
36      & obs_surf_compress,  &
37      & obs_surf_decompress
38
39   !! * Type definition for surface observation type
40
41   TYPE obs_surf
42
43      ! Bookkeeping
44
45      INTEGER :: nsurf      !: Local number of surface data within window
46      INTEGER :: nsurfmpp   !: Global number of surface data within window
47      INTEGER :: nvar       !: Number of variables at observation points
48      INTEGER :: nadd       !: Number of additional fields at observation points
49      INTEGER :: nextra     !: Number of extra fields at observation points
50      INTEGER :: nstp       !: Number of time steps
51      INTEGER :: npi        !: Number of 3D grid points
52      INTEGER :: npj
53      INTEGER :: nsurfup    !: Observation counter used in obs_oper
54      INTEGER :: nrec       !: Number of surface observation records in window
55
56      ! Arrays with size equal to the number of surface observations
57
58      INTEGER, POINTER, DIMENSION(:) :: &
59         & mi,   &        !: i-th grid coord. for interpolating to surface observation
60         & mj,   &        !: j-th grid coord. for interpolating to surface observation
61         & mt,   &        !: time record number for gridded data
62         & nsidx,&        !: Surface observation number
63         & nsfil,&        !: Surface observation number in file
64         & nyea, &        !: Year of surface observation
65         & nmon, &        !: Month of surface observation
66         & nday, &        !: Day of surface observation
67         & nhou, &        !: Hour of surface observation
68         & nmin, &        !: Minute of surface observation
69         & mstp, &        !: Time step nearest to surface observation
70         & nqc,  &        !: Surface observation qc flag
71         & ntyp           !: Type of surface observation product
72
73      CHARACTER(len=ilenname), POINTER, DIMENSION(:) :: &
74         & cvars,    &    !: Variable names
75         & cextvars, &    !: Extra variable names
76         & caddvars       !: Additional variable names
77
78      CHARACTER(len=ilenlong), POINTER, DIMENSION(:) :: &
79         & clong,    &    !: Variable long names
80         & cextlong       !: Extra variable long names
81
82      CHARACTER(len=ilenlong), POINTER, DIMENSION(:,:) :: &
83         & caddlong       !: Additional variable long names
84
85      CHARACTER(len=ilenunit), POINTER, DIMENSION(:) :: &
86         & cunit,    &    !: Variable units
87         & cextunit       !: Extra variable units
88
89      CHARACTER(len=ilenunit), POINTER, DIMENSION(:,:) :: &
90         & caddunit       !: Additional variable units
91
92      CHARACTER(len=ilengrid), POINTER, DIMENSION(:) :: &
93         & cgrid          !: Variable grids
94
95      CHARACTER(LEN=ilenwmo), POINTER, DIMENSION(:) :: &
96         & cwmo           !: WMO indentifier
97         
98      REAL(KIND=wp), POINTER, DIMENSION(:) :: &
99         & rlam, &        !: Longitude coordinate of surface observation
100         & rphi           !: Latitude coordinate of surface observation
101
102      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
103         & robs, &        !: Surface observation
104         & rmod           !: Model counterpart of the surface observation vector
105
106      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
107         & rext           !: Extra fields interpolated to observation points
108
109      REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: &
110         & radd           !: Additional fields interpolated to observation points
111
112      REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: &
113         & vdmean         !: Time averaged of model field
114
115      ! Arrays with size equal to the number of time steps in the window
116
117      INTEGER, POINTER, DIMENSION(:) :: &
118         & nsstp,     &   !: Local number of surface observations per time step
119         & nsstpmpp       !: Global number of surface observations per time step
120
121      ! Arrays with size equal to the number of observation records in the window
122      INTEGER, POINTER, DIMENSION(:) :: &
123         & mrecstp   ! Time step of the records
124
125      ! Arrays used to store source indices when
126      ! compressing obs_surf derived types
127     
128      ! Array with size nsurf
129
130      INTEGER, POINTER, DIMENSION(:) :: &
131         & nsind          !: Source indices of surface data in compressed data
132
133      ! Is this a gridded product?
134     
135      LOGICAL :: lgrid
136
137   END TYPE obs_surf
138
139   !!----------------------------------------------------------------------
140   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
141   !! $Id$
142   !! Software governed by the CeCILL license (see ./LICENSE)
143   !!----------------------------------------------------------------------
144
145CONTAINS
146   
147   SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kadd, kextra, kstp, kpi, kpj )
148      !!----------------------------------------------------------------------
149      !!                     ***  ROUTINE obs_surf_alloc  ***
150      !!                     
151      !! ** Purpose : - Allocate data for surface data arrays
152      !!
153      !! ** Method  : - Fortran-90 dynamic arrays
154      !!
155      !! History :
156      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
157      !!----------------------------------------------------------------------
158      !! * Arguments
159      TYPE(obs_surf), INTENT(INOUT) ::  surf      ! Surface data to be allocated
160      INTEGER, INTENT(IN) :: ksurf   ! Number of surface observations
161      INTEGER, INTENT(IN) :: kvar    ! Number of surface variables
162      INTEGER, INTENT(IN) :: kadd    ! Number of additional fields at observation points
163      INTEGER, INTENT(IN) :: kextra  ! Number of extra fields at observation points
164      INTEGER, INTENT(IN) :: kstp    ! Number of time steps
165      INTEGER, INTENT(IN) :: kpi     ! Number of 3D grid points
166      INTEGER, INTENT(IN) :: kpj
167
168      !!* Local variables
169      INTEGER :: ji
170      INTEGER :: jvar, jadd, jext
171
172      ! Set bookkeeping variables
173
174      surf%nsurf    = ksurf
175      surf%nsurfmpp = 0
176      surf%nadd     = kadd
177      surf%nextra   = kextra
178      surf%nvar     = kvar
179      surf%nstp     = kstp
180      surf%npi      = kpi
181      surf%npj      = kpj
182
183      ! Allocate arrays of size number of variables
184
185      ALLOCATE( &
186         & surf%cvars(kvar), &
187         & surf%clong(kvar), &
188         & surf%cunit(kvar), &
189         & surf%cgrid(kvar)  &
190         & )
191
192      DO jvar = 1, kvar
193         surf%cvars(jvar) = "NotSet"
194         surf%clong(jvar) = "NotSet"
195         surf%cunit(jvar) = "NotSet"
196         surf%cgrid(jvar) = ""
197      END DO
198
199      ! Allocate additional/extra variable metadata
200
201      ALLOCATE( &
202         & surf%caddvars(kadd),      &
203         & surf%caddlong(kadd,kvar), &
204         & surf%caddunit(kadd,kvar), &
205         & surf%cextvars(kextra),    &
206         & surf%cextlong(kextra),    &
207         & surf%cextunit(kextra)     &
208         )
209         
210      DO jadd = 1, kadd
211         surf%caddvars(jadd) = "NotSet"
212         DO jvar = 1, kvar
213            surf%caddlong(jadd,jvar) = "NotSet"
214            surf%caddunit(jadd,jvar) = "NotSet"
215         END DO
216      END DO
217         
218      DO jext = 1, kextra
219         surf%cextvars(jext) = "NotSet"
220         surf%cextlong(jext) = "NotSet"
221         surf%cextunit(jext) = "NotSet"
222      END DO
223     
224      ! Allocate arrays of number of surface data size
225
226      ALLOCATE( &
227         & surf%mi(ksurf),      &
228         & surf%mj(ksurf),      &
229         & surf%mt(ksurf),      &
230         & surf%nsidx(ksurf),   &
231         & surf%nsfil(ksurf),   &
232         & surf%nyea(ksurf),    &
233         & surf%nmon(ksurf),    &
234         & surf%nday(ksurf),    &
235         & surf%nhou(ksurf),    &
236         & surf%nmin(ksurf),    &
237         & surf%mstp(ksurf),    &
238         & surf%nqc(ksurf),     &
239         & surf%ntyp(ksurf),    &
240         & surf%cwmo(ksurf),    &
241         & surf%rlam(ksurf),    &
242         & surf%rphi(ksurf),    &
243         & surf%nsind(ksurf)    &
244         & )
245
246      surf%mt(:) = -1
247
248
249      ! Allocate arrays of number of surface data size * number of variables
250
251      ALLOCATE( & 
252         & surf%robs(ksurf,kvar), &
253         & surf%rmod(ksurf,kvar)  &
254         & )   
255
256      ! Allocate arrays of number of extra fields at observation points
257
258      ALLOCATE( & 
259         & surf%rext(ksurf,kextra) &
260         & )
261
262      surf%rext(:,:) = 0.0_wp 
263
264      ! Allocate arrays of number of additional fields at observation points
265
266      ALLOCATE( & 
267         & surf%radd(ksurf,kadd,kvar) &
268         & )
269
270      surf%radd(:,:,:) = 0.0_wp 
271
272      ! Allocate arrays of number of time step size
273
274      ALLOCATE( &
275         & surf%nsstp(kstp),     &
276         & surf%nsstpmpp(kstp)   &
277         & )
278
279      ! Allocate arrays of size number of grid points
280
281      ALLOCATE( &
282         & surf%vdmean(kpi,kpj,kvar) &
283         & )
284
285      ! Set defaults for compression indices
286     
287      DO ji = 1, ksurf
288         surf%nsind(ji) = ji
289      END DO
290     
291      ! Set defaults for number of observations per time step
292
293      surf%nsstp(:)     = 0
294      surf%nsstpmpp(:)  = 0
295
296      ! Set the observation counter used in obs_oper
297
298      surf%nsurfup     = 0
299     
300      ! Not gridded by default
301         
302      surf%lgrid       = .FALSE.
303             
304   END SUBROUTINE obs_surf_alloc
305
306   SUBROUTINE obs_surf_dealloc( surf )
307      !!----------------------------------------------------------------------
308      !!                     ***  ROUTINE obs_surf_dealloc  ***
309      !!                     
310      !! ** Purpose : - Deallocate data for surface data arrays
311      !!
312      !! ** Method  : - Fortran-90 dynamic arrays
313      !!
314      !! History :
315      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
316      !!----------------------------------------------------------------------
317      !! * Arguments
318      TYPE(obs_surf), INTENT(INOUT) :: &
319         & surf      ! Surface data to be allocated
320
321      !!* Local variables
322
323      ! Deallocate arrays of number of surface data size
324
325      DEALLOCATE( &
326         & surf%mi,      &
327         & surf%mj,      &
328         & surf%mt,      &
329         & surf%nsidx,   &
330         & surf%nsfil,   &
331         & surf%nyea,    &
332         & surf%nmon,    &
333         & surf%nday,    &
334         & surf%nhou,    &
335         & surf%nmin,    &
336         & surf%mstp,    &
337         & surf%nqc,     &
338         & surf%ntyp,    &
339         & surf%cwmo,    &
340         & surf%rlam,    &
341         & surf%rphi,    &
342         & surf%nsind    &
343         & )
344
345      ! Allocate arrays of number of surface data size * number of variables
346
347      DEALLOCATE( & 
348         & surf%robs,    &
349         & surf%rmod     &
350         & )
351
352      ! Deallocate arrays of number of extra fields at observation points
353
354      DEALLOCATE( & 
355         & surf%rext &
356         & )
357
358      ! Deallocate arrays of number of additional fields at observation points
359
360      DEALLOCATE( & 
361         & surf%radd &
362         & )
363
364      ! Deallocate arrays of size number of grid points size times
365      ! number of variables
366
367      DEALLOCATE( &
368         & surf%vdmean &
369         & )
370
371      ! Deallocate arrays of number of time step size
372
373      DEALLOCATE( &
374         & surf%nsstp,     &
375         & surf%nsstpmpp   &
376         & )
377
378      ! Dellocate arrays of size number of variables
379
380      DEALLOCATE( &
381         & surf%cvars, &
382         & surf%clong, &
383         & surf%cunit, &
384         & surf%cgrid  &
385         & )
386
387      ! Dellocate additional/extra variables metadata
388
389      DEALLOCATE( &
390         & surf%caddvars, &
391         & surf%caddlong, &
392         & surf%caddunit, &
393         & surf%cextvars, &
394         & surf%cextlong, &
395         & surf%cextunit  &
396         )
397
398   END SUBROUTINE obs_surf_dealloc
399
400   SUBROUTINE obs_surf_compress( surf, newsurf, lallocate, kumout, lvalid )
401      !!----------------------------------------------------------------------
402      !!                     ***  ROUTINE obs_surf_compress  ***
403      !!                     
404      !! ** Purpose : - Extract sub-information from a obs_surf type
405      !!                into a new obs_surf type
406      !!
407      !! ** Method  : - The data is copied from surf to new surf.
408      !!                In the case of lvalid being present only the
409      !!                selected data will be copied.
410      !!                If lallocate is true the data in the newsurf is
411      !!                allocated either with the same number of elements
412      !!                as surf or with only the subset of elements defined
413      !!                by the optional selection.
414      !!
415      !! History :
416      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
417      !!----------------------------------------------------------------------
418      !! * Arguments
419      TYPE(obs_surf), INTENT(IN)    :: surf      ! Original surface data
420      TYPE(obs_surf), INTENT(INOUT) :: newsurf   ! New surface data with a subset of the original data
421      LOGICAL :: lallocate     ! Allocate newsurf data
422      INTEGER,INTENT(IN) :: kumout        ! Fortran unit for messages
423      LOGICAL, OPTIONAL, INTENT(in), DIMENSION(:) :: &
424         & lvalid         ! Valid of surface observations
425     
426      !!* Local variables
427      INTEGER :: insurf
428      INTEGER :: ji
429      INTEGER :: jk
430      INTEGER :: jadd
431      LOGICAL, DIMENSION(:), ALLOCATABLE :: llvalid
432
433      ! Count how many elements there should be in the new data structure
434
435      IF ( PRESENT(lvalid) ) THEN
436         insurf = 0
437         DO ji = 1, surf%nsurf
438            IF ( lvalid(ji) ) THEN
439               insurf = insurf + 1
440            ENDIF
441         END DO
442      ELSE
443         insurf = surf%nsurf
444      ENDIF
445
446      ! Optionally allocate data in the new data structure
447
448      IF ( lallocate ) THEN
449         CALL obs_surf_alloc( newsurf,  insurf, surf%nvar, surf%nadd, &
450            & surf%nextra, surf%nstp, surf%npi, surf%npj )
451      ENDIF
452
453      ! Allocate temporary valid array to unify the code for both cases
454
455      ALLOCATE( llvalid(surf%nsurf) )
456      IF ( PRESENT(lvalid) ) THEN
457         llvalid(:)  = lvalid(:)
458      ELSE
459         llvalid(:)  = .TRUE.
460      ENDIF
461
462      ! Setup bookkeeping variables
463
464      insurf = 0
465
466      ! Loop over source surface data
467
468      DO ji = 1, surf%nsurf
469
470         IF ( llvalid(ji) ) THEN
471
472            ! Copy the header information
473
474            insurf = insurf + 1
475
476            newsurf%mi(insurf)    = surf%mi(ji)
477            newsurf%mj(insurf)    = surf%mj(ji)
478            newsurf%mt(insurf)    = surf%mt(ji)
479            newsurf%nsidx(insurf) = surf%nsidx(ji)
480            newsurf%nsfil(insurf) = surf%nsfil(ji)
481            newsurf%nyea(insurf)  = surf%nyea(ji)
482            newsurf%nmon(insurf)  = surf%nmon(ji)
483            newsurf%nday(insurf)  = surf%nday(ji)
484            newsurf%nhou(insurf)  = surf%nhou(ji)
485            newsurf%nmin(insurf)  = surf%nmin(ji)
486            newsurf%mstp(insurf)  = surf%mstp(ji)
487            newsurf%nqc(insurf)   = surf%nqc(ji)
488            newsurf%ntyp(insurf)  = surf%ntyp(ji)
489            newsurf%cwmo(insurf)  = surf%cwmo(ji)
490            newsurf%rlam(insurf)  = surf%rlam(ji)
491            newsurf%rphi(insurf)  = surf%rphi(ji)
492
493            DO jk = 1, surf%nvar
494
495               newsurf%robs(insurf,jk)  = surf%robs(ji,jk)
496               newsurf%rmod(insurf,jk)  = surf%rmod(ji,jk)
497               
498               DO jadd = 1, surf%nadd
499                  newsurf%radd(insurf,jadd,jk) = surf%radd(ji,jadd,jk)
500               END DO
501               
502            END DO
503
504            DO jk = 1, surf%nextra
505
506               newsurf%rext(insurf,jk) = surf%rext(ji,jk)
507
508            END DO
509           
510            ! nsind is the index of the original surface data
511           
512            newsurf%nsind(insurf) = ji
513
514         ENDIF
515
516      END DO
517
518      ! Update MPP counters
519
520      newsurf%nsurf = insurf
521      CALL obs_mpp_sum_integer ( newsurf%nsurf, newsurf%nsurfmpp )
522
523      ! Set book keeping variables which do not depend on number of obs.
524
525      newsurf%nstp     = surf%nstp
526      newsurf%cvars(:) = surf%cvars(:)
527      newsurf%clong(:) = surf%clong(:)
528      newsurf%cunit(:) = surf%cunit(:)
529      newsurf%cgrid(:) = surf%cgrid(:)
530      newsurf%caddvars(:) = surf%caddvars(:)
531      newsurf%caddlong(:) = surf%caddlong(:)
532      newsurf%caddunit(:) = surf%caddunit(:)
533      newsurf%cextvars(:) = surf%cextvars(:)
534      newsurf%cextlong(:) = surf%cextlong(:)
535      newsurf%cextunit(:) = surf%cextunit(:)
536     
537      ! Set gridded stuff
538     
539      newsurf%mt(insurf)    = surf%mt(ji)
540 
541      ! Deallocate temporary data
542
543      DEALLOCATE( llvalid )
544     
545   END SUBROUTINE obs_surf_compress
546
547   SUBROUTINE obs_surf_decompress( surf, oldsurf, ldeallocate, kumout )
548      !!----------------------------------------------------------------------
549      !!                     ***  ROUTINE obs_surf_decompress  ***
550      !!                     
551      !! ** Purpose : - Copy back information to original surface data type
552      !!
553      !! ** Method  : - Reinsert updated information from a previous
554      !!                copied/compressed surface data type into the original
555      !!                surface data and optionally deallocate the surface
556      !!                data input
557      !!
558      !! History :
559      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
560      !!----------------------------------------------------------------------
561      !! * Arguments
562      TYPE(obs_surf),INTENT(INOUT) :: surf       ! Updated surface data
563      TYPE(obs_surf),INTENT(INOUT) :: oldsurf    ! Original surface data
564      LOGICAL :: ldeallocate ! Deallocate the updated data of insertion
565      INTEGER,INTENT(in) :: kumout      ! Output unit
566     
567      !!* Local variables
568      INTEGER :: ji
569      INTEGER :: jj
570      INTEGER :: jk
571      INTEGER :: jadd
572
573      ! Copy data from surf to old surf
574
575      DO ji = 1, surf%nsurf
576
577         jj=surf%nsind(ji)
578
579         oldsurf%mi(jj)    = surf%mi(ji)
580         oldsurf%mj(jj)    = surf%mj(ji)
581         oldsurf%mt(jj)    = surf%mt(ji)
582         oldsurf%nsidx(jj) = surf%nsidx(ji)
583         oldsurf%nsfil(jj) = surf%nsfil(ji)
584         oldsurf%nyea(jj)  = surf%nyea(ji)
585         oldsurf%nmon(jj)  = surf%nmon(ji)
586         oldsurf%nday(jj)  = surf%nday(ji)
587         oldsurf%nhou(jj)  = surf%nhou(ji)
588         oldsurf%nmin(jj)  = surf%nmin(ji)
589         oldsurf%mstp(jj)  = surf%mstp(ji)
590         oldsurf%nqc(jj)   = surf%nqc(ji)
591         oldsurf%ntyp(jj)  = surf%ntyp(ji)
592         oldsurf%cwmo(jj)  = surf%cwmo(ji)
593         oldsurf%rlam(jj)  = surf%rlam(ji)
594         oldsurf%rphi(jj)  = surf%rphi(ji)
595
596      END DO
597
598      DO jk = 1, surf%nvar
599
600         DO ji = 1, surf%nsurf
601           
602            jj=surf%nsind(ji)
603
604            oldsurf%robs(jj,jk)  = surf%robs(ji,jk)
605            oldsurf%rmod(jj,jk)  = surf%rmod(ji,jk)
606               
607            DO jadd = 1, surf%nadd
608               oldsurf%radd(jj,jadd,jk) = surf%radd(ji,jadd,jk)
609            END DO
610
611         END DO
612
613      END DO
614
615      DO jk = 1, surf%nextra
616
617         DO ji = 1, surf%nsurf
618           
619            jj=surf%nsind(ji)
620
621            oldsurf%rext(jj,jk)  = surf%rext(ji,jk)
622
623         END DO
624
625      END DO
626
627      ! Optionally deallocate the updated surface data
628
629      IF ( ldeallocate ) CALL obs_surf_dealloc( surf )
630     
631   END SUBROUTINE obs_surf_decompress
632   
633END MODULE obs_surf_def
634
Note: See TracBrowser for help on using the repository browser.