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

source: branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90 @ 6225

Last change on this file since 6225 was 6225, checked in by jamesharle, 8 years ago

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

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