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 branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS – NEMO

source: branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90 @ 11449

Last change on this file since 11449 was 11449, checked in by mattmartin, 4 years ago

Committed first version of changes to output climatology values at obs locations in the fdbk files.
File size: 17.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
26   IMPLICIT NONE
27
28   !! * Routine/type accessibility
29   PRIVATE
30
31   PUBLIC &
32      & obs_surf,           &
33      & obs_surf_alloc,     &
34      & obs_surf_dealloc,   &
35      & obs_surf_compress,  &
36      & obs_surf_decompress
37
38   !! * Type definition for surface observation type
39
40   TYPE obs_surf
41
42      ! Bookkeeping
43
44      INTEGER :: nsurf      !: Local number of surface data within window
45      INTEGER :: nsurfmpp   !: Global number of surface data within window
46      INTEGER :: nvar       !: Number of variables at observation points
47      INTEGER :: nextra     !: Number of extra fields at observation points
48      INTEGER :: nstp       !: Number of time steps
49      INTEGER :: npi        !: Number of 3D grid points
50      INTEGER :: npj
51      INTEGER :: nsurfup    !: Observation counter used in obs_oper
52      INTEGER :: nrec       !: Number of surface observation records in window
53
54      ! Arrays with size equal to the number of surface observations
55
56      INTEGER, POINTER, DIMENSION(:) :: &
57         & mi,   &        !: i-th grid coord. for interpolating to surface observation
58         & mj,   &        !: j-th grid coord. for interpolating to surface observation
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      CHARACTER(len=8), POINTER, DIMENSION(:) :: &
72         & cvars          !: Variable names
73
74      CHARACTER(len=8), POINTER, DIMENSION(:) :: &
75         & cext           !: Extra field names
76
77      CHARACTER(LEN=8), POINTER, DIMENSION(:) :: &
78         & cwmo           !: WMO indentifier
79         
80      REAL(KIND=wp), POINTER, DIMENSION(:) :: &
81         & rlam, &        !: Longitude coordinate of surface observation
82         & rphi           !: Latitude coordinate of surface observation
83
84      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
85         & robs, &        !: Surface observation
86         & rmod, &        !: Model counterpart of the surface observation vector
87         & rclm           !: Climatological counterpart of the surface observation vector
88         
89      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
90         & rext           !: Extra fields interpolated to observation points
91
92      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
93         & vdmean         !: Time averaged of model field
94
95      ! Arrays with size equal to the number of time steps in the window
96
97      INTEGER, POINTER, DIMENSION(:) :: &
98         & nsstp,     &   !: Local number of surface observations per time step
99         & nsstpmpp       !: Global number of surface observations per time step
100
101      ! Arrays with size equal to the number of observation records in the window
102      INTEGER, POINTER, DIMENSION(:) :: &
103         & mrecstp   ! Time step of the records
104
105      ! Arrays used to store source indices when
106      ! compressing obs_surf derived types
107     
108      ! Array with size nsurf
109
110      INTEGER, POINTER, DIMENSION(:) :: &
111         & nsind          !: Source indices of surface data in compressed data
112
113      ! Is this a gridded product?
114     
115      LOGICAL :: lgrid
116
117   END TYPE obs_surf
118
119   !!----------------------------------------------------------------------
120   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
121   !! $Id$
122   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
123   !!----------------------------------------------------------------------
124
125CONTAINS
126   
127   SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kextra, kstp, kpi, kpj )
128      !!----------------------------------------------------------------------
129      !!                     ***  ROUTINE obs_surf_alloc  ***
130      !!                     
131      !! ** Purpose : - Allocate data for surface data arrays
132      !!
133      !! ** Method  : - Fortran-90 dynamic arrays
134      !!
135      !! History :
136      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
137      !!----------------------------------------------------------------------
138      !! * Arguments
139      TYPE(obs_surf), INTENT(INOUT) ::  surf      ! Surface data to be allocated
140      INTEGER, INTENT(IN) :: ksurf   ! Number of surface observations
141      INTEGER, INTENT(IN) :: kvar    ! Number of surface variables
142      INTEGER, INTENT(IN) :: kextra  ! Number of extra fields at observation points
143      INTEGER, INTENT(IN) :: kstp    ! Number of time steps
144      INTEGER, INTENT(IN) :: kpi     ! Number of 3D grid points
145      INTEGER, INTENT(IN) :: kpj
146
147      !!* Local variables
148      INTEGER :: ji
149      INTEGER :: jvar
150
151      ! Set bookkeeping variables
152
153      surf%nsurf    = ksurf
154      surf%nsurfmpp = 0
155      surf%nextra   = kextra
156      surf%nvar     = kvar
157      surf%nstp     = kstp
158      surf%npi      = kpi
159      surf%npj      = kpj
160
161      ! Allocate arrays of size number of variables
162
163      ALLOCATE( &
164         & surf%cvars(kvar)    &
165         & )
166
167      DO jvar = 1, kvar
168         surf%cvars(jvar) = "NotSet"
169      END DO
170     
171      ! Allocate arrays of number of surface data size
172
173      ALLOCATE( &
174         & surf%mi(ksurf),      &
175         & surf%mj(ksurf),      &
176         & surf%mt(ksurf),      &
177         & surf%nsidx(ksurf),   &
178         & surf%nsfil(ksurf),   &
179         & surf%nyea(ksurf),    &
180         & surf%nmon(ksurf),    &
181         & surf%nday(ksurf),    &
182         & surf%nhou(ksurf),    &
183         & surf%nmin(ksurf),    &
184         & surf%mstp(ksurf),    &
185         & surf%nqc(ksurf),     &
186         & surf%ntyp(ksurf),    &
187         & surf%cwmo(ksurf),    &
188         & surf%rlam(ksurf),    &
189         & surf%rphi(ksurf),    &
190         & surf%nsind(ksurf)    &
191         & )
192
193      surf%mt(:) = -1
194
195
196      ! Allocate arrays of number of surface data size * number of variables
197
198      ALLOCATE( & 
199         & surf%robs(ksurf,kvar), &
200         & surf%rmod(ksurf,kvar), &
201         & surf%rclm(ksurf,kvar)  &         
202         & )   
203
204      ! Allocate arrays of number of extra fields at observation points
205
206      ALLOCATE( & 
207         & surf%rext(ksurf,kextra), &
208         & surf%cext(kextra)        &
209         & )
210
211      surf%rext(:,:) = 0.0_wp 
212
213      DO ji = 1, kextra
214         surf%cext(ji) = "NotSet"
215      END DO
216
217      ! Allocate arrays of number of time step size
218
219      ALLOCATE( &
220         & surf%nsstp(kstp),     &
221         & surf%nsstpmpp(kstp)   &
222         & )
223
224      ! Allocate arrays of size number of grid points
225
226      ALLOCATE( &
227         & surf%vdmean(kpi,kpj) &
228         & )
229
230      ! Set defaults for compression indices
231     
232      DO ji = 1, ksurf
233         surf%nsind(ji) = ji
234      END DO
235     
236      ! Set defaults for number of observations per time step
237
238      surf%nsstp(:)     = 0
239      surf%nsstpmpp(:)  = 0
240
241      ! Set the observation counter used in obs_oper
242
243      surf%nsurfup     = 0
244     
245      ! Not gridded by default
246         
247      surf%lgrid       = .FALSE.
248             
249   END SUBROUTINE obs_surf_alloc
250
251   SUBROUTINE obs_surf_dealloc( surf )
252      !!----------------------------------------------------------------------
253      !!                     ***  ROUTINE obs_surf_dealloc  ***
254      !!                     
255      !! ** Purpose : - Deallocate data for surface data arrays
256      !!
257      !! ** Method  : - Fortran-90 dynamic arrays
258      !!
259      !! History :
260      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
261      !!----------------------------------------------------------------------
262      !! * Arguments
263      TYPE(obs_surf), INTENT(INOUT) :: &
264         & surf      ! Surface data to be allocated
265
266      !!* Local variables
267
268      ! Deallocate arrays of number of surface data size
269
270      DEALLOCATE( &
271         & surf%mi,      &
272         & surf%mj,      &
273         & surf%mt,      &
274         & surf%nsidx,   &
275         & surf%nsfil,   &
276         & surf%nyea,    &
277         & surf%nmon,    &
278         & surf%nday,    &
279         & surf%nhou,    &
280         & surf%nmin,    &
281         & surf%mstp,    &
282         & surf%nqc,     &
283         & surf%ntyp,    &
284         & surf%cwmo,    &
285         & surf%rlam,    &
286         & surf%rphi,    &
287         & surf%nsind    &
288         & )
289
290      ! Allocate arrays of number of surface data size * number of variables
291
292      DEALLOCATE( & 
293         & surf%robs,    &
294         & surf%rmod,    &
295         & surf%rclm     &         
296         & )
297
298      ! Deallocate arrays of number of extra fields at observation points
299
300      DEALLOCATE( & 
301         & surf%rext, &
302         & surf%cext &
303         & )
304
305      ! Deallocate arrays of size number of grid points size times
306      ! number of variables
307
308      DEALLOCATE( &
309         & surf%vdmean &
310         & )
311
312      ! Deallocate arrays of number of time step size
313
314      DEALLOCATE( &
315         & surf%nsstp,     &
316         & surf%nsstpmpp   &
317         & )
318
319      ! Dellocate arrays of size number of variables
320
321      DEALLOCATE( &
322         & surf%cvars     &
323         & )
324
325   END SUBROUTINE obs_surf_dealloc
326
327   SUBROUTINE obs_surf_compress( surf, newsurf, lallocate, kumout, lvalid )
328      !!----------------------------------------------------------------------
329      !!                     ***  ROUTINE obs_surf_compress  ***
330      !!                     
331      !! ** Purpose : - Extract sub-information from a obs_surf type
332      !!                into a new obs_surf type
333      !!
334      !! ** Method  : - The data is copied from surf to new surf.
335      !!                In the case of lvalid being present only the
336      !!                selected data will be copied.
337      !!                If lallocate is true the data in the newsurf is
338      !!                allocated either with the same number of elements
339      !!                as surf or with only the subset of elements defined
340      !!                by the optional selection.
341      !!
342      !! History :
343      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
344      !!----------------------------------------------------------------------
345      !! * Arguments
346      TYPE(obs_surf), INTENT(IN)    :: surf      ! Original surface data
347      TYPE(obs_surf), INTENT(INOUT) :: newsurf   ! New surface data with a subset of the original data
348      LOGICAL :: lallocate     ! Allocate newsurf data
349      INTEGER,INTENT(IN) :: kumout        ! Fortran unit for messages
350      LOGICAL, OPTIONAL, INTENT(in), DIMENSION(:) :: &
351         & lvalid         ! Valid of surface observations
352     
353      !!* Local variables
354      INTEGER :: insurf
355      INTEGER :: ji
356      INTEGER :: jk
357      LOGICAL, DIMENSION(:), ALLOCATABLE :: llvalid
358
359      ! Count how many elements there should be in the new data structure
360
361      IF ( PRESENT(lvalid) ) THEN
362         insurf = 0
363         DO ji = 1, surf%nsurf
364            IF ( lvalid(ji) ) THEN
365               insurf = insurf + 1
366            ENDIF
367         END DO
368      ELSE
369         insurf = surf%nsurf
370      ENDIF
371
372      ! Optionally allocate data in the new data structure
373
374      IF ( lallocate ) THEN
375         CALL obs_surf_alloc( newsurf,  insurf, surf%nvar, &
376            & surf%nextra, surf%nstp, surf%npi, surf%npj )
377      ENDIF
378
379      ! Allocate temporary valid array to unify the code for both cases
380
381      ALLOCATE( llvalid(surf%nsurf) )
382      IF ( PRESENT(lvalid) ) THEN
383         llvalid(:)  = lvalid(:)
384      ELSE
385         llvalid(:)  = .TRUE.
386      ENDIF
387
388      ! Setup bookkeeping variables
389
390      insurf = 0
391
392      ! Loop over source surface data
393
394      DO ji = 1, surf%nsurf
395
396         IF ( llvalid(ji) ) THEN
397
398            ! Copy the header information
399
400            insurf = insurf + 1
401
402            newsurf%mi(insurf)    = surf%mi(ji)
403            newsurf%mj(insurf)    = surf%mj(ji)
404            newsurf%mt(insurf)    = surf%mt(ji)
405            newsurf%nsidx(insurf) = surf%nsidx(ji)
406            newsurf%nsfil(insurf) = surf%nsfil(ji)
407            newsurf%nyea(insurf)  = surf%nyea(ji)
408            newsurf%nmon(insurf)  = surf%nmon(ji)
409            newsurf%nday(insurf)  = surf%nday(ji)
410            newsurf%nhou(insurf)  = surf%nhou(ji)
411            newsurf%nmin(insurf)  = surf%nmin(ji)
412            newsurf%mstp(insurf)  = surf%mstp(ji)
413            newsurf%nqc(insurf)   = surf%nqc(ji)
414            newsurf%ntyp(insurf)  = surf%ntyp(ji)
415            newsurf%cwmo(insurf)  = surf%cwmo(ji)
416            newsurf%rlam(insurf)  = surf%rlam(ji)
417            newsurf%rphi(insurf)  = surf%rphi(ji)
418
419            DO jk = 1, surf%nvar
420
421               newsurf%robs(insurf,jk)  = surf%robs(ji,jk)
422               newsurf%rmod(insurf,jk)  = surf%rmod(ji,jk)
423               newsurf%rclm(insurf,jk)  = surf%rclm(ji,jk)               
424               
425            END DO
426
427            DO jk = 1, surf%nextra
428
429               newsurf%rext(insurf,jk) = surf%rext(ji,jk)
430
431            END DO
432           
433            ! nsind is the index of the original surface data
434           
435            newsurf%nsind(insurf) = ji
436
437         ENDIF
438
439      END DO
440
441      ! Update MPP counters
442
443      newsurf%nsurf = insurf
444      CALL obs_mpp_sum_integer ( newsurf%nsurf, newsurf%nsurfmpp )
445
446      ! Set book keeping variables which do not depend on number of obs.
447
448      newsurf%nstp     = surf%nstp
449      newsurf%cvars(:) = surf%cvars(:)
450      newsurf%cext(:)  = surf%cext(:)
451     
452      ! Set gridded stuff
453     
454      newsurf%mt(insurf)    = surf%mt(ji)
455 
456      ! Deallocate temporary data
457
458      DEALLOCATE( llvalid )
459     
460   END SUBROUTINE obs_surf_compress
461
462   SUBROUTINE obs_surf_decompress( surf, oldsurf, ldeallocate, kumout )
463      !!----------------------------------------------------------------------
464      !!                     ***  ROUTINE obs_surf_decompress  ***
465      !!                     
466      !! ** Purpose : - Copy back information to original surface data type
467      !!
468      !! ** Method  : - Reinsert updated information from a previous
469      !!                copied/compressed surface data type into the original
470      !!                surface data and optionally deallocate the surface
471      !!                data input
472      !!
473      !! History :
474      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
475      !!----------------------------------------------------------------------
476      !! * Arguments
477      TYPE(obs_surf),INTENT(INOUT) :: surf       ! Updated surface data
478      TYPE(obs_surf),INTENT(INOUT) :: oldsurf    ! Original surface data
479      LOGICAL :: ldeallocate ! Deallocate the updated data of insertion
480      INTEGER,INTENT(in) :: kumout      ! Output unit
481     
482      !!* Local variables
483      INTEGER :: ji
484      INTEGER :: jj
485      INTEGER :: jk
486
487      ! Copy data from surf to old surf
488
489      DO ji = 1, surf%nsurf
490
491         jj=surf%nsind(ji)
492
493         oldsurf%mi(jj)    = surf%mi(ji)
494         oldsurf%mj(jj)    = surf%mj(ji)
495         oldsurf%mt(jj)    = surf%mt(ji)
496         oldsurf%nsidx(jj) = surf%nsidx(ji)
497         oldsurf%nsfil(jj) = surf%nsfil(ji)
498         oldsurf%nyea(jj)  = surf%nyea(ji)
499         oldsurf%nmon(jj)  = surf%nmon(ji)
500         oldsurf%nday(jj)  = surf%nday(ji)
501         oldsurf%nhou(jj)  = surf%nhou(ji)
502         oldsurf%nmin(jj)  = surf%nmin(ji)
503         oldsurf%mstp(jj)  = surf%mstp(ji)
504         oldsurf%nqc(jj)   = surf%nqc(ji)
505         oldsurf%ntyp(jj)  = surf%ntyp(ji)
506         oldsurf%cwmo(jj)  = surf%cwmo(ji)
507         oldsurf%rlam(jj)  = surf%rlam(ji)
508         oldsurf%rphi(jj)  = surf%rphi(ji)
509
510      END DO
511
512      DO jk = 1, surf%nvar
513
514         DO ji = 1, surf%nsurf
515           
516            jj=surf%nsind(ji)
517
518            oldsurf%robs(jj,jk)  = surf%robs(ji,jk)
519            oldsurf%rmod(jj,jk)  = surf%rmod(ji,jk)
520            oldsurf%rclm(jj,jk)  = surf%rclm(ji,jk)           
521
522         END DO
523
524      END DO
525
526      DO jk = 1, surf%nextra
527
528         DO ji = 1, surf%nsurf
529           
530            jj=surf%nsind(ji)
531
532            oldsurf%rext(jj,jk)  = surf%rext(ji,jk)
533
534         END DO
535
536      END DO
537
538      ! Optionally deallocate the updated surface data
539
540      IF ( ldeallocate ) CALL obs_surf_dealloc( surf )
541     
542   END SUBROUTINE obs_surf_decompress
543   
544END MODULE obs_surf_def
545
Note: See TracBrowser for help on using the repository browser.