program make_global_monthly_cldprds implicit none real*4 dtr parameter (dtr = 3.14159/180.0) character*120 Input_File, parm, FileName integer Number_of_Files, FileCounter, ierr, i, j, ij, jj, kj, * month_number, bad_month(120) real*4 indata(720,360,36), nmean, val1, val2, zsum, znum, zavg, * uwan, uwdn, ulan, uldn, means(4), zsums(4), znums(4), * zavgs(4), wtzsums(4), wtsums(4), glbavgs(4), * rlat, wt, wtzsum, wtsum, glbavg real*4 sum_months(12,4), num_months(12,4), avg_months(12,4) real*4 sum_month(12), num_month(12), avg_month(12) real*4 sum, num data bad_month /0,0,0,0,0,0,0,0,0,0,0,0, * 0,0,0,0,0,0,0,0,0,0,0,0, * 0,0,0,0,0,0,0,0,0,0,0,0, * 0,0,0,0,0,0,0,0,0,0,0,0, * 0,0,0,0,0,0,0,0,0,0,0,0, * 0,0,0,0,0,0,0,0,0,0,0,0, * 0,0,0,0,0,0,0,0,0,0,0,0, * 0,0,0,0,0,0,0,0,0,0,0,0, * 0,0,0,0,0,0,0,0,0,0,0,0, * 0,0,0,0,0,0,0,0,0,0,0,0/ c data bad_month /0,0,0,0,0,0,0,1,1,1,1,1, c * 1,1,0,0,0,1,0,0,0,0,0,0, c * 0,1,0,0,0,0,0,0,0,0,0,0, c * 0,1,0,0,0,0,0,0,0,0,1,1, c * 0,0,0,1,0,0,0,0,0,0,0,0, c * 0,0,0,0,0,0,0,0,0,0,0,0, c * 0,0,0,0,0,0,0,0,0,0,0,0, c * 0,0,0,0,0,0,0,0,0,0,0,0, c * 0,0,0,0,0,0,0,0,0,0,0,0, c * 0,0,0,0,0,1,1,1,1,1,1,1/ data sum_month /12*0.0/, num_month /12*0.0/ data sum_months /48*0.0/, num_months /48*0.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 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 c do FileCounter = 1 , 1 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 '', + A100,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 '', + A100,i10)') FileName, ierr go to 100 end if c------------------------------------------------------------------------------- c Loop through data the data. c For now, only 60S-60N for CTPs. c Use 50S-50N for UTLS clouds (zones 80-280). wtzsum = 0.0 wtsum = 0.0 wtzsums(1) = 0.0 wtzsums(2) = 0.0 wtzsums(3) = 0.0 wtzsums(4) = 0.0 wtsums(1) = 0.0 wtsums(2) = 0.0 wtsums(3) = 0.0 wtsums(4) = 0.0 do j = 60, 300 c do j = 80, 280 c Tropics only (30S-30N, zones 120-240). c do j = 120, 240 zsum = 0.0 znum = 0.0 zsums(1) = 0.0 zsums(2) = 0.0 zsums(3) = 0.0 zsums(4) = 0.0 znums(1) = 0.0 znums(2) = 0.0 znums(3) = 0.0 znums(4) = 0.0 do i = 1, 720 c Longitudes 120W-30W) c do i = 480, 660 means(1) = -999.0 means(2) = -999.0 means(3) = -999.0 means(4) = -999.0 c Get mean of monthly AN and DN high cloud frequencies. val1 = indata(i,j,20) val2 = indata(i,j,24) c Get mean of monthly AN and DN overall cloud frequencies. c val1 = indata(i,j,19) c val2 = indata(i,j,23) c Get mean of monthly AN and DN UTLS cloud frequencies. c val1 = indata(i,j,27) c val2 = indata(i,j,28) uwan = indata(i,j,27) uwdn = indata(i,j,28) ulan = indata(i,j,29) uldn = indata(i,j,30) num = 0.0 sum= 0.0 c AN + DN c if(val1 .gt. -990.0 .and. val2 .gt. -990.0) then c nmean = (val1 + val2) / 2.0 c else if(val1 .gt. -990.0) then c nmean = val1 c else if(val2 .gt. -990.0) then c nmean = val2 c else c nmean = -999.0 c end if c AN + DN, land and water together. c if(uwan .gt. -990.0) then c num = num + 1.0 c sum = sum + uwan c end if c if(ulan .gt. -990.0) then c num = num + 1.0 c sum = sum + ulan c end if c if(uwdn .gt. -990.0) then c num = num + 1.0 c sum = sum + uwdn c end if c if(uldn .gt. -990.0) then c num = num + 1.0 c sum = sum + uldn c end if c if(num .gt. 0.0) then c nmean = sum / num c else c nmean = -990.0 c end if c AN only. c if(val1 .gt. -990.0) then c nmean = val1 c else c nmean = -999.0 c end if c AN only, land and water together. c if(uwan .gt. -990.0 .and. ulan .gt. -990.0) then c nmean = (uwan + ulan) / 2.0 c else if(uwan .gt. -990.0) then c nmean = uwan c else if(ulan .gt. -990.0) then c nmean = ulan c else c nmean = -999.0 c end if c DN only. if(val2 .gt. -990.0) then nmean = val2 else nmean = -999.0 end if c DN only, land and water together. c if(uwdn .gt. -990.0 .and. uldn .gt. -990.0) then c nmean = (uwdn + uldn) / 2.0 c else if(uwdn .gt. -990.0) then c nmean = uwdn c else if(uldn .gt. -990.0) then c nmean = uldn c else c nmean = -999.0 c end if c Land AN and DN, water AN and DN, separately. c if(uwan .gt. -990.0) then c means(1) = uwan c end if c if(uwdn .gt. -990.0) then c means(2) = uwdn c end if c if(ulan .gt. -990.0) then c means(3) = ulan c end if c if(uldn .gt. -990.0) then c means(4) = uldn c end if c Sum all valid values in the current latitude zone. if(nmean .gt. -990.0) then zsum = zsum + nmean znum = znum + 1.0 end if c write(*,'(''CFs: '',2i5,5f10.2)') i, j, val1, val2, nmean, znum, zsum c do ij = 1, 4 c if(means(ij) .gt. -990.0) then c zsums(ij) = zsums(ij) + means(ij) c znums(ij) = znums(ij) + 1.0 c end if c enddo c write(*,'(''CFs: '',2i5,4f10.2)') i, j, (means(jj),jj=1,4) c write(*,'(8f10.2)') (znums(jj),jj=1,4), (zsums(jj),jj=1,4) enddo c Get zonal monthly mean. if(znum .gt. 0.0) then zavg = zsum / znum else zavg = -999.0 end if c do jj = 1, 4 c if(znums(jj) .gt. 0.0) then c zavgs(jj) = zsums(jj) / znums(jj) c else c zavgs(jj) = -999.0 c end if c write(*,'(''zavgs: '', i5,3f15.4)') j, znums(jj), zsums(jj), c * zavgs(jj) c enddo c write(*,'(/)') c Get weighted zonal sum. if(zavg .gt. -990.0) then c Get zonal (area) weight. rlat = 90.0 - (j*0.5 - 0.25) wt = cos(rlat * dtr) c Sum up weighted zonal means. wtzsum = wtzsum + (zavg * wt) wtsum = wtsum + wt end if c write(*,'(''sums: '',5f12.4)') rlat, zavg, wt, wtzsum, wtsum c do kj = 1, 4 c if(zavgs(kj) .gt. -990.0) then c rlat = 90.0 - (j*0.5 - 0.25) c wt = cos(rlat * dtr) c wtzsums(kj) = wtzsums(kj) + (zavgs(kj) * wt) c wtsums(kj) = wtsums(kj) + wt c end if c enddo enddo c------------------------------------------------------------------------------- c Get global average. if(wtsum .gt. 0.0) then glbavg = wtzsum / wtsum else glbavg = -999.0 end if write(*,'(i5,3f10.2)') FileCounter, wtzsum, wtsum, glbavg month_number = mod(FileCounter, 12) if(month_number .eq. 0) month_number = 12 if(glbavg .ge. 0.0 .and. bad_month(FileCounter) .eq. 0) then sum_month(month_number) = sum_month(month_number) + glbavg num_month(month_number) = num_month(month_number) + 1.0 end if c do ij = 1, 4 c if(wtsums(ij) .gt. 0.0) then c glbavgs(ij) = wtzsums(ij) / wtsums(ij) c else c glbavgs(ij) = -999.0 c end if c write(*,'(i5,3f10.2)') FileCounter, wtzsums(ij), wtsums(ij), glbavgs(ij) c if(glbavgs(ij) .ge. 0.0 .and. bad_month(FileCounter) .eq. 0) then c sum_months(month_number, ij) = sum_months(month_number, ij) + glbavgs(ij) c num_months(month_number, ij) = num_months(month_number, ij) + 1.0 c end if c enddo c write(*,'(2i5,4f10.2)') FileCounter, month_number, (glbavgs(jj),jj=1,4) c------------------------------------------------------------------------------- enddo do ij = 1, 12 c do jj = 1, 4 c if(num_months(ij,jj) .gt. 0.0) then c avg_months(ij,jj) = sum_months(ij,jj) / num_months(ij,jj) c else c avg_months(ij,jj) = -999.0 c end if c enddo c write(*,'(i5,4f10.2)') ij, (avg_months(ij,kj),kj=1,4) if(num_month(ij) .gt. 0.0) then avg_month(ij) = sum_month(ij) / num_month(ij) else avg_month(ij) = -999.0 end if write(*,'(i5,4f10.2)') ij, avg_month(ij) enddo go to 200 100 continue 200 close (20) c------------------------------------------------------------------------------- end