program simple_xy_nc4_wr use netcdf implicit none ! When we create netCDF files, variables and dimensions, we get back ! an ID for each one. integer :: ncid, varid ! Loop indexes, and error handling. integer :: x, y, status integer :: n_arguments ! # of command line argument integer :: iargc, isat ! function declaration character(len=18) :: infile_list character(len=76) :: file_nc character(len=134) :: file_nc_full character(len=80) :: file_outfile CHARACTER(LEN=64) :: name1,name2,name3,name4,name5,vname INTEGER :: nscan, nfov, nchan, nlev, ilay INTEGER :: nvars, nattrs, nunlimdimid, nformat INTEGER :: Field_of_view INTEGER :: xtype, ndims, is, i, j, icnt1 INTEGER, DIMENSION(3) :: dimids integer*2 :: high !!!INTEGER :: iyr1, iyrmth1, idy1 integer*2,dimension(:,:),allocatable :: temp, prc, sn, sfc, fg integer*2,dimension(:),allocatable :: iyr,imth,idy,ihr,imin,isec real,dimension(:,:),allocatable :: long, latt high = 0.0 !!!iyr1 = 2021 write (6,'('' RHEL6 CODE!!!!! '')') write (6,'('' RHEL6 CODE!!!!! '')') write (6,'('' RHEL6 CODE!!!!! '')') write (6,'('' RHEL6 CODE!!!!! '')') write (6,'('' RHEL6 CODE!!!!! '')') do isat = 19, 19 if (isat .eq. 18) then file_outfile(1:80) = '/cpc/prod/cpcsat/processes/ABOP_RH6/data/noaa18/MiRS/decd/MiRS-MHS-NOAA18-DECODE' open (95,file=file_outfile) file_nc_full(1:58) = '/cpc/prod/cpcsat/processes/ABOP_RH6/data/noaa18/MiRS/orb1/' !---- get input BUFR file from command line n_arguments = iargc() if (n_arguments .eq. 1) then call getarg(1, infile_list) write (6,'('' input file list '',a16)') infile_list else write(*,*) 'read_nc.x input_file_nc_IMG' stop endif elseif (isat .eq. 19) then file_outfile(1:80) = '/cpc/prod/cpcsat/processes/ABOP_RH6/data/noaa19/MiRS/decd/MiRS-MHS-NOAA19-DECODE' open (95,file=file_outfile) file_nc_full(1:58) = '/cpc/prod/cpcsat/processes/ABOP_RH6/data/noaa19/MiRS/orb1/' !---- get input BUFR file from command line n_arguments = iargc() if (n_arguments .eq. 1) then call getarg(1, infile_list) write (6,'('' input file list '',a16)') infile_list else write(*,*) 'read_nc.x input_file_nc_IMG' stop endif endif write (6,'('' input file list here '',a16)') infile_list open (12,file=infile_list) do icnt1 = 1, 99999 200 continue read (12,'(a76)',end=250) file_nc ! read(file_nc(24:27),'(i4)') iyr1 ! read(file_nc(24:29),'(i6)') iyrmth1 ! read(file_nc(30:31),'(i6)') idy1 ! write(file_nc_full(38:41),'(i4)') iyr1 ! write(file_nc_full(43:48),'(i6)') iyrmth1 ! write(file_nc_full(50:51),'(i2)') idy1 file_nc_full(59:134) = file_nc write (6,'('' input file '',a140)') file_nc_full !Open netCDF file status = nf90_open(file_nc_full, nf90_nowrite, ncid) if( status .ne. nf90_noerr ) then ! STOP 'open error' goto200 endif !check dimension status = nf90_inquire_dimension(ncid,1,name1, nscan) status = nf90_inquire_dimension(ncid,2,name2, nfov) status = nf90_inquire_dimension(ncid,4,name4, nlev) status = nf90_inquire_dimension(ncid,5,name5, nchan) nfov = 90 write (*,*) 'nscan', nscan write (*,*) 'nfov', nfov write (*,*) 'nchan', nchan write (*,*) 'nlev', nlev write (*,*) 'name1 = ', name1 write (*,*) 'name2 = ', name2 ! write (*,*) 'name3 = ', name3 ! write (*,*) 'name4 = ', name4 ! write (*,*) 'name5 = ', name5 status = nf90_inquire(ncid,ndims,nvars,nattrs,nunlimdimid,nformat) write (*,*) 'nvars', nvars !---- inquire all, there should a way to determine 36 here... do i=1,nvars status = nf90_inquire_variable(ncid,i,vname,xtype,ndims,dimids) ! write (*,*) 'vname = ', vname ! write (*,*) 'xtype', xtype ! write (*,*) 'ndims', ndims ! write (*,*) 'dimids', dimids enddo allocate(temp(nfov,nscan)) status = nf90_inq_varid(ncid,'TSkin',varid) status = nf90_get_var(ncid,varid,temp) write(*,*) temp(1,1) allocate(prc(nfov,nscan)) status = nf90_inq_varid(ncid,'RR',varid) status = nf90_get_var(ncid,varid,prc) allocate(fg(nfov,nscan)) status = nf90_inq_varid(ncid,'RFlag',varid) status = nf90_get_var(ncid,varid,fg) allocate(sfc(nfov,nscan)) status = nf90_inq_varid(ncid,'Sfc_type',varid) status = nf90_get_var(ncid,varid,sfc) allocate(sn(nfov,nscan)) status = nf90_inq_varid(ncid,'SFR',varid) status = nf90_get_var(ncid,varid,sn) allocate(long(nfov,nscan)) status = nf90_inq_varid(ncid,'Longitude',varid) status = nf90_get_var(ncid,varid,long) allocate(latt(nfov,nscan)) status = nf90_inq_varid(ncid,'Latitude',varid) status = nf90_get_var(ncid,varid,latt) allocate(iyr(nscan)) status = nf90_inq_varid(ncid,'ScanTime_year',varid) status = nf90_get_var(ncid,varid,iyr) allocate(imth(nscan)) status = nf90_inq_varid(ncid,'ScanTime_month',varid) status = nf90_get_var(ncid,varid,imth) allocate(idy(nscan)) status = nf90_inq_varid(ncid,'ScanTime_dom',varid) status = nf90_get_var(ncid,varid,idy) allocate(ihr(nscan)) status = nf90_inq_varid(ncid,'ScanTime_hour',varid) status = nf90_get_var(ncid,varid,ihr) allocate(imin(nscan)) status = nf90_inq_varid(ncid,'ScanTime_minute',varid) status = nf90_get_var(ncid,varid,imin) allocate(isec(nscan)) status = nf90_inq_varid(ncid,'ScanTime_second',varid) status = nf90_get_var(ncid,varid,isec) write(*,*) prc(1,1) write (6,'('' PRECIP '')') do i = 1, nscan ! write (*,*) 'nfov', nfov do j = 1, nfov ! write (*,*) 'nfov', j write(95,'(10i8,2x,2(f9.3))') iyr(i),imth(i),idy(i),ihr(i),imin(i),prc(j,i),sn(j,i),fg(j,i),sfc(j,i),j,long(j,i),latt(j,i) if (prc(j,i).gt.high) then high = prc(j,i) write (6,'(4i8,3x,2(1x,f9.2))') j,i,temp(j,i),prc(j,i),long(j,i),latt(j,i) endif enddo enddo deallocate(temp) deallocate(prc) deallocate(sn) deallocate(fg) deallocate(sfc) deallocate(long) deallocate(latt) deallocate(iyr) deallocate(imth) deallocate(idy) deallocate(ihr) deallocate(imin) deallocate(isec) !---- ...... status = nf90_close(ncid) write (6,'('' High = '',i8)') high goto200 ! End the input file loop enddo 250 continue close(95) close(12) ! End satellite loop enddo stop end program simple_xy_nc4_wr