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.
fbprint.F90 in branches/UKMO/r6232_tracer_advection/NEMOGCM/TOOLS/OBSTOOLS/src – NEMO

source: branches/UKMO/r6232_tracer_advection/NEMOGCM/TOOLS/OBSTOOLS/src/fbprint.F90 @ 9295

Last change on this file since 9295 was 3002, checked in by djlea, 12 years ago

Update documentation for obstools and dataplot. Removal of dataplot code not needed. Addition of headers to some dataplot code. Addition of .exe to command example in obstools.

File size: 17.7 KB
Line 
1PROGRAM fbprint
2   !!---------------------------------------------------------------------
3   !!
4   !!                     ** PROGRAM fbprint **
5   !!
6   !!  ** Purpose : Print feedback file contents as text
7   !!
8   !!  ** Method  : Use of utilities from obs_fbm.
9   !!
10   !!  ** Action  :
11   !!
12   !!   Usage :
13   !!     fbprint.exe [options] inputfile
14   !!   Options :
15   !!     -b            shorter output
16   !!     -q            QC flags (nqc=1) select observations based on QC flags
17   !!     -Q            QC flags (nqc=2) select observations based on QC flags
18   !!     -B            QC flags (nqc=3) select observations based on QC flags
19   !!     -u            unsorted
20   !!     -s ID         select station ID 
21   !!     -t TYPE       select observation type
22   !!     -v NUM1-NUM2  select variable range to print by number (default all)
23   !!     -a NUM1-NUM2  select additional variable range to print by number (default all)
24   !!     -e NUM1-NUM2  select extra variable range to print by number (default all)
25   !!     -d            output date range
26   !!     -D            print depths
27   !!     -z            use zipped files
28   !!
29   !!   History :
30   !!        ! 2010 (K. Mogensen) Initial version
31   !!----------------------------------------------------------------------
32   USE toolspar_kind 
33   USE obs_fbm
34   USE index_sort
35   USE date_utils
36   USE proftools
37
38   IMPLICIT NONE
39   !
40   ! Command line arguments input file
41   !
42#ifndef NOIARGCPROTO
43   INTEGER,EXTERNAL :: iargc
44#endif
45   INTEGER :: nargs
46   CHARACTER(len=256) :: cdinfile, cdbrief
47   LOGICAL :: lbrief, lqcflags, lstat, ltyp, lsort, ldaterange, lzinp, ldepths
48   CHARACTER(len=ilenwmo) :: cdstat
49   CHARACTER(len=ilentyp) :: cdtyp
50   INTEGER :: nqc
51   INTEGER :: nvar1, nvar2, nadd1, nadd2, next1, next2
52   !
53   ! Input data
54   !
55   TYPE(obfbdata) :: obsdata
56   !
57   ! Loop variables
58   !
59   INTEGER :: ii, iarg, ip
60   !
61   ! Sorting
62   !
63   INTEGER :: iwmo
64   REAL(KIND=dp),ALLOCATABLE :: zsort(:,:)
65   INTEGER,ALLOCATABLE  :: iindex(:)
66   !
67   ! Get number of command line arguments
68   !
69   nargs  = IARGC()
70   lbrief = .FALSE.
71   lstat = .FALSE.
72   ltyp = .FALSE.
73   ldaterange = .FALSE.
74   ldepths = .FALSE.
75   cdstat = 'XXXXXXX'
76   cdtyp = 'XXXX'
77   lsort = .TRUE.
78   nqc = 0
79   nvar1 = -1
80   nvar2 = -1
81   nadd1 = -1
82   nadd2 = -1
83   next1 = -1
84   next2 = -1
85   lzinp = .FALSE.
86   IF ( nargs < 1 ) THEN
87      CALL usage()
88   ENDIF
89   iarg = 1
90   DO
91      IF ( iarg == nargs ) EXIT
92      CALL getarg( iarg, cdbrief )
93      IF ( cdbrief == '-b' ) THEN
94         lbrief = .TRUE.
95         iarg = iarg + 1
96      ELSEIF( cdbrief == '-q' ) THEN
97         lqcflags = .TRUE.
98         nqc=1
99         iarg = iarg + 1
100      ELSEIF( cdbrief == '-Q' ) THEN
101         lqcflags = .TRUE.
102         nqc=2
103         iarg = iarg + 1
104      ELSEIF( cdbrief == '-B' ) THEN
105         lqcflags = .TRUE.
106         nqc=3
107         iarg = iarg + 1
108      ELSEIF( cdbrief == '-u' ) THEN
109         lsort = .FALSE.
110         iarg = iarg + 1
111      ELSEIF ( cdbrief == '-s' ) THEN
112         lstat = .TRUE.
113         CALL getarg( iarg + 1, cdstat )
114         iarg = iarg + 2 
115      ELSEIF ( cdbrief == '-t' ) THEN
116         ltyp = .TRUE.
117         CALL getarg( iarg + 1, cdtyp )
118         iarg = iarg + 2 
119      ELSEIF ( cdbrief == '-v' ) THEN
120         CALL getarg( iarg + 1, cdbrief )
121         ip=INDEX(cdbrief,'-')
122         IF (ip==0) THEN
123            READ(cdbrief,'(I10)') nvar1
124            IF (nvar1==0) THEN
125               nvar2=-1
126            ELSE
127               nvar2 = nvar1
128            ENDIF
129         ELSEIF(ip==1) THEN
130            nvar1=1
131            READ(cdbrief(ip+1:),'(I10)') nvar2
132         ELSE
133            READ(cdbrief(1:ip-1),'(I10)') nvar1
134            READ(cdbrief(ip+1:),'(I10)') nvar2
135         ENDIF
136         iarg = iarg + 2
137      ELSEIF ( cdbrief == '-a' ) THEN
138         CALL getarg( iarg + 1, cdbrief )
139         ip=INDEX(cdbrief,'-')
140         IF (ip==0) THEN
141            READ(cdbrief,'(I10)') nadd1
142            IF (nadd1==0) THEN
143               nadd2=-1
144            ELSE
145               nadd2 = nadd1
146            ENDIF
147         ELSEIF(ip==1) THEN
148            nadd1=1
149            READ(cdbrief(ip+1:),'(I10)') nadd2
150         ELSE
151            READ(cdbrief(1:ip-1),'(I10)') nadd1
152            READ(cdbrief(ip+1:),'(I10)') nadd2
153         ENDIF
154         iarg = iarg + 2
155      ELSEIF ( cdbrief == '-e' ) THEN
156         CALL getarg( iarg + 1, cdbrief )
157         ip=INDEX(cdbrief,'-')
158         IF (ip==0) THEN
159            READ(cdbrief,'(I10)') next1
160            IF (next1==0) THEN
161               next2=-1
162            ELSE
163               next2 = next1
164            ENDIF
165         ELSEIF(ip==1) THEN
166            next1=1
167            READ(cdbrief(ip+1:),'(I10)') next2
168         ELSE
169            READ(cdbrief(1:ip-1),'(I10)') next1
170            READ(cdbrief(ip+1:),'(I10)') next2
171         ENDIF
172         iarg = iarg + 2
173      ELSEIF ( cdbrief == '-d' ) THEN
174         ldaterange=.TRUE.
175         iarg = iarg + 1
176      ELSEIF ( cdbrief == '-D' ) THEN
177         ldepths=.TRUE.
178         iarg = iarg + 1
179      ELSEIF ( cdbrief == '-z' ) THEN
180         lzinp=.TRUE.
181         iarg = iarg + 1
182      ELSE
183         CALL usage
184      ENDIF
185   ENDDO
186   CALL getarg( nargs, cdinfile )
187   !
188   ! Get input data
189   !
190   IF (lzinp) THEN
191#if defined NOSYSTEM
192      WRITE(*,*)'Compressed files need the system subroutine call'
193      CALL abort
194#else
195      CALL system( 'cp '//TRIM(cdinfile)//' fbprint_tmp.nc.gz' )
196      CALL system( 'gzip -df fbprint_tmp.nc.gz' )
197      CALL read_obfbdata( 'fbprint_tmp.nc', obsdata )
198      CALL system( 'rm -f fbprint_tmp.nc' )
199#endif
200   ELSE
201      CALL read_obfbdata( TRIM(cdinfile), obsdata )
202   ENDIF
203   CALL sealsfromargo( obsdata )
204   WRITE(*,'(2A,I9,A,I9,A)')TRIM(cdinfile), ' has ', obsdata%nobs ,&
205      & ' observations and a maximum of ', obsdata%nlev, ' levels'
206   IF (nvar1<0) THEN
207      nvar1 = 1
208      nvar2 = obsdata%nvar
209   ENDIF
210   IF (nadd1<0) THEN
211      nadd1 = 1
212      nadd2 = obsdata%nadd
213   ENDIF
214   IF (next1<0) THEN
215      next1 = 1
216      next2 = obsdata%next
217   ENDIF
218   !
219   ! Sort the data
220   !   
221   ALLOCATE(zsort(5,obsdata%nobs),iindex(obsdata%nobs))
222   IF (lsort) THEN
223      DO ii=1,obsdata%nobs
224         zsort(1,ii)=obsdata%ptim(ii)
225         zsort(2,ii)=obsdata%pphi(ii)
226         zsort(3,ii)=obsdata%plam(ii)
227         iwmo = TRANSFER( obsdata%cdwmo(ii)(1:4), iwmo )
228         zsort(4,ii) = iwmo
229         iwmo = TRANSFER( obsdata%cdwmo(ii)(5:8), iwmo )
230         zsort(5,ii) = iwmo
231      ENDDO
232      CALL index_sort_dp_n(zsort,5,iindex,obsdata%nobs)
233   ELSE
234      DO ii=1,obsdata%nobs
235         iindex(ii)=ii
236      ENDDO
237   ENDIF
238   IF (ldaterange) THEN
239      IF (obsdata%nobs>0) THEN
240         WRITE(*,'(A)')'First observation'
241         CALL print_time(obsdata%ptim(1))
242         WRITE(*,'(A)')'Last observation'
243         CALL print_time(obsdata%ptim(obsdata%nobs))
244      ENDIF
245   ELSE
246      !
247      ! Print the sorted list
248      !   
249      DO ii=1,obsdata%nobs
250         IF (lstat) THEN
251            IF (TRIM(ADJUSTL(cdstat)) /= &
252               &TRIM(ADJUSTL(obsdata%cdwmo(iindex(ii))))) CYCLE
253         ENDIF
254         IF (ltyp) THEN
255            IF (TRIM(ADJUSTL(cdtyp)) /= &
256               &TRIM(ADJUSTL(obsdata%cdtyp(iindex(ii))))) CYCLE
257         ENDIF
258         IF (ldepths) THEN
259            CALL print_depths(obsdata,iindex(ii))
260         ELSE
261            IF (lqcflags) THEN
262               CALL print_obs_qc(obsdata,iindex(ii),nqc,nvar1,nvar2)
263            ELSE
264               CALL print_obs(obsdata,iindex(ii),lbrief,&
265                  &           nvar1,nvar2,nadd1,nadd2,next1,next2)
266            ENDIF
267         ENDIF
268      ENDDO
269
270   ENDIF
271
272CONTAINS
273
274   SUBROUTINE usage
275      WRITE(*,'(A)')'Usage:'
276      WRITE(*,'(A)')'fbprint [options] inputfile'
277      CALL abort()
278   END SUBROUTINE usage
279   
280   SUBROUTINE print_depths(obsdata,iindex)
281      IMPLICIT NONE
282      TYPE(obfbdata) :: obsdata
283      INTEGER :: iindex
284      INTEGER :: kj
285      REAL :: mindep,maxdep
286
287      mindep=10000
288      maxdep=0
289      DO kj=1,obsdata%nlev
290         IF (obsdata%pdep(kj,iindex)<99999.0) THEN
291            IF (obsdata%pdep(kj,iindex)>maxdep) maxdep=obsdata%pdep(kj,iindex)
292            IF (obsdata%pdep(kj,iindex)<mindep) mindep=obsdata%pdep(kj,iindex)
293         ENDIF
294      ENDDO
295     
296      WRITE(*,*)'Fileindex           = ',obsdata%kindex(iindex)
297      WRITE(*,*)'Station identifier  = ',obsdata%cdwmo(iindex)
298      WRITE(*,*)'Station type        = ',obsdata%cdtyp(iindex)
299      WRITE(*,*)'Latitude            = ',obsdata%pphi(iindex)
300      WRITE(*,*)'Longtude            = ',obsdata%plam(iindex)
301      CALL print_time( obsdata%ptim(iindex) )
302      WRITE(*,*)'Position QC         = ',obsdata%ipqc(iindex)
303      WRITE(*,*)'Observation QC      = ',obsdata%ioqc(iindex)
304      WRITE(*,*)'Minimum obs. depth  = ',mindep
305      WRITE(*,*)'Maximum obs. depth  = ',maxdep
306      WRITE(*,*)
307
308   END SUBROUTINE print_depths
309
310   SUBROUTINE print_obs(obsdata,iindex,lshort,&
311      &                 kvar1,kvar2,kadd1,kadd2,kext1,kext2)
312      IMPLICIT NONE
313      TYPE(obfbdata) :: obsdata
314      INTEGER :: iindex
315      LOGICAL :: lshort
316      INTEGER :: kvar1,kvar2,kadd1,kadd2,kext1,kext2
317      INTEGER :: jv,ja,je,jk
318      INTEGER :: kj
319      LOGICAL :: lskip
320      CHARACTER(len=1024) :: cdfmt1,cdfmt2
321      CHARACTER(len=16) :: cdtmp
322
323      WRITE(*,*)'Fileindex           = ',obsdata%kindex(iindex)
324      WRITE(*,*)'Station identifier  = ',obsdata%cdwmo(iindex)
325      WRITE(*,*)'Station type        = ',obsdata%cdtyp(iindex)
326      WRITE(*,*)'Latitude            = ',obsdata%pphi(iindex)
327      WRITE(*,*)'Longtude            = ',obsdata%plam(iindex)
328      CALL print_time( obsdata%ptim(iindex) )
329      WRITE(*,*)'Position QC         = ',obsdata%ipqc(iindex)
330      WRITE(*,*)'Observation QC      = ',obsdata%ioqc(iindex)
331      IF (.NOT.lshort) THEN
332         DO jv = kvar1, kvar2
333            WRITE(*,*)'Variable name       = ',obsdata%cname(jv)
334            WRITE(*,*)'Variable QC         = ',obsdata%ivqc(iindex,jv)
335            IF (obsdata%lgrid) THEN
336               WRITE(*,*)'Grid I              = ',obsdata%iobsi(iindex,jv)
337               WRITE(*,*)'Grid J              = ',obsdata%iobsj(iindex,jv)
338            ENDIF
339         ENDDO
340         cdfmt1='(1X,A8,1X,A8'
341         cdfmt2='(1X,F8.2,1X,I8'
342         DO jv = kvar1, kvar2
343            cdfmt1 = TRIM(cdfmt1)//',1X,A15,1X,A8'
344            cdfmt2 = TRIM(cdfmt2)//',1X,E15.9,1X,I8'
345            IF (kadd2-kadd1+1>0) THEN
346               WRITE(cdtmp,'(I10)')kadd2-kadd1+1
347               cdfmt1 = TRIM(cdfmt1)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,A15)'
348               cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,E15.9)'
349            ENDIF
350            IF (obsdata%lgrid) THEN
351               cdfmt1 = TRIM(cdfmt1)//',1X,A10'
352               cdfmt2 = TRIM(cdfmt2)//',1X,I10'
353            ENDIF
354         ENDDO
355         IF (kext2-kext1+1>0) THEN
356            WRITE(cdtmp,'(I10)')kext2-kext1+1
357            cdfmt1 = TRIM(cdfmt1)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,A15)'
358            cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,E15.9)'
359         ENDIF
360         cdfmt1=TRIM(cdfmt1)//')'
361         cdfmt2=TRIM(cdfmt2)//')'
362         IF (obsdata%lgrid) THEN
363            WRITE(*,FMT=cdfmt1)&
364               & 'DEPTH', 'DEP_QC', &
365               & (TRIM(obsdata%cname(jv))//'_OBS', &
366               & TRIM(obsdata%cname(jv))//'_QC' , &
367               & (TRIM(obsdata%cname(jv))//'_'//TRIM(obsdata%caddname(ja)),&
368               & ja = kadd1, kadd2 ), &
369               & TRIM(obsdata%cname(jv))//'_K' , &
370               & jv = kvar1, kvar2 ), &
371               & ( TRIM(obsdata%cextname(ja)),&
372               & ja = kext1, kext2 )
373            DO kj=1,obsdata%nlev
374               IF (obsdata%pdep(kj,iindex)<99999.0) THEN
375                  WRITE (*,FMT=cdfmt2) &
376                     & obsdata%pdep(kj,iindex),   &
377                     & obsdata%idqc(kj,iindex),   &
378                     & ( obsdata%pob(kj,iindex,jv), obsdata%ivlqc(kj,iindex,jv), &
379                     & ( obsdata%padd(kj,iindex,ja,jv) , ja = kadd1, kadd2 ), &
380                     & obsdata%iobsk(kj,iindex,jv), &
381                     & jv = kvar1, kvar2 ), &
382                     & ( obsdata%pext(kj,iindex,ja), ja = kext1, kext2 )
383               ENDIF
384            ENDDO
385         ELSE
386            cdfmt1=TRIM(cdfmt1)//')'
387            cdfmt2=TRIM(cdfmt2)//')'
388            WRITE(*,FMT=cdfmt1)&
389               & 'DEPTH', 'DEP_QC', &
390               & (TRIM(obsdata%cname(jv))//'_OBS', &
391               & TRIM(obsdata%cname(jv))//'_QC' , &
392               & (TRIM(obsdata%cname(jv))//TRIM(obsdata%caddname(ja)),&
393               & ja = kadd1, kadd2 ), &
394               & jv = kvar1, kvar2 ), &
395               & ( TRIM(obsdata%cextname(ja)),&
396               & ja = kext1, kext2 )
397            DO kj=1,obsdata%nlev
398               IF (obsdata%pdep(kj,iindex)<99999.0) THEN
399                  WRITE (*,FMT=cdfmt2) &
400                     & obsdata%pdep(kj,iindex),   &
401                     & obsdata%idqc(kj,iindex),   &
402                     & ( obsdata%pob(kj,iindex,jv), obsdata%ivlqc(kj,iindex,jv), &
403                     & ( obsdata%padd(kj,iindex,ja,jv) , ja = kadd1, kadd2 ), &
404                     & jv = kvar1, kvar2 ), &
405                     & ( obsdata%pext(kj,iindex,ja), ja = kext1, kext2 )
406               ENDIF
407            ENDDO
408         ENDIF
409      ENDIF
410      WRITE(*,*)
411   END SUBROUTINE print_obs
412   
413   SUBROUTINE print_obs_qc(obsdata,iindex,kqc,kvar1,kvar2)
414      IMPLICIT NONE
415      TYPE(obfbdata) :: obsdata
416      INTEGER :: iindex
417      LOGICAL :: lqc
418      INTEGER :: kqc
419      INTEGER :: kvar1,kvar2
420      INTEGER :: jv,ja,je,jk
421      INTEGER :: kj
422      LOGICAL :: lskip
423      CHARACTER(len=1024) :: cdfmt1,cdfmt2
424      CHARACTER(len=16) :: cdtmp
425      INTEGER :: iqcf
426     
427      IF (kqc==2) THEN
428         lskip=.TRUE.
429         IF (obsdata%ipqc(iindex)>1) lskip=.FALSE.
430         IF (obsdata%ioqc(iindex)>1) lskip=.FALSE.
431         DO jv = kvar1, kvar2
432            IF (obsdata%ivqc(iindex,jv)>1) lskip=.FALSE.
433         ENDDO
434         DO kj=1,obsdata%nlev
435            IF (obsdata%pdep(kj,iindex)<99999.0) THEN
436               IF (obsdata%idqc(kj,iindex)>1) lskip=.FALSE.
437               DO jv = kvar1, kvar2
438                  IF (obsdata%ivlqc(kj,iindex,jv)>1) lskip=.FALSE.
439               ENDDO
440            ENDIF
441         ENDDO
442         IF (lskip) RETURN
443      ELSEIF (kqc==3) THEN
444         lskip=.TRUE.
445         DO kj=1,obsdata%nlev
446            IF (obsdata%pdep(kj,iindex)<99999.0) THEN
447               iqcf=0
448               DO jv = kvar1, kvar2
449                  IF (obsdata%ivlqc(kj,iindex,jv)>1) iqcf=iqcf+1
450                  IF (iqcf==obsdata%nvar) lskip=.FALSE.
451               ENDDO
452            ENDIF
453         ENDDO
454         IF (lskip) RETURN
455      ENDIF
456      WRITE(*,*)'Fileindex           = ',obsdata%kindex(iindex)
457      WRITE(*,*)'Station identifier  = ',obsdata%cdwmo(iindex)
458      WRITE(*,*)'Station type        = ',obsdata%cdtyp(iindex)
459      WRITE(*,*)'Latitude            = ',obsdata%pphi(iindex)
460      WRITE(*,*)'Longtude            = ',obsdata%plam(iindex)
461      CALL print_time( obsdata%ptim(iindex) )
462      WRITE(*,*)'Position QC         = ',obsdata%ipqc(iindex)
463      WRITE(*,*)'Position QC flags   = ',obsdata%ipqcf(:,iindex)
464      WRITE(*,*)'Observation QC      = ',obsdata%ioqc(iindex)
465      WRITE(*,*)'Observation QC flags= ',obsdata%ioqcf(:,iindex)
466      DO jv = kvar1, kvar2
467         WRITE(*,*)'Variable name       = ',obsdata%cname(jv)
468         WRITE(*,*)'Variable QC         = ',obsdata%ivqc(iindex,jv)
469         WRITE(*,*)'Variable QC flags   = ',obsdata%ivqcf(:,iindex,jv)
470      ENDDO
471      cdfmt1='(1X,A8,1X,A8'
472      cdfmt2='(1X,F8.2,1X,I8'
473      WRITE(cdtmp,'(I10)')obsdata%nqcf
474      cdfmt1 = TRIM(cdfmt1)//',1X,A18'
475      cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(I9)'
476      DO jv = kvar1, kvar2
477         cdfmt1 = TRIM(cdfmt1)//',1X,A15,1X,A8'
478         cdfmt2 = TRIM(cdfmt2)//',1X,E15.9,1X,I8'
479         WRITE(cdtmp,'(I10)')obsdata%nqcf
480         cdfmt1 = TRIM(cdfmt1)//',1X,A18'
481         cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(I9)'
482      ENDDO
483      IF (obsdata%next>0) THEN
484         WRITE(cdtmp,'(I10)')obsdata%next
485         cdfmt1 = TRIM(cdfmt1)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,A15)'
486         cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,E15.9)'
487      ENDIF
488      cdfmt1=TRIM(cdfmt1)//')'
489      cdfmt2=TRIM(cdfmt2)//')'
490      WRITE(*,FMT=cdfmt1)&
491         & 'DEPTH', 'DEP_QC', 'DEP_QC_FLAGS', &
492         & (TRIM(obsdata%cname(jv))//'_OBS', &
493         & TRIM(obsdata%cname(jv))//'_QC' , &
494         & TRIM(obsdata%cname(jv))//'_QC_FLAGS',&
495         & jv = kvar1, kvar2 ), &
496         & ( TRIM(obsdata%cextname(ja)),&
497         & ja = 1, obsdata%next )
498      DO kj=1,obsdata%nlev
499         IF (kqc>=2)  THEN
500            lskip=.TRUE.
501            IF (obsdata%idqc(kj,iindex)>1) lskip=.FALSE.
502            DO jv = kvar1, kvar2
503               IF (obsdata%ivlqc(kj,iindex,jv)>1) lskip=.FALSE.
504            ENDDO
505            IF (lskip) CYCLE
506         ENDIF
507         IF (obsdata%pdep(kj,iindex)<99999.0) THEN
508            WRITE (*,FMT=cdfmt2) &
509               & obsdata%pdep(kj,iindex),   &
510               & obsdata%idqc(kj,iindex),   &
511               & ( obsdata%idqcf(ja,kj,iindex), ja = 1, obsdata%nqcf ), &
512               & ( obsdata%pob(kj,iindex,jv), obsdata%ivlqc(kj,iindex,jv), &
513               & ( obsdata%ivlqcf(ja,kj,iindex,jv) , ja=1, obsdata%nqcf ), &
514               & jv = kvar1, kvar2 ), &
515               & ( obsdata%pext(kj,iindex,ja), ja=1, obsdata%next )
516         ENDIF
517      ENDDO
518      WRITE(*,*)
519     
520   END SUBROUTINE print_obs_qc
521
522   SUBROUTINE print_time(ptim)
523      IMPLICIT NONE
524      REAL(fbdp) :: ptim
525      INTEGER:: iyr,imon,iday,ihou,imin,isec     
526      WRITE(*,*)'Julian date         = ',ptim
527      CALL jul2greg(isec,imin,ihou,iday,imon,iyr,ptim)
528      WRITE(*,'(1X,A,I4,2I2.2)') &
529         &      'Gregorian date      = ',iyr,imon,iday
530      WRITE(*,'(1X,A,I2.2,A1,I2.2,A1,I2.2)') &
531         &      'Time                = ',ihou,':',imin,':',isec
532   END  SUBROUTINE print_time
533
534END PROGRAM fbprint
535
536   
Note: See TracBrowser for help on using the repository browser.