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

source: branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90 @ 11468

Last change on this file since 11468 was 11468, checked in by mattmartin, 5 years ago

Merged changes to allow writing of climatological information to feedback files.

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