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

source: branches/UKMO/r5936_hadgem3_cplseq/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90 @ 7131

Last change on this file since 7131 was 7131, checked in by jcastill, 7 years ago

Remove svn keywords

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