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

source: branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_surf_def.F90 @ 2001

Last change on this file since 2001 was 2001, checked in by djlea, 14 years ago

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