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/2019/dev_ASINTER-01-05_merged/src/OCE/OBS – NEMO

source: NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/OBS/obs_surf_def.F90 @ 12165

Last change on this file since 12165 was 10068, checked in by nicolasmartin, 6 years ago

First part of modifications to have a common default header : fix typos and SVN keywords properties

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