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 @ 15487

Last change on this file since 15487 was 15487, checked in by dford, 8 months ago

Remove some comments and add some spaces.

File size: 20.4 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         & mt,   &        !: time record number for gridded data
60         & nsidx,&        !: Surface observation number
61         & nsfil,&        !: Surface observation number in file
62         & nyea, &        !: Year of surface observation
63         & nmon, &        !: Month of surface observation
64         & nday, &        !: Day of surface observation
65         & nhou, &        !: Hour of surface observation
66         & nmin, &        !: Minute of surface observation
67         & mstp, &        !: Time step nearest to surface observation
68         & nqc,  &        !: Surface observation qc flag
69         & ntyp           !: Type of surface observation product
70
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(:) :: &
98         & cwmo           !: WMO indentifier
99         
100      REAL(KIND=wp), POINTER, DIMENSION(:) :: &
101         & rlam, &        !: Longitude coordinate of surface observation
102         & rphi           !: Latitude coordinate of surface observation
103
104      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
105         & robs, &        !: Surface observation
106         & rmod           !: Model counterpart of the surface observation vector
107
108      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
109         & rext           !: Extra fields interpolated to observation points
110
111      REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: &
112         & radd           !: Additional fields interpolated to observation points
113
114      REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: &
115         & vdmean         !: Time averaged of model field
116
117      ! Arrays with size equal to the number of time steps in the window
118
119      INTEGER, POINTER, DIMENSION(:) :: &
120         & nsstp,     &   !: Local number of surface observations per time step
121         & nsstpmpp       !: Global number of surface observations per time step
122
123      ! Arrays with size equal to the number of observation records in the window
124      INTEGER, POINTER, DIMENSION(:) :: &
125         & mrecstp   ! Time step of the records
126
127      ! Arrays used to store source indices when
128      ! compressing obs_surf derived types
129     
130      ! Array with size nsurf
131
132      INTEGER, POINTER, DIMENSION(:) :: &
133         & nsind          !: Source indices of surface data in compressed data
134
135      ! Is this a gridded product?
136     
137      LOGICAL :: lgrid
138
139   END TYPE obs_surf
140
141   !!----------------------------------------------------------------------
142   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
143   !! $Id$
144   !! Software governed by the CeCILL license (see ./LICENSE)
145   !!----------------------------------------------------------------------
146
147CONTAINS
148   
149   SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kadd, kextra, kstp, kpi, kpj )
150      !!----------------------------------------------------------------------
151      !!                     ***  ROUTINE obs_surf_alloc  ***
152      !!                     
153      !! ** Purpose : - Allocate data for surface data arrays
154      !!
155      !! ** Method  : - Fortran-90 dynamic arrays
156      !!
157      !! History :
158      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
159      !!----------------------------------------------------------------------
160      !! * Arguments
161      TYPE(obs_surf), INTENT(INOUT) ::  surf      ! Surface data to be allocated
162      INTEGER, INTENT(IN) :: ksurf   ! Number of surface observations
163      INTEGER, INTENT(IN) :: kvar    ! Number of surface variables
164      INTEGER, INTENT(IN) :: kadd    ! Number of additional fields at observation points
165      INTEGER, INTENT(IN) :: kextra  ! Number of extra fields at observation points
166      INTEGER, INTENT(IN) :: kstp    ! Number of time steps
167      INTEGER, INTENT(IN) :: kpi     ! Number of 3D grid points
168      INTEGER, INTENT(IN) :: kpj
169
170      !!* Local variables
171      INTEGER :: ji
172      INTEGER :: jvar, jadd, jext
173
174      ! Set bookkeeping variables
175
176      surf%nsurf    = ksurf
177      surf%nsurfmpp = 0
178      surf%nadd     = kadd
179      surf%nextra   = kextra
180      surf%nvar     = kvar
181      surf%nstp     = kstp
182      surf%npi      = kpi
183      surf%npj      = kpj
184
185      ! Allocate arrays of size number of variables
186
187      ALLOCATE( &
188         & surf%cvars(kvar), &
189         & surf%clong(kvar), &
190         & surf%cunit(kvar), &
191         & surf%cgrid(kvar)  &
192         & )
193
194      DO jvar = 1, kvar
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"
224      END DO
225     
226      ! Allocate arrays of number of surface data size
227
228      ALLOCATE( &
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      ALLOCATE( &
247         & surf%mi(ksurf,kvar), &
248         & surf%mj(ksurf,kvar)  &
249         & )
250
251      surf%mt(:) = -1
252
253
254      ! Allocate arrays of number of surface data size * number of variables
255
256      ALLOCATE( & 
257         & surf%robs(ksurf,kvar), &
258         & surf%rmod(ksurf,kvar)  &
259         & )   
260
261      ! Allocate arrays of number of extra fields at observation points
262
263      ALLOCATE( & 
264         & surf%rext(ksurf,kextra) &
265         & )
266
267      surf%rext(:,:) = 0.0_wp 
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
277      ! Allocate arrays of number of time step size
278
279      ALLOCATE( &
280         & surf%nsstp(kstp),     &
281         & surf%nsstpmpp(kstp)   &
282         & )
283
284      ! Allocate arrays of size number of grid points
285
286      ALLOCATE( &
287         & surf%vdmean(kpi,kpj,kvar) &
288         & )
289
290      ! Set defaults for compression indices
291     
292      DO ji = 1, ksurf
293         surf%nsind(ji) = ji
294      END DO
295     
296      ! Set defaults for number of observations per time step
297
298      surf%nsstp(:)     = 0
299      surf%nsstpmpp(:)  = 0
300
301      ! Set the observation counter used in obs_oper
302
303      surf%nsurfup     = 0
304     
305      ! Not gridded by default
306         
307      surf%lgrid       = .FALSE.
308             
309   END SUBROUTINE obs_surf_alloc
310
311   SUBROUTINE obs_surf_dealloc( surf )
312      !!----------------------------------------------------------------------
313      !!                     ***  ROUTINE obs_surf_dealloc  ***
314      !!                     
315      !! ** Purpose : - Deallocate data for surface data arrays
316      !!
317      !! ** Method  : - Fortran-90 dynamic arrays
318      !!
319      !! History :
320      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
321      !!----------------------------------------------------------------------
322      !! * Arguments
323      TYPE(obs_surf), INTENT(INOUT) :: &
324         & surf      ! Surface data to be allocated
325
326      !!* Local variables
327
328      ! Deallocate arrays of number of surface data size
329
330      DEALLOCATE( &
331         & surf%mi,      &
332         & surf%mj,      &
333         & surf%mt,      &
334         & surf%nsidx,   &
335         & surf%nsfil,   &
336         & surf%nyea,    &
337         & surf%nmon,    &
338         & surf%nday,    &
339         & surf%nhou,    &
340         & surf%nmin,    &
341         & surf%mstp,    &
342         & surf%nqc,     &
343         & surf%ntyp,    &
344         & surf%cwmo,    &
345         & surf%rlam,    &
346         & surf%rphi,    &
347         & surf%nsind    &
348         & )
349
350      ! Allocate arrays of number of surface data size * number of variables
351
352      DEALLOCATE( & 
353         & surf%robs,    &
354         & surf%rmod     &
355         & )
356
357      ! Deallocate arrays of number of extra fields at observation points
358
359      DEALLOCATE( & 
360         & surf%rext &
361         & )
362
363      ! Deallocate arrays of number of additional fields at observation points
364
365      DEALLOCATE( & 
366         & surf%radd &
367         & )
368
369      ! Deallocate arrays of size number of grid points size times
370      ! number of variables
371
372      DEALLOCATE( &
373         & surf%vdmean &
374         & )
375
376      ! Deallocate arrays of number of time step size
377
378      DEALLOCATE( &
379         & surf%nsstp,     &
380         & surf%nsstpmpp   &
381         & )
382
383      ! Dellocate arrays of size number of variables
384
385      DEALLOCATE( &
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         )
402
403   END SUBROUTINE obs_surf_dealloc
404
405   SUBROUTINE obs_surf_compress( surf, newsurf, lallocate, kumout, lvalid )
406      !!----------------------------------------------------------------------
407      !!                     ***  ROUTINE obs_surf_compress  ***
408      !!                     
409      !! ** Purpose : - Extract sub-information from a obs_surf type
410      !!                into a new obs_surf type
411      !!
412      !! ** Method  : - The data is copied from surf to new surf.
413      !!                In the case of lvalid being present only the
414      !!                selected data will be copied.
415      !!                If lallocate is true the data in the newsurf is
416      !!                allocated either with the same number of elements
417      !!                as surf or with only the subset of elements defined
418      !!                by the optional selection.
419      !!
420      !! History :
421      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
422      !!----------------------------------------------------------------------
423      !! * Arguments
424      TYPE(obs_surf), INTENT(IN)    :: surf      ! Original surface data
425      TYPE(obs_surf), INTENT(INOUT) :: newsurf   ! New surface data with a subset of the original data
426      LOGICAL :: lallocate     ! Allocate newsurf data
427      INTEGER,INTENT(IN) :: kumout        ! Fortran unit for messages
428      LOGICAL, OPTIONAL, INTENT(in), DIMENSION(:) :: &
429         & lvalid         ! Valid of surface observations
430     
431      !!* Local variables
432      INTEGER :: insurf
433      INTEGER :: ji
434      INTEGER :: jk
435      INTEGER :: jadd
436      LOGICAL, DIMENSION(:), ALLOCATABLE :: llvalid
437
438      ! Count how many elements there should be in the new data structure
439
440      IF ( PRESENT(lvalid) ) THEN
441         insurf = 0
442         DO ji = 1, surf%nsurf
443            IF ( lvalid(ji) ) THEN
444               insurf = insurf + 1
445            ENDIF
446         END DO
447      ELSE
448         insurf = surf%nsurf
449      ENDIF
450
451      ! Optionally allocate data in the new data structure
452
453      IF ( lallocate ) THEN
454         CALL obs_surf_alloc( newsurf,  insurf, surf%nvar, surf%nadd, &
455            & surf%nextra, surf%nstp, surf%npi, surf%npj )
456      ENDIF
457
458      ! Allocate temporary valid array to unify the code for both cases
459
460      ALLOCATE( llvalid(surf%nsurf) )
461      IF ( PRESENT(lvalid) ) THEN
462         llvalid(:)  = lvalid(:)
463      ELSE
464         llvalid(:)  = .TRUE.
465      ENDIF
466
467      ! Setup bookkeeping variables
468
469      insurf = 0
470
471      ! Loop over source surface data
472
473      DO ji = 1, surf%nsurf
474
475         IF ( llvalid(ji) ) THEN
476
477            ! Copy the header information
478
479            insurf = insurf + 1
480
481            newsurf%mi(insurf,:)  = surf%mi(ji,:)
482            newsurf%mj(insurf,:)  = surf%mj(ji,:)
483            newsurf%mt(insurf)    = surf%mt(ji)
484            newsurf%nsidx(insurf) = surf%nsidx(ji)
485            newsurf%nsfil(insurf) = surf%nsfil(ji)
486            newsurf%nyea(insurf)  = surf%nyea(ji)
487            newsurf%nmon(insurf)  = surf%nmon(ji)
488            newsurf%nday(insurf)  = surf%nday(ji)
489            newsurf%nhou(insurf)  = surf%nhou(ji)
490            newsurf%nmin(insurf)  = surf%nmin(ji)
491            newsurf%mstp(insurf)  = surf%mstp(ji)
492            newsurf%nqc(insurf)   = surf%nqc(ji)
493            newsurf%ntyp(insurf)  = surf%ntyp(ji)
494            newsurf%cwmo(insurf)  = surf%cwmo(ji)
495            newsurf%rlam(insurf)  = surf%rlam(ji)
496            newsurf%rphi(insurf)  = surf%rphi(ji)
497
498            DO jk = 1, surf%nvar
499
500               newsurf%robs(insurf,jk)  = surf%robs(ji,jk)
501               newsurf%rmod(insurf,jk)  = surf%rmod(ji,jk)
502               
503               DO jadd = 1, surf%nadd
504                  newsurf%radd(insurf,jadd,jk) = surf%radd(ji,jadd,jk)
505               END DO
506               
507            END DO
508
509            DO jk = 1, surf%nextra
510
511               newsurf%rext(insurf,jk) = surf%rext(ji,jk)
512
513            END DO
514           
515            ! nsind is the index of the original surface data
516           
517            newsurf%nsind(insurf) = ji
518
519         ENDIF
520
521      END DO
522
523      ! Update MPP counters
524
525      newsurf%nsurf = insurf
526      CALL obs_mpp_sum_integer ( newsurf%nsurf, newsurf%nsurfmpp )
527
528      ! Set book keeping variables which do not depend on number of obs.
529
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(:)
541     
542      ! Set gridded stuff
543     
544      newsurf%mt(insurf)    = surf%mt(ji)
545 
546      ! Deallocate temporary data
547
548      DEALLOCATE( llvalid )
549     
550   END SUBROUTINE obs_surf_compress
551
552   SUBROUTINE obs_surf_decompress( surf, oldsurf, ldeallocate, kumout )
553      !!----------------------------------------------------------------------
554      !!                     ***  ROUTINE obs_surf_decompress  ***
555      !!                     
556      !! ** Purpose : - Copy back information to original surface data type
557      !!
558      !! ** Method  : - Reinsert updated information from a previous
559      !!                copied/compressed surface data type into the original
560      !!                surface data and optionally deallocate the surface
561      !!                data input
562      !!
563      !! History :
564      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
565      !!----------------------------------------------------------------------
566      !! * Arguments
567      TYPE(obs_surf),INTENT(INOUT) :: surf       ! Updated surface data
568      TYPE(obs_surf),INTENT(INOUT) :: oldsurf    ! Original surface data
569      LOGICAL :: ldeallocate ! Deallocate the updated data of insertion
570      INTEGER,INTENT(in) :: kumout      ! Output unit
571     
572      !!* Local variables
573      INTEGER :: ji
574      INTEGER :: jj
575      INTEGER :: jk
576      INTEGER :: jadd
577
578      ! Copy data from surf to old surf
579
580      DO ji = 1, surf%nsurf
581
582         jj = surf%nsind(ji)
583
584         oldsurf%mi(jj,:)  = surf%mi(ji,:)
585         oldsurf%mj(jj,:)  = surf%mj(ji,:)
586         oldsurf%mt(jj)    = surf%mt(ji)
587         oldsurf%nsidx(jj) = surf%nsidx(ji)
588         oldsurf%nsfil(jj) = surf%nsfil(ji)
589         oldsurf%nyea(jj)  = surf%nyea(ji)
590         oldsurf%nmon(jj)  = surf%nmon(ji)
591         oldsurf%nday(jj)  = surf%nday(ji)
592         oldsurf%nhou(jj)  = surf%nhou(ji)
593         oldsurf%nmin(jj)  = surf%nmin(ji)
594         oldsurf%mstp(jj)  = surf%mstp(ji)
595         oldsurf%nqc(jj)   = surf%nqc(ji)
596         oldsurf%ntyp(jj)  = surf%ntyp(ji)
597         oldsurf%cwmo(jj)  = surf%cwmo(ji)
598         oldsurf%rlam(jj)  = surf%rlam(ji)
599         oldsurf%rphi(jj)  = surf%rphi(ji)
600
601      END DO
602
603      DO jk = 1, surf%nvar
604
605         DO ji = 1, surf%nsurf
606           
607            jj = surf%nsind(ji)
608
609            oldsurf%robs(jj,jk)  = surf%robs(ji,jk)
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
615
616         END DO
617
618      END DO
619
620      DO jk = 1, surf%nextra
621
622         DO ji = 1, surf%nsurf
623           
624            jj = surf%nsind(ji)
625
626            oldsurf%rext(jj,jk)  = surf%rext(ji,jk)
627
628         END DO
629
630      END DO
631
632      ! Optionally deallocate the updated surface data
633
634      IF ( ldeallocate ) CALL obs_surf_dealloc( surf )
635     
636   END SUBROUTINE obs_surf_decompress
637   
638END MODULE obs_surf_def
639
Note: See TracBrowser for help on using the repository browser.