Page 1 Source Listing CURRENT_DATE 2013-05-14 19:53 dtsset.f90 1 ! 2 ! 3 ! Description: Set valued for ECWMF application 4 ! 5 ! Author: Yucheng Song EMC/NCEP 6 ! 7 ! 2008.07.18 8 9 program dtsset 10 ! testing options to include the grib_api library 11 use grib_api 12 ! use grib_api_f77 13 ! use machine 14 implicit none 15 integer(kind = 4) :: centre, date 16 integer(kind = 4) :: infile,outfile 17 integer(kind = 4) :: igrib, iret 18 integer(kind = 4) :: mem 19 integer(kind = 4) :: nlon 20 integer(kind = 4) :: nlat 21 integer(kind = 4) :: ilon,ilat,i1,i2 22 integer(kind = 4) :: obsdate,leadtime,opttime 23 integer(kind = 4) :: lon1,lon2,lat1,lat2,reso 24 integer(kind = 4) :: vrlatu,vrlonl,vrlatl,vrlonu 25 real(kind = 4) :: rlon1,rlon2,rlat1,rlat2,rreso 26 real(kind = 4) :: rvrlatu,rvrlonl,rvrlatl,rvrlonu 27 real(kind = 4), dimension(:), allocatable :: values 28 29 read(5,*)nlon,nlat,rlon1,rlon2,rlat1,rlat2,rreso,obsdate,rvrlatu,rvrlonl,& 30 rvrlatl,rvrlonu,leadtime,opttime,mem 31 if (rlon1.gt.180) then 32 rlon1=rlon1 - 360.0 33 endif 34 if (rlon2.gt.180) then 35 rlon2=rlon2 - 360.0 36 endif 37 lon1=rlon1*1000 38 lon2=rlon2*1000 39 lat1=rlat1*1000 40 lat2=rlat2*1000 41 reso=rreso*1000*2 42 if (rvrlonl.gt.180) then 43 rvrlonl=rvrlonl-360.0 44 endif 45 if (rvrlonu.gt.180) then 46 rvrlonu=rvrlonu-360.0 47 endif 48 49 vrlatu=rvrlatu*100 50 vrlonl=rvrlonl*100 51 vrlatl=rvrlatl*100 52 vrlonu=rvrlonu*100 53 54 print*, nlon, nlat, lon1,lon2, mem 55 open (unit=121,FORM='FORMATTED') 56 allocate(values(nlon*nlat), stat=iret) 57 Page 2 Source Listing CHECK_SETTINGS 2013-05-14 19:53 dtsset.f90 58 do ilat=1,nlat 59 do ilon=1,nlon 60 read (121,31)i1, i2, values((ilat-1)*nlon+ilon) 61 enddo 62 enddo 63 64 31 format(2i5,f12.3) 65 66 centre = 07 67 call current_date(date) 68 print*, date 69 ! call grib_open_file(infile,'2008012800_354.grib','r') 70 71 ! call grib_new_from_file(infile,igrib) 72 call grib_new_from_template(igrib, 'SAC_NCEP') 73 print*, igrib 74 75 call grib_open_file(outfile, & 76 'out.grib1','w') 77 78 call grib_set(igrib,'dataDate',obsdate/100) 79 call grib_set(igrib,'dataTime',mod(obsdate,100)*100) 80 ! call grib_set(igrib,'date',obsdate) 81 call grib_set(igrib,'centre',centre) 82 call grib_set(igrib,'values', values) 83 84 call grib_set(igrib,'editionNumber',1) 85 ! ECMWF local table 2 version 128 86 call grib_set(igrib,'gribTablesVersionNo',128) 87 call grib_set(igrib,'identificationOfOriginatingGeneratingCentre',7) 88 call grib_set(igrib,'generatingProcessIdentifier',96) 89 call grib_set(igrib,'gridDefinition',255) ! undefined GRID, user defined 90 91 call grib_set(igrib,'section1Flags',128) 92 ! According to Table 128 or NCEP table, 126 = WMIXEsfc 93 call grib_set(igrib,'indicatorOfParameter',126) 94 95 call grib_set(igrib,'indicatorOfTypeOfLevel',1) 96 call grib_set(igrib,'level',0) 97 98 ! No need if called grib_set(igrib,'date',date) 99 ! call grib_set(igrib,'yearOfCentury',8) 100 ! call grib_set(igrib,'month',1) 101 ! call grib_set(igrib,'day',28) 102 ! call grib_set(igrib,'hour',0) 103 ! call grib_set(igrib,'minute',0) 104 105 call grib_set(igrib,'localDefinitionNumber',21) 106 107 ! 9 = TOST (mars/class.table) 108 call grib_set(igrib,'marsClass',9) 109 110 ! 64 = Signal variance (mars/type.table) */ 111 call grib_set(igrib,'marsType',64) 112 113 ! 1110 = Sensitive area prediction (mars/stream.table) */ 114 call grib_set(igrib,'marsStream',1110) Page 3 Source Listing CHECK_SETTINGS 2013-05-14 19:53 dtsset.f90 115 116 call grib_set(igrib,'numberOfForecastsInEnsemble',mem) 117 ! 0 lat-lon box region, 1 circular region 118 call grib_set(igrib,'shapeOfVerificationArea',1) 119 ! Verification Region definition 120 call grib_set(igrib,'accuracyMultipliedByFactor',100) 121 call grib_set(igrib,'numberOfVerticalCoordinateValues',0) 122 call grib_set(igrib,'northWestLatitudeOfVerficationArea',vrlatu) 123 call grib_set(igrib,'northWestLongitudeOfVerficationArea',vrlonl) 124 call grib_set(igrib,'southEastLatitudeOfVerficationArea',vrlatl) 125 call grib_set(igrib,'southEastLongitudeOfVerficationArea',vrlonu) 126 127 ! Set Target time values 128 call grib_set(igrib,'optimisationTime',opttime) 129 call grib_set(igrib,'forecastLeadTime',leadtime) 130 131 132 ! 0 = Latitude/Longitude Grid (grib1/6.table) 133 call grib_set(igrib,'dataRepresentationType',0) 134 135 ! Set Search domain 136 137 call grib_set(igrib,'numberOfPointsAlongAParallel',nlon) 138 call grib_set(igrib,'numberOfPointsAlongAMeridian',nlat) 139 call grib_set(igrib,'latitudeOfFirstGridPoint',lat2) 140 call grib_set(igrib,'latitudeOfLastGridPoint',lat1) 141 call grib_set(igrib,'longitudeOfFirstGridPoint',lon1) 142 call grib_set(igrib,'longitudeOfLastGridPoint',lon2) 143 call grib_set(igrib,'iDirectionIncrement',reso) 144 call grib_set(igrib,'jDirectionIncrement',reso) 145 ! Refer http://www.nco.ncep.noaa.gov/pmb/docs/on388/table7.html 146 ! You have to convert the binary to decimal, e.g. 10000000 = 128 147 ! 148 call grib_set(igrib,'resolutionAndComponentFlags',128) 149 call grib_set(igrib,'scanningMode',0) 150 151 ! call grib_set_long(igrib,"complexPacking",0) 152 153 deallocate(values) 154 155 ! check if it is correct in the actual GRIB message 156 call check_settings(igrib) 157 ! write modified message to a file 158 call grib_write(igrib,outfile) 159 160 call grib_release(igrib) 161 162 call grib_close_file(infile) 163 164 call grib_close_file(outfile) 165 166 contains 167 168 !====================================== 169 subroutine current_date(date) 170 integer, intent(out) :: date 171 Page 4 Source Listing CURRENT_DATE 2013-05-14 19:53 dtsset.f90 172 integer :: val_date(8) 173 call date_and_time ( values = val_date) 174 175 date = val_date(1)* 10000 + val_date(2)*100 + val_date(3) 176 end subroutine current_date ENTRY POINTS Name dtsset_IP_current_date_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References CURRENT_DATE Subr 169 67 DATE Dummy 169 I(4) 4 scalar ARG,OUT 175 DATE_AND_TIME Intrin 173 173 VAL_DATE Local 172 I(4) 4 1 8 173,175 Page 5 Source Listing CURRENT_DATE 2013-05-14 19:53 dtsset.f90 177 !====================================== 178 subroutine check_settings(gribid) 179 ! use grib_api ! test removal 180 implicit none 181 integer, intent(in) :: gribid 182 183 integer(kind = 4) :: int_value 184 character(len = 10) :: string_value 185 186 ! get centre as a integer 187 call grib_get(gribid,'centre',int_value) 188 write(*,*) "get centre as a integer - centre = ",int_value 189 190 ! get centre as a string 191 call grib_get(gribid,'centre',string_value) 192 write(*,*) "get centre as a string - centre = ",string_value 193 194 ! get date as a string 195 call grib_get(gribid,'dataDate',string_value) 196 write(*,*) "get date as a string - date = ",string_value 197 198 end subroutine check_settings ENTRY POINTS Name dtsset_IP_check_settings_ Page 6 Source Listing CHECK_SETTINGS 2013-05-14 19:53 Symbol Table dtsset.f90 SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References CHECK_SETTINGS Subr 178 156 GRIBID Dummy 178 I(4) 4 scalar ARG,IN 187,191,195 GRIB_GET Local 187 scalar 187,191,195 GRIB_GET_INT Subr 187 187 GRIB_GET_STRING Subr 191 191,195 INT_VALUE Local 183 I(4) 4 scalar 187,188 STRING_VALUE Local 184 CHAR 10 scalar 191,192,195,196 Page 7 Source Listing CHECK_SETTINGS 2013-05-14 19:53 dtsset.f90 199 end program dtsset ENTRY POINTS Name MAIN__ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 31 Label 64 60 CENTRE Local 15 I(4) 4 scalar 66,81 DATE Local 15 I(4) 4 scalar 67,68 DTSSET Prog 9 GRIB_API Module 11 11 GRIB_CLOSE_FILE Subr 162 162,164 GRIB_NEW_FROM_TEMPLATE Subr 72 72 GRIB_OPEN_FILE Subr 75 75 GRIB_RELEASE Subr 160 160 GRIB_SET Local 78 scalar 78,79,81,82,84,86,87,88,89,91,93,9 5,96,105,108,111,114,116,118,120,1 21,122,123,124,125,128,129,133,137 ,138,139,140,141,142,143,144,148,1 49 GRIB_SET_INT Subr 78 78,79,81,84,86,87,88,89,91,93,95,9 6,105,108,111,114,116,118,120,121, 122,123,124,125,128,129,133,137,13 8,139,140,141,142,143,144,148,149 GRIB_SET_REAL4_ARRAY Subr 82 82 GRIB_WRITE Subr 158 158 I1 Local 21 I(4) 4 scalar 60 I2 Local 21 I(4) 4 scalar 60 IGRIB Local 17 I(4) 4 scalar 72,73,78,79,81,82,84,86,87,88,89,9 1,93,95,96,105,108,111,114,116,118 ,120,121,122,123,124,125,128,129,1 33,137,138,139,140,141,142,143,144 ,148,149,156,158,160 ILAT Local 21 I(4) 4 scalar 58,60 ILON Local 21 I(4) 4 scalar 59,60 INFILE Local 16 I(4) 4 scalar 162 IRET Local 17 I(4) 4 scalar 56 LAT1 Local 23 I(4) 4 scalar 39,140 LAT2 Local 23 I(4) 4 scalar 40,139 LEADTIME Local 22 I(4) 4 scalar 30,129 LON1 Local 23 I(4) 4 scalar 37,54,141 LON2 Local 23 I(4) 4 scalar 38,54,142 MEM Local 18 I(4) 4 scalar 30,54,116 MOD Func 79 scalar 79 NLAT Local 20 I(4) 4 scalar 29,54,56,58,138 NLON Local 19 I(4) 4 scalar 29,54,56,59,60,137 OBSDATE Local 22 I(4) 4 scalar 29,78,79 OPTTIME Local 22 I(4) 4 scalar 30,128 OUTFILE Local 16 I(4) 4 scalar 75,158,164 Page 8 Source Listing CHECK_SETTINGS 2013-05-14 19:53 Symbol Table dtsset.f90 Name Object Declared Type Bytes Dimen Elements Attributes References RESO Local 23 I(4) 4 scalar 41,143,144 RLAT1 Local 25 R(4) 4 scalar 29,39 RLAT2 Local 25 R(4) 4 scalar 29,40 RLON1 Local 25 R(4) 4 scalar 29,31,32,37 RLON2 Local 25 R(4) 4 scalar 29,34,35,38 RRESO Local 25 R(4) 4 scalar 29,41 RVRLATL Local 26 R(4) 4 scalar 30,51 RVRLATU Local 26 R(4) 4 scalar 29,49 RVRLONL Local 26 R(4) 4 scalar 29,42,43,50 RVRLONU Local 26 R(4) 4 scalar 30,45,46,52 VALUES Local 27 R(4) 4 1 1 ALC 56,60,82,153 VRLATL Local 24 I(4) 4 scalar 51,124 VRLATU Local 24 I(4) 4 scalar 49,122 VRLONL Local 24 I(4) 4 scalar 50,123 VRLONU Local 24 I(4) 4 scalar 52,125 Page 9 Source Listing CHECK_SETTINGS 2013-05-14 19:53 Subprograms/Common Blocks dtsset.f90 SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References CHECK_SETTINGS Subr 178 156 CURRENT_DATE Subr 169 67 DTSSET Prog 9 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 old_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__ -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 Page 10 Source Listing CHECK_SETTINGS 2013-05-14 19:53 dtsset.f90 no -fpconstant -fpe3 -fprm nearest no -ftz -fp_model noprecise -fp_model fast -fp_model nostrict -fp_model nosource -fp_model nodouble -fp_model noextended -fp_model novery_fast -fp_model noexcept -fp_model nono_except -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/gp2/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/intel64/,.f90,./.f90, /gpfs/gp1/nco/ops/nwprod/wsr.v3.0.0/sorc/wsr_dtsset.fd/../../libs/ecmwf_grib_api-1.9.16/include/.f90,/usrx/local/intel/composerxe/mkl/include/.f90, /usrx/local/intel/composerxe/tbb/include/.f90,/gpfs/gp2/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/intel64/.f90, /gpfs/gp2/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/.f90,/usr/local/include/.f90,/usr/lib/gcc/x86_64-redhat-linux/4.4.6/include/.f90, /usr/include/.f90,/usr/include/.f90 -list filename : dtsset.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100