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 @ 2287

Last change on this file since 2287 was 2287, checked in by smasson, 13 years ago

update licence of all NEMO files...

  • Property svn:keywords set to Id
File size: 15.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 :: 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
97   !!----------------------------------------------------------------------
98   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
99   !! $Id$
100   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
101   !!----------------------------------------------------------------------
102
103CONTAINS
104   
105   SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kextra, kstp )
106      !!----------------------------------------------------------------------
107      !!                     ***  ROUTINE obs_surf_alloc  ***
108      !!                     
109      !! ** Purpose : - Allocate data for surface data arrays
110      !!
111      !! ** Method  : - Fortran-90 dynamic arrays
112      !!
113      !! History :
114      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
115      !!----------------------------------------------------------------------
116      !! * Arguments
117      TYPE(obs_surf), INTENT(INOUT) ::  surf      ! Surface data to be allocated
118      INTEGER, INTENT(IN) :: ksurf   ! Number of surface observations
119      INTEGER, INTENT(IN) :: kvar    ! Number of surface variables
120      INTEGER, INTENT(IN) :: kextra  ! Number of extra fields at observation points
121      INTEGER, INTENT(IN) :: kstp    ! Number of time steps
122
123      !!* Local variables
124      INTEGER :: ji
125
126      ! Set bookkeeping variables
127
128      surf%nsurf    = ksurf
129      surf%nsurfmpp = 0
130      surf%nextra   = kextra
131      surf%nvar     = kvar
132      surf%nstp     = kstp
133     
134      ! Allocate arrays of number of surface data size
135
136      ALLOCATE( &
137         & surf%mi(ksurf),      &
138         & surf%mj(ksurf),      &
139         & surf%nsidx(ksurf),   &
140         & surf%nsfil(ksurf),   &
141         & surf%nyea(ksurf),    &
142         & surf%nmon(ksurf),    &
143         & surf%nday(ksurf),    &
144         & surf%nhou(ksurf),    &
145         & surf%nmin(ksurf),    &
146         & surf%mstp(ksurf),    &
147         & surf%nqc(ksurf),     &
148         & surf%ntyp(ksurf),    &
149         & surf%cwmo(ksurf),    &
150         & surf%rlam(ksurf),    &
151         & surf%rphi(ksurf),    &
152         & surf%nsind(ksurf)    &
153         & )
154
155
156      ! Allocate arrays of number of surface data size * number of variables
157
158      ALLOCATE( & 
159         & surf%robs(ksurf,kvar), &
160         & surf%rmod(ksurf,kvar)  &
161         & )   
162
163      ! Allocate arrays of number of extra fields at observation points
164
165      ALLOCATE( & 
166         & surf%rext(ksurf,kextra) &
167         & )
168
169      ! Allocate arrays of number of time step size
170
171      ALLOCATE( &
172         & surf%nsstp(kstp),     &
173         & surf%nsstpmpp(kstp)   &
174         & )
175
176      ! Set defaults for compression indices
177     
178      DO ji = 1, ksurf
179         surf%nsind(ji) = ji
180      END DO
181     
182      ! Set defaults for number of observations per time step
183
184      surf%nsstp(:)     = 0
185      surf%nsstpmpp(:)  = 0
186
187      ! Set the observation counter used in obs_oper
188
189      surf%nsurfup     = 0
190             
191   END SUBROUTINE obs_surf_alloc
192
193   SUBROUTINE obs_surf_dealloc( surf )
194      !!----------------------------------------------------------------------
195      !!                     ***  ROUTINE obs_surf_dealloc  ***
196      !!                     
197      !! ** Purpose : - Deallocate data for surface data arrays
198      !!
199      !! ** Method  : - Fortran-90 dynamic arrays
200      !!
201      !! History :
202      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
203      !!----------------------------------------------------------------------
204      !! * Arguments
205      TYPE(obs_surf), INTENT(INOUT) :: &
206         & surf      ! Surface data to be allocated
207
208      !!* Local variables
209
210      ! Deallocate arrays of number of surface data size
211
212      DEALLOCATE( &
213         & surf%mi,      &
214         & surf%mj,      &
215         & surf%nsidx,   &
216         & surf%nsfil,   &
217         & surf%nyea,    &
218         & surf%nmon,    &
219         & surf%nday,    &
220         & surf%nhou,    &
221         & surf%nmin,    &
222         & surf%mstp,    &
223         & surf%nqc,     &
224         & surf%ntyp,    &
225         & surf%cwmo,    &
226         & surf%rlam,    &
227         & surf%rphi,    &
228         & surf%nsind    &
229         & )
230
231      ! Allocate arrays of number of surface data size * number of variables
232
233      DEALLOCATE( & 
234         & surf%robs,    &
235         & surf%rmod     &
236         & )
237
238      ! Deallocate arrays of number of extra fields at observation points
239
240      DEALLOCATE( & 
241         & surf%rext &
242         & )
243
244      ! Deallocate arrays of number of time step size
245
246      DEALLOCATE( &
247         & surf%nsstp,     &
248         & surf%nsstpmpp   &
249         & )
250
251   END SUBROUTINE obs_surf_dealloc
252
253   SUBROUTINE obs_surf_compress( surf, newsurf, lallocate, kumout, lvalid )
254      !!----------------------------------------------------------------------
255      !!                     ***  ROUTINE obs_surf_compress  ***
256      !!                     
257      !! ** Purpose : - Extract sub-information from a obs_surf type
258      !!                into a new obs_surf type
259      !!
260      !! ** Method  : - The data is copied from surf to new surf.
261      !!                In the case of lvalid being present only the
262      !!                selected data will be copied.
263      !!                If lallocate is true the data in the newsurf is
264      !!                allocated either with the same number of elements
265      !!                as surf or with only the subset of elements defined
266      !!                by the optional selection.
267      !!
268      !! History :
269      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
270      !!----------------------------------------------------------------------
271      !! * Arguments
272      TYPE(obs_surf), INTENT(IN)    :: surf      ! Original surface data
273      TYPE(obs_surf), INTENT(INOUT) :: newsurf   ! New surface data with a subset of the original data
274      LOGICAL :: lallocate     ! Allocate newsurf data
275      INTEGER,INTENT(IN) :: kumout        ! Fortran unit for messages
276      LOGICAL, OPTIONAL, INTENT(in), DIMENSION(:) :: &
277         & lvalid         ! Valid of surface observations
278     
279      !!* Local variables
280      INTEGER :: insurf
281      INTEGER :: ji
282      INTEGER :: jk
283      LOGICAL, DIMENSION(:), ALLOCATABLE :: 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%cwmo(insurf)  = surf%cwmo(ji)
341            newsurf%rlam(insurf)  = surf%rlam(ji)
342            newsurf%rphi(insurf)  = surf%rphi(ji)
343
344            DO jk = 1, surf%nvar
345
346               newsurf%robs(insurf,jk)  = surf%robs(ji,jk)
347               newsurf%rmod(insurf,jk)  = surf%rmod(ji,jk)
348               
349            END DO
350
351            DO jk = 1, surf%nextra
352
353               newsurf%rext(insurf,jk) = surf%rext(ji,jk)
354
355            END DO
356           
357            ! nsind is the index of the original surface data
358           
359            newsurf%nsind(insurf) = ji
360
361         ENDIF
362
363      END DO
364
365      ! Update MPP counters
366
367      newsurf%nsurf = insurf
368      CALL obs_mpp_sum_integer ( newsurf%nsurf, newsurf%nsurfmpp )
369
370      ! Set book keeping variables which do not depend on number of obs.
371
372      newsurf%nstp  = surf%nstp
373 
374      ! Deallocate temporary data
375
376      DEALLOCATE( llvalid )
377     
378   END SUBROUTINE obs_surf_compress
379
380   SUBROUTINE obs_surf_decompress( surf, oldsurf, ldeallocate, kumout )
381      !!----------------------------------------------------------------------
382      !!                     ***  ROUTINE obs_surf_decompress  ***
383      !!                     
384      !! ** Purpose : - Copy back information to original surface data type
385      !!
386      !! ** Method  : - Reinsert updated information from a previous
387      !!                copied/compressed surface data type into the original
388      !!                surface data and optionally deallocate the surface
389      !!                data input
390      !!
391      !! History :
392      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
393      !!----------------------------------------------------------------------
394      !! * Arguments
395      TYPE(obs_surf),INTENT(INOUT) :: surf       ! Updated surface data
396      TYPE(obs_surf),INTENT(INOUT) :: oldsurf    ! Original surface data
397      LOGICAL :: ldeallocate ! Deallocate the updated data of insertion
398      INTEGER,INTENT(in) :: kumout      ! Output unit
399     
400      !!* Local variables
401      INTEGER :: ji
402      INTEGER :: jj
403      INTEGER :: jk
404
405      ! Copy data from surf to old surf
406
407      DO ji = 1, surf%nsurf
408
409         jj=surf%nsind(ji)
410
411         oldsurf%mi(jj)    = surf%mi(ji)
412         oldsurf%mj(jj)    = surf%mj(ji)
413         oldsurf%nsidx(jj) = surf%nsidx(ji)
414         oldsurf%nsfil(jj) = surf%nsfil(ji)
415         oldsurf%nyea(jj)  = surf%nyea(ji)
416         oldsurf%nmon(jj)  = surf%nmon(ji)
417         oldsurf%nday(jj)  = surf%nday(ji)
418         oldsurf%nhou(jj)  = surf%nhou(ji)
419         oldsurf%nmin(jj)  = surf%nmin(ji)
420         oldsurf%mstp(jj)  = surf%mstp(ji)
421         oldsurf%nqc(jj)   = surf%nqc(ji)
422         oldsurf%ntyp(jj)  = surf%ntyp(ji)
423         oldsurf%cwmo(jj)  = surf%cwmo(ji)
424         oldsurf%rlam(jj)  = surf%rlam(ji)
425         oldsurf%rphi(jj)  = surf%rphi(ji)
426
427      END DO
428
429      DO jk = 1, surf%nvar
430
431         DO ji = 1, surf%nsurf
432           
433            jj=surf%nsind(ji)
434
435            oldsurf%robs(jj,jk)  = surf%robs(ji,jk)
436            oldsurf%rmod(jj,jk)  = surf%rmod(ji,jk)
437
438         END DO
439
440      END DO
441
442      DO jk = 1, surf%nextra
443
444         DO ji = 1, surf%nsurf
445           
446            jj=surf%nsind(ji)
447
448            oldsurf%rext(jj,jk)  = surf%rext(ji,jk)
449
450         END DO
451
452      END DO
453
454      ! Optionally deallocate the updated surface data
455
456      IF ( ldeallocate ) CALL obs_surf_dealloc( surf )
457     
458   END SUBROUTINE obs_surf_decompress
459   
460END MODULE obs_surf_def
461
Note: See TracBrowser for help on using the repository browser.