Page 1 Source Listing AVHRR 2012-12-13 18:36 avhrr.f90 1 MODULE GAC_1B_PROC 2 3 implicit none 4 5 ! Include machine dependent parameters. 6 include 'gac1b.inc' ! Header and data record definition 613 include 'rfac.inc' ! Record length divisor 614 615 ! Declare/set parameters. 616 ! avh_mxpix = total number of bytes (4608) in AVHRR GAC data record 617 ! cavh_size = number of 4-byte words in avh_mxpix bytes (4608/4=1152) 618 ! nid,nnd= number of arguments in arrays in DATTIM call. 619 ! mch = number of channels 620 ! mpos = number of spots (positions) on a scan line 621 ! 637 integer, parameter :: real_32=selected_real_kind(6,37) 638 integer, parameter :: real_64=selected_real_kind(15,307) 639 integer, parameter :: mch=5,mpos=409,maxread=200000 640 integer, parameter :: nreal=22,ntot=nreal+mch,bit_qc=0 641 integer, parameter :: stdout=6,lu1b=11,wbf_sea_a_lcr=51,wbf_lnd_o_cld=52 642 integer, parameter :: lundx=20,nprint=500,nmon=12 643 integer, parameter :: nlat_msk=2881,nlon_msk=5761,nlat_sst=360,nlon_sst=720 644 645 real, parameter :: lon1_msk=-180.0,lat1_msk=90.0,lon2_msk=180.0,lat2_msk=-90.0 646 real, parameter :: lon1_sst=0.25,lat1_sst=-89.75,lon2_sst=359.75,lat2_sst=89.75 647 real, parameter :: tlo=100.,thi=400.,vislo=0.01,vishi=100. 648 real, parameter :: dxy=0.5,dtr=3.141593,bmiss = 10E11,ttp=271.5 649 650 ! Variables 651 ! 652 integer :: lsubdrp,ierr,lapchrp,ltnkidp,ltnkid,lsubdr,lapchr,kdate,jdate 653 integer :: cld_bit,clavr_cld,id_ncep,itime 654 integer :: pyear0,pddd0,pyear,pddd,yyyy,mm,dd,hh,atime,nbf,ilat,ilon,iret 655 integer :: idate,rtgsst,navysst,iline,iyear,iddd,jyd,jtype,j3ab,nrecs,nscan 656 integer :: nri,nrec,jmd1,jmd2,jmd3,sathgt,jsat,jsat0,nlo,line,ioff,i,j,k,n,ios 657 integer :: imon,jmon,im,idum,nlev,flag,missing,lu_ncepsst,iy_ncep,im_ncep 658 !DAK 659 integer :: ilimb 660 !DAK 661 662 integer*1 :: land_sea_tag 663 664 real(real_64) scale,scale5,scale6,scale7,scale9,scale12,sctime 665 666 logical :: ex,lfirst 667 668 character(len=80) :: APPCHR,APPCHRP 669 character(len=12) :: SUBDIR,TANKID,SUBDIRP,TANKIDP 670 character(len=10) :: catime 671 character(len=8) :: cncepsst_date,statid,cid,TLFLAG,TLFLAGP,SUBSET,SUBSETP 672 character(len=4) :: cyyyy 673 character(len=2) :: cmm,cdd,chh,csat 674 675 ! Arrays 676 ! 677 integer, dimension(mch,mpos) :: counts 678 integer, dimension(mch) :: ichan Page 2 Source Listing AVHRR 2012-12-13 18:36 avhrr.f90 679 integer, dimension(6) :: good_lines,bad_lines 680 integer, dimension(-1:10), public :: lu_bufr 681 integer, dimension(mpos) :: cld 682 integer, dimension(-1:0) :: pyyyyddd,pyyyy,pyy,pmm,pdd 683 integer, dimension(-1:0) :: sst_date,lu_sst 684 685 integer idt(3),ndt(7),intime(8),outime(8) 686 687 integer*1, dimension(nlon_msk,nlat_msk) :: lst 688 689 real, dimension(nmon,nlat_sst,nlon_sst) :: clima 690 real, dimension(mpos) :: solzen,satzen,rlocaz,alat,alon,avh_qc 691 real, dimension(mch,mpos) :: avh_rad,avh_bt 692 693 real(8), dimension(ntot) :: rdata 694 695 real rinc(5) 696 697 character(len=2), dimension(-1:100), public :: cpmm,cpdd 698 character(len=2), dimension(6) :: chn_name 699 character(len=4), dimension(-1:100), public :: cpyyyy 700 character(len=10),dimension(20) :: cbufr_time 701 702 ! Data assignment 703 ! 704 data chn_name/'01','02','3B','04','05','3A'/ 705 data good_lines/6*0/ 706 data bad_lines/6*0/ 707 data ichan / 1, 2, 3, 4, 5/ 708 data nrec/0/ 709 data lfirst /.false./ 710 711 712 713 contains 714 715 SUBROUTINE AVHRR(SUBSET,SUBSETP) 716 !$$$ subprogram documentation block 717 ! 718 ! SUBPROGRAM: AVHRR 719 ! PRGMMR: KEYSER ORG: NP22 DATE: 2006-10-19 720 ! 721 ! ABSTRACT: Decodes a single scan line from a raw AVHRR 1B format file and 722 ! stores report (selected spot) observations into array for later encoding 723 ! into output BUFR file. 724 ! 725 ! PROGRAM HISTORY LOG: 726 ! 2003-01-29 Xu Li Original author 727 ! 2006-10-19 Keyser Improved docblocks and comments 728 ! 729 ! USAGE: CALL AVHRR(SUBSET,SUBSETP) 730 ! INPUT ARGUMENT LIST: 731 ! SUBSET - BUFR message type for clear and oceanic reports 732 ! SUBSETP - BUFR message type for cloudy or overland reports 733 ! 734 ! REMARKS: None 735 ! Page 3 Source Listing AVHRR 2012-12-13 18:36 avhrr.f90 736 ! ATTRIBUTES: 737 ! LANGUAGE: FORTRAN 90 (free format) 738 ! MACHINE: NCEP WCOSS 739 ! 740 !$$$ 741 742 implicit none 743 744 character(len=8) :: SUBSET,SUBSETP 745 746 ! Extract scan line number, date/time, position, and type 747 ! ------------------------------------------------------- 748 749 iline = avh_scnlin ! scan line number 750 iyear = avh_scnlinyr ! scan line year 751 iddd = avh_scnlindy ! scan line day of year 752 itime = avh_scnlintime ! scan line UTC time of day in 753 ! milliseconds 754 sctime = 1.d-3*itime 755 jyd = 1000*iyear + iddd 756 757 ! Get year : ndt(1) 758 ! month : ndt(2) 759 ! day : ndt(3) 760 ! hour : ndt(4) 761 ! minute : ndt(5) 762 ! second : ndt(6) 763 ! milisecond : ndt(7) 764 ! 765 !!!!! call dattim(idt,ndt) 766 767 im = ndt(2) 768 769 ! Determine the selection mode for Channel 3 (A or B) 770 ! --------------------------------------------------- 771 772 j3ab = ibits(avh_scnlinbit,0,1) ! 0 = 3B; 1 = 3A 773 774 ! Extract navigation data 775 ! ----------------------- 776 777 scale = 1.d-1 778 sathgt = avh_scalti*scale ! spacecraft altitude (km) 779 780 ! Extract earth location data 781 ! --------------------------- 782 783 scale = 1.d-4 784 do i = 5,mpos,8 785 alat(i) = avh_pos(1,(i-5)/8+1)*scale 786 alon(i) = avh_pos(2,(i-5)/8+1)*scale 787 end do 788 789 ! Extract angular relationships 790 ! ----------------------------- 791 792 scale = 1.d-2 Page 4 Source Listing AVHRR 2012-12-13 18:36 avhrr.f90 793 do i = 5,mpos,8 794 solzen(i) = avh_ang(1,(i-5)/8+1)*scale 795 satzen(i) = avh_ang(2,(i-5)/8+1)*scale 796 rlocaz(i) = avh_ang(3,(i-5)/8+1)*scale 797 end do 798 799 ! Angles and lat/lon are only available for 51 pixels in one AVHRR GAC scan 800 ! line (mpos pixels), interpolation is needed to get the lat/lon for every 801 ! pixel 802 ! ------------------------------------------------------------------------- 803 804 call lag(solzen,0) 805 call lag(satzen,0) 806 call lag(rlocaz,0) 807 808 call lag(alat,0) 809 call lag(alon,1) 810 811 ! Extract AVHRR counts 812 ! -------------------- 813 814 ioff = -4 815 do i = 1, 408, 3 816 ioff = ioff + 5 817 818 ! Unpack channel 1 819 ! ---------------- 820 821 counts(1,i+0) = ibits(avh_hrpt(ioff+0),20,10) 822 counts(1,i+1) = ibits(avh_hrpt(ioff+1), 0,10) 823 counts(1,i+2) = ibits(avh_hrpt(ioff+3),10,10) 824 825 ! Unpack channel 2 826 ! ---------------- 827 828 counts(2,i+0) = ibits(avh_hrpt(ioff+0),10,10) 829 counts(2,i+1) = ibits(avh_hrpt(ioff+2),20,10) 830 counts(2,i+2) = ibits(avh_hrpt(ioff+3), 0,10) 831 832 ! Unpack channel 3 (A or B) 833 ! ------------------------- 834 835 counts(3,i+0) = ibits(avh_hrpt(ioff+0), 0,10) 836 counts(3,i+1) = ibits(avh_hrpt(ioff+2),10,10) 837 counts(3,i+2) = ibits(avh_hrpt(ioff+4),20,10) 838 839 ! Unpack channel 4 840 ! ---------------- 841 842 counts(4,i+0) = ibits(avh_hrpt(ioff+1),20,10) 843 counts(4,i+1) = ibits(avh_hrpt(ioff+2), 0,10) 844 counts(4,i+2) = ibits(avh_hrpt(ioff+4),10,10) 845 846 ! Unpack channel 5 847 ! ---------------- 848 849 counts(5,i+0) = ibits(avh_hrpt(ioff+1),10,10) Page 5 Source Listing AVHRR 2012-12-13 18:36 avhrr.f90 850 counts(5,i+1) = ibits(avh_hrpt(ioff+3),20,10) 851 counts(5,i+2) = ibits(avh_hrpt(ioff+4), 0,10) 852 853 enddo 854 855 ioff = ioff + 5 ! ioff = 681 856 857 counts(1,mpos) = ibits(avh_hrpt(ioff+0),20,10) 858 counts(2,mpos) = ibits(avh_hrpt(ioff+0),10,10) 859 counts(3,mpos) = ibits(avh_hrpt(ioff+0), 0,10) 860 counts(4,mpos) = ibits(avh_hrpt(ioff+1),20,10) 861 counts(5,mpos) = ibits(avh_hrpt(ioff+1),10,10) 862 863 ! (1) Convert counts into radiances and albedo/Tb 864 ! (may contain missing values: bad calibration ...); 865 ! (2) Save the quality indicator for each pixel : avh_qc(i),i = 1, mpos 866 ! (3) Save the statistics of the number of good/bad lines: 867 ! good_lines(i) and bad_lines(i), i = 1, 6 868 ! -------------------------------------------------------------------- 869 870 call gac_lbc(iline) 871 872 ! Decode CLAVR cloud detection information (flags) 873 ! ------------------------------------------------ 874 875 cld = 7 ! 7 = missing 876 cld_bit = ibits(clv_bit,0,1) 877 878 if ( cld_bit == 1 ) then 879 do i = 1, 401, 8 880 n = (i-1)/8 + 1 ! 1 2 3 4 ... 50 51 881 do j = 0, 7 882 ! i + j = 1 2 ... 8 9 10 ... 16 ... 401 ... 408 883 cld(i+j) = ibits(ccmc(n),14-2*j,2) 884 enddo 885 enddo 886 cld(mpos) = ibits(ccmc(52),14,2) 887 endif 888 889 ! Exclude the pixels overland and definitely cloudy 890 ! ------------------------------------------------- 891 892 do i = 1,mpos 893 894 if (avh_qc(i) == 0.0) then 895 ilat = nint((nlat_msk-1)*(alat(i)-lat1_msk)/(lat2_msk-lat1_msk)) + 1 896 ilon = nint((nlon_msk-1)*(alon(i)-lon1_msk)/(lon2_msk-lon1_msk)) + 1 897 ilat = max(1,min(ilat,nlat_msk)) 898 ilon = max(1,min(ilon,nlon_msk)) 899 land_sea_tag = lst(ilon,ilat) 900 901 if ( land_sea_tag == 1 ) then 902 avh_qc(i) = 2.0 ! exclude overland pixels 903 elseif ( land_sea_tag == 0 ) then 904 if ( cld(i) == 3 .or. cld(i) == 2 ) then 905 clavr_cld = clavr_cld + 1 906 avh_qc(i) = 2.0 ! cloudy Page 6 Source Listing AVHRR 2012-12-13 18:36 avhrr.f90 907 endif 908 endif 909 endif 910 enddo 911 912 ! Write AVHRR data for each spot position on current scan line 913 ! ------------------------------------------------------------ 914 915 do i = 1,mpos 916 917 !DAK 918 ! Temporary fix by DAK to exclude any "spots" on the limb of the scans 919 ! because the extrapolations may not be done properly in subroutine LAG 920 ! (e.g., longitude which can vary greatly from one reported spot to the 921 ! next at very high latitudes) - Xu Li is working on a permanent fix 922 ! ---------------------------------------------------------------------- 923 if(i.lt.5.or.i.gt.(mpos-4)) then 924 ilimb = ilimb + 1 925 !ppppppp 926 !!!!! print *, 'On scan ',iline,'; toss this spot - on limb, pos = ',i 927 !ppppppp 928 cycle 929 endif 930 !DAK 931 932 if (avh_qc(i) == 0.0 .or. avh_qc(i) == 2.0) then 933 934 idt(1) = itime/1000 935 idt(2) = mod(jyd,1000) 936 idt(3) = jyd/1000 937 938 call dattim(idt,ndt) 939 intime(1:3) = ndt(1:3) 940 intime(4) = 0 941 intime(5:7) = ndt(4:6) 942 intime(8) = mod(itime,1000) 943 944 rinc(1:4) = 0.0 945 rinc(5) = real(500000 + 125*i) / 1000. 946 call w3movdat(rinc,intime,outime) 947 948 ! Assign array for BUFR 949 ! --------------------- 950 951 rdata( 1) = outime(1) ! 4-digit year 952 rdata( 2) = outime(2) ! month of a year 953 rdata( 3) = outime(3) ! day of a month 954 rdata( 4) = outime(5) ! hour of a day 955 rdata( 5) = outime(6) ! minute of a hour 956 ! second of a minute (high-res) 957 rdata( 6) = 1.0_8 * outime(7) + 0.001_8 * & 958 (real(outime(8)) + rinc(5) - int(rinc(5))) 959 960 !!!!! print *,'nrec, rdata( 6) : ',nrec, rdata(6) 961 962 rdata( 7) = alat(i) ! latitude 963 rdata( 8) = alon(i) ! longitude Page 7 Source Listing AVHRR 2012-12-13 18:36 avhrr.f90 964 rdata( 9) = jsat ! Satellite ID 965 rdata(10) = jtype ! Instrument ID (2 = AVHRR) 966 rdata(11) = iline ! Number of scan line 967 rdata(12) = i ! Number of the field of view 968 rdata(13) = sathgt*1000 ! Satellite altitude 969 rdata(14) = satzen(i) ! satellite zenith angle 970 rdata(15) = solzen(i) ! solar zenith angle 971 rdata(16) = j3ab ! Mode of 3A/3B: 0 = 3B, 1 = 3A 972 rdata(17) = cld(i) ! CLAVR cloud flag: 973 ! 0 = clear, 974 ! 1 = probably clear, 975 ! 2 = probably cloudy, 976 ! 3 = cloudy 977 rdata(18) = avh_bt(1,i) ! AVHRR (GAC) for Ch-1 albedo 978 rdata(19) = avh_bt(2,i) ! AVHRR (GAC) for Ch-2 albedo 979 rdata(20) = avh_bt(3,i) ! AVHRR (GAC) for Ch-3 alb/Tb 980 rdata(21) = avh_bt(4,i) ! AVHRR (GAC) for Ch-4 Tb 981 rdata(22) = avh_bt(5,i) ! AVHRR (GAC) for Ch-5 Tb 982 983 nrec = nrec + 1 984 985 !!!!! write(*,'(2I8,5f16.2)') clavr_cld,cld(i),avh_bt(1,i),avh_bt(2,i), & 986 !!!!! avh_bt(3,i),avh_bt(4,i),avh_bt(5,i) 987 988 call bufr1b(avh_qc(i),subset,subsetp) ! Encode data in BUFR 989 endif 990 end do 991 992 END SUBROUTINE AVHRR Page 8 Source Listing AVHRR 2012-12-13 18:36 Entry Points avhrr.f90 ENTRY POINTS Name gac_1b_proc_mp_avhrr_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ALAT Local 164 R(4) 4 1 409 164,187,274,341 ALON Local 165 R(4) 4 1 409 165,188,275,342 AVHRR Subr 94 AVH_ANG Scalar 173 I(2) 2 2 153 COM 173,174,175 AVH_BT Local 356 R(4) 4 2 2045 356,357,358,359,360,754,793,805,82 6,837,875,886,899,922,933,968,979, 990,1024,1035,1046 AVH_HRPT Scalar 200 I(4) 4 1 682 COM 200,201,202,207,208,209,214,215,21 6,221,222,223,228,229,230,236,237, 238,239,240 AVH_POS Scalar 164 I(4) 4 2 102 COM 164,165 AVH_QC Local 273 R(4) 4 1 409 273,281,285,311,367,1055,1064 AVH_SCALTI Scalar 157 I(2) 2 scalar COM 157 AVH_SCNLIN Scalar 128 I(2) 2 scalar COM 128 AVH_SCNLINBIT Scalar 151 I(2) 2 scalar COM 151 AVH_SCNLINDY Scalar 130 I(2) 2 scalar COM 130 AVH_SCNLINTIME Scalar 131 I(4) 4 scalar COM 131 AVH_SCNLINYR Scalar 129 I(2) 2 scalar COM 129 CCMC Scalar 262 I(2) 2 1 52 COM 262,265 CLAVR_CLD Local 284 I(4) 4 scalar 284 CLD Local 254 I(4) 4 1 409 254,262,265,283,351 CLD_BIT Local 255 I(4) 4 scalar 255,257 CLV_BIT Scalar 255 I(4) 4 scalar COM 255 COUNTS Local 200 I(4) 4 2 2045 200,201,202,207,208,209,214,215,21 6,221,222,223,228,229,230,236,237, 238,239,240,793,826,871,922,964,10 19 I Local 163 I(4) 4 scalar 163,164,165,172,173,174,175,194,20 0,201,202,207,208,209,214,215,216, 221,222,223,228,229,230,258,259,26 2,271,273,274,275,281,283,285,294, 302,311,324,341,342,346,348,349,35 1,356,357,358,359,360,367,1194,119 5,1196,1199,1202,1203,1210,1211,12 12,1214,1238,1239,1240,1243,1246,1 247,1254,1255,1256,1258,1277,1278, 1279,1282,1285,1286,1293,1294,1295 ,1297,1314,1315,1316,1319,1322,132 3,1330,1331,1332,1334,1351,1352,13 53,1356,1359,1360,1367,1368,1369,1 371,1388,1389,1390,1393,1396,1397, 1404,1405,1406,1408 IBITS Func 151 scalar 151,200,201,202,207,208,209,214,21 5,216,221,222,223,228,229,230,236, Page 9 Source Listing AVHRR 2012-12-13 18:36 Symbol Table avhrr.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 237,238,239,240,255,262,265 IDDD Local 130 I(4) 4 scalar 130,134 IDT Local 313 I(4) 4 1 3 313,314,315,317 ILAT Local 274 I(4) 4 scalar 274,276,278 ILIMB Local 303 I(4) 4 scalar 303 ILINE Local 128 I(4) 4 scalar 128,249,345 ILON Local 275 I(4) 4 scalar 275,277,278 IM Local 146 I(4) 4 scalar 146 INT Func 337 scalar 337 INTIME Local 318 I(4) 4 1 8 318,319,320,321,325 IOFF Local 193 I(4) 4 scalar 193,195,200,201,202,207,208,209,21 4,215,216,221,222,223,228,229,230, 234,236,237,238,239,240 ITIME Local 131 I(4) 4 scalar 131,133,313,321 IYEAR Local 129 I(4) 4 scalar 129,134,1500 J Local 260 I(4) 4 scalar 260,262,1201,1202,1203,1245,1246,1 247,1284,1285,1286,1321,1322,1323, 1358,1359,1360,1395,1396,1397 J3AB Local 151 I(4) 4 scalar 151,350 JSAT Local 343 I(4) 4 scalar 343 JTYPE Local 344 I(4) 4 scalar 344 JYD Local 134 I(4) 4 scalar 134,314,315 LAND_SEA_TAG Local 278 I(1) 1 scalar 278,280,282 LAT1_MSK Param 274 R(4) 4 scalar 274 LAT2_MSK Param 274 R(4) 4 scalar 274 LON1_MSK Param 275 R(4) 4 scalar 275 LON2_MSK Param 275 R(4) 4 scalar 275 LST Local 278 I(1) 1 2 16597441 278 MAX Func 276 scalar 276,277 MIN Func 276 scalar 276,277 MOD Func 314 scalar 314,321 MPOS Param 163 I(4) 4 scalar 56,60,69,70,163,172,236,237,238,23 9,240,265,271,294,302,752,757,792, 804,825,836,870,884,897,921,932,96 3,977,988,1018,1033,1044,1054,1063 ,1179,1188,1233,1311,1314,1319,132 1,1348,1351,1356,1358,1385,1388,13 93,1395 N Local 259 I(4) 4 scalar 259,262,457,458,459,460 NDT Local 146 I(4) 4 1 7 146,317,318,320 NINT Func 274 scalar 274,275 NLAT_MSK Param 274 I(4) 4 scalar 66,274,276 NLON_MSK Param 275 I(4) 4 scalar 66,275,277 NREC Local 362 I(4) 4 scalar 87,362 OUTIME Local 325 I(4) 4 1 8 325,330,331,332,333,334,336,337 RDATA Local 330 R(8) 8 1 27 330,331,332,333,334,336,341,342,34 3,344,345,346,347,348,349,350,351, 356,357,358,359,360,425,427,428,42 9,430,431,433,435,436,437,438,439, 443,444,445,446,447,448,449,450,45 1,452,453,454,455,464 REAL Func 324 scalar 324,337 RINC Local 323 R(4) 4 1 5 323,324,325,337 RLOCAZ Local 175 R(4) 4 1 409 175,185 SATHGT Local 157 I(4) 4 scalar 157,347 Page 10 Source Listing AVHRR 2012-12-13 18:36 Symbol Table avhrr.f90 Name Object Declared Type Bytes Dimen Elements Attributes References SATZEN Local 174 R(4) 4 1 409 174,184,348 SCALE Local 156 R(8) 8 scalar 156,157,162,164,165,171,173,174,17 5 SCTIME Local 133 R(8) 8 scalar 133 SOLZEN Local 173 R(4) 4 1 409 173,183,349 SUBSET Dummy 94 CHAR 8 scalar ARG,INOUT 367 SUBSETP Dummy 94 CHAR 8 scalar ARG,INOUT 367 W3MOVDAT Subr 325 325 Page 11 Source Listing AVHRR 2012-12-13 18:36 avhrr.f90 993 994 995 SUBROUTINE BUFR1B(MQC,SUBSET,SUBSETP) 996 !$$$ MAIN PROGRAM DOCUMENTATION BLOCK 997 ! 998 ! SUBPROGRAM: BUFR1B 999 ! PRGMMR: KEYSER ORG: NP22 DATE: 2006-10-19 1000 ! 1001 ! ABSTRACT: Generates a single BUFR subset (report) from AVHRR GAC 1B data on 1002 ! a single "spot" (on a scan line) and encodes it into output BUFR file. 1003 ! 1004 ! PROGRAM HISTORY LOG: 1005 ! 2003-01-29 Xu Li Original author 1006 ! 2006-10-19 Keyser Improved docblocks and comments 1007 ! 1008 ! USAGE: CALL BUFR1B(MQC,SUBSET,SUBSETP) 1009 ! 1010 ! INPUT ARGUMENTS: 1011 ! MQC - Real indicator for either clear and oceanic (=0.0) or cloudy or 1012 ! overland (=2.0) 1013 ! SUBSET - BUFR message type for clear and oceanic reports 1014 ! SUBSETP - BUFR message type for cloudy or overland reports 1015 ! 1016 ! REMARKS: None 1017 ! 1018 ! ATTRIBUTES: 1019 ! LANGUAGE: FORTRAN 90 (free format) 1020 ! MACHINE: NCEP WCOSS 1021 ! 1022 !$$$ 1023 1024 CHARACTER*80 HEADR 1025 CHARACTER*8 SUBSET,SUBSETP 1026 REAL INCN(5), TMBR(5), ALBD(5) 1027 REAL(8) HDR(13),BUFRF(3,5) 1028 real :: mqc 1029 1030 DATA HEADR/& 1031 'YEAR MNTH DAYS HOUR MINU SECO CLATH CLONH SAID FOVN SAZA SOZA CLAVR'/ 1032 1033 ! TRANSLATE ONE AVHRR(GAC) SPOT TO BUFR FORMAT 1034 ! ---------------------------------------------------------- 1035 ! NC021xxx | YEAR MNTH DAYS HOUR MINU 1036 ! NC021xxx ! 202129 201132 SECO 201000 202000 1037 ! NC021xxx | CLATH CLONH SAID 201129 FOVN 201000 1038 ! NC021xxx | SAZA SOZA CLAVR "AVCSEQ"5 1039 ! | 1040 ! AVCSEQ | INCN ALBD TMBR 1041 ! ----------------------------------------------------------- 1042 1043 ALBD = bmiss 1044 TMBR = bmiss 1045 1046 if ( rdata(16) == 0. ) then ! 3B 1047 1048 ALBD(1) = rdata(18) ! Ch-1 albedo 1049 ALBD(2) = rdata(19) ! Ch-2 albedo Page 12 Source Listing BUFR1B 2012-12-13 18:36 avhrr.f90 1050 TMBR(3) = rdata(20) ! Ch-3 BT 1051 TMBR(4) = rdata(21) ! Ch-4 BT 1052 TMBR(5) = rdata(22) ! Ch-5 BT 1053 1054 elseif ( rdata(16) == 1. ) then ! 3A 1055 1056 ALBD(1) = rdata(18) ! Ch-1 albedo 1057 ALBD(2) = rdata(19) ! Ch-2 albedo 1058 ALBD(3) = rdata(20) ! Ch-3 albedo 1059 TMBR(4) = rdata(21) ! Ch-4 BT 1060 TMBR(5) = rdata(22) ! Ch-5 BT 1061 1062 endif 1063 1064 HDR( 1) = rdata( 1) ! 4-digit year 1065 HDR( 2) = rdata( 2) ! month of a year 1066 HDR( 3) = rdata( 3) ! day of a month 1067 HDR( 4) = rdata( 4) ! hour of a day 1068 HDR( 5) = rdata( 5) ! minute of a hour 1069 HDR( 6) = rdata( 6) ! second of a minute 1070 HDR( 7) = rdata( 7) ! latitude 1071 HDR( 8) = rdata( 8) ! longitude 1072 HDR( 9) = rdata( 9) ! Satellite ID 1073 HDR(10) = rdata(12) ! IFOV 1074 HDR(11) = rdata(14) ! satellite zenith angle 1075 HDR(12) = rdata(15) ! solar zenith angle 1076 HDR(13) = rdata(17) ! CLAVR cloud flag 1077 1078 DO N=1,5 1079 BUFRF(1,N) = N + 47 1080 BUFRF(2,N) = ALBD(N) 1081 BUFRF(3,N) = TMBR(N) 1082 ENDDO 1083 1084 idate = & 1085 nint(rdata(1))*1000000+nint(rdata(2))*10000+nint(rdata(3))*100+nint(rdata(4)) 1086 1087 if (mqc == 0.0 ) then ! Clear and oceanic reports 1088 if ( nbf /= wbf_sea_a_lcr ) then 1089 nbf = wbf_sea_a_lcr 1090 CALL CLOSMG(wbf_lnd_o_cld,SUBSETP,idate) 1091 CALL OPENMB(wbf_sea_a_lcr,SUBSET,idate) 1092 endif 1093 elseif (mqc == 2.0 ) then ! Cloudy or overland reports 1094 if ( nbf /= wbf_lnd_o_cld ) then 1095 nbf = wbf_lnd_o_cld 1096 CALL CLOSMG(wbf_sea_a_lcr,SUBSET,idate) 1097 CALL OPENMB(wbf_lnd_o_cld,SUBSETP,idate) 1098 endif 1099 endif 1100 1101 CALL UFBINT(nbf,HDR, 13,1,IRET,HEADR) 1102 CALL UFBREP(nbf,BUFRF, 3,5,IRET,'INCN ALBD TMBR') 1103 CALL WRITCP(nbf) ! Write subset (report) into 1104 ! compressed BUFR message 1105 1106 END SUBROUTINE BUFR1B Page 13 Source Listing BUFR1B 2012-12-13 18:36 Entry Points avhrr.f90 ENTRY POINTS Name gac_1b_proc_mp_bufr1b_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ALBD Local 405 R(4) 4 1 5 422,427,428,435,436,437,459 BMISS Param 422 R(4) 4 scalar 422,423,754,759,794,805,806,827,83 7,838,885,886,898,899,923,933,934, 978,979,989,990,1034,1035,1045,104 6 BUFR1B Subr 374 367 BUFRF Local 406 R(8) 8 2 15 458,459,460,481 CLOSMG Subr 469 469,475 HDR Local 406 R(8) 8 1 13 443,444,445,446,447,448,449,450,45 1,452,453,454,455,480 HEADR Local 403 CHAR 80 scalar 409,480 IDATE Local 463 I(4) 4 scalar 463,469,470,475,476 INCN Local 405 R(4) 4 1 5 IRET Local 480 I(4) 4 scalar 480,481 MQC Dummy 374 R(4) 4 scalar ARG,INOUT 466,472 NBF Local 467 I(4) 4 scalar 467,468,473,474,480,481,482 NINT Func 464 scalar 464 OPENMB Subr 470 470,476 SUBSET Dummy 374 CHAR 8 scalar ARG,INOUT 470,475 SUBSETP Dummy 374 CHAR 8 scalar ARG,INOUT 469,476 TMBR Local 405 R(4) 4 1 5 423,429,430,431,438,439,460 UFBINT Subr 480 480 UFBREP Subr 481 481 WBF_LND_O_CLD Param 469 I(4) 4 scalar 469,473,474,476 WBF_SEA_A_LCR Param 467 I(4) 4 scalar 467,468,470,475 WRITCP Subr 482 482 Page 14 Source Listing BUFR1B 2012-12-13 18:36 avhrr.f90 1107 1108 1109 SUBROUTINE GAC_LBC(LINE) 1110 !$$$ MAIN PROGRAM DOCUMENTATION BLOCK 1111 ! 1112 ! SUBPROGRAM: GAC_LBC 1113 ! PRGMMR: KEYSER ORG: NP22 DATE: 2006-10-19 1114 ! 1115 ! ABSTRACT: For each Level 1B AVHRR scan line, converts numerical counts into 1116 ! radiances and brightness temperatures (GAC Level 1C). 1117 ! 1118 ! PROGRAM HISTORY LOG: 1119 ! 2003-01-14 Xu Li Original author 1120 ! 2006-10-19 Keyser Improved docblocks and comments 1121 ! 1122 ! USAGE: CALL GAC_LBC(LINE) 1123 ! 1124 ! INPUT ARGUMENTS: 1125 ! LINE - Scan line number 1126 ! 1127 ! REMARKS: 1128 ! Needs include files "gac1b.inc" and "cavh_cpi.inc" 1129 ! 1130 ! ATTRIBUTES: 1131 ! LANGUAGE: FORTRAN 90 (free format) 1132 ! MACHINE: NCEP WCOSS 1133 ! 1134 !$$$ 1135 1136 implicit none 1137 1138 !---- DECLARATIONS ----------------------------------------------------- 1139 1140 character*62 sccid 1141 data sccid/'%Z% %M% version %I% on %G%'/ 1142 1143 !---- ARGUMENTS -------------------------------------------------------- 1144 1145 integer line ! Scan line number 1146 1147 include 'gac1b.inc' ! Header and data record definition 1754 include 'cavh_cpi.inc' ! AVHRC1 "CPIDS" related parameters 1755 1756 !---- LOCAL VARIABLES -------------------------------------------------- 1757 1849 integer p,c ! Pixel, channel 1850 real rcount ! Earth viewed numerical count 1851 integer ncount ! Earth viewed numerical count 1852 1853 real slope ! Coeff. for visible calibration 1854 real intercept ! .... 1855 real tabalb(0:1023,3) ! Table for count to albedo 1856 1857 real k1,k2,k3 ! Coeff. conversion count ->radiance 1858 double precision nu ! Central wavenumber 1859 real radiance ! Radiance mW/cm2.st.cm-1 1860 integer expon3 ! Exponent of scaling factor for 1st Page 15 Source Listing GAC_LBC 2012-12-13 18:36 avhrr.f90 1861 ! IR cal. coeff 1862 integer expon4 ! Exponent of scaling factor for 2nd 1863 ! IR cal. coeff 1864 integer expon5 ! Exponent of scaling factor for 3rd 1865 ! IR cal. coeff 1866 real scale3 ! Scaling factor for k1 1867 real scale4 ! Scaling factor for k2 1868 real scale5 ! Scaling factor for k3 1869 !!!!! data scale3 /1.e-06/ 1870 !!!!! data scale4 /1.e-06/ 1871 !!!!! data scale5 /1.e-06/ 1872 1873 integer good_qc ! Good quality word 1874 integer bad_qc ! Bad quality word 1875 integer*4 status_channel ! avh_h_inststat2 or avh_h_inststat1 1876 logical first /.true./ 1877 integer vcoefset ! Visible coeff. set 1878 1879 save ! Save local tables and logical first 1880 1881 !---- EQUIVALENCES ----------------------------------------------------- 1882 1883 !---- FUNCTIONS -------------------------------------------------------- 1884 1885 real avh_cir_r ! Radiance to brightness temperature 1886 ! conversion (real) 1887 1888 !---- CODE ------------------------------------------------------------- 1889 1890 1891 if (first ) then 1892 1893 ! FIRST TIME IN HERE ... 1894 1895 ! Modification to correct lack of accuracy of scaling factors proposed by NOAA 1896 ! ( M. Derrien 26/01/1999) 1897 ! -- must be considered only for a transition, because we do not change the 1898 ! l1bversnb number due to CMS consideration and we don't have the new 1899 ! NESDIS scaling factors. 1900 ! This will change scaling factors only for 1B files whose data are newer 1901 ! than 27 January 1999,12 UTC date where changed at CMS. 1902 ! 1903 ! Now avh_filler2(3) stores the 3 exponents of the scaling coefficients. 1904 ! Subroutine avh_lbc will be able to read the new exponents and will 1905 ! suppose exponent 6 for all archived files. Beware of reading these new 1906 ! files without taking into account the filler2 array. 1907 ! ---------------------------------------------------------------------------- 1908 1909 ! Xu Li, 08/16/2005: From NESDIS people (Chao), NOAA satellite data format was 1910 ! updated on April 28, 2005. 1911 ! For AVHRR Ch-4 & Ch-5, IR calibration exponent of scaling 1912 ! coefficient 3 (expon5) has been changed (6 -> 7). 1913 ! ---------------------------------------------------------------------------- 1914 1915 expon3=6 1916 expon4=6 1917 expon5=7 Page 16 Source Listing GAC_LBC 2012-12-13 18:36 avhrr.f90 1918 1919 scale3 = 10. ** (-1 *expon3) 1920 scale4 = 10. ** (-1 *expon4) 1921 scale5 = 10. ** (-1 *expon5) 1922 1923 !!!!!$ if (avh_h_startdatajd.ge.17923.5) then 1924 !!!!!$ scale3 = 1.e-09 1925 !!!!!$ endif 1926 1927 ! We use the prelaunch coefficients (indice 3) 1928 ! operationnal set is 1 1929 ! test set is 2 1930 ! --------------------------------------------- 1931 1932 !!!!!!! vcoefset=3 1933 1934 ! Xu Li, 09/08/2005: change to use operational set (1) 1935 ! ---------------------------------------------------- 1936 1937 vcoefset = 1 1938 do c = 1, avh_mxvischn 1939 !!!!!!! slope = avh_calvis(1,vcoefset,c)*1.e-10 1940 !!!!!!! intercept = avh_calvis(2,vcoefset,c)*1.e-7 1941 1942 slope = avh_calvis(1,vcoefset,c)*1.e-7 1943 intercept = avh_calvis(2,vcoefset,c)*1.e-6 1944 1945 do ncount = 0 , avh_calvis(5,vcoefset,c),1 1946 tabalb(ncount,c) = (slope * float(ncount) + intercept) 1947 1948 if(tabalb(ncount,c).lt.0.) tabalb(ncount,c)=0. 1949 enddo 1950 !!!!!!! slope = avh_calvis(3,vcoefset,c)*1.e-10 1951 !!!!!!! intercept = avh_calvis(4,vcoefset,c)*1.e-7 1952 1953 slope = avh_calvis(3,vcoefset,c)*1.e-7 1954 intercept = avh_calvis(4,vcoefset,c)*1.e-6 1955 1956 do ncount = avh_calvis(5,vcoefset,c), 1023 1957 tabalb(ncount,c) = (slope * float(ncount) + intercept) 1958 1959 if(tabalb(ncount,c).lt.0.) tabalb(ncount,c)=0. 1960 enddo 1961 enddo 1962 1963 !!!!! write(*,*) 'tabalb(ncount,1) : ' 1964 !!!!! write(*,'(10F9.2)') (tabalb(ncount,1),ncount=0,1023) 1965 1966 !!!!! write(*,*) 'tabalb(ncount,2) : ' 1967 !!!!! write(*,'(10F9.2)') (tabalb(ncount,2),ncount=0,1023) 1968 1969 !!!!! write(*,*) 'tabalb(ncount,3) : ' 1970 !!!!! write(*,'(10F9.2)') (tabalb(ncount,3),ncount=0,1023) 1971 1972 !!!!! write(*,*) 'counts(1,ncount) : ' 1973 !!!!! write(*,'(15I6)') (counts(1,ncount),ncount=1,mpos) 1974 Page 17 Source Listing GAC_LBC 2012-12-13 18:36 avhrr.f90 1975 !!!!! write(*,*) 'counts(2,ncount) : ' 1976 !!!!! write(*,'(15I6)') (counts(2,ncount),ncount=1,mpos) 1977 1978 !!!!! write(*,*) 'counts(3,ncount) : ' 1979 !!!!! write(*,'(15I6)') (counts(3,ncount),ncount=1,mpos) 1980 1981 !!!!! write(*,*) 'counts(4,ncount) : ' 1982 !!!!! write(*,'(15I6)') (counts(4,ncount),ncount=1,mpos) 1983 1984 !!!!! write(*,*) 'counts(5,ncount) : ' 1985 !!!!! write(*,'(15I6)') (counts(5,ncount),ncount=1,mpos) 1986 1987 1988 ! Infrared channels 1989 ! ----------------- 1990 1991 ! C1 and C2 are defined here because the common cavh_cpi has net been 1992 ! initialized (call avh_cpar) 1993 ! 1994 ! planck1 is C1 * nu3 1995 ! planck2 is C2 * nu 1996 ! avh_bandcor(1,c) is nu (cm-1) 1997 ! avh_bandcor(2,c) is intercept (K) 1998 ! avh_bandcor(3,c) is slope (K/K) 1999 ! ------------------------------------------------------------------- 2000 2001 ! Xu Li: update C1, C2 2002 ! 2003 !!!! C1 = 0.000011910659d0 2004 !!!! C2 = 1.438833d0 2005 2006 C1 = 0.000011910427d0 2007 C2 = 1.4387752d0 2008 2009 ! Planck coefficients channel 3B 2010 ! ------------------------------ 2011 2012 c=1 2013 nu=avh_h_radtempcnv(1,c)*1.e-02 2014 planck1(c)=C1*nu*nu*nu 2015 planck2(c)=C2*nu 2016 avh_bandcor(1,c)=nu 2017 avh_bandcor(2,c)=avh_h_radtempcnv(2,c)*1.e-05 2018 avh_bandcor(3,c)=avh_h_radtempcnv(3,c)*1.e-06 2019 2020 ! Planck coefficients channel 4 2021 ! ----------------------------- 2022 2023 c=2 2024 nu=avh_h_radtempcnv(1,c)*1.e-03 2025 planck1(c)=C1*nu*nu*nu 2026 planck2(c)=C2*nu 2027 avh_bandcor(1,c)=nu 2028 avh_bandcor(2,c)=avh_h_radtempcnv(2,c)*1.e-05 2029 avh_bandcor(3,c)=avh_h_radtempcnv(3,c)*1.e-06 2030 2031 ! Planck coefficients channel 5 Page 18 Source Listing GAC_LBC 2012-12-13 18:36 avhrr.f90 2032 ! ----------------------------- 2033 2034 c=3 2035 nu=avh_h_radtempcnv(1,c)*1.e-03 2036 planck1(c)=C1*nu*nu*nu 2037 planck2(c)=C2*nu 2038 avh_bandcor(1,c)=nu 2039 avh_bandcor(2,c)=avh_h_radtempcnv(2,c)*1.e-05 2040 avh_bandcor(3,c)=avh_h_radtempcnv(3,c)*1.e-06 2041 2042 ! Radiance to temperature tables, all IR channels (common temp_conv) 2043 ! ------------------------------------------------------------------ 2044 2045 call avh_icon 2046 2047 first = .false. 2048 endif 2049 2050 ! Channel status for the line 2051 ! --------------------------- 2052 2053 status_channel = avh_h_inststat1 2054 2055 if (avh_h_statchrecnb.eq.0) then 2056 status_channel = avh_h_inststat1 2057 else if(line.ge.avh_h_statchrecnb) then 2058 status_channel = avh_h_inststat2 2059 endif 2060 2061 ! MISSING LINE TEST 2062 ! ----------------- 2063 2064 if(ibits(avh_qualind,31,1) == 1 .or. ibits(avh_qualind,30,1) == 1 .or. & 2065 ibits(avh_qualind,28,1) == 1 .or. ibits(avh_qualind,27,1) == 1 )then 2066 2067 ! Missing line, 0 ==> 5 channels 2068 ! ------------------------------ 2069 2070 do p=1,mpos 2071 do c=1,5 2072 avh_bt(c,p)=bmiss 2073 enddo 2074 enddo 2075 do p=1,mpos 2076 do c=1,5 2077 avh_rad(c,p)=bmiss 2078 enddo 2079 enddo 2080 missing = 1 2081 bad_lines(1) = bad_lines(1) + 1 2082 bad_lines(2) = bad_lines(2) + 1 2083 bad_lines(3) = bad_lines(3) + 1 2084 bad_lines(4) = bad_lines(4) + 1 2085 bad_lines(5) = bad_lines(5) + 1 2086 bad_lines(6) = bad_lines(6) + 1 2087 2088 else Page 19 Source Listing GAC_LBC 2012-12-13 18:36 avhrr.f90 2089 2090 ! GOOD LINE 2091 ! --------- 2092 2093 missing = 0 2094 2095 ! Channel VIS 1 2096 ! ============= 2097 2098 c = 1 2099 2100 ! Testing if the channel is enabled (1) 2101 ! ------------------------------------- 2102 2103 if(ibits(status_channel,13,1).eq.1)then 2104 2105 good_lines(1) = good_lines(1)+1 2106 2107 ! Loop on mpos pixels 2108 ! ------------------- 2109 2110 do p = 1, mpos 2111 avh_bt(c,p) = tabalb(counts(c,p),c) 2112 avh_rad(c,p)= bmiss 2113 enddo 2114 2115 2116 else 2117 2118 ! Channel is disabled 2119 ! ------------------- 2120 2121 bad_lines(1) = bad_lines(1) + 1 2122 do p=1,mpos 2123 avh_bt(c,p) = bmiss 2124 avh_rad(c,p) = bmiss 2125 enddo 2126 endif 2127 2128 ! Channel VIS 2 2129 ! ============= 2130 2131 c = 2 2132 2133 ! Testing if the channel is enabled (1) 2134 ! ------------------------------------- 2135 2136 if(ibits(status_channel,12,1).eq.1)then 2137 2138 good_lines(2) = good_lines(2)+1 2139 2140 ! Loop on mpos pixels 2141 ! ------------------- 2142 2143 do p=1,mpos 2144 avh_bt(c,p) = tabalb(counts(c,p),c) 2145 avh_rad(c,p) = bmiss Page 20 Source Listing GAC_LBC 2012-12-13 18:36 avhrr.f90 2146 enddo 2147 2148 else 2149 2150 ! Channel is disabled 2151 ! ------------------- 2152 2153 bad_lines(2) = bad_lines(2) + 1 2154 do p=1,mpos 2155 avh_bt(c,p) = bmiss 2156 avh_rad(c,p) = bmiss 2157 enddo 2158 endif 2159 2160 ! Channel IR 3B or Channel Vis 3A 2161 ! =============================== 2162 2163 c = 3 2164 2165 ! Bits 1-0 of avh_scnlinbit : channel 3 select (0 = 3b; 1 = 3a; 2 = transition) 2166 ! ----------------------------------------------------------------------------- 2167 2168 if(ibits(avh_scnlinbit,0,1) == 0)then 2169 2170 ! Testing if the channel 3B is enabled (1) 2171 ! ---------------------------------------- 2172 2173 if(ibits(status_channel,10,1).eq.1)then 2174 2175 ! Testing the calibration quality flag 2176 ! ------------------------------------ 2177 2178 if(ibits(avh_calqual(1),7,1).eq.0)then 2179 k1=avh_calir(1,1,1)*scale3 2180 k2=avh_calir(2,1,1)*scale4 2181 k3=avh_calir(3,1,1)*scale5 2182 2183 good_lines(3) = good_lines(3)+1 2184 2185 ! Loop on mpos pixels 2186 ! ------------------- 2187 2188 do p=1,mpos 2189 rcount = float(counts(c,p)) 2190 !!!!!! radiance = k1*rcount*rcount + k2*rcount + k3 2191 radiance = k1 + k2*rcount + k3*rcount*rcount 2192 avh_rad(c,p) = radiance 2193 avh_bt(c,p)=avh_cir_r(radiance,1) 2194 enddo 2195 2196 else 2197 2198 ! Calibration not usable for channel 3B 2199 ! ------------------------------------- 2200 2201 bad_lines(3) = bad_lines(3) + 1 2202 do p=1,mpos Page 21 Source Listing GAC_LBC 2012-12-13 18:36 avhrr.f90 2203 avh_rad(c,p) = bmiss 2204 avh_bt(c,p) = bmiss 2205 enddo 2206 2207 endif 2208 2209 else 2210 2211 ! Channel is disabled 2212 ! ------------------- 2213 2214 bad_lines(3) = bad_lines(3) + 1 2215 do p=1,mpos 2216 avh_rad(c,p) = bmiss 2217 avh_bt(c,p) = bmiss 2218 enddo 2219 endif 2220 2221 elseif ( ibits(avh_scnlinbit,0,1) == 1) then 2222 2223 ! Bits 1-0 of avh_scnlinbit : channel 3 select (0 = 3b; 1 = 3a; 2 = transition) 2224 ! ----------------------------------------------------------------------------- 2225 2226 ! Channel IR 3A 2227 ! ============= 2228 2229 ! Testing if the channel 3A is enabled (1) 2230 ! ---------------------------------------- 2231 2232 if(ibits(status_channel,11,1).eq.1)then 2233 2234 good_lines(6) = good_lines(6)+1 2235 2236 ! Loop on mpos pixels 2237 ! ------------------- 2238 2239 do p=1,mpos 2240 avh_bt(c,p) = tabalb(counts(c,p),3) 2241 avh_rad(c,p) = bmiss 2242 enddo 2243 2244 else 2245 2246 ! Channel is disabled 2247 ! ------------------- 2248 2249 bad_lines(6) = bad_lines(6) + 1 2250 do p=1,mpos 2251 avh_bt(c,p) = bmiss 2252 avh_rad(c,p) = bmiss 2253 enddo 2254 endif 2255 2256 endif 2257 2258 ! Channel IR 4 2259 ! ============ Page 22 Source Listing GAC_LBC 2012-12-13 18:36 avhrr.f90 2260 2261 c = 4 2262 2263 ! Testing if the channel is enabled (1) 2264 ! ------------------------------------- 2265 2266 if(ibits(status_channel,9,1).eq.1)then 2267 2268 ! Testing the calibration quality flag 2269 ! ------------------------------------ 2270 2271 if(ibits(avh_calqual(2),7,1).eq.0)then 2272 k1=avh_calir(1,1,2)*scale3 2273 k2=avh_calir(2,1,2)*scale4 2274 k3=avh_calir(3,1,2)*scale5 2275 2276 good_lines(4) = good_lines(4)+1 2277 2278 ! Loop on mpos pixels 2279 ! ------------------- 2280 2281 do p=1,mpos 2282 rcount = float(counts(c,p)) 2283 !!!!! radiance = k1*rcount*rcount + k2*rcount + k3 2284 radiance = k1 + k2*rcount + k3*rcount*rcount 2285 avh_rad(c,p) = radiance 2286 avh_bt(c,p)=avh_cir_r(radiance,2) 2287 2288 enddo 2289 else 2290 2291 ! Calibration not usable 2292 ! ---------------------- 2293 2294 bad_lines(4) = bad_lines(4) + 1 2295 do p=1,mpos 2296 avh_rad(c,p) = bmiss 2297 avh_bt(c,p) = bmiss 2298 enddo 2299 endif 2300 else 2301 2302 ! Channel is disabled 2303 ! ------------------- 2304 2305 bad_lines(4) = bad_lines(4) + 1 2306 do p=1,mpos 2307 avh_rad(c,p) = bmiss 2308 avh_bt(c,p) = bmiss 2309 enddo 2310 endif 2311 2312 ! Channel IR 5 2313 ! ============ 2314 2315 c = 5 2316 Page 23 Source Listing GAC_LBC 2012-12-13 18:36 avhrr.f90 2317 ! Testing if the channel is enabled (1) 2318 ! ------------------------------------- 2319 2320 if(ibits(status_channel,8,1).eq.1)then 2321 2322 ! Testing the calibration quality flag 2323 ! ------------------------------------ 2324 2325 if(ibits(avh_calqual(3),7,1).eq.0)then 2326 2327 k1=avh_calir(1,1,3)*scale3 2328 k2=avh_calir(2,1,3)*scale4 2329 k3=avh_calir(3,1,3)*scale5 2330 2331 good_lines(5) = good_lines(5)+1 2332 2333 ! Loop on mpos pixels 2334 ! ------------------- 2335 2336 do p=1,mpos 2337 rcount = float(counts(c,p)) 2338 !!!!! radiance = k1*rcount*rcount + k2*rcount + k3 2339 radiance = k1 + k2*rcount + k3*rcount*rcount 2340 2341 avh_rad(c,p) = radiance 2342 avh_bt(c,p)=avh_cir_r(radiance,3) 2343 2344 enddo 2345 else 2346 2347 ! Calibration not usable 2348 ! ---------------------- 2349 2350 bad_lines(5) = bad_lines(5) + 1 2351 do p=1,mpos 2352 avh_rad(c,p) = bmiss 2353 avh_bt(c,p) = bmiss 2354 enddo 2355 endif 2356 else 2357 2358 ! Channel is disabled 2359 ! ------------------- 2360 2361 bad_lines(5) = bad_lines(5) + 1 2362 do p=1,mpos 2363 avh_rad(c,p) = bmiss 2364 avh_bt(c,p) = bmiss 2365 enddo 2366 endif 2367 2368 endif 2369 2370 good_qc = 0 2371 if(missing == 0) then 2372 do p=1,mpos 2373 avh_qc(p) = good_qc ! good line Page 24 Source Listing GAC_LBC 2012-12-13 18:36 avhrr.f90 2374 end do 2375 else 2376 2377 bad_qc = ibset(good_qc,bit_qc) 2378 2379 print*,'missing AVHRR line',line 2380 2381 do p = 1, mpos 2382 avh_qc(p) = bad_qc ! missing line 2383 end do 2384 endif 2385 2386 END SUBROUTINE GAC_LBC ENTRY POINTS Name gac_1b_proc_mp_gac_lbc_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References AVH_ANG Scalar 535 I(2) 2 2 153 COM AVH_ATTANGTIME Scalar 528 I(4) 4 scalar COM AVH_BANDCOR Scalar 71 R(8) 8 2 9 COM 698,699,700,709,710,711,720,721,72 2 AVH_BITFLAG1 Scalar 567 I(2) 2 scalar COM AVH_BITFLAG2 Scalar 575 I(4) 4 scalar COM AVH_CALIR Scalar 478 I(4) 4 3 18 COM 861,862,863,954,955,956,1009,1010, 1011 AVH_CALQUAL Scalar 445 I(2) 2 1 3 COM 860,953,1007 AVH_CALVIS Scalar 463 I(4) 4 3 45 COM 624,625,627,635,636,638 AVH_CBITERR Scalar 457 I(2) 2 scalar COM AVH_CIR_R Func 567 R(4) 4 scalar 875,968,1024 AVH_CLOCKDRIFT Scalar 365 I(2) 2 scalar COM AVH_DBDATA Scalar 569 I(2) 2 scalar COM AVH_DT Scalar 591 I(4) 4 1 1152 COM AVH_FILLER0 Scalar 373 I(2) 2 1 5 COM AVH_FILLER1 Scalar 459 I(4) 4 1 2 COM AVH_FILLER2 Scalar 500 I(4) 4 1 3 COM AVH_FILLER3 Scalar 540 I(2) 2 1 3 COM AVH_FILLER4 Scalar 547 I(4) 4 1 2 COM AVH_FILLER5 Scalar 557 I(2) 2 scalar COM AVH_FILLER6 Scalar 563 I(4) 4 1 2 COM AVH_FILLER7 Scalar 570 I(4) 4 1 3 COM AVH_FILLER8 Scalar 582 I(2) 2 1 3 COM AVH_FILLER9 Scalar 589 I(4) 4 1 112 COM AVH_HD Scalar 302 I(4) 4 1 1152 COM AVH_HRPT Scalar 561 I(4) 4 1 682 COM AVH_H_ADCONTEMP Scalar 282 I(2) 2 1 5 COM AVH_H_ALBCNV Scalar 185 I(4) 4 2 6 COM AVH_H_ARGPER Scalar 228 I(4) 4 scalar COM AVH_H_AUXSYNCERRSUM Scalar 123 I(2) 2 scalar COM Page 25 Source Listing GAC_LBC 2012-12-13 18:36 Symbol Table avhrr.f90 Name Object Declared Type Bytes Dimen Elements Attributes References AVH_H_BBTEMP1 Scalar 260 I(2) 2 1 5 COM AVH_H_BBTEMP2 Scalar 262 I(2) 2 1 5 COM AVH_H_BBTEMP3 Scalar 264 I(2) 2 1 5 COM AVH_H_BBTEMP4 Scalar 266 I(2) 2 1 5 COM AVH_H_BBTEMPCHN3B Scalar 288 I(2) 2 1 5 COM AVH_H_BBTEMPCHN4 Scalar 290 I(2) 2 1 5 COM AVH_H_BBTEMPCHN5 Scalar 292 I(2) 2 1 5 COM AVH_H_BLANK Scalar 53 CHAR 1 scalar COM AVH_H_BLKSZ Scalar 60 I(2) 2 scalar COM AVH_H_BPTEMP Scalar 278 I(2) 2 1 5 COM AVH_H_CALLOCSCNLIN Scalar 112 I(2) 2 scalar COM AVH_H_CHTEMP Scalar 276 I(2) 2 1 5 COM AVH_H_CPIDSDY Scalar 89 I(2) 2 scalar COM AVH_H_CPIDSYR Scalar 88 I(2) 2 scalar COM AVH_H_D4BVOLT Scalar 284 I(2) 2 1 5 COM AVH_H_D5BVOLT Scalar 286 I(2) 2 1 5 COM AVH_H_DATAGAPS Scalar 117 I(2) 2 scalar COM AVH_H_DATANAME Scalar 64 CHAR 42 scalar COM AVH_H_DATATYP Scalar 68 I(2) 2 scalar COM AVH_H_EARTHPOS Scalar 272 I(2) 2 1 5 COM AVH_H_EARTHSUN Scalar 244 I(4) 4 scalar COM AVH_H_ECCEN Scalar 226 I(4) 4 scalar COM AVH_H_ELECCUR Scalar 268 I(2) 2 1 5 COM AVH_H_ELECTEMP Scalar 274 I(2) 2 1 5 COM AVH_H_ENDDATADY Scalar 85 I(2) 2 scalar COM AVH_H_ENDDATAJD Scalar 82 I(4) 4 scalar COM AVH_H_ENDDATATIME Scalar 86 I(4) 4 scalar COM AVH_H_ENDDATAYR Scalar 84 I(2) 2 scalar COM AVH_H_EPODY Scalar 222 I(2) 2 scalar COM AVH_H_EPOTIME Scalar 223 I(4) 4 scalar COM AVH_H_EPOYR Scalar 221 I(2) 2 scalar COM AVH_H_FILLER0 Scalar 63 I(2) 2 1 3 COM AVH_H_FILLER1 Scalar 91 I(2) 2 1 4 COM AVH_H_FILLER2 Scalar 105 I(2) 2 scalar COM AVH_H_FILLER3 Scalar 150 I(4) 4 scalar COM AVH_H_FILLER4 Scalar 155 I(2) 2 1 5 COM AVH_H_FILLER5 Scalar 181 I(4) 4 1 2 COM AVH_H_FILLER6 Scalar 203 I(4) 4 1 3 COM AVH_H_FILLER7 Scalar 213 I(2) 2 scalar COM AVH_H_FILLER8 Scalar 245 I(4) 4 1 4 COM AVH_H_FILLER9 Scalar 300 I(2) 2 1 1960 COM AVH_H_HDRCNT Scalar 61 I(2) 2 scalar COM AVH_H_INCLI Scalar 227 I(4) 4 scalar COM AVH_H_INSTID Scalar 67 I(2) 2 scalar COM AVH_H_INSTSTAT1 Scalar 95 I(4) 4 scalar COM 735,738 AVH_H_INSTSTAT2 Scalar 108 I(4) 4 scalar COM 740 AVH_H_IRTTCOEF Scalar 179 I(2) 2 2 24 COM AVH_H_L1BVERSDY Scalar 56 I(2) 2 scalar COM AVH_H_L1BVERSNB Scalar 54 I(2) 2 scalar COM AVH_H_L1BVERSYR Scalar 55 I(2) 2 scalar COM AVH_H_LOCBIT Scalar 210 I(2) 2 scalar COM AVH_H_LOCERRCODE Scalar 138 I(2) 2 scalar COM AVH_H_LOCERRIND Scalar 134 I(2) 2 scalar COM AVH_H_MANOM Scalar 231 I(4) 4 scalar COM AVH_H_MHTEMP Scalar 280 I(2) 2 1 5 COM Page 26 Source Listing GAC_LBC 2012-12-13 18:36 Symbol Table avhrr.f90 Name Object Declared Type Bytes Dimen Elements Attributes References AVH_H_MISSCNLIN Scalar 115 I(2) 2 scalar COM AVH_H_MODELID Scalar 207 CHAR 8 scalar COM AVH_H_MOTORCUR Scalar 270 I(2) 2 1 5 COM AVH_H_NADLOCTOL Scalar 208 I(2) 2 scalar COM AVH_H_OKDATAFR Scalar 119 I(2) 2 scalar COM AVH_H_PACSDATASRC Scalar 147 I(2) 2 scalar COM AVH_H_PACSPARITYERR Scalar 121 I(2) 2 scalar COM AVH_H_PACSSTATFIELD Scalar 139 I(2) 2 scalar COM AVH_H_PCALALGIND Scalar 173 I(2) 2 scalar COM AVH_H_PCALALGOPT Scalar 174 I(2) 2 scalar COM AVH_H_PCHPOW Scalar 256 I(2) 2 1 5 COM AVH_H_PCHTEMP Scalar 252 I(2) 2 1 5 COM AVH_H_PCHTEMPEXT Scalar 254 I(2) 2 1 5 COM AVH_H_PITCHERR Scalar 217 I(2) 2 scalar COM AVH_H_PRBLKID Scalar 65 CHAR 8 scalar COM AVH_H_RACALIND Scalar 160 I(2) 2 scalar COM AVH_H_RADTEMPCNV Scalar 194 I(4) 4 2 9 COM 695,699,700,706,710,711,717,721,72 2 AVH_H_RASCNOD Scalar 229 I(4) 4 scalar COM AVH_H_RDTEMP Scalar 258 I(2) 2 1 5 COM AVH_H_RECLG Scalar 58 I(2) 2 scalar COM AVH_H_REFVOLT Scalar 294 I(2) 2 1 5 COM AVH_H_RESERVED1 Scalar 253 I(2) 2 scalar COM AVH_H_RESERVED10 Scalar 271 I(2) 2 scalar COM AVH_H_RESERVED11 Scalar 273 I(2) 2 scalar COM AVH_H_RESERVED12 Scalar 275 I(2) 2 scalar COM AVH_H_RESERVED13 Scalar 277 I(2) 2 scalar COM AVH_H_RESERVED14 Scalar 279 I(2) 2 scalar COM AVH_H_RESERVED15 Scalar 281 I(2) 2 scalar COM AVH_H_RESERVED16 Scalar 283 I(2) 2 scalar COM AVH_H_RESERVED17 Scalar 285 I(2) 2 scalar COM AVH_H_RESERVED18 Scalar 287 I(2) 2 scalar COM AVH_H_RESERVED19 Scalar 289 I(2) 2 scalar COM AVH_H_RESERVED2 Scalar 255 I(2) 2 scalar COM AVH_H_RESERVED20 Scalar 291 I(2) 2 scalar COM AVH_H_RESERVED21 Scalar 293 I(2) 2 scalar COM AVH_H_RESERVED22 Scalar 295 I(2) 2 scalar COM AVH_H_RESERVED3 Scalar 257 I(2) 2 scalar COM AVH_H_RESERVED4 Scalar 259 I(2) 2 scalar COM AVH_H_RESERVED5 Scalar 261 I(2) 2 scalar COM AVH_H_RESERVED6 Scalar 263 I(2) 2 scalar COM AVH_H_RESERVED7 Scalar 265 I(2) 2 scalar COM AVH_H_RESERVED8 Scalar 267 I(2) 2 scalar COM AVH_H_RESERVED9 Scalar 269 I(2) 2 scalar COM AVH_H_ROLLERR Scalar 215 I(2) 2 scalar COM AVH_H_SATID Scalar 66 I(2) 2 scalar COM AVH_H_SCALALGIND Scalar 176 I(2) 2 scalar COM AVH_H_SCALALGOPT Scalar 177 I(2) 2 scalar COM AVH_H_SCNLIN Scalar 110 I(2) 2 scalar COM AVH_H_SITEID Scalar 52 CHAR 3 scalar COM AVH_H_SMAXIS Scalar 225 I(4) 4 scalar COM AVH_H_SOCCLOCKUPIND Scalar 130 I(2) 2 scalar COM AVH_H_SOLARCALDY Scalar 171 I(2) 2 scalar COM AVH_H_SOLARCALYR Scalar 169 I(2) 2 scalar COM AVH_H_SPARE1 Scalar 151 CHAR 8 scalar COM Page 27 Source Listing GAC_LBC 2012-12-13 18:36 Symbol Table avhrr.f90 Name Object Declared Type Bytes Dimen Elements Attributes References AVH_H_SPARE2 Scalar 153 CHAR 8 scalar COM AVH_H_STARTDATADY Scalar 79 I(2) 2 scalar COM AVH_H_STARTDATAJD Scalar 76 I(4) 4 scalar COM AVH_H_STARTDATATIME Scalar 80 I(4) 4 scalar COM AVH_H_STARTDATAYR Scalar 78 I(2) 2 scalar COM AVH_H_STATCHRECNB Scalar 106 I(2) 2 scalar COM 737,739 AVH_H_TIMESEQERR Scalar 126 I(2) 2 scalar COM AVH_H_TIMESEQERRCODE Scalar 129 I(2) 2 scalar COM AVH_H_TIPSRC Scalar 72 I(2) 2 scalar COM AVH_H_XPOS Scalar 232 I(4) 4 scalar COM AVH_H_XVEL Scalar 238 I(4) 4 scalar COM AVH_H_YAWERR Scalar 219 I(2) 2 scalar COM AVH_H_YPOS Scalar 234 I(4) 4 scalar COM AVH_H_YVEL Scalar 240 I(4) 4 scalar COM AVH_H_ZPOS Scalar 236 I(4) 4 scalar COM AVH_H_ZVEL Scalar 242 I(4) 4 scalar COM AVH_INSTEMP Scalar 581 I(1) 1 1 22 COM AVH_MXHRPCHN Param 35 I(4) 4 scalar AVH_MXIRCHN Param 35 I(4) 4 scalar 194,445,478 AVH_MXPIX Param 36 I(4) 4 scalar AVH_MXVISCHN Param 35 I(4) 4 scalar 185,463,620 AVH_NAVSTAT Scalar 504 I(4) 4 scalar COM AVH_PITCHANG Scalar 531 I(2) 2 scalar COM AVH_POS Scalar 541 I(4) 4 2 102 COM AVH_QUALIND Scalar 377 I(4) 4 scalar COM 746,747 AVH_RAD Local 759 R(4) 4 2 2045 759,794,806,827,838,874,885,898,92 3,934,967,978,989,1023,1034,1045 AVH_ROLLANG Scalar 530 I(2) 2 scalar COM AVH_SCALTI Scalar 533 I(2) 2 scalar COM AVH_SCNLIN Scalar 362 I(2) 2 scalar COM AVH_SCNLINBIT Scalar 367 I(2) 2 scalar COM 850,903 AVH_SCNLINDY Scalar 364 I(2) 2 scalar COM AVH_SCNLINQUAL Scalar 399 I(4) 4 scalar COM AVH_SCNLINTIME Scalar 366 I(4) 4 scalar COM AVH_SCNLINYR Scalar 363 I(2) 2 scalar COM AVH_TELEM Scalar 552 I(2) 2 1 103 COM AVH_YAWANG Scalar 532 I(2) 2 scalar COM A_RADCOR Scalar 60 R(4) 4 1 3 COM BAD_LINES Local 763 I(4) 4 1 6 85,763,764,765,766,767,768,803,835 ,883,896,931,976,987,1032,1043 BAD_QC Local 556 I(4) 4 scalar 1059,1064 BB_MAX Scalar 53 I(4) 4 1 3 COM BB_MIN Scalar 53 I(4) 4 1 3 COM BIT_QC Param 1059 I(4) 4 scalar 1059 B_RADCOR Scalar 60 R(4) 4 1 3 COM C Local 531 I(4) 4 scalar 620,624,625,627,628,630,635,636,63 8,639,641,694,695,696,697,698,699, 700,705,706,707,708,709,710,711,71 6,717,718,719,720,721,722,753,754, 758,759,780,793,794,805,806,813,82 6,827,837,838,845,871,874,875,885, 886,898,899,922,923,933,934,943,96 4,967,968,978,979,989,990,997,1019 ,1023,1024,1034,1035,1045,1046 C1 Scalar 24 R(8) 8 scalar COM 688,696,707,718 Page 28 Source Listing GAC_LBC 2012-12-13 18:36 Symbol Table avhrr.f90 Name Object Declared Type Bytes Dimen Elements Attributes References C2 Scalar 24 R(8) 8 scalar COM 689,697,708,719 CAVHCPIDS Common 83 2000 CAVH_SIZE Param 39 I(4) 4 scalar 302,591 CCMC Scalar 588 I(2) 2 1 52 COM CLV_BIT Scalar 586 I(4) 4 scalar COM CLV_REV Scalar 587 I(4) 4 scalar COM CONV_PRT Scalar 25 R(4) 4 2 20 COM CPLANCK Common 91 64 CTH_MAX Scalar 55 I(4) 4 1 4 COM CTH_MIN Scalar 55 I(4) 4 1 4 COM C_RADCOR Scalar 60 R(4) 4 1 3 COM EXPON3 Local 542 I(4) 4 scalar 597,601 EXPON4 Local 544 I(4) 4 scalar 598,602 EXPON5 Local 546 I(4) 4 scalar 599,603 FIRST Local 558 L(4) 4 scalar 558,573,729 FLOAT Func 628 scalar 628,639,871,964,1019 GAC1BDT Common 593 4608 GAC1BHD Common 306 4608 GAC_LBC Subr 488 249 GOOD_LINES Local 787 I(4) 4 1 6 84,787,820,865,916,958,1013 GOOD_QC Local 555 I(4) 4 scalar 1052,1055,1059 IBITS Func 746 scalar 746,747,785,818,850,855,860,903,91 4,948,953,1002,1007 IBSET Func 1059 scalar 1059 INTERCEPT Local 536 R(4) 4 scalar 625,628,636,639 IR_CENTWA Scalar 48 R(4) 4 2 12 COM IR_NRESP Scalar 45 R(8) 8 2 180 COM IR_STARTWA Scalar 42 R(8) 8 1 3 COM IR_WAVINC Scalar 42 R(8) 8 1 3 COM IT1 Scalar 46 I(4) 4 1 4 COM IT2 Scalar 46 I(4) 4 1 4 COM K1 Local 539 R(4) 4 scalar 861,873,954,966,1009,1021 K2 Local 539 R(4) 4 scalar 862,873,955,966,1010,1021 K3 Local 539 R(4) 4 scalar 863,873,956,966,1011,1021 LINE Dummy 488 I(4) 4 scalar ARG,INOUT 739,1061 MISSING Local 762 I(4) 4 scalar 762,775,1053 NBVISCHN Scalar 16 I(4) 4 scalar COM NCOUNT Local 533 I(4) 4 scalar 627,628,630,638,639,641 NU Local 540 R(8) 8 scalar 695,696,697,698,706,707,708,709,71 7,718,719,720 NWORDS Param 41 I(4) 4 scalar 561 P Local 531 I(4) 4 scalar 752,754,757,759,792,793,794,804,80 5,806,825,826,827,836,837,838,870, 871,874,875,884,885,886,897,898,89 9,921,922,923,932,933,934,963,964, 967,968,977,978,979,988,989,990,10 18,1019,1023,1024,1033,1034,1035,1 044,1045,1046,1054,1055,1063,1064 PLANCK1 Scalar 90 R(8) 8 1 3 COM 696,707,718 PLANCK2 Scalar 90 R(8) 8 1 3 COM 697,708,719 RADIANCE Local 541 R(4) 4 scalar 873,874,875,966,967,968,1021,1023, 1024 RCOUNT Local 532 R(4) 4 scalar 871,873,964,966,1019,1021 RECLAVH Param 37 I(4) 4 scalar 39 RSP Scalar 70 R(4) 4 1 3 COM Page 29 Source Listing GAC_LBC 2012-12-13 18:36 Symbol Table avhrr.f90 Name Object Declared Type Bytes Dimen Elements Attributes References SCALE3 Local 548 R(4) 4 scalar 601,861,954,1009 SCALE4 Local 549 R(4) 4 scalar 602,862,955,1010 SCALE5 Local 550 R(4) 4 scalar 603,863,956,1011 SCCID Local 519 CHAR 62 scalar 520 SLOPE Local 535 R(4) 4 scalar 624,628,635,639 SP_MAX Scalar 50 I(4) 4 1 6 COM SP_MIN Scalar 50 I(4) 4 1 6 COM STATUS_CHANNEL Local 557 I(4) 4 scalar 735,738,740,785,818,855,914,948,10 02 TABALB Local 537 R(4) 4 2 3072 628,630,639,641,793,826,922 VCOEFSET Local 559 I(4) 4 scalar 619,624,625,627,635,636,638 VERSDY Scalar 22 I(4) 4 scalar COM VERSNB Scalar 18 I(4) 4 scalar COM VERSYR Scalar 20 I(4) 4 scalar COM VIS_CNTLIM Scalar 58 I(4) 4 1 3 COM VIS_ECWA Scalar 36 R(4) 4 1 3 COM VIS_EQWI Scalar 36 R(4) 4 1 3 COM VIS_INT Scalar 30 R(4) 4 2 6 COM VIS_ISI Scalar 36 R(4) 4 1 3 COM VIS_SLOPE Scalar 30 R(4) 4 2 6 COM WEIGHT_PRT Scalar 28 R(4) 4 1 4 COM Page 30 Source Listing GAC_LBC 2012-12-13 18:36 avhrr.f90 2387 2388 2389 SUBROUTINE AVH_ICON 2390 !$$$ MAIN PROGRAM DOCUMENTATION BLOCK 2391 ! 2392 ! SUBPROGRAM: AVH_ICON 2393 ! PRGMMR: KEYSER ORG: NP22 DATE: 2006-10-19 2394 ! 2395 ! ABSTRACT: Initializes lookup tables to convert radiances into temperature for 2396 ! the 3 AVHRR IR channels. 2397 ! 2398 ! PROGRAM HISTORY LOG: 2399 ! 1995-09-01 Marcel Derrien Original author 2400 ! 2003-01-14 Xu Li ???? 2401 ! 2006-10-19 Keyser Improved docblocks and comments 2402 ! 2403 ! USAGE: CALL AVH_ICON 2404 ! 2405 ! REMARKS: None 2406 ! 2407 ! ATTRIBUTES: 2408 ! LANGUAGE: FORTRAN 90 (free format) 2409 ! MACHINE: NCEP WCOSS 2410 ! 2411 !$$$ 2412 implicit none 2413 2414 ! DECLARATIONS 2415 ! ------------ 2416 2417 character*62 sccsid 2418 2419 data sccsid/'@(#) avh_icon.F version 1.1 on 3/24/98'/ 2420 2421 ! COMMONS 2422 ! ------- 2423 2424 include 'cavh_cpi.inc' 2516 real rbeg(3),rstep(3),rend(3) 2517 real tconv(4000,3) 2518 common/temp_conv/rbeg,rstep,rend,tconv 2519 2520 ! Local variables 2521 ! --------------- 2522 2523 real r 2524 integer i 2525 integer c 2526 integer ios 2527 2528 ! FUNCTIONS 2529 ! --------- 2530 2531 real avh_brig 2532 2533 rbeg(1)=1.e-4 2534 Page 31 Source Listing AVH_ICON 2012-12-13 18:36 avhrr.f90 2535 rbeg(2)=1. 2536 rbeg(3)=1. 2537 rstep(1)=5.e-04 2538 rstep(2)=0.1 2539 rstep(3)=0.1 2540 do i = 1 , 3 2541 rend(i)=rbeg(i) + 3999.* rstep(i) 2542 enddo 2543 do i = 1,4000 2544 do c = 1,3 2545 r = rbeg(c) + (i-1)* rstep(c) 2546 tconv(i,c) = avh_brig(r,c,ios) 2547 enddo 2548 enddo 2549 2550 END SUBROUTINE AVH_ICON ENTRY POINTS Name gac_1b_proc_mp_avh_icon_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References AVH_BANDCOR Scalar 71 R(8) 8 2 9 COM AVH_BRIG Func 1122 R(4) 4 scalar 1137 AVH_ICON Subr 1071 727 A_RADCOR Scalar 60 R(4) 4 1 3 COM BB_MAX Scalar 53 I(4) 4 1 3 COM BB_MIN Scalar 53 I(4) 4 1 3 COM B_RADCOR Scalar 60 R(4) 4 1 3 COM C Local 1116 I(4) 4 scalar 1135,1136,1137 C1 Scalar 24 R(8) 8 scalar COM C2 Scalar 24 R(8) 8 scalar COM CAVHCPIDS Common 83 2000 CONV_PRT Scalar 25 R(4) 4 2 20 COM CPLANCK Common 91 64 CTH_MAX Scalar 55 I(4) 4 1 4 COM CTH_MIN Scalar 55 I(4) 4 1 4 COM C_RADCOR Scalar 60 R(4) 4 1 3 COM I Local 1115 I(4) 4 scalar 1131,1132,1134,1136,1137 IOS Local 1117 I(4) 4 scalar 1137 IR_CENTWA Scalar 48 R(4) 4 2 12 COM IR_NRESP Scalar 45 R(8) 8 2 180 COM IR_STARTWA Scalar 42 R(8) 8 1 3 COM IR_WAVINC Scalar 42 R(8) 8 1 3 COM IT1 Scalar 46 I(4) 4 1 4 COM IT2 Scalar 46 I(4) 4 1 4 COM NBVISCHN Scalar 16 I(4) 4 scalar COM PLANCK1 Scalar 90 R(8) 8 1 3 COM PLANCK2 Scalar 90 R(8) 8 1 3 COM R Local 1114 R(4) 4 scalar 1136,1137 Page 32 Source Listing AVH_ICON 2012-12-13 18:36 Symbol Table avhrr.f90 Name Object Declared Type Bytes Dimen Elements Attributes References RBEG Scalar 1107 R(4) 4 1 3 COM 1124,1126,1127,1132,1136 REND Scalar 1107 R(4) 4 1 3 COM 1132 RSP Scalar 70 R(4) 4 1 3 COM RSTEP Scalar 1107 R(4) 4 1 3 COM 1128,1129,1130,1132,1136 SCCSID Local 1099 CHAR 62 scalar 1101 SP_MAX Scalar 50 I(4) 4 1 6 COM SP_MIN Scalar 50 I(4) 4 1 6 COM TCONV Scalar 1108 R(4) 4 2 12000 COM 1137 TEMP_CONV Common 1109 48036 VERSDY Scalar 22 I(4) 4 scalar COM VERSNB Scalar 18 I(4) 4 scalar COM VERSYR Scalar 20 I(4) 4 scalar COM VIS_CNTLIM Scalar 58 I(4) 4 1 3 COM VIS_ECWA Scalar 36 R(4) 4 1 3 COM VIS_EQWI Scalar 36 R(4) 4 1 3 COM VIS_INT Scalar 30 R(4) 4 2 6 COM VIS_ISI Scalar 36 R(4) 4 1 3 COM VIS_SLOPE Scalar 30 R(4) 4 2 6 COM WEIGHT_PRT Scalar 28 R(4) 4 1 4 COM Page 33 Source Listing AVH_ICON 2012-12-13 18:36 avhrr.f90 2551 2552 2553 SUBROUTINE LAG(Y,IMODE) 2554 !$$$ MAIN PROGRAM DOCUMENTATION BLOCK 2555 ! 2556 ! SUBPROGRAM: LAG 2557 ! PRGMMR: KEYSER ORG: NP22 DATE: 2006-10-19 2558 ! 2559 ! ABSTRACT: Given selected parameter (solar zenith angle, satellite zenith 2560 ! angle, relative azuimuth angle,lat,lon) on 51 spaced-apart pixels in one 2561 ! AVHRR GAC scan, inteprolates parameter to all pixels in scan. 2562 ! 2563 ! PROGRAM HISTORY LOG: 2564 ! 2003-01-14 Xu Li Original author 2565 ! 2006-10-19 Keyser Improved docblocks and comments 2566 ! 2567 ! USAGE: CALL LAG(Y,IMODE) 2568 ! INPUT ARGUMENTS: 2569 ! Y - Parameter with values on 51 spaced-apart pixels 2570 ! IMODE - Identifies case where parameter passed in (Y) is longitude (=1) 2571 ! since extra logic is invoked (this is set to 0 for all other 2572 ! parameters) 2573 ! 2574 ! OUTPUT ARGUMENTS: 2575 ! Y - Parameter with values on all pixels (via interpolation) 2576 ! 2577 ! REMARKS: NONE 2578 ! 2579 ! ATTRIBUTES: 2580 ! LANGUAGE: FORTRAN 90 (free format) 2581 ! MACHINE: NCEP WCOSS 2582 ! 2583 !$$$ 2584 2585 implicit none 2586 2587 integer, parameter :: n1=5, dn=8 2588 real, dimension(mpos) :: y0,y 2589 2590 integer :: n0,n,imode,domd 2591 real :: L,max 2592 2593 ! Lagrangian interpolation for the pixels between n1 + 1 = 6 and mpos/2 = 204 2594 ! ---------------------------------------------------------------------------- 2595 2596 ! n0 = 13, 29, 45, ... , 173,189 2597 do n0 = n1 + dn , mpos/2, 2*dn 2598 ! n = (6...11 12 14...19 20)... (182...188,190...196) 2599 do n = n0 - (dn - 1), n0 + (dn - 1) 2600 if ( n /= n0 ) then 2601 y(n) = 0.0 2602 max = -99999.0 2603 do i = n0 - dn , n0 + dn, dn 2604 if ( y(i) >= max ) then 2605 max = y(i) 2606 endif 2607 enddo Page 34 Source Listing LAG 2012-12-13 18:36 avhrr.f90 2608 do i = n0 - dn , n0 + dn, dn 2609 L = 1.0 2610 do j = n0 - dn , n0 + dn, dn 2611 if (j /= i ) then 2612 L = L*real(n-j)/real(i-j) 2613 endif 2614 enddo 2615 2616 ! Handle transition across dateline {abs(slon) close to 180 and sign changes} 2617 ! --------------------------------------------------------------------------- 2618 2619 y0(i) = y(i) 2620 if ( y0(i) < -50.0 .and. imode == 1 .and. max > 0.0 ) then 2621 y0(i) = y0(i) + 360.0 2622 endif 2623 y(n) = y(n) + L*y0(i) 2624 enddo 2625 if ( imode == 1 ) then 2626 if ( y(n) > 180.0 ) then 2627 y(n) = y(n) - 360.0 2628 elseif ( y(n) < -180.0 ) then 2629 y(n) = y(n) + 360.0 2630 endif 2631 endif 2632 endif 2633 enddo 2634 enddo 2635 2636 ! Lagrangian interpolation for the pixels between mpos/2 - 1 = 404 and 2637 ! mpos/2 + dn = 214 2638 ! -------------------------------------------------------------------- 2639 2640 ! n0 = 397, 381, ..., 237,221 2641 ! n = (404...398 396... 390)... (228...222,220...214) 2642 do n0 = mpos -dn/2 - dn , mpos/2 + 2, -2*dn 2643 do n = n0 + (dn - 1), n0 - (dn - 1), -1 2644 if ( n /= n0 ) then 2645 y(n) = 0.0 2646 max = -99999.0 2647 do i = n0 + dn , n0 - dn, -dn 2648 if ( y(i) >= max ) then 2649 max = y(i) 2650 endif 2651 enddo 2652 do i = n0 + dn , n0 - dn, -dn 2653 L = 1.0 2654 do j = n0 + dn , n0 - dn, -dn 2655 if (j /= i ) then 2656 L = L*real(n-j)/real(i-j) 2657 endif 2658 enddo 2659 2660 ! Handle transition across dateline {abs(slon) close to 180 and sign changes} 2661 ! --------------------------------------------------------------------------- 2662 2663 y0(i) = y(i) 2664 if ( y0(i) < -50.0 .and. imode == 1 .and. max > 0.0 ) then Page 35 Source Listing LAG 2012-12-13 18:36 avhrr.f90 2665 y0(i) = y0(i) + 360.0 2666 endif 2667 y(n) = y(n) + L*y0(i) 2668 enddo 2669 if ( imode == 1 ) then 2670 if ( y(n) > 180.0 ) then 2671 y(n) = y(n) - 360.0 2672 elseif ( y(n) < -180.0 ) then 2673 y(n) = y(n) + 360.0 2674 endif 2675 endif 2676 endif 2677 enddo 2678 enddo 2679 2680 ! 5-point Lagrangian extrapolation for the begining pixels n = 1 - 4 2681 ! ------------------------------------------------------------------ 2682 2683 do n = 1, n1 - 1 2684 y(n) = 0.0 2685 max = -99999.0 2686 do i = n1, n1 + 4*dn, dn ! 5 13 21 29 37 45 2687 if ( y(i) >= max ) then 2688 max = y(i) 2689 endif 2690 enddo 2691 do i = n1, n1 + 4*dn, dn ! 5 13 21 29 37 45 2692 L = 1.0 2693 do j = n1, n1 + 4*dn, dn 2694 if (j /= i ) then 2695 L = L*real(n-j)/real(i-j) 2696 endif 2697 enddo 2698 2699 ! Handle transition across dateline {abs(slon) close to 180 and sign changes} 2700 ! --------------------------------------------------------------------------- 2701 2702 y0(i) = y(i) 2703 if ( y0(i) < -50.0 .and. imode == 1 .and. max > 0.0 ) then 2704 y0(i) = y0(i) + 360.0 2705 endif 2706 y(n) = y(n) + L*y0(i) 2707 enddo 2708 if ( imode == 1 ) then 2709 if ( y(n) > 180.0 ) then 2710 y(n) = y(n) - 360.0 2711 elseif ( y(n) < -180.0 ) then 2712 y(n) = y(n) + 360.0 2713 endif 2714 endif 2715 enddo 2716 2717 ! 3-point Lagrangian interpolation for the pixels (198, ..., 204) 2718 ! --------------------------------------------------------------- 2719 2720 do n = mpos/2 - dn + 2, mpos/2 ! 198 - 204 2721 y(n) = 0.0 Page 36 Source Listing LAG 2012-12-13 18:36 avhrr.f90 2722 max = -99999.0 2723 do i = mpos/2 + 1 - 2*dn, mpos/2 + 1, dn ! 189,197,205 2724 if ( y(i) >= max ) then 2725 max = y(i) 2726 endif 2727 enddo 2728 do i = mpos/2 + 1 - 2*dn, mpos/2 + 1, dn ! 189,197,205 2729 L = 1.0 2730 do j = mpos/2 + 1 - 2*dn, mpos/2 + 1, dn ! 189,197,205 2731 if (j /= i ) then 2732 L = L*real(n-j)/real(i-j) 2733 endif 2734 enddo 2735 2736 ! Handle transition across dateline {abs(slon) close to 180 and sign changes} 2737 ! --------------------------------------------------------------------------- 2738 2739 y0(i) = y(i) 2740 if ( y0(i) < -50.0 .and. imode == 1 .and. max > 0.0 ) then 2741 y0(i) = y0(i) + 360.0 2742 endif 2743 y(n) = y(n) + L*y0(i) 2744 enddo 2745 if ( imode == 1 ) then 2746 if ( y(n) > 180.0 ) then 2747 y(n) = y(n) - 360.0 2748 elseif ( y(n) < -180.0 ) then 2749 y(n) = y(n) + 360.0 2750 endif 2751 endif 2752 enddo 2753 2754 ! 3-point Lagrangian interpolation for the pixels (206, ..., 212) 2755 ! --------------------------------------------------------------- 2756 2757 do n = mpos/2 + 2, mpos/2 + dn ! 206 - 212 2758 y(n) = 0.0 2759 max = -99999.0 2760 do i = mpos/2 + 1, mpos/2 + 1 + 2*dn, dn ! 205,213,221 2761 if ( y(i) >= max ) then 2762 max = y(i) 2763 endif 2764 enddo 2765 do i = mpos/2 + 1, mpos/2 + 1 + 2*dn, dn ! 205,213,221 2766 L = 1.0 2767 do j = mpos/2 + 1, mpos/2 + 1 + 2*dn, dn ! 205,213,221 2768 if (j /= i ) then 2769 L = L*real(n-j)/real(i-j) 2770 endif 2771 enddo 2772 2773 ! Handle transition across dateline {abs(slon) close to 180 and sign changes} 2774 ! --------------------------------------------------------------------------- 2775 2776 y0(i) = y(i) 2777 if ( y0(i) < -50.0 .and. imode == 1 .and. max > 0.0 ) then 2778 y0(i) = y0(i) + 360.0 Page 37 Source Listing LAG 2012-12-13 18:36 avhrr.f90 2779 endif 2780 y(n) = y(n) + L*y0(i) 2781 enddo 2782 if ( imode == 1 ) then 2783 if ( y(n) > 180.0 ) then 2784 y(n) = y(n) - 360.0 2785 elseif ( y(n) < -180.0 ) then 2786 y(n) = y(n) + 360.0 2787 endif 2788 endif 2789 enddo 2790 2791 ! 5-point Lagrangian extrapolation for the ending pixels (406-mpos) 2792 ! ----------------------------------------------------------------- 2793 2794 do n = mpos - dn/2 + 1, mpos 2795 y(n) = 0.0 2796 max = -99999.0 2797 do i = mpos - dn/2 - 4*dn , mpos - dn/2 , dn 2798 if ( y(i) >= max ) then 2799 max = y(i) 2800 endif 2801 enddo 2802 do i = mpos - dn/2 - 4*dn , mpos - dn/2 , dn 2803 L = 1.0 2804 do j = mpos - dn/2 - 4*dn , mpos - dn/2 , dn 2805 if (j /= i ) then 2806 L = L*real(n-j)/real(i-j) 2807 endif 2808 enddo 2809 2810 ! Handle transition across dateline {abs(slon) close to 180 and sign changes} 2811 ! --------------------------------------------------------------------------- 2812 2813 y0(i) = y(i) 2814 if ( y0(i) < -50.0 .and. imode == 1 .and. max > 0.0 ) then 2815 y0(i) = y0(i) + 360.0 2816 endif 2817 y(n) = y(n) + L*y0(i) 2818 enddo 2819 if ( imode == 1 ) then 2820 if ( y(n) > 180.0 ) then 2821 y(n) = y(n) - 360.0 2822 elseif ( y(n) < -180.0 ) then 2823 y(n) = y(n) + 360.0 2824 endif 2825 endif 2826 enddo 2827 2828 END SUBROUTINE LAG Page 38 Source Listing LAG 2012-12-13 18:36 Entry Points avhrr.f90 ENTRY POINTS Name gac_1b_proc_mp_lag_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References DN Param 1178 I(4) 4 scalar 1188,1190,1194,1199,1201,1233,1234 ,1238,1243,1245,1277,1282,1284,131 1,1314,1319,1321,1348,1351,1356,13 58,1385,1388,1393,1395 DOMD Local 1181 I(4) 4 scalar IMODE Dummy 1144 I(4) 4 scalar ARG,INOUT 1211,1216,1255,1260,1294,1299,1331 ,1336,1368,1373,1405,1410 L Local 1182 R(4) 4 scalar 1200,1203,1214,1244,1247,1258,1283 ,1286,1297,1320,1323,1334,1357,136 0,1371,1394,1397,1408 LAG Subr 1144 183,184,185,187,188 MAX Local 1182 R(4) 4 scalar 1193,1195,1196,1211,1237,1239,1240 ,1255,1276,1278,1279,1294,1313,131 5,1316,1331,1350,1352,1353,1368,13 87,1389,1390,1405 N Local 1181 I(4) 4 scalar 1190,1191,1192,1203,1214,1217,1218 ,1219,1220,1234,1235,1236,1247,125 8,1261,1262,1263,1264,1274,1275,12 86,1297,1300,1301,1302,1303,1311,1 312,1323,1334,1337,1338,1339,1340, 1348,1349,1360,1371,1374,1375,1376 ,1377,1385,1386,1397,1408,1411,141 2,1413,1414 N0 Local 1181 I(4) 4 scalar 1188,1190,1191,1194,1199,1201,1233 ,1234,1235,1238,1243,1245 N1 Param 1178 I(4) 4 scalar 1188,1274,1277,1282,1284 REAL Func 1203 scalar 1203,1247,1286,1323,1360,1397 Y Dummy 1144 R(4) 4 1 409 ARG,INOUT 1192,1195,1196,1210,1214,1217,1218 ,1219,1220,1236,1239,1240,1254,125 8,1261,1262,1263,1264,1275,1278,12 79,1293,1297,1300,1301,1302,1303,1 312,1315,1316,1330,1334,1337,1338, 1339,1340,1349,1352,1353,1367,1371 ,1374,1375,1376,1377,1386,1389,139 0,1404,1408,1411,1412,1413,1414 Y0 Local 1179 R(4) 4 1 409 1210,1211,1212,1214,1254,1255,1256 ,1258,1293,1294,1295,1297,1330,133 1,1332,1334,1367,1368,1369,1371,14 04,1405,1406,1408 Page 39 Source Listing LAG 2012-12-13 18:36 avhrr.f90 2829 2830 2831 SUBROUTINE DATTIM(IDT,NDT) 2832 !$$$ SUBPROGRAM DOCUMENTATION BLOCK 2833 ! SUBPROGRAM: DATTIM 2834 ! PRGMMR: Katz ORG: NP2 DATE: 1997-11-06 2835 ! 2836 ! ABSTRACT: Converts year, day-of-year, and second-of-day into year, 2837 ! month-of-year, day-of-month, hour-of-day, minute-of-hour, and 2838 ! second-of-minute. 2839 ! 2840 ! PROGRAM HISTORY LOG: 2841 ! 1997-11-06 Katz Original author 2842 ! 2843 ! USAGE: CALL DATTIM(IDT,NDT) 2844 ! INPUT ARGUMENT LIST: 2845 ! IDT - Integer array argument containing three members: 2846 ! year, day-of-year, and second-of-day 2847 ! 2848 ! OUTPUT ARGUMENT LIST: 2849 ! KDT - Integer array argument containing six members: 2850 ! year, month-of-year, day-of-month, hour-of-day, 2851 ! minute-of-hour, and second-of-minute 2852 ! 2853 ! Remarks: 2854 ! 2855 ! Attributes: 2856 ! Language: FORTRAN 90 (free format) 2857 ! Machine: NCEP WCOSS 2858 ! 2859 !$$$ 2860 2861 ! Array arguments .. 2862 ! ------------------ 2863 2864 integer idt(3),ndt(6) 2865 2866 integer :: julian 2867 2868 ! Local scalars .. 2869 ! ---------------- 2870 2871 integer :: iday,imon,iyr,jday,jda,idyr,idaywk,idayyr 2872 integer :: kyr,idy,jdn,jmo 2873 2874 ! External subroutines .. 2875 ! ----------------------- 2876 2877 external w3fs26 2878 2879 ! Intrinsic functions .. 2880 ! ---------------------- 2881 2882 intrinsic mod 2883 2884 julian(IYR,IDYR) = -31739 + 1461 * (IYR + 4799) / 4 & 2885 -3 * ((IYR + 4899) / 100) / 4 + IDYR Page 40 Source Listing DATTIM 2012-12-13 18:36 avhrr.f90 2886 2887 iyr = idt(3) 2888 jday = idt(2) 2889 2890 ! If year is two digits, convert to 4 digits 2891 ! ------------------------------------------ 2892 2893 if (iyr.ge.0.and.iyr.le.99) then 2894 if (iyr.lt.21) then 2895 kyr = iyr + 2000 2896 else 2897 kyr = iyr + 1900 2898 endif 2899 else 2900 kyr = iyr 2901 endif 2902 2903 ! Compute Julian day number as number days after 4713 BC 2904 ! ------------------------------------------------------ 2905 2906 idy = jday 2907 jdn = julian(kyr,idy) 2908 2909 call w3fs26(jdn,iyear,jmo,jda,idaywk,idayyr) 2910 2911 ndt(1) = iyr 2912 ndt(2) = jmo 2913 ndt(3) = jda 2914 ndt(4) = idt(1)/3600 2915 ndt(5) = mod(idt(1),3600)/60 2916 ndt(6) = idt(1) - 3600*ndt(4) - 60*ndt(5) 2917 2918 END SUBROUTINE DATTIM Page 41 Source Listing DATTIM 2012-12-13 18:36 Entry Points avhrr.f90 ENTRY POINTS Name gac_1b_proc_mp_dattim_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References DATTIM Subr 1422 317 IDAY Local 1462 I(4) 4 scalar IDAYWK Local 1462 I(4) 4 scalar 1500 IDAYYR Local 1462 I(4) 4 scalar 1500 IDT Dummy 1422 I(4) 4 1 3 ARG,INOUT 1478,1479,1505,1506,1507 IDY Local 1463 I(4) 4 scalar 1497,1498 IDYR Local 1462 I(4) 4 scalar IMON Local 1462 I(4) 4 scalar IYR Local 1462 I(4) 4 scalar 1478,1484,1485,1486,1488,1491,1502 JDA Local 1462 I(4) 4 scalar 1500,1504 JDAY Local 1462 I(4) 4 scalar 1479,1497 JDN Local 1463 I(4) 4 scalar 1498,1500 JMO Local 1463 I(4) 4 scalar 1500,1503 JULIAN Local 1457 I(4) 4 scalar 1498 KYR Local 1463 I(4) 4 scalar 1486,1488,1491,1498 MOD Func 1473 scalar 1506 NDT Dummy 1422 I(4) 4 1 6 ARG,INOUT 1502,1503,1504,1505,1506,1507 W3FS26 Subr 1468 1500 Page 42 Source Listing DATTIM 2012-12-13 18:36 avhrr.f90 2919 2920 END MODULE GAC_1B_PROC SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References APPCHR Local 47 CHAR 80 scalar APPCHRP Local 47 CHAR 80 scalar ATIME Local 33 I(4) 4 scalar AVH_ATTANGTIME Scalar 528 I(4) 4 scalar COM AVH_BITFLAG1 Scalar 567 I(2) 2 scalar COM AVH_BITFLAG2 Scalar 575 I(4) 4 scalar COM AVH_CALIR Scalar 478 I(4) 4 3 18 COM AVH_CALQUAL Scalar 445 I(2) 2 1 3 COM AVH_CALVIS Scalar 463 I(4) 4 3 45 COM AVH_CBITERR Scalar 457 I(2) 2 scalar COM AVH_CLOCKDRIFT Scalar 365 I(2) 2 scalar COM AVH_DBDATA Scalar 569 I(2) 2 scalar COM AVH_DT Scalar 591 I(4) 4 1 1152 COM AVH_FILLER0 Scalar 373 I(2) 2 1 5 COM AVH_FILLER1 Scalar 459 I(4) 4 1 2 COM AVH_FILLER2 Scalar 500 I(4) 4 1 3 COM AVH_FILLER3 Scalar 540 I(2) 2 1 3 COM AVH_FILLER4 Scalar 547 I(4) 4 1 2 COM AVH_FILLER5 Scalar 557 I(2) 2 scalar COM AVH_FILLER6 Scalar 563 I(4) 4 1 2 COM AVH_FILLER7 Scalar 570 I(4) 4 1 3 COM AVH_FILLER8 Scalar 582 I(2) 2 1 3 COM AVH_FILLER9 Scalar 589 I(4) 4 1 112 COM AVH_HD Scalar 302 I(4) 4 1 1152 COM AVH_H_ADCONTEMP Scalar 282 I(2) 2 1 5 COM AVH_H_ALBCNV Scalar 185 I(4) 4 2 6 COM AVH_H_ARGPER Scalar 228 I(4) 4 scalar COM AVH_H_AUXSYNCERRSUM Scalar 123 I(2) 2 scalar COM AVH_H_BBTEMP1 Scalar 260 I(2) 2 1 5 COM AVH_H_BBTEMP2 Scalar 262 I(2) 2 1 5 COM AVH_H_BBTEMP3 Scalar 264 I(2) 2 1 5 COM AVH_H_BBTEMP4 Scalar 266 I(2) 2 1 5 COM AVH_H_BBTEMPCHN3B Scalar 288 I(2) 2 1 5 COM AVH_H_BBTEMPCHN4 Scalar 290 I(2) 2 1 5 COM AVH_H_BBTEMPCHN5 Scalar 292 I(2) 2 1 5 COM AVH_H_BLANK Scalar 53 CHAR 1 scalar COM AVH_H_BLKSZ Scalar 60 I(2) 2 scalar COM AVH_H_BPTEMP Scalar 278 I(2) 2 1 5 COM AVH_H_CALLOCSCNLIN Scalar 112 I(2) 2 scalar COM AVH_H_CHTEMP Scalar 276 I(2) 2 1 5 COM AVH_H_CPIDSDY Scalar 89 I(2) 2 scalar COM AVH_H_CPIDSYR Scalar 88 I(2) 2 scalar COM AVH_H_D4BVOLT Scalar 284 I(2) 2 1 5 COM AVH_H_D5BVOLT Scalar 286 I(2) 2 1 5 COM AVH_H_DATAGAPS Scalar 117 I(2) 2 scalar COM AVH_H_DATANAME Scalar 64 CHAR 42 scalar COM AVH_H_DATATYP Scalar 68 I(2) 2 scalar COM AVH_H_EARTHPOS Scalar 272 I(2) 2 1 5 COM AVH_H_EARTHSUN Scalar 244 I(4) 4 scalar COM Page 43 Source Listing DATTIM 2012-12-13 18:36 Symbol Table avhrr.f90 Name Object Declared Type Bytes Dimen Elements Attributes References AVH_H_ECCEN Scalar 226 I(4) 4 scalar COM AVH_H_ELECCUR Scalar 268 I(2) 2 1 5 COM AVH_H_ELECTEMP Scalar 274 I(2) 2 1 5 COM AVH_H_ENDDATADY Scalar 85 I(2) 2 scalar COM AVH_H_ENDDATAJD Scalar 82 I(4) 4 scalar COM AVH_H_ENDDATATIME Scalar 86 I(4) 4 scalar COM AVH_H_ENDDATAYR Scalar 84 I(2) 2 scalar COM AVH_H_EPODY Scalar 222 I(2) 2 scalar COM AVH_H_EPOTIME Scalar 223 I(4) 4 scalar COM AVH_H_EPOYR Scalar 221 I(2) 2 scalar COM AVH_H_FILLER0 Scalar 63 I(2) 2 1 3 COM AVH_H_FILLER1 Scalar 91 I(2) 2 1 4 COM AVH_H_FILLER2 Scalar 105 I(2) 2 scalar COM AVH_H_FILLER3 Scalar 150 I(4) 4 scalar COM AVH_H_FILLER4 Scalar 155 I(2) 2 1 5 COM AVH_H_FILLER5 Scalar 181 I(4) 4 1 2 COM AVH_H_FILLER6 Scalar 203 I(4) 4 1 3 COM AVH_H_FILLER7 Scalar 213 I(2) 2 scalar COM AVH_H_FILLER8 Scalar 245 I(4) 4 1 4 COM AVH_H_FILLER9 Scalar 300 I(2) 2 1 1960 COM AVH_H_HDRCNT Scalar 61 I(2) 2 scalar COM AVH_H_INCLI Scalar 227 I(4) 4 scalar COM AVH_H_INSTID Scalar 67 I(2) 2 scalar COM AVH_H_INSTSTAT1 Scalar 95 I(4) 4 scalar COM AVH_H_INSTSTAT2 Scalar 108 I(4) 4 scalar COM AVH_H_IRTTCOEF Scalar 179 I(2) 2 2 24 COM AVH_H_L1BVERSDY Scalar 56 I(2) 2 scalar COM AVH_H_L1BVERSNB Scalar 54 I(2) 2 scalar COM AVH_H_L1BVERSYR Scalar 55 I(2) 2 scalar COM AVH_H_LOCBIT Scalar 210 I(2) 2 scalar COM AVH_H_LOCERRCODE Scalar 138 I(2) 2 scalar COM AVH_H_LOCERRIND Scalar 134 I(2) 2 scalar COM AVH_H_MANOM Scalar 231 I(4) 4 scalar COM AVH_H_MHTEMP Scalar 280 I(2) 2 1 5 COM AVH_H_MISSCNLIN Scalar 115 I(2) 2 scalar COM AVH_H_MODELID Scalar 207 CHAR 8 scalar COM AVH_H_MOTORCUR Scalar 270 I(2) 2 1 5 COM AVH_H_NADLOCTOL Scalar 208 I(2) 2 scalar COM AVH_H_OKDATAFR Scalar 119 I(2) 2 scalar COM AVH_H_PACSDATASRC Scalar 147 I(2) 2 scalar COM AVH_H_PACSPARITYERR Scalar 121 I(2) 2 scalar COM AVH_H_PACSSTATFIELD Scalar 139 I(2) 2 scalar COM AVH_H_PCALALGIND Scalar 173 I(2) 2 scalar COM AVH_H_PCALALGOPT Scalar 174 I(2) 2 scalar COM AVH_H_PCHPOW Scalar 256 I(2) 2 1 5 COM AVH_H_PCHTEMP Scalar 252 I(2) 2 1 5 COM AVH_H_PCHTEMPEXT Scalar 254 I(2) 2 1 5 COM AVH_H_PITCHERR Scalar 217 I(2) 2 scalar COM AVH_H_PRBLKID Scalar 65 CHAR 8 scalar COM AVH_H_RACALIND Scalar 160 I(2) 2 scalar COM AVH_H_RADTEMPCNV Scalar 194 I(4) 4 2 9 COM AVH_H_RASCNOD Scalar 229 I(4) 4 scalar COM AVH_H_RDTEMP Scalar 258 I(2) 2 1 5 COM AVH_H_RECLG Scalar 58 I(2) 2 scalar COM AVH_H_REFVOLT Scalar 294 I(2) 2 1 5 COM Page 44 Source Listing DATTIM 2012-12-13 18:36 Symbol Table avhrr.f90 Name Object Declared Type Bytes Dimen Elements Attributes References AVH_H_RESERVED1 Scalar 253 I(2) 2 scalar COM AVH_H_RESERVED10 Scalar 271 I(2) 2 scalar COM AVH_H_RESERVED11 Scalar 273 I(2) 2 scalar COM AVH_H_RESERVED12 Scalar 275 I(2) 2 scalar COM AVH_H_RESERVED13 Scalar 277 I(2) 2 scalar COM AVH_H_RESERVED14 Scalar 279 I(2) 2 scalar COM AVH_H_RESERVED15 Scalar 281 I(2) 2 scalar COM AVH_H_RESERVED16 Scalar 283 I(2) 2 scalar COM AVH_H_RESERVED17 Scalar 285 I(2) 2 scalar COM AVH_H_RESERVED18 Scalar 287 I(2) 2 scalar COM AVH_H_RESERVED19 Scalar 289 I(2) 2 scalar COM AVH_H_RESERVED2 Scalar 255 I(2) 2 scalar COM AVH_H_RESERVED20 Scalar 291 I(2) 2 scalar COM AVH_H_RESERVED21 Scalar 293 I(2) 2 scalar COM AVH_H_RESERVED22 Scalar 295 I(2) 2 scalar COM AVH_H_RESERVED3 Scalar 257 I(2) 2 scalar COM AVH_H_RESERVED4 Scalar 259 I(2) 2 scalar COM AVH_H_RESERVED5 Scalar 261 I(2) 2 scalar COM AVH_H_RESERVED6 Scalar 263 I(2) 2 scalar COM AVH_H_RESERVED7 Scalar 265 I(2) 2 scalar COM AVH_H_RESERVED8 Scalar 267 I(2) 2 scalar COM AVH_H_RESERVED9 Scalar 269 I(2) 2 scalar COM AVH_H_ROLLERR Scalar 215 I(2) 2 scalar COM AVH_H_SATID Scalar 66 I(2) 2 scalar COM AVH_H_SCALALGIND Scalar 176 I(2) 2 scalar COM AVH_H_SCALALGOPT Scalar 177 I(2) 2 scalar COM AVH_H_SCNLIN Scalar 110 I(2) 2 scalar COM AVH_H_SITEID Scalar 52 CHAR 3 scalar COM AVH_H_SMAXIS Scalar 225 I(4) 4 scalar COM AVH_H_SOCCLOCKUPIND Scalar 130 I(2) 2 scalar COM AVH_H_SOLARCALDY Scalar 171 I(2) 2 scalar COM AVH_H_SOLARCALYR Scalar 169 I(2) 2 scalar COM AVH_H_SPARE1 Scalar 151 CHAR 8 scalar COM AVH_H_SPARE2 Scalar 153 CHAR 8 scalar COM AVH_H_STARTDATADY Scalar 79 I(2) 2 scalar COM AVH_H_STARTDATAJD Scalar 76 I(4) 4 scalar COM AVH_H_STARTDATATIME Scalar 80 I(4) 4 scalar COM AVH_H_STARTDATAYR Scalar 78 I(2) 2 scalar COM AVH_H_STATCHRECNB Scalar 106 I(2) 2 scalar COM AVH_H_TIMESEQERR Scalar 126 I(2) 2 scalar COM AVH_H_TIMESEQERRCODE Scalar 129 I(2) 2 scalar COM AVH_H_TIPSRC Scalar 72 I(2) 2 scalar COM AVH_H_XPOS Scalar 232 I(4) 4 scalar COM AVH_H_XVEL Scalar 238 I(4) 4 scalar COM AVH_H_YAWERR Scalar 219 I(2) 2 scalar COM AVH_H_YPOS Scalar 234 I(4) 4 scalar COM AVH_H_YVEL Scalar 240 I(4) 4 scalar COM AVH_H_ZPOS Scalar 236 I(4) 4 scalar COM AVH_H_ZVEL Scalar 242 I(4) 4 scalar COM AVH_INSTEMP Scalar 581 I(1) 1 1 22 COM AVH_MXHRPCHN Param 35 I(4) 4 scalar AVH_MXIRCHN Param 35 I(4) 4 scalar 194,445,478 AVH_MXPIX Param 36 I(4) 4 scalar AVH_MXVISCHN Param 35 I(4) 4 scalar 185,463 AVH_NAVSTAT Scalar 504 I(4) 4 scalar COM Page 45 Source Listing DATTIM 2012-12-13 18:36 Symbol Table avhrr.f90 Name Object Declared Type Bytes Dimen Elements Attributes References AVH_PITCHANG Scalar 531 I(2) 2 scalar COM AVH_QUALIND Scalar 377 I(4) 4 scalar COM AVH_ROLLANG Scalar 530 I(2) 2 scalar COM AVH_SCNLINQUAL Scalar 399 I(4) 4 scalar COM AVH_TELEM Scalar 552 I(2) 2 1 103 COM AVH_YAWANG Scalar 532 I(2) 2 scalar COM CATIME Local 49 CHAR 10 scalar CAVH_SIZE Param 39 I(4) 4 scalar 302,591 CBUFR_TIME Local 79 CHAR 10 1 20 CDD Local 52 CHAR 2 scalar CHH Local 52 CHAR 2 scalar CHN_NAME Local 77 CHAR 2 1 6 83 CID Local 50 CHAR 8 scalar CLIMA Local 68 R(4) 4 3 3110400 CLV_REV Scalar 587 I(4) 4 scalar COM CMM Local 52 CHAR 2 scalar CNCEPSST_DATE Local 50 CHAR 8 scalar CPDD Local 76 CHAR 2 1 102 76 CPMM Local 76 CHAR 2 1 102 76 CPYYYY Local 78 CHAR 4 1 102 78 CSAT Local 52 CHAR 2 scalar CYYYY Local 51 CHAR 4 scalar DD Local 33 I(4) 4 scalar DTR Param 27 R(4) 4 scalar DXY Param 27 R(4) 4 scalar EX Local 45 L(4) 4 scalar FLAG Local 36 I(4) 4 scalar GAC1BDT Common 593 4608 GAC1BHD Common 306 4608 GAC_1B_PROC Module 1 HH Local 33 I(4) 4 scalar ICHAN Local 57 I(4) 4 1 5 86 IDUM Local 36 I(4) 4 scalar ID_NCEP Local 32 I(4) 4 scalar IERR Local 31 I(4) 4 scalar IMON Local 36 I(4) 4 scalar IM_NCEP Local 36 I(4) 4 scalar IOS Local 35 I(4) 4 scalar IY_NCEP Local 36 I(4) 4 scalar JDATE Local 31 I(4) 4 scalar JMD1 Local 35 I(4) 4 scalar JMD2 Local 35 I(4) 4 scalar JMD3 Local 35 I(4) 4 scalar JMON Local 36 I(4) 4 scalar JSAT0 Local 35 I(4) 4 scalar K Local 35 I(4) 4 scalar KDATE Local 31 I(4) 4 scalar LAPCHR Local 31 I(4) 4 scalar LAPCHRP Local 31 I(4) 4 scalar LAT1_SST Param 25 R(4) 4 scalar LAT2_SST Param 25 R(4) 4 scalar LFIRST Local 45 L(4) 4 scalar 88 LINE Local 35 I(4) 4 scalar LON1_SST Param 25 R(4) 4 scalar LON2_SST Param 25 R(4) 4 scalar Page 46 Source Listing DATTIM 2012-12-13 18:36 Symbol Table avhrr.f90 Name Object Declared Type Bytes Dimen Elements Attributes References LSUBDR Local 31 I(4) 4 scalar LSUBDRP Local 31 I(4) 4 scalar LTNKID Local 31 I(4) 4 scalar LTNKIDP Local 31 I(4) 4 scalar LU1B Param 20 I(4) 4 scalar LUNDX Param 21 I(4) 4 scalar LU_BUFR Local 59 I(4) 4 1 12 59 LU_NCEPSST Local 36 I(4) 4 scalar LU_SST Local 62 I(4) 4 1 2 MAXREAD Param 18 I(4) 4 scalar MCH Param 18 I(4) 4 scalar 19,56,57,70 MM Local 33 I(4) 4 scalar NAVYSST Local 34 I(4) 4 scalar NLAT_SST Param 22 I(4) 4 scalar 68 NLEV Local 36 I(4) 4 scalar NLO Local 35 I(4) 4 scalar NLON_SST Param 22 I(4) 4 scalar 68 NMON Param 21 I(4) 4 scalar 68 NPRINT Param 21 I(4) 4 scalar NREAL Param 19 I(4) 4 scalar 19 NRECS Local 34 I(4) 4 scalar NRI Local 35 I(4) 4 scalar NSCAN Local 34 I(4) 4 scalar NTOT Param 19 I(4) 4 scalar 72 NWORDS Param 41 I(4) 4 scalar 561 PDD Local 61 I(4) 4 1 2 PDDD Local 33 I(4) 4 scalar PDDD0 Local 33 I(4) 4 scalar PMM Local 61 I(4) 4 1 2 PYEAR Local 33 I(4) 4 scalar PYEAR0 Local 33 I(4) 4 scalar PYY Local 61 I(4) 4 1 2 PYYYY Local 61 I(4) 4 1 2 PYYYYDDD Local 61 I(4) 4 1 2 REAL_32 Param 16 I(4) 4 scalar REAL_64 Param 17 I(4) 4 scalar 43 RECLAVH Param 37 I(4) 4 scalar 39 RFAC Param 15 I(4) 4 scalar RTGSST Local 34 I(4) 4 scalar SCALE12 Local 43 R(8) 8 scalar SCALE5 Local 43 R(8) 8 scalar SCALE6 Local 43 R(8) 8 scalar SCALE7 Local 43 R(8) 8 scalar SCALE9 Local 43 R(8) 8 scalar SELECTED_REAL_KIND Func 16 scalar 16,17 SST_DATE Local 62 I(4) 4 1 2 STATID Local 50 CHAR 8 scalar STDOUT Param 20 I(4) 4 scalar SUBDIR Local 48 CHAR 12 scalar SUBDIRP Local 48 CHAR 12 scalar SUBSET Local 50 CHAR 8 scalar SUBSETP Local 50 CHAR 8 scalar TANKID Local 48 CHAR 12 scalar TANKIDP Local 48 CHAR 12 scalar THI Param 26 R(4) 4 scalar Page 47 Source Listing DATTIM 2012-12-13 18:36 Symbol Table avhrr.f90 Name Object Declared Type Bytes Dimen Elements Attributes References TLFLAG Local 50 CHAR 8 scalar TLFLAGP Local 50 CHAR 8 scalar TLO Param 26 R(4) 4 scalar TTP Param 27 R(4) 4 scalar VISHI Param 26 R(4) 4 scalar VISLO Param 26 R(4) 4 scalar YYYY Local 33 I(4) 4 scalar Page 48 Source Listing DATTIM 2012-12-13 18:36 avhrr.f90 2921 Page 49 Source Listing DATTIM 2012-12-13 18:36 Subprograms/Common Blocks avhrr.f90 SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References AVHRR Subr 94 AVH_ICON Subr 1071 727 BUFR1B Subr 374 367 CAVHCPIDS Common 83 2000 CPLANCK Common 91 64 DATTIM Subr 1422 317 GAC1BDT Common 593 4608 GAC1BHD Common 306 4608 GAC_1B_PROC Module 1 GAC_LBC Subr 488 249 LAG Subr 1144 183,184,185,187,188 TEMP_CONV Common 1109 48036 COMPILER OPTIONS BEING USED -align nocommons -align nodcommons -align noqcommons -align records -align nosequence -align norec1byte -align norec2byte -align norec4byte -align norec8byte -align norec16byte -altparam -assume accuracy_sensitive -assume nobscc -assume nobuffered_io -assume byterecl -assume nocc_omp -assume nocstring -assume nodummy_aliases -assume nofpe_summary -assume noieee_fpe_flags -assume nominus0 -assume noold_boz -assume old_unit_star -assume noold_ldout_format -assume noold_logical_ldio -assume old_maxminloc -assume old_xor -assume protect_constants -assume noprotect_parens -assume split_common -assume source_include -assume nostd_intent_in -assume nostd_mod_proc_name -assume norealloc_lhs -assume underscore -assume no2underscores no -auto -auto_scalar no -bintext -ccdefault default -check noargs -check noarg_temp_created -check nobounds -check noformat -check nooutput_conversion -check nooverflow -check nopointers -check power -check noshape -check nounderflow -check nouninitialized -coarray-num-procs 0 no -coarray-config-file -convert big_endian -cross_reference -D __INTEL_COMPILER=1210 -D __unix__ -D __unix -D __linux__ -D __linux -D __gnu_linux__ -D unix -D linux -D __ELF__ -D __x86_64 -D __x86_64__ -D _MT -D __INTEL_COMPILER_BUILD_DATE=20120612 -D __i686 -D __i686__ -D __pentiumpro -D __pentiumpro__ Page 50 Source Listing DATTIM 2012-12-13 18:36 avhrr.f90 -D __pentium4 -D __pentium4__ -D __tune_pentium4__ -D __SSE2__ -D __SSE__ -D __MMX__ -double_size 64 no -d_lines no -Qdyncom -error_limit 30 no -f66 no -f77rtl no -fast -fpscomp nofilesfromcmd -fpscomp nogeneral -fpscomp noioformat -fpscomp noldio_spacing -fpscomp nologicals no -fpconstant -fpe3 -fprm nearest no -ftz -fp_model noprecise -fp_model nofast -fp_model strict -fp_model nosource -fp_model nodouble -fp_model noextended -fp_model novery_fast -fp_model noexcept -fp_model nono_except -fp_modbits nofp_contract -fp_modbits nono_fp_contract -fp_modbits nofenv_access -fp_modbits nono_fenv_access -fp_modbits nocx_limited_range -fp_modbits nono_cx_limited_range -fp_modbits noprec_div -fp_modbits nono_prec_div -fp_modbits noprec_sqrt -fp_modbits nono_prec_sqrt -fp_modbits noftz -fp_modbits no_ftz -fp_modbits nointrin_limited_range -fp_modbits nono_intrin_limited_range -fp_modbits notrunc_compares -fp_modbits nono_trunc_compares -fp_modbits noieee_nan_compares -fp_modbits nono_ieee_nan_compares -fp_modbits nohonor_f32_conversion -fp_modbits nono_honor_f32_conversion -fp_modbits nohonor_f64_conversion -fp_modbits nono_honor_f64_conversion -fp_modbits nono_x87_copy -fp_modbits nono_no_x87_copy -fp_modbits noexception_semantics -fp_modbits nono_exception_semantics -fp_modbits noprecise_libm_functions -fp_modbits nono_precise_libm_functions -heap_arrays 0 no -threadprivate_compat -free -g0 -iface nomixed_str_len_arg -iface nono_mixed_str_len_arg no -intconstant -integer_size 32 no -mixed_str_len_arg no -module -names lowercase no -noinclude -O2 no -pad_source -real_size 32 no -recursive -reentrancy none no -sharable_localsaves -vec=simd -show noinclude -show map -show options no -syntax_only no -threadcom no -U no -vms -w noall -w nonone -w alignments -w noargument_checking -w nodeclarations -w general -w noignore_bounds -w noignore_loc -w nointerfaces -w notruncated_source -w uncalled -w uninitialized -w nounused -w usage -includepath : /gpfs/tp2/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/,.f,./.f,/usrx/local/intel/composerxe/mkl/include/.f, /usrx/local/intel/composerxe/tbb/include/.f,/gpfs/tp2/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/intel64/.f, /gpfs/tp2/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/.f,/usr/local/include/.f,/usr/lib/gcc/x86_64-redhat-linux/4.4.6/include/.f, /usr/include/.f,/usr/include/.f -list filename : avhrr.lst -o filename : none Page 51 Source Listing DATTIM 2012-12-13 18:36 avhrr.f90 COMPILER: Intel(R) Fortran 12.1-2100