MODULE MODULE_NAMELIST !-----------------------------------------------------------------------------! ! Read the namelist file name "nml_filename" unit "iunit" ! ! D. GILL, April 1998 ! F. VANDENBERGHE, March 2001 !-----------------------------------------------------------------------------! USE MODULE_DATE USE MODULE_MM5 use map_utils #ifdef BKG USE MODULE_MAP #endif IMPLICIT NONE CHARACTER (LEN = 80) :: obs_gts_filename CHARACTER (LEN = 80) :: obs_err_filename CHARACTER (LEN = 80) :: prepbufr_output_filename CHARACTER (LEN = 80) :: prepbufr_table_filename CHARACTER (LEN = 3) :: fg_format integer :: iix, jjx, imap_proj, i_grid, j_grid,m_expand real :: standard_lon, moad_cen_lat, cen_lat, cen_lon,& dds, xxx, yyy, xxc, yyc, xlatt, xlonn type (proj_info) :: map_info #ifdef BKG CHARACTER (LEN = 80) :: first_guess_file #endif CHARACTER (LEN = 19) :: time_window_min CHARACTER (LEN = 19) :: time_analysis CHARACTER (LEN = 19) :: time_window_max, time_ahead CHARACTER (LEN = 5) :: USE_FOR INTEGER :: max_number_of_obs, idt, num_time_slots,& num_slots_past, num_slots_ahead, & output_ob_format = 2, & slot_len = 0 LOGICAL :: fatal_if_exceed_max_obs = .TRUE. LOGICAL :: qc_test_vert_consistency = .TRUE., & qc_test_convective_adj = .TRUE., & qc_test_above_lid = .TRUE., & remove_above_lid = .TRUE., & Thining_SATOB = .TRUE., & Thining_SSMI = .TRUE., & Thining_QSCAT = .TRUE. LOGICAL :: print_gts_read = .TRUE., & print_gpspw_read = .TRUE., & print_recoverp = .TRUE., & print_duplicate_loc = .TRUE., & print_duplicate_time = .TRUE., & print_recoverh = .TRUE., & print_qc_vert = .TRUE., & print_qc_conv = .TRUE., & print_qc_lid = .TRUE., & print_uncomplete = .TRUE. LOGICAL :: write_synop, write_ship , write_metar, write_buoy , & write_pilot, write_sound, write_amdar, write_satem, & write_satob, write_airep, write_gpspw, write_gpsztd,& write_gpsref,write_gpseph,write_ssmt1, write_ssmt2, & write_ssmi , write_tovs , write_qscat, write_profl, & write_bogus, write_airs , write_tamdar #ifdef BKG INTEGER :: time_earlier, time_later NAMELIST /RECORD1/ obs_gts_filename, obs_err_filename, & first_guess_file, fg_format NAMELIST /RECORD2/ time_earlier, time_later, time_analysis #else NAMELIST /RECORD1/ obs_gts_filename, obs_err_filename, fg_format NAMELIST /RECORD2/ time_window_min,time_analysis,time_window_max #endif NAMELIST /RECORD3/ max_number_of_obs, fatal_if_exceed_max_obs NAMELIST /RECORD4/ qc_test_vert_consistency, qc_test_convective_adj, & qc_test_above_lid, remove_above_lid,domain_check_h,& Thining_SATOB, Thining_SSMI, Thining_QSCAT NAMELIST /RECORD5/ print_gts_read, print_gpspw_read, & print_recoverp, & print_duplicate_loc, print_duplicate_time, & print_recoverh, print_qc_vert, & print_qc_conv, print_qc_lid, & #ifdef BKG user_defined_area, & print_uncomplete NAMELIST /RECORD6/ x_left, x_right, & y_bottom, y_top #else print_uncomplete NAMELIST /RECORD6/ ptop, ps0, ts0, tlp, pis0, tis0, & base_pres, base_temp, base_lapse, & base_strat_temp, base_tropo_pres NAMELIST /RECORD7/ iproj, phic, xlonc, truelat1, truelat2, & moad_cen_lat, standard_lon NAMELIST /RECORD8/ idd, maxnes, nestix, nestjx, dis, numc, & nesti, nestj #endif NAMELIST /RECORD9/ prepbufr_output_filename, & prepbufr_table_filename, output_ob_format, & USE_FOR, num_slots_past, num_slots_ahead, & write_synop, write_ship , write_metar, write_buoy , & write_pilot, write_sound, write_amdar, write_satem, & write_satob, write_airep, write_gpspw, write_gpsztd,& write_gpsref,write_gpseph,write_ssmt1, write_ssmt2, & write_ssmi , write_tovs , write_qscat, write_profl, & write_bogus, write_airs , write_tamdar CONTAINS SUBROUTINE GET_NAMELIST (nml_filename, iunit) CHARACTER (LEN = *) :: nml_filename INTEGER :: iunit INTEGER, DIMENSION (20) :: nml_read_errors INTEGER :: i, iost, ita, itb INTEGER :: error_number LOGICAL :: exist, fatal LOGICAL :: good_date1, good_date2 CHARACTER (LEN = 80) :: error_message CHARACTER (LEN = 80) :: proc_file = "PROC_NAMELIST" include 'missing.inc' !-----------------------------------------------------------------------------! ! Opening the NAMELIST file constitutes an important step. #ifdef BKG maxnes = 10 time_earlier=-90 ! in minutes time_later = 90 ! in minutes #endif iunit = 99 OPEN ( FILE = nml_filename, & UNIT = iunit, & STATUS = 'OLD', & ACCESS = 'SEQUENTIAL', & FORM = 'FORMATTED', & ACTION = 'READ', & IOSTAT = error_number ) IF ( error_number .NE. 0 ) THEN error_message = ' Error opening namelist file: ' fatal = .TRUE. CALL error_handler (proc_file, error_message, nml_filename, fatal) ENDIF ! Read namelist record nml_read_errors = 0 ! default: fg_format = 'MM5' obs_err_filename = 'obserr.txt' use_for = '3DVAR' ! . Initialize the new defined namelist variables (YRG 05/10/2007): base_pres = missing_r base_temp = missing_r base_lapse = missing_r base_strat_temp = missing_r base_tropo_pres = missing_r write_synop = .true. write_ship = .true. write_metar = .true. write_buoy = .true. write_pilot = .true. write_sound = .true. write_amdar = .true. write_satem = .true. write_satob = .true. write_airep = .true. write_gpspw = .true. write_gpsztd= .true. write_gpsref= .true. write_gpseph= .true. write_ssmt1 = .true. write_ssmt2 = .true. write_ssmi = .true. write_tovs = .true. write_qscat = .true. write_profl = .true. write_bogus = .true. write_airs = .true. write_tamdar= .true. READ ( UNIT = iunit , NML = record1 , IOSTAT = nml_read_errors(1) ) WRITE ( UNIT = 0 , NML = record1 ) IF ( nml_read_errors(1) .NE. 0 ) THEN WRITE ( UNIT = 0 , FMT = '(A)' ) ' Error in NAMELIST record 1' STOP ENDIF READ ( UNIT = iunit , NML = record2 , IOSTAT = nml_read_errors(2) ) WRITE ( UNIT = 0 , NML = record2 ) IF ( nml_read_errors(2) .NE. 0 ) THEN WRITE ( UNIT = 0 , FMT = '(A)' ) ' Error in NAMELIST record 2' STOP ENDIF READ ( UNIT = iunit , NML = record3 , IOSTAT = nml_read_errors(3) ) WRITE ( UNIT = 0 , NML = record3 ) IF ( nml_read_errors(3) .NE. 0 ) THEN WRITE ( UNIT = 0 , FMT = '(A)' ) ' Error in NAMELIST record 3' STOP ENDIF READ ( UNIT = iunit , NML = record4 , IOSTAT = nml_read_errors(4) ) WRITE ( UNIT = 0 , NML = record4 ) IF ( nml_read_errors(4) .NE. 0 ) THEN WRITE ( UNIT = 0 , FMT = '(A)' ) ' Error in NAMELIST record 4' STOP ENDIF #ifdef BKG user_defined_area = .false. #endif READ ( UNIT = iunit , NML = record5 , IOSTAT = nml_read_errors(5) ) WRITE ( UNIT = 0 , NML = record5 ) IF ( nml_read_errors(5) .NE. 0 ) THEN WRITE ( UNIT = 0 , FMT = '(A)' ) ' Error in NAMELIST record 5' STOP ENDIF ! Default values for tropopause (YRG, 04/12/2007): pis0 = 20000.0 tis0 = 215.0 ! --------------------------------------------------------- #ifdef BKG if(user_defined_area) then x_left = 0.0 x_right =1.0e20 y_bottom=0.0 y_top =1.0e20 READ ( UNIT = iunit , NML = record6 , IOSTAT = nml_read_errors(6) ) WRITE ( UNIT = 0 , NML = record6 ) IF ( nml_read_errors(6) .NE. 0 ) THEN WRITE ( UNIT = 0 , FMT = '(A)' ) ' Error in NAMELIST record 6' STOP ENDIF end if #else READ ( UNIT = iunit , NML = record6 , IOSTAT = nml_read_errors(6) ) ! ! . use the new defined namelist variables (YRG 05/10/2007): if (base_pres /= missing_r) ps0 = base_pres if (base_temp /= missing_r) ts0 = base_temp if (base_lapse /= missing_r) tlp = base_lapse if (base_strat_temp /= missing_r) tis0 = base_strat_temp if (base_tropo_pres /= missing_r) pis0 = base_tropo_pres WRITE ( UNIT = 0 , NML = record6 ) IF ( nml_read_errors(6) .NE. 0 ) THEN WRITE ( UNIT = 0 , FMT = '(A)' ) ' Error in NAMELIST record 6' STOP ENDIF READ ( UNIT = iunit , NML = record7 , IOSTAT = nml_read_errors(7) ) WRITE ( UNIT = 0 , NML = record7 ) IF ( nml_read_errors(7) .NE. 0 ) THEN WRITE ( UNIT = 0 , FMT = '(A)' ) ' Error in NAMELIST record 7' STOP ENDIF READ ( UNIT = iunit , NML = record8 , IOSTAT = nml_read_errors(8) ) WRITE ( UNIT = 0 , NML = record8 ) IF ( nml_read_errors(8) .NE. 0 ) THEN WRITE ( UNIT = 0 , FMT = '(A)' ) ' Error in NAMELIST record 8' STOP ENDIF #endif prepbufr_output_filename = 'prepbufr_output_filename' prepbufr_table_filename = 'prepbufr_table_filename' READ ( UNIT = iunit , NML = record9 , IOSTAT = nml_read_errors(9) ) WRITE ( UNIT = 0 , NML = record9 ) IF ( nml_read_errors(9) .NE. 0 ) THEN WRITE ( UNIT = 0 , FMT = '(A)' ) ' Error in NAMELIST record 9' STOP ENDIF ! test for existence of table OPEN (UNIT = 10, FILE = prepbufr_table_filename, STATUS='old', IOSTAT=iost) if (iost .ne. 0 .and. output_ob_format .ne. 2) then write(0,*) ' ' write(0,*) 'You requested prepbufr output format, but I cannot open the prepbufr table.' write(0,*) 'Check that the file exists and the variables in record9 of the namelist are set properly.' write(0,*) 'output_ob_format = ',output_ob_format, & 'prepbufr_table_filename = ',prepbufr_table_filename STOP endif CLOSE (10) ! Process read error error_number = SUM ( nml_read_errors ) IF (error_number .NE. 0 ) THEN error_message = ' Error reading namelist file: ' fatal = .TRUE. CALL error_handler (proc_file, error_message, nml_filename, fatal) END IF ! After the NAMELIST file is input, the unit needs to ! be properly closed. CLOSE ( UNIT = iunit ) #ifdef BKG !--Get Big Record Header iunit = 41 OPEN ( FILE = first_guess_file, & UNIT = iunit, & STATUS = 'OLD', & ACCESS = 'SEQUENTIAL', & FORM = 'UNFORMATTED', & ACTION = 'READ', & IOSTAT = error_number ) call get_map_params (iunit) CLOSE ( UNIT = iunit ) #endif ! Check consistency IF ((remove_above_lid) .AND. (.NOT. qc_test_above_lid)) THEN qc_test_above_lid = .TRUE. ENDIF ! Time window IF (LEN_TRIM (time_window_min) .LE. 10) THEN WRITE (time_window_min,'(A4,"-",A2,"-",A2,"_",A2,":",A2,":",A2)') & time_window_min ( 1: 4), time_window_min ( 5: 6), & time_window_min ( 7: 8), time_window_min ( 9:10), & '00', '00' ELSE IF (LEN_TRIM (time_window_min) .LE. 14) THEN WRITE (time_window_min,'(A4,"-",A2,"-",A2,"_",A2,":",A2,":",A2)') & time_window_min ( 1: 4), time_window_min ( 5: 6), & time_window_min ( 7: 8), time_window_min ( 9:10), & time_window_min (11:12), time_window_min (13:14) ENDIF #ifdef BKG time_window_min=time_analysis time_window_max=time_analysis call geth_newdate (time_window_min, time_analysis(1:16), time_earlier) call geth_newdate (time_window_max, time_analysis(1:16), time_later) #else IF (LEN_TRIM (time_analysis) .LE. 10) THEN WRITE (time_analysis,'(A4,"-",A2,"-",A2,"_",A2,":",A2,":",A2)') & time_analysis ( 1: 4), time_analysis ( 5: 6), & time_analysis ( 7: 8), time_analysis ( 9:10), & '00', '00' ELSE IF (LEN_TRIM (time_analysis) .LE. 14) THEN WRITE (time_analysis,'(A4,"-",A2,"-",A2,"_",A2,":",A2,":",A2)') & time_analysis ( 1: 4), time_analysis ( 5: 6), & time_analysis ( 7: 8), time_analysis ( 9:10), & time_analysis (11:12), time_analysis (13:14) ENDIF IF (LEN_TRIM (time_window_max) .LE. 10) THEN WRITE (time_window_max,'(A4,"-",A2,"-",A2,"_",A2,":",A2,":",A2)') & time_window_max ( 1: 4), time_window_max ( 5: 6), & time_window_max ( 7: 8), time_window_max ( 9:10), & '00', '00' ELSE IF (LEN_TRIM (time_window_max) .LE. 14) THEN WRITE (time_window_max,'(A4,"-",A2,"-",A2,"_",A2,":",A2,":",A2)') & time_window_max ( 1: 4), time_window_max ( 5: 6), & time_window_max ( 7: 8), time_window_max ( 9:10), & time_window_max (11:12), time_window_max (13:14) ENDIF #endif CALL GETH_IDTS (time_analysis, time_window_min,itb,good_date1) CALL GETH_IDTS (time_analysis, time_window_max,ita,good_date2) IF ((itb .LT. 0) .OR. (ita .GT. 0.) .OR. & (.NOT. good_date1) .OR. (.NOT. good_date2)) THEN error_message = & " Error: The time window [" // TRIM (time_window_min) // ", " // & TRIM (time_window_max) // & "] does not mencompass the analysis time: " fatal = .TRUE. CALL error_handler (proc_file, error_message, time_analysis, fatal) END IF IF ( use_for == '3DVAR' ) THEN num_slots_past = 0 num_slots_ahead = 0 slot_len = itb -ita ELSE IF ( use_for == 'FGAT ' .or. use_for == '4DVAR' ) THEN if (num_slots_past <= 0) then write(0,'("===> For FGAT or 4DVAR,",a,i2,a)') & "the num_slots_past (=", num_slots_past, ") MUST be > 0 ???" stop endif slot_len = itb / num_slots_past idt = slot_len * num_slots_ahead if ( idt /= -ita ) then call geth_newdate (time_ahead, time_analysis, idt) write(0,'(3a,i2/a,1x,a)') 'time_window_max =', time_window_max,& ' in namelist is NOT consistent with num_slots_ahead=',& num_slots_ahead,' Reset the time_window_max to be ', time_ahead time_window_max = time_ahead endif ELSE error_message = & "Error: obsproc only used for 3DVAR, FGAT, and 4DVAR," // & " check the variable: use_for " fatal = .TRUE. CALL error_handler (proc_file, error_message, use_for, fatal) stop ENDIF num_time_slots = num_slots_past + num_slots_ahead + 1 if (num_time_slots <= 2) num_time_slots = 1 if (iproj <0 .or.iproj > 3) then write (0,'(/a)') '*** Please check the iproj setting??? ' write (0,'(5x,a)') 'iproj = 0 ===> PROJ_LATLON for Global domain.' write (0,'(5x,a)') 'iproj = 1 ===> PROJ_LC for Lambert Congormsl.' write (0,'(5x,a)') 'iproj = 2 ===> PROJ_PS for Polar Stereographic.' write (0,'(5x,a)') 'iproj = 3 ===> PROJ_ME for Mercator' write (0,'(a)') '??? iproj setting outside the range......' STOP endif if (fg_format == 'WRF') then write(0,'(/15x,a,a,a)') '=== 3DVAR_OBSPROC is used for WRF ', & use_for,' ===' write(0,'(10x,a,i2,a,i5,a/)') '{number of slots =', num_time_slots, & ', length of the full-slot =', slot_len, ' sec.}' ! .. Set up the map_info using the central lat/lon: if(iproj == 0) then imap_proj = PROJ_LATLON else if(iproj == 1) then imap_proj = PROJ_LC else if(iproj == 2) then imap_proj = PROJ_PS else if(iproj == 3) then imap_proj = PROJ_MERC endif cen_lat = phic cen_lon = xlonc iix = nestix(1) jjx = nestjx(1) dds = dis(1)*1000.0 xxc = real(jjx)/2. yyc = real(iix)/2. call map_set(imap_proj, cen_lat, cen_lon, xxc, yyc, dds, & standard_lon, truelat1, truelat2, map_info) write(0,*)'map_info:', imap_proj, iproj write(0,*)'code,lat1,lon1,dx,dlat,dlon,stdlon,truelat1,truelat2,hemi,cone,polei,polej,rsw,rebydx,knowni,knownj,init' write(0,*) map_info ! .. Calculate the size for Mother Of All Domains and the low-left corner position ! ! (The purpose doing this is for plotting the OBS distribution map with MAP_plot. Y.-R. Guo) ! if (xlonc /= standard_lon .or. phic /= moad_cen_lat) then phic = moad_cen_lat xlonc = standard_lon idd = 2 if (maxnes < idd) maxnes = idd nestix(2) = iix nestjx(2) = jjx dis(2) = dis(1) numc(2) = 1 write(0,'(/a,2e20.12)') ' cen_lon , cen_lat :', & cen_lon, cen_lat write(0,'( a,2e20.12)')' xlonc, phic:', xlonc, phic write(0,'(/3X,a)') & '## Compute the nestix(1), nestjx(1), nesti(2), and nstj(2): ##' xxc = real(jjx)/2.0 yyc = real(iix)/2.0 call latlon_to_ij(map_info, phic , xlonc , xxx, yyy) ! write(0,'("latlon_to_ij: phic, xlonc, xxx, yyy :",4f15.5)') phic, xlonc, xxx, yyy i_grid = nint(xxx-xxc) j_grid = nint(yyy-yyc) m_expand = 16 write(0,'("i_grid, j_grid, m_expand:",3I8)') i_grid, j_grid, m_expand nestjx(1) = jjx + 2*abs(i_grid) + m_expand nestix(1) = iix + 2*abs(j_grid) + m_expand nesti(2) = m_expand/2 + 1 if (j_grid < 0) nesti(2) = nesti(2) - 2*j_grid nestj(2) = m_expand/2 + 1 if (i_grid < 0) nestj(2) = nestj(2) - 2*i_grid write(0,'(a,2i5,2x,a,2i5/)') & ' Dimension of MOAD: ix, jx:', nestix(1), nestjx(1), & ' nesti(2), nestj(2):', nesti(2), nestj(2) endif endif END SUBROUTINE GET_NAMELIST END MODULE MODULE_NAMELIST