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/r6232_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS – NEMO

source: branches/UKMO/r6232_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90 @ 11203

Last change on this file since 11203 was 11203, checked in by jcastill, 5 years ago

Remove the svn keywords that were introduced in the last modification

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