PROGRAM bufr2fb #ifdef HAS_BUFR USE toolspar_kind USE obs_fbm USE bufrdata USE convmerge IMPLICIT NONE ! ! Command line arguments for output file and input files ! #ifndef NOIARGCPROTO INTEGER,EXTERNAL :: iargc #endif INTEGER :: nargs CHARACTER(len=256) :: cdtsfilem, cdtsfile1, cduvfilem, cduvfile1 CHARACTER(len=256),ALLOCATABLE :: cdinfile(:) ! ! Input data ! TYPE(obfbdata), POINTER :: bufrtsm(:), bufrts1(:), bufruvm(:), bufruv1(:) INTEGER :: ninfiles INTEGER :: ntottsm, nmaxlevts, ntotts1 INTEGER :: ntotuvm, nmaxlevuv, ntotuv1 ! ! Loop variables ! INTEGER :: ia ! ! Get number of command line arguments ! nargs=IARGC() IF (nargs < 4) THEN WRITE(*,'(A)')'Usage:' WRITE(*,'(A)')'bufr2fb TS_outputfile_prof TS_outputfile_surf '//& & 'UV_outputfile_prof UV_outputfile_surf '//& & 'inputfile1 inputfile2 ...' CALL abort() ENDIF CALL getarg(1,cdtsfilem) CALL getarg(2,cdtsfile1) CALL getarg(3,cduvfilem) CALL getarg(4,cduvfile1) ! ! Get input data ! ALLOCATE( bufrtsm(MAX(nargs-4,1)) ) ALLOCATE( bufrts1(MAX(nargs-4,1)) ) ALLOCATE( bufruvm(MAX(nargs-4,1)) ) ALLOCATE( bufruv1(MAX(nargs-4,1)) ) ALLOCATE( cdinfile(MAX(nargs-4,1)) ) ntottsm = 0 ntotts1 = 0 ntotuvm = 0 ntotuv1 = 0 ninfiles = nargs - 4 DO ia=1,ninfiles CALL getarg( ia + 4, cdinfile(ia) ) CALL read_bufrfile( TRIM(cdinfile(ia)), & & bufrtsm(ia), bufrts1(ia), & & bufruvm(ia), bufruv1(ia) ) WRITE(*,'(2A)')'File = ',TRIM(cdinfile(ia)) WRITE(*,'(A,I9,A)')'has',bufrtsm(ia)%nobs,' TS profiles' WRITE(*,'(A,I9,A)')'and',bufruvm(ia)%nobs,' UV profiles' WRITE(*,'(A,I9,A)')'and',bufrts1(ia)%nobs,' TS single level' WRITE(*,'(A,I9,A)')'and',bufruv1(ia)%nobs,' UV single level' ntottsm = ntottsm + bufrtsm(ia)%nobs ntotuvm = ntotuvm + bufruvm(ia)%nobs ntotts1 = ntotts1 + bufrts1(ia)%nobs ntotuv1 = ntotuv1 + bufruv1(ia)%nobs ENDDO IF (ninfiles==0) THEN CALL init_obfbdata( bufrtsm(1) ) CALL alloc_obfbdata( bufrtsm(1), 2, 0, 1, 0, 1, .FALSE. ) bufrtsm(1)%cname(1) = 'POTM' bufrtsm(1)%cname(2) = 'PSAL' bufrtsm(1)%coblong(1) = 'Potential temperature' bufrtsm(1)%coblong(2) = 'Practical salinity' bufrtsm(1)%cobunit(1) = 'Degrees Celsius' bufrtsm(1)%cobunit(2) = 'PSU' bufrtsm(1)%cextname(1) = 'TEMP' bufrtsm(1)%cextlong(1) = 'Insitu temperature' bufrtsm(1)%cextunit(1) = 'Degrees Celsius' bufrtsm(1)%cdjuldref = '19500101000000' CALL init_obfbdata( bufrts1(1) ) CALL alloc_obfbdata( bufrts1(1), 2, 0, 1, 0, 1, .FALSE. ) bufrts1(1)%cname(1) = 'POTM' bufrts1(1)%cname(2) = 'PSAL' bufrts1(1)%coblong(1) = 'Potential temperature' bufrts1(1)%coblong(2) = 'Practical salinity' bufrts1(1)%cobunit(1) = 'Degrees Celsius' bufrts1(1)%cobunit(2) = 'PSU' bufrts1(1)%cextname(1) = 'TEMP' bufrts1(1)%cextlong(1) = 'Insitu temperature' bufrts1(1)%cextunit(1) = 'Degrees Celsius' bufrts1(1)%cdjuldref = '19500101000000' CALL init_obfbdata( bufruvm(1) ) CALL alloc_obfbdata( bufruvm(1), 2, 0, 1, 0, 0, .FALSE. ) bufruvm(1)%cname(1) = 'UVEL' bufruvm(1)%cname(2) = 'VVEL' bufruvm(1)%coblong(1) = 'Zonal current' bufruvm(1)%coblong(2) = 'Meridional current' bufruvm(1)%cobunit(1) = 'Meters per second' bufruvm(1)%cobunit(2) = 'Meters per second' bufruvm(1)%cdjuldref = '19500101000000' CALL init_obfbdata( bufruv1(1) ) CALL alloc_obfbdata( bufruv1(1), 2, 0, 1, 0, 0, .FALSE. ) bufruv1(1)%cname(1) = 'UVEL' bufruv1(1)%cname(2) = 'VVEL' bufruv1(1)%coblong(1) = 'Zonal current' bufruv1(1)%coblong(2) = 'Meridional current' bufruv1(1)%cobunit(1) = 'Meters per second' bufruv1(1)%cobunit(2) = 'Meters per second' bufruv1(1)%cdjuldref = '19500101000000' ENDIF WRITE(*,'(A,I8)') 'Total TS profiles : ',ntottsm WRITE(*,'(A,I8)') 'Total TS single : ',ntotts1 WRITE(*,'(A,I8)') 'Total UV profiles : ',ntotuvm WRITE(*,'(A,I8)') 'Total UV single : ',ntotuv1 ! ! Merge and output the data. ! IF (TRIM(cdtsfilem)/='none') THEN ! Convert insitu temperature to potential temperature using the model ! salinity if no potential temperature DO ia = 1, ninfiles call fbpotem( bufrtsm(ia) ) ENDDO CALL conv_fbmerge( TRIM(cdtsfilem), ninfiles, bufrtsm ) ENDIF IF (TRIM(cdtsfile1)/='none') THEN DO ia = 1, ninfiles call fbpotem( bufrts1(ia) ) ENDDO CALL conv_fbmerge( TRIM(cdtsfile1), ninfiles, bufrts1 ) ENDIF IF (TRIM(cduvfilem)/='none') THEN CALL conv_fbmerge( TRIM(cduvfilem), ninfiles, bufruvm ) ENDIF IF (TRIM(cduvfile1)/='none') THEN CALL conv_fbmerge( TRIM(cduvfile1), ninfiles, bufruv1 ) ENDIF CONTAINS #include "obs_conv.h90" SUBROUTINE fbpotem( fbdata ) ! Convert insitu temperature to potential temperature TYPE(obfbdata) :: fbdata REAL :: zpres INTEGER :: jo,jk DO jo = 1, fbdata%nobs IF ( fbdata%pphi(jo) < 9999.0 ) THEN DO jk = 1, fbdata%nlev IF ( ( fbdata%pob(jk,jo,1) >= 9999.0 ) .AND. & & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. & & ( fbdata%pob(jk,jo,2) < 9999.0 ) .AND. & & ( fbdata%pext(jk,jo,1) < 9999.0 ) ) THEN zpres = dep_to_p( REAL(fbdata%pdep(jk,jo),wp), & & REAL(fbdata%pphi(jo),wp) ) fbdata%pob(jk,jo,1) = potemp( & & REAL(fbdata%pob(jk,jo,2), wp), & & REAL(fbdata%pext(jk,jo,1), wp), & & REAL(zpres,wp), 0.0_wp ) ENDIF ENDDO ENDIF ENDDO END SUBROUTINE fbpotem #else WRITE(*,'(A)')'bufr2fb compiled without -DHAS_BUFR so '//& & 'running it is pointless' CALL abort #endif END PROGRAM bufr2fb