program create_daily_cloud_data_utls c------------------------------------------------------------------------------- c c Reads HIRS FOV netcdf files for a calendar day and generates daily gridded c mean values at 0.5-degree resolution (equal angle). Output files are in c binary format. c c Command line inputs in order: c c input list file text file containing a list of input HIRS orbital c files (level 2) c output file name output file (binary) c c Program outputs: c Daily mean gridded HIRS cloud products in array 'outdata': c outdata(j,i,1) = ascending node (AN) cloud top pressure c outdata(j,i,2) = AN high cloud top pressure (< 440 hPa) c outdata(j,i,3) = AN middle cloud top pressure (440-680 hPa) c outdata(j,i,4) = AN low cloud top pressure (> 680 hPa) c outdata(j,i,5) = descending node (DN) cloud top pressure c outdata(j,i,6) = DN high cloud top pressure (< 440 hPa) c outdata(j,i,7) = DN middle cloud top pressure (440-680 hPa) c outdata(j,i,8) = DN low cloud top pressure (> 680 hPa) c outdata(j,i,9) = AN effective cloud amount c outdata(j,i,10) = AN effective cloud amount from high clouds c outdata(j,i,11) = AN effective cloud amount from middle clouds c outdata(j,i,12) = AN effective cloud amount from low clouds c outdata(j,i,13) = DN effective cloud amount c outdata(j,i,14) = DN effective cloud amount from high clouds c outdata(j,i,15) = DN effective cloud amount from middle clouds c outdata(j,i,16) = DN effective cloud amount from low clouds c outdata(j,i,17) = AN cloud top temperature c outdata(j,i,18) = DN cloud top temperature c outdata(j,i,19) = AN % clouds c outdata(j,i,20) = AN % high clouds c outdata(j,i,21) = AN % middle clouds c outdata(j,i,22) = AN % low clouds c outdata(j,i,23) = DN % clouds c outdata(j,i,24) = DN % high clouds c outdata(j,i,25) = DN % middle clouds c outdata(j,i,26) = DN % low clouds c outdata(j,i,27) = AN water % upper tropospheric/lower stratospheric (UTLS) clouds c outdata(j,i,28) = DN water % upper tropospheric/lower stratospheric (UTLS) clouds c outdata(j,i,29) = AN land % upper tropospheric/lower stratospheric (UTLS) clouds c outdata(j,i,30) = DN land % upper tropospheric/lower stratospheric (UTLS) clouds c outdata(j,i,31) = AN PATMOS-x (AVHRR) mean cloud top pressure c outdata(j,i,32) = DN PATMOS-x (AVHRR) mean cloud top pressure c outdata(j,i,33) = AN PATMOS-x (AVHRR) % high clouds (from mean CTPs in HIRS IFOVs) c outdata(j,i,34) = DN PATMOS-x (AVHRR) % high clouds (from mean CTPs in HIRS IFOVs) c outdata(j,i,35) = AN PATMOS-x (AVHRR) high cloud top pressure (< 440 hPa) c outdata(j,i,36) = DN PATMOS-x (AVHRR) high cloud top pressure (< 440 hPa) c c Revision history: c 10/13 R. Frey New version patterned after netcdf version c 03/14 R. Frey Added PATMOS-x CTPs, high cloud frequencies c c------------------------------------------------------------------------------- implicit none c------------------------------------------------------------------------------- integer nbins parameter (nbins = 720 * 360) integer nbins_out parameter (nbins_out = nbins * 36) integer nib, njb parameter (nib = 720) parameter (njb = 360) c------------------------------------------------------------------------------- character*120 Input_File, parm, FileName, outfile character*7 cctp(3) integer Number_of_Files, FileCounter, ierr integer i, j, kk integer jb, ib integer table(3,5), tabtot, it, jt, jj, ntot, nbad, nclr, nxtra_co2, nvalid, nco2 integer icf, cf_dista(10), ieca, eca_dista(10), ictp, ctp_dista(10) integer cf_distd(10), eca_distd(10), ctp_distd(10) integer ncfa, ncfd real*4 cf_norma(10), cf_normd(10), eca_norma(10), eca_normd(10) real*4 ctp_norma(10), ctp_normd(10) real*4 indata(1100, 56, 16) real*4 lat, lon, ctp, cth, tct, eca, met, dnf, node, vza, sctm, cf, lf, flag, utls_flag, * avhrr_ctp real*4 colat, rlon, d_sctm, tabpct(3,5) real*4 outdata(nib,njb,36) real*4 nreta(nib,njb), nretd(nib,njb) real*4 ncleara(nib,njb), ncleard(nib,njb) real*4 ntota(nib,njb), ntotd(nib,njb) real*4 nw_tota(nib,njb), nw_totd(nib,njb) real*4 nl_tota(nib,njb), nl_totd(nib,njb) real*4 sum_ctpa(nib,njb), sum_tcta(nib,njb), sum_ecaa(nib,njb) real*4 sum_ctpah(nib,njb), sum_ctpam(nib,njb), sum_ctpal(nib,njb) real*4 sum_ecaah(nib,njb), sum_ecaam(nib,njb), sum_ecaal(nib,njb) real*4 sum_ctpd(nib,njb), sum_tctd(nib,njb), sum_ecad(nib,njb) real*4 sum_ctpdh(nib,njb), sum_ctpdm(nib,njb), sum_ctpdl(nib,njb) real*4 sum_ecadh(nib,njb), sum_ecadm(nib,njb), sum_ecadl(nib,njb) real*4 mean_ctpa(nib,njb), mean_tcta(nib,njb), mean_ecaa(nib,njb) real*4 mean_ctpah(nib,njb), mean_ctpam(nib,njb), mean_ctpal(nib,njb) real*4 mean_ecaah(nib,njb), mean_ecaam(nib,njb), mean_ecaal(nib,njb) real*4 mean_ctpd(nib,njb), mean_tctd(nib,njb), mean_ecad(nib,njb) real*4 mean_ctpdh(nib,njb), mean_ctpdm(nib,njb), mean_ctpdl(nib,njb) real*4 mean_ecadh(nib,njb), mean_ecadm(nib,njb), mean_ecadl(nib,njb) real*4 max_sctma(nib,njb), max_sctmd(nib,njb) real*4 max_vzaa(nib,njb), max_vzad(nib,njb) real*4 n_hia(nib,njb), n_mida(nib,njb), n_loa(nib,njb) real*4 pct_hia(nib,njb), pct_mida(nib,njb), pct_loa(nib,njb) real*4 n_hid(nib,njb), n_midd(nib,njb), n_lod(nib,njb) real*4 pct_hid(nib,njb), pct_midd(nib,njb), pct_lod(nib,njb) real*4 pct_clda(nib,njb), pct_cldd(nib,njb) real*4 nw_utlsa(nib,njb), nw_utlsd(nib,njb) real*4 nl_utlsa(nib,njb), nl_utlsd(nib,njb) real*4 pctw_utlsa(nib,njb), pctw_utlsd(nib,njb) real*4 pctl_utlsa(nib,njb), pctl_utlsd(nib,njb) real*4 sum_avhrr_ctpa(nib,njb), sum_avhrr_ctpd(nib,njb) real*4 mean_avhrr_ctpa(nib,njb), mean_avhrr_ctpd(nib,njb) real*4 n_avhrr_ctpa(nib,njb), n_avhrr_ctpd(nib,njb) real*4 n_hiavha(nib,njb), n_hiavhd(nib,njb) real*4 pct_hiavha(nib,njb), pct_hiavhd(nib,njb) real*4 sum_avhctpah(nib,njb), sum_avhctpdh(nib,njb) real*4 mean_avhctpah(nib,njb), mean_avhctpdh(nib,njb) real*4 sbnd4a(nib,njb), sbnd5a(nib,njb), sbnd6a(nib,njb), sbnd7a(nib,njb), sbnd8a(nib,njb) real*4 sbnd4d(nib,njb), sbnd5d(nib,njb), sbnd6d(nib,njb), sbnd7d(nib,njb), sbnd8d(nib,njb) real*4 mbnd4a(nib,njb), mbnd5a(nib,njb), mbnd6a(nib,njb), mbnd7a(nib,njb), mbnd8a(nib,njb) real*4 mbnd4d(nib,njb), mbnd5d(nib,njb), mbnd6d(nib,njb), mbnd7d(nib,njb), mbnd8d(nib,njb) c------------------------------------------------------------------------------- c Data statements. data nreta /nbins * 0.0/ , nretd /nbins * 0.0/ data ncleara /nbins * 0.0/ , ncleard /nbins * 0.0/ data ntota /nbins * 0.0/ , ntotd /nbins * 0.0/ data nw_tota /nbins * 0.0/ , nw_totd /nbins * 0.0/ data nl_tota /nbins * 0.0/ , nl_totd /nbins * 0.0/ data sum_ctpa /nbins * 0.0/, sum_tcta /nbins * 0.0/, sum_ecaa /nbins * 0.0/ data sum_ctpah /nbins * 0.0/, sum_ctpam /nbins * 0.0/, sum_ctpal /nbins * 0.0/ data sum_ecaah /nbins * 0.0/, sum_ecaam /nbins * 0.0/, sum_ecaal /nbins * 0.0/ data sum_ctpd /nbins * 0.0/, sum_tctd /nbins * 0.0/, sum_ecad /nbins * 0.0/ data sum_ctpdh /nbins * 0.0/, sum_ctpdm /nbins * 0.0/, sum_ctpdl /nbins * 0.0/ data sum_ecadh /nbins * 0.0/, sum_ecadm /nbins * 0.0/, sum_ecadl /nbins * 0.0/ data max_sctma /nbins * -1000.0/, max_vzaa /nbins * -1000.0/ data max_sctmd /nbins * -1000.0/, max_vzad /nbins * -1000.0/ data mean_ctpa /nbins * -999.0/, mean_tcta /nbins * -999.0/, mean_ecaa /nbins * -999.0/ data mean_ctpah /nbins * -999.0/, mean_ctpam /nbins * -999.0/, mean_ctpal /nbins * -999.0/ data mean_ecaah /nbins * -999.0/, mean_ecaam /nbins * -999.0/, mean_ecaal /nbins * -999.0/ data mean_ctpd /nbins * -999.0/, mean_tctd /nbins * -999.0/, mean_ecad /nbins * -999.0/ data mean_ctpdh /nbins * -999.0/, mean_ctpdm /nbins * -999.0/, mean_ctpdl /nbins * -999.0/ data mean_ecadh /nbins * -999.0/, mean_ecadm /nbins * -999.0/, mean_ecadl /nbins * -999.0/ data n_hia /nbins*0.0/, n_mida /nbins*0.0/, n_loa /nbins*0.0/ data n_hid /nbins*0.0/, n_midd /nbins*0.0/, n_lod /nbins*0.0/ data nw_utlsa /nbins*0.0/, nw_utlsd /nbins*0.0/ data nl_utlsa /nbins*0.0/, nl_utlsd /nbins*0.0/ data pct_hia /nbins * -999.0/, pct_mida /nbins * -999.0/ data pct_hiavha /nbins * -999.0/, pct_hiavhd /nbins * -999.0/ data pct_loa /nbins * -999.0/, pct_clda /nbins * -999.0/ data pct_hid /nbins * -999.0/, pct_midd /nbins * -999.0/ data pct_lod /nbins * -999.0/, pct_cldd /nbins * -999.0/ data pctw_utlsa /nbins * -999.0/, pctw_utlsd /nbins * -999.0/ data pctl_utlsa /nbins * -999.0/, pctl_utlsd /nbins * -999.0/ data tabtot /0/, nco2 /0/, ntot /0/, nbad /0/, nclr /0/, nxtra_co2 /0/, nvalid /0/ data table /15*0/ data outdata /nbins_out * -999.0/ data mean_avhrr_ctpa /nbins * -999.0/, mean_avhrr_ctpd /nbins * -999.0/ data n_avhrr_ctpa /nbins * 0.0/, n_avhrr_ctpd /nbins * 0.0/ data sum_avhrr_ctpa /nbins * 0.0/, sum_avhrr_ctpd /nbins * 0.0/ data n_hiavha /nbins * 0.0/, n_hiavhd /nbins * 0.0/ data sum_avhctpah /nbins * 0.0/, sum_avhctpdh /nbins * 0.0/ data mean_avhctpah /nbins * -999.0/, mean_avhctpdh /nbins * -999.0/ data sbnd4a /nbins*0.0/, sbnd5a /nbins*0.0/, sbnd6a /nbins*0.0/, sbnd7a /nbins * 0.0/, sbnd8a /nbins*0.0/ data sbnd4d /nbins*0.0/, sbnd5d /nbins*0.0/, sbnd6d /nbins*0.0/, sbnd7d /nbins * 0.0/, sbnd8d /nbins*0.0/ data mbnd4a /nbins * -999.0/, mbnd5a /nbins * -999.0/, mbnd6a /nbins * -999.0 / data mbnd7a /nbins * -999.0/, mbnd8a /nbins * -999.0/, mbnd4d /nbins * -999.0 / data mbnd5d /nbins * -999.0/, mbnd6d /nbins * -999.0/, mbnd7d /nbins * -999.0 / data mbnd8d /nbins * -999.0/ data cf_dista /10*0/, cf_distd /10*0/, eca_dista /10*0/, eca_distd /10*0/ data ctp_dista /10*0/, ctp_distd /10*0/ data ncfa /0/, ncfd /0/ c------------------------------------------------------------------------------- c Get input file name. This file contains a list of binary files c to be processed. call getarg(1,parm) read(parm,'(a120)') Input_File write(*,'(2x,'' Input List File is: '',A70)') Input_File c------------------------------------------------------------------------------- c Get output file name. call getarg(2,parm) read(parm,'(a120)') outfile write(*,'(2x,'' Output File is: '',A120)') outfile c------------------------------------------------------------------------------- c Open the input list file containing file names. open(20, file=Input_File, form='formatted', + status='old', iostat = ierr) if (ierr .ne. 0) then write(*,'(2x,''Could not open input ascii file '', + A70,i10)') Input_File, ierr endif c------------------------------------------------------------------------------- c Determine the number of files to be read in Number_of_Files = 0 FileName = "1" Do While (FileName .ne. " ") FileName = " " read(20,'(a)',iostat=ierr) FileName Number_of_Files = Number_of_Files + 1 end do Number_of_Files = Number_of_Files - 1 write(*,'(2x,'' Number of Granules '',i10)') Number_of_Files c------------------------------------------------------------------------------- c Go back to the beginning to read the files rewind(20) c------------------------------------------------------------------------------- do FileCounter = 1 , Number_of_Files read(20,'(a120)',iostat=ierr) FileName write(*,'(a120)') FileName c------------------------------------------------------------------------------- c Open and read data file. open(30,file=FileName,form='unformatted',access='sequential',iostat=ierr) if(ierr .ne. 0) then write(*,'(2x,''Could not open input data file '', + A70,i10)') FileName, ierr go to 100 end if read(30,iostat=ierr) indata if(ierr .ne. 0) then write(*,'(2x,''Could not read input data file '', + A70,i10)') FileName, ierr go to 100 end if c------------------------------------------------------------------------------- c Loop through data the data. do i = 1, 1100 do j = 13, 44 c------------------------------------------------------------------------------- c Obtain HIRS data. lat = indata(i,j,1) lon = indata(i,j,2) ctp = indata(i,j,3) cth = indata(i,j,4) tct = indata(i,j,5) eca = indata(i,j,6) met = indata(i,j,7) dnf = indata(i,j,8) node = indata(i,j,9) vza = indata(i,j,10) sctm = indata(i,j,11) cf = indata(i,j,12) lf = indata(i,j,13) flag = indata(i,j,14) utls_flag = indata(i,j,15) avhrr_ctp = indata(i,j,16) c write(*,'(8f12.3)') lat,lon,ctp,tct,eca,met,dnf,node,vza,cf,lf,flag, c * utls_flag, avhrr_ctp c------------------------------------------------------------------------------- c Bin data by lat, lon into 0.5-degree bins. Begin longitude index c at Greenwich. Find j and i indecis. if(lat .ge. -90.0 .and. lat .le. 90.0 .and. * lon .ge. -180.0 .and. lon .le. 180.0) then colat = 90.0 - lat jb = int( colat / 0.5 ) + 1 if(jb .gt. 360) jb = 360 if(lon .lt. 0.0) then rlon = lon + 360.0 else rlon = lon end if ib = int( rlon / 0.5 ) + 1 if(ib .gt. 720) ib = 720 c write(*,'(2f12.3,i10,2f12.3,i10)') lat,colat,jb,lon,rlon,ib c------------------------------------------------------------------------------- c Compute/collect statistical data for the various HIRS products. c if(abs(lat) .le. 30.0) then c if(abs(lat) .le. 60.0) then c if(abs(lat) .le. 60.0 .and. abs(lat) .ge. 30.0) then ntot = ntot + 1 if(flag .ne. 0.0) then if(flag .eq. 2.0) nxtra_co2 = nxtra_co2 + 1 if(flag .eq. 1.0) nclr = nclr + 1 if(flag .eq. 3.0 .or. flag .eq. 2.0) nvalid = nvalid + 1 c if(flag .eq. 3.0) nvalid = nvalid + 1 c Check node. 'node' is an AN/DN index where 1=AN, 2=DN. if(node .eq. 1.0) then c Ascending node. c If first data in bin, or from same orbit, then composite. Otherwise, c over-write previous data with the current. c Use scan time to determine if new orbit. d_sctm = sctm - max_sctma(ib,jb) if(ntota(ib,jb) .eq. 0.0 .or. d_sctm .lt. 600000.0) then if(sctm .gt. max_sctma(ib,jb)) max_sctma(ib,jb) = sctm if(vza .gt. max_vzaa(ib,jb)) max_vzaa(ib,jb) = vza if(flag .eq. 3.0 .or. flag .eq. 2.0) then ntota(ib,jb) = ntota(ib,jb) + 1.0 nreta(ib,jb) = nreta(ib,jb) + 1.0 if(lf .eq. 0.0) then nw_tota(ib,jb) = nw_tota(ib,jb) + 1.0 else if(lf .eq. 1.0) then nl_tota(ib,jb) = nl_tota(ib,jb) + 1.0 end if if(utls_flag .eq. 2.0) then if(lf .eq. 0.0) then nw_utlsa(ib,jb) = nw_utlsa(ib,jb) + 1.0 else if(lf .eq. 1.0) then nl_utlsa(ib,jb) = nl_utlsa(ib,jb) + 1.0 end if end if sum_ctpa(ib,jb) = sum_ctpa(ib,jb) + ctp sum_tcta(ib,jb) = sum_tcta(ib,jb) + tct sum_ecaa(ib,jb) = sum_ecaa(ib,jb) + eca if(avhrr_ctp .gt. 0.0) then sum_avhrr_ctpa(ib,jb) = sum_avhrr_ctpa(ib,jb) + avhrr_ctp n_avhrr_ctpa(ib,jb) = n_avhrr_ctpa(ib,jb) + 1 if(avhrr_ctp .le. 440.0) then n_hiavha(ib,jb) = n_hiavha(ib,jb) + 1.0 sum_avhctpah(ib,jb) = sum_avhctpah(ib,jb) + avhrr_ctp end if end if if(ctp .le. 440.0) then n_hia(ib,jb) = n_hia(ib,jb) + 1.0 sum_ctpah(ib,jb) = sum_ctpah(ib,jb) + ctp sum_ecaah(ib,jb) = sum_ecaah(ib,jb) + eca else if(ctp .gt. 440.0 .and. ctp .le. 680.0) then n_mida(ib,jb) = n_mida(ib,jb) + 1.0 sum_ctpam(ib,jb) = sum_ctpam(ib,jb) + ctp sum_ecaam(ib,jb) = sum_ecaam(ib,jb) + eca else if(ctp .gt. 680.0) then n_loa(ib,jb) = n_loa(ib,jb) + 1.0 sum_ctpal(ib,jb) = sum_ctpal(ib,jb) + ctp sum_ecaal(ib,jb) = sum_ecaal(ib,jb) + eca end if c Test c Get distributions of various products. c if(ctp .le. 440.0 .and. abs(lat) .le. 60 .and. abs(lat) .ge. 30) then c if(ctp .le. 440.0 .and. abs(lat) .le. 60 .and. abs(lat) .ge. 30) then if(ctp .le. 440.0 .and. abs(lat) .le. 30) then c if(ctp .le. 440.0) then if(eca .ge. 0.20) then icf = int(cf / 0.1) + 1 if(icf .gt. 10) icf = 10 cf_dista(icf) = cf_dista(icf) + 1 c write(*,'(f8.3, 2i8)') cf, icf, cf_dista(icf) ieca = int(eca / 0.1) + 1 if(ieca .gt. 10) ieca = 10 eca_dista(ieca) = eca_dista(ieca) + 1 c write(*,'(f8.3, 2i8)') eca, ieca, eca_dista(ieca) ictp = int((ctp - 100.0) / 50.0) + 1 if(ictp .lt. 0) ictp = 1 ctp_dista(ictp) = ctp_dista(ictp) + 1 c write(*,'(f8.3, 2i8)') ctp, ictp, ctp_dista(ictp) ncfa = ncfa + 1 end if end if else if(flag .eq. 1.0) then ntota(ib,jb) = ntota(ib,jb) + 1.0 ncleara(ib,jb) = ncleara(ib,jb) + 1.0 if(lf .eq. 0.0) then nw_tota(ib,jb) = nw_tota(ib,jb) + 1.0 else if(lf .eq. 1.0) then nl_tota(ib,jb) = nl_tota(ib,jb) + 1.0 end if end if else if(vza .lt. max_vzaa(ib,jb)) then max_sctma(ib,jb) = sctm nreta(ib,jb) = 0.0 ncleara(ib,jb) = 0.0 n_hia(ib,jb) = 0.0 n_hiavha(ib,jb) = 0.0 n_mida(ib,jb) = 0.0 n_loa(ib,jb) = 0.0 nw_utlsa(ib,jb) = 0.0 nl_utlsa(ib,jb) = 0.0 sum_ctpa(ib,jb) = 0.0 sum_tcta(ib,jb) = 0.0 sum_ecaa(ib,jb) = 0.0 sum_ctpah(ib,jb) = 0.0 sum_ecaah(ib,jb) = 0.0 sum_ctpam(ib,jb) = 0.0 sum_ecaam(ib,jb) = 0.0 sum_ctpal(ib,jb) = 0.0 sum_ecaal(ib,jb) = 0.0 sum_avhrr_ctpa(ib,jb) = 0.0 n_avhrr_ctpa(ib,jb) = 0.0 sum_avhctpah(ib,jb) = 0.0 if(flag .eq. 3.0 .or. flag .eq. 2.0) then ntota(ib,jb) = 1.0 nreta(ib,jb) = 1.0 if(lf .eq. 0.0) then nw_tota(ib,jb) = 1.0 else if(lf .eq. 1.0) then nl_tota(ib,jb) = 1.0 end if if(utls_flag .eq. 2.0) then if(lf .eq. 0.0) then nw_utlsa(ib,jb) = 1.0 else if(lf .eq. 1.0) then nl_utlsa(ib,jb) = 1.0 end if end if sum_ctpa(ib,jb) = ctp sum_tcta(ib,jb) = tct sum_ecaa(ib,jb) = eca if(avhrr_ctp .gt. 0.0) then sum_avhrr_ctpa(ib,jb) = avhrr_ctp n_avhrr_ctpa(ib,jb) = 1.0 if(avhrr_ctp .le. 440.0) then n_hiavha(ib,jb) = 1.0 sum_avhctpah(ib,jb) = avhrr_ctp end if end if if(ctp .le. 440.0) then n_hia(ib,jb) = 1.0 sum_ctpah(ib,jb) = ctp sum_ecaah(ib,jb) = eca else if(ctp .gt. 440.0 .and. ctp .le. 680.0) then n_mida(ib,jb) = 1.0 sum_ctpam(ib,jb) = ctp sum_ecaam(ib,jb) = eca else if(ctp .gt. 680.0) then n_loa(ib,jb) = 1.0 sum_ctpal(ib,jb) = ctp sum_ecaal(ib,jb) = eca end if c if(ctp .le. 440.0 .and. abs(lat) .le. 60 .and. abs(lat) .ge. 30) then c if(ctp .le. 440.0 .and. abs(lat) .le. 60 .and. abs(lat) .ge. 30) then if(ctp .le. 440.0 .and. abs(lat) .le. 30) then c if(ctp .le. 440.0) then if(eca .ge. 0.20) then icf = int(cf / 0.1) + 1 if(icf .gt. 10) icf = 10 cf_dista(icf) = cf_dista(icf) + 1 c write(*,'(f8.3, 2i8)') cf, icf, cf_dista(icf) ieca = int(eca / 0.1) + 1 if(ieca .gt. 10) ieca = 10 eca_dista(ieca) = eca_dista(ieca) + 1 c write(*,'(f8.3, 2i8)') eca, ieca, eca_dista(ieca) ictp = int((ctp - 100.0) / 50.0) + 1 if(ictp .lt. 0) ictp = 1 ctp_dista(ictp) = ctp_dista(ictp) + 1 c write(*,'(f8.3, 2i8)') ctp, ictp, ctp_dista(ictp) ncfa = ncfa + 1 end if end if else if(flag .eq. 1.0) then ntota(ib,jb) = 1.0 ncleara(ib,jb) = 1.0 if(lf .eq. 0.0) then nw_tota(ib,jb) = 1.0 else if(lf .eq. 1.0) then nl_tota(ib,jb) = 1.0 end if end if end if else c Descending node. c If first data in bin, or from same orbit, then composite. Otherwise, c over-write previous data with the current. c Use scan time to determine if new orbit. d_sctm = sctm - max_sctmd(ib,jb) if(ntotd(ib,jb) .eq. 0.0 .or. d_sctm .lt. 600000.0) then if(sctm .gt. max_sctmd(ib,jb)) max_sctmd(ib,jb) = sctm if(vza .gt. max_vzad(ib,jb)) max_vzad(ib,jb) = vza if(flag .eq. 3.0 .or. flag .eq. 2.0) then ntotd(ib,jb) = ntotd(ib,jb) + 1.0 nretd(ib,jb) = nretd(ib,jb) + 1.0 if(lf .eq. 0.0) then nw_totd(ib,jb) = nw_totd(ib,jb) + 1.0 else if(lf .eq. 1.0) then nl_totd(ib,jb) = nl_totd(ib,jb) + 1.0 end if if(utls_flag .eq. 2.0) then if(lf .eq. 0.0) then nw_utlsd(ib,jb) = nw_utlsd(ib,jb) + 1.0 else if(lf .eq. 1.0) then nl_utlsd(ib,jb) = nl_utlsd(ib,jb) + 1.0 end if end if sum_ctpd(ib,jb) = sum_ctpd(ib,jb) + ctp sum_tctd(ib,jb) = sum_tctd(ib,jb) + tct sum_ecad(ib,jb) = sum_ecad(ib,jb) + eca if(avhrr_ctp .gt. 0.0) then sum_avhrr_ctpd(ib,jb) = sum_avhrr_ctpd(ib,jb) + avhrr_ctp n_avhrr_ctpd(ib,jb) = n_avhrr_ctpd(ib,jb) + 1 if(avhrr_ctp .le. 440.0) then n_hiavhd(ib,jb) = n_hiavhd(ib,jb) + 1.0 sum_avhctpdh(ib,jb) = sum_avhctpdh(ib,jb) + avhrr_ctp end if end if if(ctp .le. 440.0) then n_hid(ib,jb) = n_hid(ib,jb) + 1.0 sum_ctpdh(ib,jb) = sum_ctpdh(ib,jb) + ctp sum_ecadh(ib,jb) = sum_ecadh(ib,jb) + eca else if(ctp .gt. 440.0 .and. ctp .le. 680.0) then n_midd(ib,jb) = n_midd(ib,jb) + 1.0 sum_ctpdm(ib,jb) = sum_ctpdm(ib,jb) + ctp sum_ecadm(ib,jb) = sum_ecadm(ib,jb) + eca else if(ctp .gt. 680.0) then n_lod(ib,jb) = n_lod(ib,jb) + 1.0 sum_ctpdl(ib,jb) = sum_ctpdl(ib,jb) + ctp sum_ecadl(ib,jb) = sum_ecadl(ib,jb) + eca end if c if(ctp .le. 440.0 .and. abs(lat) .le. 60 .and. abs(lat) .ge. 30) then c if(ctp .le. 440.0 .and. abs(lat) .le. 60 .and. abs(lat) .ge. 30) then if(ctp .le. 440.0 .and. abs(lat) .le. 30) then c if(ctp .le. 440.0) then if(eca .ge. 0.20) then icf = int(cf / 0.1) + 1 if(icf .gt. 10) icf = 10 cf_distd(icf) = cf_distd(icf) + 1 ieca = int(eca / 0.1) + 1 if(ieca .gt. 10) ieca = 10 eca_distd(ieca) = eca_distd(ieca) + 1 c write(*,'(f8.3, 2i8)') eca, ieca, eca_distd(ieca) ictp = int((ctp - 100.0) / 50.0) + 1 if(ictp .lt. 0) ictp = 1 ctp_distd(ictp) = ctp_distd(ictp) + 1 c write(*,'(f8.3, 2i8)') ctp, ictp, ctp_distd(ictp) ncfd = ncfd + 1 end if end if else if(flag .eq. 1.0) then ntotd(ib,jb) = ntotd(ib,jb) + 1.0 ncleard(ib,jb) = ncleard(ib,jb) + 1.0 if(lf .eq. 0.0) then nw_totd(ib,jb) = nw_totd(ib,jb) + 1.0 else if(lf .eq. 1.0) then nl_totd(ib,jb) = nl_totd(ib,jb) + 1.0 end if end if else if(vza .lt. max_vzad(ib,jb)) then max_sctmd(ib,jb) = sctm nretd(ib,jb) = 0.0 ncleard(ib,jb) = 0.0 n_hid(ib,jb) = 0.0 n_hiavhd(ib,jb) = 0.0 n_midd(ib,jb) = 0.0 n_lod(ib,jb) = 0.0 nw_utlsd(ib,jb) = 0.0 nl_utlsd(ib,jb) = 0.0 sum_ctpd(ib,jb) = 0.0 sum_tctd(ib,jb) = 0.0 sum_ecad(ib,jb) = 0.0 sum_ctpdh(ib,jb) = 0.0 sum_ecadh(ib,jb) = 0.0 sum_ctpdm(ib,jb) = 0.0 sum_ecadm(ib,jb) = 0.0 sum_ctpdl(ib,jb) = 0.0 sum_ecadl(ib,jb) = 0.0 sum_avhrr_ctpd(ib,jb) = 0.0 n_avhrr_ctpd(ib,jb) = 0.0 sum_avhctpdh(ib,jb) = 0.0 if(flag .eq. 3.0 .or. flag .eq. 2.0) then ntotd(ib,jb) = 1.0 nretd(ib,jb) = 1.0 if(lf .eq. 0.0) then nw_totd(ib,jb) = 1.0 else if(lf .eq. 1.0) then nl_totd(ib,jb) = 1.0 end if if(utls_flag .eq. 2.0) then if(lf .eq. 0.0) then nw_utlsd(ib,jb) = 1.0 else if(lf .eq. 1.0) then nl_utlsd(ib,jb) = 1.0 end if end if sum_ctpd(ib,jb) = ctp sum_tctd(ib,jb) = tct sum_ecad(ib,jb) = eca if(avhrr_ctp .gt. 0.0) then sum_avhrr_ctpd(ib,jb) = avhrr_ctp n_avhrr_ctpd(ib,jb) = 1.0 if(avhrr_ctp .le. 440.0) then n_hiavhd(ib,jb) = 1.0 sum_avhctpdh(ib,jb) = avhrr_ctp end if end if if(ctp .le. 440.0) then n_hid(ib,jb) = 1.0 sum_ctpdh(ib,jb) = ctp sum_ecadh(ib,jb) = eca else if(ctp .gt. 440.0 .and. ctp .le. 680.0) then n_midd(ib,jb) = 1.0 sum_ctpdm(ib,jb) = ctp sum_ecadm(ib,jb) = eca else if(ctp .gt. 680.0) then n_lod(ib,jb) = 1.0 sum_ctpdl(ib,jb) = ctp sum_ecadl(ib,jb) = eca end if c if(ctp .le. 440.0 .and. abs(lat) .le. 60 .and. abs(lat) .ge. 30) then c if(ctp .le. 440.0 .and. abs(lat) .le. 60 .and. abs(lat) .ge. 30) then if(ctp .le. 440.0 .and. abs(lat) .le. 30) then c if(ctp .le. 440.0) then if(eca .ge. 0.20) then icf = int(cf / 0.1) + 1 if(icf .gt. 10) icf = 10 cf_distd(icf) = cf_distd(icf) + 1 ieca = int(eca / 0.1) + 1 if(ieca .gt. 10) ieca = 10 eca_distd(ieca) = eca_distd(ieca) + 1 c write(*,'(f8.3, 2i8)') eca, ieca, eca_distd(ieca) ictp = int((ctp - 100.0) / 50.0) + 1 if(ictp .lt. 0) ictp = 1 ctp_distd(ictp) = ctp_distd(ictp) + 1 c write(*,'(f8.3, 2i8)') ctp, ictp, ctp_distd(ictp) ncfd = ncfd + 1 end if end if else if(flag .eq. 1.0) then ntotd(ib,jb) = 1.0 ncleard(ib,jb) = 1.0 if(lf .eq. 0.0) then nw_totd(ib,jb) = 1.0 else if (lf .eq. 1.0) then nl_totd(ib,jb) = 1.0 end if end if end if end if c------------------------------------------------------------------------------- c Get CTP/CEE table. if(flag .eq. 3.0 .or. flag .eq. 2.0) then if(abs(lat) .le. 60.0) then tabtot = tabtot + 1 if(ctp .lt. 440.0 .and. eca .le. 0.25) table(1,1) = table(1,1) + 1 if(ctp .ge. 440.0 .and. ctp .lt. 680.0 .and. eca .le. 0.25) * table(2,1) = table(2,1) + 1 if(ctp .ge. 680.0 .and. eca .le. 0.25) table(3,1) = table(3,1) + 1 if(ctp .lt. 440.0 .and. eca .gt. 0.25 .and. eca .le. 0.50) * table(1,2) = table(1,2) + 1 if(ctp .ge. 440.0 .and. ctp .lt. 680.0 .and. eca .gt. 0.25 .and. * eca .le. 0.50) table(2,2) = table(2,2) + 1 if(ctp .ge. 680.0 .and. eca .gt. 0.25 .and. eca .le. 0.50) * table(3,2) = table(3,2) + 1 if(ctp .lt. 440.0 .and. eca .gt. 0.50 .and. eca .le. 0.75) * table(1,3) = table(1,3) + 1 if(ctp .ge. 440.0 .and. ctp .lt. 680.0 .and. eca .gt. 0.50 .and. * eca .le. 0.75) table(2,3) = table(2,3) + 1 if(ctp .ge. 680.0 .and. eca .gt. 0.50 .and. eca .le. 0.75) * table(3,3) = table(3,3) + 1 if(ctp .lt. 440.0 .and. eca .gt. 0.75 .and. eca .le. 0.95) * table(1,4) = table(1,4) + 1 if(ctp .ge. 440.0 .and. ctp .lt. 680.0 .and. eca .gt. 0.75 .and. * eca .le. 0.95) table(2,4) = table(2,4) + 1 if(ctp .ge. 680.0 .and. eca .gt. 0.75 .and. eca .le. 0.95) * table(3,4) = table(3,4) + 1 if(ctp .lt. 440.0 .and. eca .gt. 0.95) table(1,5) = table(1,5) + 1 if(ctp .ge. 440.0 .and. ctp .lt. 680.0 .and. eca .gt. 0.95) * table(2,5) = table(2,5) + 1 if(ctp .ge. 680.0 .and. eca .gt. 0.95) table(3,5) = table(3,5) + 1 if(met .ne. 6) nco2 = nco2 + 1 end if end if c------------------------------------------------------------------------------- else if(flag .eq. 0.0) then nbad = nbad + 1 end if c end if end if c------------------------------------------------------------------------------- c End of elements loop. enddo c End of scan lines loop. enddo c------------------------------------------------------------------------------- c End of orbits loop. enddo c------------------------------------------------------------------------------- c Get percentage table. write(*,'(/,21x,''CTP/CEE Table'')') write(*,'(14x,''Cloud Effective Emissivity'',/)') write(*,'(3x,''CTP'',8x,''0-25'',6x,''25-50'',5x,''50-75'',5x,''75-95'',5x,''>95'')') write(*,'(''__________________________________________________________'',/)') if(tabtot .gt. 0) then cctp(1) = '< 440 ' cctp(2) = '680-440' cctp(3) = '> 680 ' do it = 1, 3 do jt = 1, 5 tabpct(it,jt) = (real(table(it,jt)) / tabtot) * 100.0 enddo write(*,'(1x,a7,2x,''|'',f7.2,4f10.2)') cctp(it),(tabpct(it,jj),jj=1,5) c write(*,'(1x,a7,2x,''|'',i7,4i10)') cctp(it),(table(it,jj),jj=1,5) enddo write(*,'(''__________________________________________________________'')') write(*,'(/,''Number valid retrievals: '',i10)') tabtot write(*,'(''Percentage CO2-slicing retrievals: '',f7.2,/)') (real(nco2)/tabtot)*100.0 write(*,'(''Total FOVs: '',i10)') ntot write(*,'(''Total valid cloud retrievals: '',i10)') nvalid write(*,'(''Total clear FOVs: '',i10)') nclr write(*,'(''Total missing FOVs: '',i10)') nbad write(*,'(''Total additional CO2-slicing retrievals: '',i10)') nxtra_co2 write(*,'(''Percentage of clear FOVs: '',f10.2)') (real(nclr)/(ntot-nbad))*100.0 end if c------------------------------------------------------------------------------- c Compute means for HIRS products. do i = 1, 360 do j = 1, 720 if(nreta(j,i) .gt. 0.0) then mean_ctpa(j,i) = sum_ctpa(j,i) / nreta(j,i) mean_tcta(j,i) = sum_tcta(j,i) / nreta(j,i) mean_ecaa(j,i) = sum_ecaa(j,i) / nreta(j,i) end if if(n_avhrr_ctpa(j,i) .gt. 0.0) then mean_avhrr_ctpa(j,i) = sum_avhrr_ctpa(j,i) / n_avhrr_ctpa(j,i) end if if(ntota(j,i) .gt. 0.0) then pct_clda(j,i) = ( nreta(j,i) / ntota(j,i) ) * 100.0 pct_hia(j,i) = ( n_hia(j,i) / ntota(j,i) ) * 100.0 pct_hiavha(j,i) = ( n_hiavha(j,i) / ntota(j,i) ) * 100.0 pct_mida(j,i) = ( n_mida(j,i) / ntota(j,i) ) * 100.0 pct_loa(j,i) = ( n_loa(j,i) / ntota(j,i) ) * 100.0 end if if(nw_tota(j,i) .gt. 0.0) then pctw_utlsa(j,i) = ( nw_utlsa(j,i) / nw_tota(j,i) ) * 100.0 end if if(nl_tota(j,i) .gt. 0.0) then pctl_utlsa(j,i) = ( nl_utlsa(j,i) / nl_tota(j,i) ) * 100.0 end if if(n_hia(j,i) .gt. 0.0) then mean_ctpah(j,i) = sum_ctpah(j,i) / n_hia(j,i) mean_ecaah(j,i) = sum_ecaah(j,i) / n_hia(j,i) end if if(n_mida(j,i) .gt. 0.0) then mean_ctpam(j,i) = sum_ctpam(j,i) / n_mida(j,i) mean_ecaam(j,i) = sum_ecaam(j,i) / n_mida(j,i) end if if(n_loa(j,i) .gt. 0.0) then mean_ctpal(j,i) = sum_ctpal(j,i) / n_loa(j,i) mean_ecaal(j,i) = sum_ecaal(j,i) / n_loa(j,i) end if if(n_hiavha(j,i) .gt. 0.0) then mean_avhctpah(j,i) = sum_avhctpah(j,i) / n_hiavha(j,i) end if if(nretd(j,i) .gt. 0.0) then mean_ctpd(j,i) = sum_ctpd(j,i) / nretd(j,i) mean_tctd(j,i) = sum_tctd(j,i) / nretd(j,i) mean_ecad(j,i) = sum_ecad(j,i) / nretd(j,i) end if if(n_avhrr_ctpd(j,i) .gt. 0.0) then mean_avhrr_ctpd(j,i) = sum_avhrr_ctpd(j,i) / n_avhrr_ctpd(j,i) end if if(ntotd(j,i) .gt. 0.0) then pct_cldd(j,i) = ( nretd(j,i) / ntotd(j,i) ) * 100.0 pct_hid(j,i) = ( n_hid(j,i) / ntotd(j,i) ) * 100.0 pct_hiavhd(j,i) = ( n_hiavhd(j,i) / ntotd(j,i) ) * 100.0 pct_midd(j,i) = ( n_midd(j,i) / ntotd(j,i) ) * 100.0 pct_lod(j,i) = ( n_lod(j,i) / ntotd(j,i) ) * 100.0 end if if(nw_totd(j,i) .gt. 0.0) then pctw_utlsd(j,i) = ( nw_utlsd(j,i) / nw_totd(j,i) ) * 100.0 end if if(nl_totd(j,i) .gt. 0.0) then pctl_utlsd(j,i) = ( nl_utlsd(j,i) / nl_totd(j,i) ) * 100.0 end if if(n_hid(j,i) .gt. 0.0) then mean_ctpdh(j,i) = sum_ctpdh(j,i) / n_hid(j,i) mean_ecadh(j,i) = sum_ecadh(j,i) / n_hid(j,i) end if if(n_midd(j,i) .gt. 0.0) then mean_ctpdm(j,i) = sum_ctpdm(j,i) / n_midd(j,i) mean_ecadm(j,i) = sum_ecadm(j,i) / n_midd(j,i) end if if(n_lod(j,i) .gt. 0.0) then mean_ctpdl(j,i) = sum_ctpdl(j,i) / n_lod(j,i) mean_ecadl(j,i) = sum_ecadl(j,i) / n_lod(j,i) end if if(n_hiavhd(j,i) .gt. 0.0) then mean_avhctpdh(j,i) = sum_avhctpdh(j,i) / n_hiavhd(j,i) end if c------------------------------------------------------------------------------- c Transfer data to output array. outdata(j,i,1) = mean_ctpa(j,i) outdata(j,i,2) = mean_ctpah(j,i) outdata(j,i,3) = mean_ctpam(j,i) outdata(j,i,4) = mean_ctpal(j,i) outdata(j,i,5) = mean_ctpd(j,i) outdata(j,i,6) = mean_ctpdh(j,i) outdata(j,i,7) = mean_ctpdm(j,i) outdata(j,i,8) = mean_ctpdl(j,i) outdata(j,i,9) = mean_ecaa(j,i) outdata(j,i,10) = mean_ecaah(j,i) outdata(j,i,11) = mean_ecaam(j,i) outdata(j,i,12) = mean_ecaal(j,i) outdata(j,i,13) = mean_ecad(j,i) outdata(j,i,14) = mean_ecadh(j,i) outdata(j,i,15) = mean_ecadm(j,i) outdata(j,i,16) = mean_ecadl(j,i) outdata(j,i,17) = mean_tcta(j,i) outdata(j,i,18) = mean_tctd(j,i) outdata(j,i,19) = pct_clda(j,i) outdata(j,i,20) = pct_hia(j,i) outdata(j,i,21) = pct_mida(j,i) outdata(j,i,22) = pct_loa(j,i) outdata(j,i,23) = pct_cldd(j,i) outdata(j,i,24) = pct_hid(j,i) outdata(j,i,25) = pct_midd(j,i) outdata(j,i,26) = pct_lod(j,i) outdata(j,i,27) = pctw_utlsa(j,i) outdata(j,i,28) = pctw_utlsd(j,i) outdata(j,i,29) = pctl_utlsa(j,i) outdata(j,i,30) = pctl_utlsd(j,i) outdata(j,i,31) = mean_avhrr_ctpa(j,i) outdata(j,i,32) = mean_avhrr_ctpd(j,i) outdata(j,i,33) = pct_hiavha(j,i) outdata(j,i,34) = pct_hiavhd(j,i) outdata(j,i,35) = mean_avhctpah(j,i) outdata(j,i,36) = mean_avhctpdh(j,i) enddo enddo c------------------------------------------------------------------------------- c do i = 1, 360 c do j = 1, 720 c write(*,'(/,2i10,2f12.3)') i,j,nreta(j,i), nretd(j,i) c write(*,'(4f12.6)') outdata(j,i,1), outdata(j,i,5), c * outdata(j,i,31), outdata(j,i,36) c enddo c enddo c------------------------------------------------------------------------------- c write(*,'(1x)') c do i = 1, 10 c if(ncfa .gt. 0) then c cf_norma(i) = (float(cf_dista(i)) / ncfa) * 100.0 c eca_norma(i) = (float(eca_dista(i)) / ncfa) * 100.0 c ctp_norma(i) = (float(ctp_dista(i)) / ncfa) * 100.0 c else c cf_norma(i) = -999.0 c eca_norma(i) = -999.0 c ctp_norma(i) = -999.0 c end if c if(ncfd .gt. 0) then c cf_normd(i) = (float(cf_distd(i)) / ncfd) * 100.0 c eca_normd(i) = (float(eca_distd(i)) / ncfd) * 100.0 c ctp_normd(i) = (float(ctp_distd(i)) / ncfd) * 100.0 c else c cf_normd(i) = -999.0 c eca_normd(i) = -999.0 c ctp_normd(i) = -999.0 c end if c write(*,'(6i15)') cf_dista(i), cf_distd(i), eca_dista(i), c * eca_distd(i), ctp_dista(I), ctp_distd(i) c write(*,'(6f12.2)') cf_norma(i), cf_normd(i), eca_norma(i), c * eca_normd(i), ctp_norma(i), ctp_normd(i) c enddo c------------------------------------------------------------------------------- c Output stats to binary file. open(40, file=outfile, form='unformatted', access='sequential') write(40) outdata close(40) c------------------------------------------------------------------------------- go to 200 100 continue 200 close (20) end