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

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90 @ 2281

Last change on this file since 2281 was 2281, checked in by smasson, 14 years ago

set proper svn properties to all files...
  • Property svn:keywords set to Id
File size: 14.8 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 :: nsurfup    !: Observation counter used in obs_oper
50
51      ! Arrays with size equal to the number of surface observations
52
53      INTEGER, POINTER, DIMENSION(:) :: &
54         & mi,   &        !: i-th grid coord. for interpolating to surface observation
55         & mj,   &        !: j-th grid coord. for interpolating to surface observation
56         & nsidx,&        !: Surface observation number
57         & nsfil,&        !: Surface observation number in file
58         & nyea, &        !: Year of surface observation
59         & nmon, &        !: Month of surface observation
60         & nday, &        !: Day of surface observation
61         & nhou, &        !: Hour of surface observation
62         & nmin, &        !: Minute of surface observation
63         & mstp, &        !: Time step nearest to surface observation
64         & nqc,  &        !: Surface observation qc flag
65         & ntyp           !: Type of surface observation product
66
67      CHARACTER(LEN=8), POINTER, DIMENSION(:) :: &
68         & cwmo           !: WMO indentifier
69         
70      REAL(KIND=wp), POINTER, DIMENSION(:) :: &
71         & rlam, &        !: Longitude coordinate of surface observation
72         & rphi           !: Latitude coordinate of surface observation
73
74      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
75         & robs, &        !: Surface observation
76         & rmod           !: Model counterpart of the surface observation vector
77
78      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
79         & rext           !: Extra fields interpolated to observation points
80
81      ! Arrays with size equal to the number of time steps in the window
82
83      INTEGER, POINTER, DIMENSION(:) :: &
84         & nsstp,     &   !: Local number of surface observations per time step
85         & nsstpmpp       !: Global number of surface observations per time step
86
87      ! Arrays used to store source indices when
88      ! compressing obs_surf derived types
89     
90      ! Array with size nsurf
91
92      INTEGER, POINTER, DIMENSION(:) :: &
93         & nsind          !: Source indices of surface data in compressed data
94
95   END TYPE obs_surf
96
97CONTAINS
98   
99   SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kextra, kstp )
100      !!----------------------------------------------------------------------
101      !!                     ***  ROUTINE obs_surf_alloc  ***
102      !!                     
103      !! ** Purpose : - Allocate data for surface data arrays
104      !!
105      !! ** Method  : - Fortran-90 dynamic arrays
106      !!
107      !! History :
108      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
109      !!----------------------------------------------------------------------
110      !! * Arguments
111      TYPE(obs_surf), INTENT(INOUT) ::  surf      ! Surface data to be allocated
112      INTEGER, INTENT(IN) :: ksurf   ! Number of surface observations
113      INTEGER, INTENT(IN) :: kvar    ! Number of surface variables
114      INTEGER, INTENT(IN) :: kextra  ! Number of extra fields at observation points
115      INTEGER, INTENT(IN) :: kstp    ! Number of time steps
116
117      !!* Local variables
118      INTEGER :: ji
119
120      ! Set bookkeeping variables
121
122      surf%nsurf    = ksurf
123      surf%nsurfmpp = 0
124      surf%nextra   = kextra
125      surf%nvar     = kvar
126      surf%nstp     = kstp
127     
128      ! Allocate arrays of number of surface data size
129
130      ALLOCATE( &
131         & surf%mi(ksurf),      &
132         & surf%mj(ksurf),      &
133         & surf%nsidx(ksurf),   &
134         & surf%nsfil(ksurf),   &
135         & surf%nyea(ksurf),    &
136         & surf%nmon(ksurf),    &
137         & surf%nday(ksurf),    &
138         & surf%nhou(ksurf),    &
139         & surf%nmin(ksurf),    &
140         & surf%mstp(ksurf),    &
141         & surf%nqc(ksurf),     &
142         & surf%ntyp(ksurf),    &
143         & surf%cwmo(ksurf),    &
144         & surf%rlam(ksurf),    &
145         & surf%rphi(ksurf),    &
146         & surf%nsind(ksurf)    &
147         & )
148
149
150      ! Allocate arrays of number of surface data size * number of variables
151
152      ALLOCATE( & 
153         & surf%robs(ksurf,kvar), &
154         & surf%rmod(ksurf,kvar)  &
155         & )   
156
157      ! Allocate arrays of number of extra fields at observation points
158
159      ALLOCATE( & 
160         & surf%rext(ksurf,kextra) &
161         & )
162
163      ! Allocate arrays of number of time step size
164
165      ALLOCATE( &
166         & surf%nsstp(kstp),     &
167         & surf%nsstpmpp(kstp)   &
168         & )
169
170      ! Set defaults for compression indices
171     
172      DO ji = 1, ksurf
173         surf%nsind(ji) = ji
174      END DO
175     
176      ! Set defaults for number of observations per time step
177
178      surf%nsstp(:)     = 0
179      surf%nsstpmpp(:)  = 0
180
181      ! Set the observation counter used in obs_oper
182
183      surf%nsurfup     = 0
184             
185   END SUBROUTINE obs_surf_alloc
186
187   SUBROUTINE obs_surf_dealloc( surf )
188      !!----------------------------------------------------------------------
189      !!                     ***  ROUTINE obs_surf_dealloc  ***
190      !!                     
191      !! ** Purpose : - Deallocate data for surface data arrays
192      !!
193      !! ** Method  : - Fortran-90 dynamic arrays
194      !!
195      !! History :
196      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
197      !!----------------------------------------------------------------------
198      !! * Arguments
199      TYPE(obs_surf), INTENT(INOUT) :: &
200         & surf      ! Surface data to be allocated
201
202      !!* Local variables
203
204      ! Deallocate arrays of number of surface data size
205
206      DEALLOCATE( &
207         & surf%mi,      &
208         & surf%mj,      &
209         & surf%nsidx,   &
210         & surf%nsfil,   &
211         & surf%nyea,    &
212         & surf%nmon,    &
213         & surf%nday,    &
214         & surf%nhou,    &
215         & surf%nmin,    &
216         & surf%mstp,    &
217         & surf%nqc,     &
218         & surf%ntyp,    &
219         & surf%cwmo,    &
220         & surf%rlam,    &
221         & surf%rphi,    &
222         & surf%nsind    &
223         & )
224
225      ! Allocate arrays of number of surface data size * number of variables
226
227      DEALLOCATE( & 
228         & surf%robs,    &
229         & surf%rmod     &
230         & )
231
232      ! Deallocate arrays of number of extra fields at observation points
233
234      DEALLOCATE( & 
235         & surf%rext &
236         & )
237
238      ! Deallocate arrays of number of time step size
239
240      DEALLOCATE( &
241         & surf%nsstp,     &
242         & surf%nsstpmpp   &
243         & )
244
245   END SUBROUTINE obs_surf_dealloc
246
247   SUBROUTINE obs_surf_compress( surf, newsurf, lallocate, kumout, lvalid )
248      !!----------------------------------------------------------------------
249      !!                     ***  ROUTINE obs_surf_compress  ***
250      !!                     
251      !! ** Purpose : - Extract sub-information from a obs_surf type
252      !!                into a new obs_surf type
253      !!
254      !! ** Method  : - The data is copied from surf to new surf.
255      !!                In the case of lvalid being present only the
256      !!                selected data will be copied.
257      !!                If lallocate is true the data in the newsurf is
258      !!                allocated either with the same number of elements
259      !!                as surf or with only the subset of elements defined
260      !!                by the optional selection.
261      !!
262      !! History :
263      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
264      !!----------------------------------------------------------------------
265      !! * Arguments
266      TYPE(obs_surf), INTENT(IN)    :: surf      ! Original surface data
267      TYPE(obs_surf), INTENT(INOUT) :: newsurf   ! New surface data with a subset of the original data
268      LOGICAL :: lallocate     ! Allocate newsurf data
269      INTEGER,INTENT(IN) :: kumout        ! Fortran unit for messages
270      LOGICAL, OPTIONAL, INTENT(in), DIMENSION(:) :: &
271         & lvalid         ! Valid of surface observations
272     
273      !!* Local variables
274      INTEGER :: insurf
275      INTEGER :: ji
276      INTEGER :: jk
277      LOGICAL, DIMENSION(:), ALLOCATABLE :: llvalid
278
279      ! Count how many elements there should be in the new data structure
280
281      IF ( PRESENT(lvalid) ) THEN
282         insurf = 0
283         DO ji = 1, surf%nsurf
284            IF ( lvalid(ji) ) THEN
285               insurf = insurf + 1
286            ENDIF
287         END DO
288      ELSE
289         insurf = surf%nsurf
290      ENDIF
291
292      ! Optionally allocate data in the new data structure
293
294      IF ( lallocate ) THEN
295         CALL obs_surf_alloc( newsurf,  insurf, surf%nvar, &
296            & surf%nextra, surf%nstp )
297      ENDIF
298
299      ! Allocate temporary valid array to unify the code for both cases
300
301      ALLOCATE( llvalid(surf%nsurf) )
302      IF ( PRESENT(lvalid) ) THEN
303         llvalid(:)  = lvalid(:)
304      ELSE
305         llvalid(:)  = .TRUE.
306      ENDIF
307
308      ! Setup bookkeeping variables
309
310      insurf = 0
311
312      ! Loop over source surface data
313
314      DO ji = 1, surf%nsurf
315
316         IF ( llvalid(ji) ) THEN
317
318            ! Copy the header information
319
320            insurf = insurf + 1
321
322            newsurf%mi(insurf)    = surf%mi(ji)
323            newsurf%mj(insurf)    = surf%mj(ji)
324            newsurf%nsidx(insurf) = surf%nsidx(ji)
325            newsurf%nsfil(insurf) = surf%nsfil(ji)
326            newsurf%nyea(insurf)  = surf%nyea(ji)
327            newsurf%nmon(insurf)  = surf%nmon(ji)
328            newsurf%nday(insurf)  = surf%nday(ji)
329            newsurf%nhou(insurf)  = surf%nhou(ji)
330            newsurf%nmin(insurf)  = surf%nmin(ji)
331            newsurf%mstp(insurf)  = surf%mstp(ji)
332            newsurf%nqc(insurf)   = surf%nqc(ji)
333            newsurf%ntyp(insurf)  = surf%ntyp(ji)
334            newsurf%cwmo(insurf)  = surf%cwmo(ji)
335            newsurf%rlam(insurf)  = surf%rlam(ji)
336            newsurf%rphi(insurf)  = surf%rphi(ji)
337
338            DO jk = 1, surf%nvar
339
340               newsurf%robs(insurf,jk)  = surf%robs(ji,jk)
341               newsurf%rmod(insurf,jk)  = surf%rmod(ji,jk)
342               
343            END DO
344
345            DO jk = 1, surf%nextra
346
347               newsurf%rext(insurf,jk) = surf%rext(ji,jk)
348
349            END DO
350           
351            ! nsind is the index of the original surface data
352           
353            newsurf%nsind(insurf) = ji
354
355         ENDIF
356
357      END DO
358
359      ! Update MPP counters
360
361      newsurf%nsurf = insurf
362      CALL obs_mpp_sum_integer ( newsurf%nsurf, newsurf%nsurfmpp )
363
364      ! Set book keeping variables which do not depend on number of obs.
365
366      newsurf%nstp  = surf%nstp
367 
368      ! Deallocate temporary data
369
370      DEALLOCATE( llvalid )
371     
372   END SUBROUTINE obs_surf_compress
373
374   SUBROUTINE obs_surf_decompress( surf, oldsurf, ldeallocate, kumout )
375      !!----------------------------------------------------------------------
376      !!                     ***  ROUTINE obs_surf_decompress  ***
377      !!                     
378      !! ** Purpose : - Copy back information to original surface data type
379      !!
380      !! ** Method  : - Reinsert updated information from a previous
381      !!                copied/compressed surface data type into the original
382      !!                surface data and optionally deallocate the surface
383      !!                data input
384      !!
385      !! History :
386      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
387      !!----------------------------------------------------------------------
388      !! * Arguments
389      TYPE(obs_surf),INTENT(INOUT) :: surf       ! Updated surface data
390      TYPE(obs_surf),INTENT(INOUT) :: oldsurf    ! Original surface data
391      LOGICAL :: ldeallocate ! Deallocate the updated data of insertion
392      INTEGER,INTENT(in) :: kumout      ! Output unit
393     
394      !!* Local variables
395      INTEGER :: ji
396      INTEGER :: jj
397      INTEGER :: jk
398
399      ! Copy data from surf to old surf
400
401      DO ji = 1, surf%nsurf
402
403         jj=surf%nsind(ji)
404
405         oldsurf%mi(jj)    = surf%mi(ji)
406         oldsurf%mj(jj)    = surf%mj(ji)
407         oldsurf%nsidx(jj) = surf%nsidx(ji)
408         oldsurf%nsfil(jj) = surf%nsfil(ji)
409         oldsurf%nyea(jj)  = surf%nyea(ji)
410         oldsurf%nmon(jj)  = surf%nmon(ji)
411         oldsurf%nday(jj)  = surf%nday(ji)
412         oldsurf%nhou(jj)  = surf%nhou(ji)
413         oldsurf%nmin(jj)  = surf%nmin(ji)
414         oldsurf%mstp(jj)  = surf%mstp(ji)
415         oldsurf%nqc(jj)   = surf%nqc(ji)
416         oldsurf%ntyp(jj)  = surf%ntyp(ji)
417         oldsurf%cwmo(jj)  = surf%cwmo(ji)
418         oldsurf%rlam(jj)  = surf%rlam(ji)
419         oldsurf%rphi(jj)  = surf%rphi(ji)
420
421      END DO
422
423      DO jk = 1, surf%nvar
424
425         DO ji = 1, surf%nsurf
426           
427            jj=surf%nsind(ji)
428
429            oldsurf%robs(jj,jk)  = surf%robs(ji,jk)
430            oldsurf%rmod(jj,jk)  = surf%rmod(ji,jk)
431
432         END DO
433
434      END DO
435
436      DO jk = 1, surf%nextra
437
438         DO ji = 1, surf%nsurf
439           
440            jj=surf%nsind(ji)
441
442            oldsurf%rext(jj,jk)  = surf%rext(ji,jk)
443
444         END DO
445
446      END DO
447
448      ! Optionally deallocate the updated surface data
449
450      IF ( ldeallocate ) CALL obs_surf_dealloc( surf )
451     
452   END SUBROUTINE obs_surf_decompress
453   
454END MODULE obs_surf_def
455
Note: See TracBrowser for help on using the repository browser.