!dis !dis Open Source License/Disclaimer, Forecast Systems Laboratory !dis NOAA/OAR/FSL, 325 Broadway Boulder, CO 80305 !dis !dis This software is distributed under the Open Source Definition, !dis which may be found at http://www.opensource.org/osd.html. !dis !dis In particular, redistribution and use in source and binary forms, !dis with or without modification, are permitted provided that the !dis following conditions are met: !dis !dis - Redistributions of source code must retain this notice, this !dis list of conditions and the following disclaimer. !dis !dis - Redistributions in binary form must provide access to this !dis notice, this list of conditions and the following disclaimer, and !dis the underlying source code. !dis !dis - All modifications to this software must be clearly documented, !dis and are solely the responsibility of the agent making the !dis modifications. !dis !dis - If significant modifications or enhancements are made to this !dis software, the FSL Software Policy Manager !dis (softwaremgr@fsl.noaa.gov) should be notified. !dis !dis THIS SOFTWARE AND ITS DOCUMENTATION ARE IN THE PUBLIC DOMAIN !dis AND ARE FURNISHED "AS IS." THE AUTHORS, THE UNITED STATES !dis GOVERNMENT, ITS INSTRUMENTALITIES, OFFICERS, EMPLOYEES, AND !dis AGENTS MAKE NO WARRANTY, EXPRESS OR IMPLIED, AS TO THE USEFULNESS !dis OF THE SOFTWARE AND DOCUMENTATION FOR ANY PURPOSE. THEY ASSUME !dis NO RESPONSIBILITY (1) FOR THE USE OF THE SOFTWARE AND !dis DOCUMENTATION; OR (2) TO PROVIDE TECHNICAL SUPPORT TO USERS. !dis !dis PROGRAM vinterp ! ! This program is one of the programs of the WRF Standard Initialization (WRFSI) ! package and is used to vertically interpolate standard meteorlogical variables ! already on the WRF horizontal grid to the WRF vertical grid coordinate. It ! also diagnoses the variables needed for WRF, and is used as the last step ! to provide initial and boundary conditions to the WRF forecast model ! ! HISTORY ! ------- ! 18 Aug 2000: Initial version - B. Shaw, NOAA/OAR/FSL/FRD/LAPB (CIRA) ! 21 May 2001: Multiple changes - B. Shaw ! - Changed to do vertical interpolation on non-staggered grid ! - Added staggering of mass variables as final step ! - Added processing of static fields for LSM support (moved from hinterp) ! Nov 2002: Added WRF I/O API output - Jacques Middlecoff, NOAA/FSL (CIRA) ! ------- ! USE vinterp_setup USE wrf_metadata USE date_pack USE wrfsi_io USE vinterp_p2z USE vinterp_etap USE vinterp_nmmhyb USE vinterp_domain USE wrfsi_static IMPLICIT NONE CHARACTER (LEN=19) :: next_date CHARACTER (LEN=2) :: dom_str CHARACTER (LEN=255) :: WRFcdlFile CHARACTER (LEN=255) :: WRFicFile,syscmd LOGICAL :: havecdl, haveic INTEGER :: d,dr INTEGER :: parent_id, parent_grid_ratio, i_parent_start, & j_parent_start, i_parent_end, j_parent_end, & nest_nx, nest_ny ! Initialize the logical flags havecdl = .false. haveic = .false. ! Get setup information from the namelist and the global metadata CALL proc_namelist CALL get_global_metadata(setup_info%input_prefix) input_vcoord = global_meta%vertical_coord PRINT '(A)', 'Pertinent global metadata: ' PRINT '(A,A)', 'Simulation Name: ', global_meta%simulation_name PRINT '(A,A)', 'User Description: ', global_meta%user_desc PRINT '(A,I2)', 'Number of domains: ', global_meta%num_domains PRINT '(A,A)', 'Input Vertical Coordinate: ', input_vcoord PRINT '(A,I8,F8.1)', 'Initial Date/Time of Metadata: ', global_meta%init_date,& global_meta%init_time PRINT '(A,I8,F8.1)', 'Ending Date/Time of Metadata: ', global_meta%end_date,& global_meta%end_time ! Loop over all domains domain_loop: DO d = 1, num_domains_to_proc if(setup_info%output_file_type == 'WRF' .or.& setup_info%output_file_type == 'BOTH') then DryRun = .true. endif have_bg_landusec = .false. have_bg_soilctop = .false. PRINT *, 'VINTERP: Processing domain ',domain_list(d) WRITE (dom_str, '(I2.2)') domain_list(d) ! Set up for loop over all dates for this domain setup_info%current_date = setup_info%starting_date setup_info%time_period_count = 0 time_loop: DO WHILE( (setup_info%current_date .LE. setup_info%ending_date) ) ! time_loop: DO WHILE( (setup_info%current_date .LE. setup_info%ending_date).AND.& ! ( (d.eq.1).or.(setup_info%current_date .EQ. setup_info%starting_date)) ) PRINT '(//A,A)','Starting current time: ',setup_info%current_date ! Populate the domain metadata information, which is a structure ! called dom_meta in the module_wrf_metadata.F file. The I/O ! routine will return a non-zero status if it cannot get the domain file CALL get_domain_metadata(domain_list(d),setup_info%current_date(1:19), & setup_info%input_prefix) IF (status.NE. 0) THEN PRINT '(A,I2,A)', 'Skipping this domain ', domain_list(d),' at this time.' CALL geth_newdate( next_date , setup_info%current_date ,& setup_info%time_increment_second ) setup_info%current_date = next_date CYCLE time_loop ! Can this be the last one and break wrf output? ENDIF ! Populate two new dom_meta entries that are not contained ! in the binary output files !WW: calculate i_parent_end from origin_parent_x/origin_parent_y and xdim/ydim ! CALL get_wrfsi_static_nestinfo(moad_dataroot,domain_list(d), & ! parent_id, i_parent_start, j_parent_start, i_parent_end, & ! j_parent_end,parent_grid_ratio, nest_nx, nest_ny) ! A couple of sanity checks !IF ( (nest_nx .NE. dom_meta%xdim) .OR. & ! (nest_ny .NE. dom_meta%ydim) ) THEN ! print *, 'Mismatch in nest dimensions between static file' ! print *, 'and hinterp domain metadata. Possible incomplete' ! print *, 'localization was done.' ! STOP !ENDIF !dom_meta%end_parent_x = i_parent_end !dom_meta%end_parent_y = j_parent_end PRINT '(A,3I4)', 'origin_parent_x,xdim,ratio_to_parent : ', & dom_meta%origin_parent_x,dom_meta%xdim,dom_meta%ratio_to_parent PRINT '(A,3I4)', 'origin_parent_y,ydim,ratio_to_parent : ', & dom_meta%origin_parent_y,dom_meta%ydim,dom_meta%ratio_to_parent dom_meta%end_parent_x = dom_meta%origin_parent_x + (dom_meta%xdim-1)/dom_meta%ratio_to_parent dom_meta%end_parent_y = dom_meta%origin_parent_y + (dom_meta%ydim-1)/dom_meta%ratio_to_parent PRINT '(A,2I4)', 'end_parent_x,end_parent_y : ',dom_meta%end_parent_x,dom_meta%end_parent_y ! If first time through, fill the terrain_hgt array in vinterp_domain ! IF (setup_info%current_date .EQ. setup_info%starting_date) THEN ! CALL fill_domain_topo(dom_meta, moad_dataroot) ! ENDIF PRINT *,'Starting current time: ',setup_info%current_date ! Convert the ASCII MM5-type date string into the WRF format ! for the metadata CALL mm5_to_wrf_date(setup_info%current_date,setup_info%wrf_current_date,& setup_info%wrf_current_time) ! Increment the time period counter. setup_info%time_period_count = setup_info%time_period_count + 1 ! Note that the opening of the output file occurs in the appropriate ! driver routine below, but the file is closed within the main ! program at the bottom of the time_loop so that the static fields ! can be written if(setup_info%output_file_type == 'WRF' .or. setup_info%output_file_type == 'BOTH') then call ext_ncd_ioinit(Status) endif dryRun = .true. dryrun_loop: do dr = 1,2 ! dryrun required by wrf I/O API print *,'DryRun = ',Dryrun ! Vertical interpolation of atmospheric fields ! is now only done for MOAD. Perhaps later there will ! be a need to do this for nests as well. vinterp_from: SELECT CASE (input_vcoord) CASE ('PRESSURE') from_press_to: SELECT CASE (output_vcoord) CASE ('ZETA ') IF(.not.DryRun)PRINT '(A)','Calling p2z_driver' CALL p2z_driver CASE ('ETAP ') ! Transform from isobaric to Eta-P levels IF(.not.DryRun)PRINT *,'Calling etap_driver' CALL etap_driver CASE ('NMMH ') IF(.not.DryRun)PRINT *,'Calling nmmhyb_driver' CALL nmmhyb_driver CASE DEFAULT PRINT '(A)', 'Sorry, but I cannot transform to: ',output_vcoord STOP 'bad_output_vcoord' END SELECT from_press_to CASE('NUMLEVEL') from_numlevel_to: SELECT CASE(output_vcoord) CASE ('ZETA ') PRINT '(A)', 'Sorry, but I cannot transform from NUMLEVEL to ZETA.' STOP 'no_numlevel_to_zeta' CASE ('ETAP ') ! Transform from isobaric to Eta-P levels IF(.not.DryRun)PRINT '(A)','Calling etap_driver' CALL etap_driver CASE DEFAULT PRINT '(A)', 'Sorry, but I cannot transform to: ',output_vcoord STOP 'bad_output_vcoord' END SELECT from_numlevel_to CASE DEFAULT PRINT '(A)', 'Sorry, but I cannot transform from: ', input_vcoord STOP 'bad_input_vcoord' END SELECT vinterp_from ! Do the static data processing vinterp_proc: SELECT CASE (output_vcoord) CASE('NMMH ') write(6,*) 'calling proc_static_nmm' CALL proc_static_nmm(setup_info%current_date) CASE ('ETAP ') ! write(6,*) 'calling proc_static' IF (d .eq. 1) THEN ! CALL proc_static(setup_info%current_date) ELSE ! For nests, only call the 1st time through IF (setup_info%current_date .EQ. setup_info%starting_date) THEN !CALL proc_static_subnest ! CALL proc_static(setup_info%current_date) ENDIF ENDIF END SELECT vinterp_proc ! if((d .EQ. 1) .or. (setup_info%current_date .eq. setup_info%starting_date))THEN if(DryRun) then if(setup_info%output_file_type == 'WRF' .or. setup_info%output_file_type == 'BOTH') then call ext_ncd_open_for_write_commit(WrfDataHandle, Status) if(Status /= 0) then print *, 'IN VINTERP:' print *,'Error in vinterp calling ext_ncd_open_for_write_commit, Status=',Status stop endif endif endif ! endif ! end moad or first time check ! JPE: DryRun was reset in module_wrfsi_io.F if a cdl file exists. if(.not.DryRun) exit DryRun = .False. enddo dryrun_loop ! Update and write out the global metadata global_meta%vertical_coord = output_vcoord IF (output_vcoord .EQ. 'ZETA ') THEN global_meta%num_stagger_z = 2 global_meta%stagger_dir_z(1) = 0.5 global_meta%stagger_dir_z(2) = 0.0 ENDIF if(setup_info%output_file_type == 'WRF' .or. setup_info%output_file_type == 'BOTH') then CALL wrf_write_global_metadata ( output_vcoord(1:4) ) call ext_ncd_ioclose(WrfDataHandle, Status) if(Status /= 0) then print *,'Error in vinterp calling ext_ncd_ioclose, Status = ',Status stop endif call ext_ncd_ioexit(Status) if(Status /= 0) then print *,'ext_ncd_ioexit error exit with status = ',Status endif endif PRINT '(A,A)','Ending current time: ',setup_info%current_date ! The first time through, if we are doing BOTH or WRF for output type, look ! to see if we have a wrf_real_input_em.dxx.cdl file in siprd. If ! we do not, we should be able to create one (only needed for MOAD) IF (d == 1) THEN IF (setup_info%current_date .EQ. setup_info%starting_date) THEN if(setup_info%output_file_type == 'WRF' .or. setup_info%output_file_type == 'BOTH') then IF (output_vcoord .EQ. 'ETAP ') THEN WRFcdlFile = TRIM(moad_dataroot) // '/siprd/wrf_real_input_em.d' // dom_str //'.cdl' ELSEIF(output_vcoord .EQ. 'ZETA ') THEN WRFcdlFile = TRIM(moad_dataroot) // '/siprd/wrf_real_input_eh.d' // dom_str //'.cdl' ELSEIF(output_vcoord .EQ. 'NMMH ') THEN WRFcdlFile = TRIM(moad_dataroot) // '/siprd/wrf_real_input_nm.d' // dom_str //'.cdl' ENDIF INQUIRE(FILE=WRFcdlFile ,EXIST=havecdl) IF (.NOT. havecdl) THEN IF (output_vcoord .EQ. 'ETAP ') THEN WRFicFile = TRIM(moad_dataroot) // '/siprd/wrf_real_input_em.d' // dom_str // '.' //& setup_info%current_date(1:19) ELSEIF(output_vcoord .EQ. 'ZETA ') THEN WRFicFile = TRIM(moad_dataroot) // '/siprd/wrf_real_input_eh.d' // dom_str // '.' //& setup_info%current_date(1:19) ELSEIF(output_vcoord .EQ. 'NMMH ') THEN WRFicFile = TRIM(moad_dataroot) // '/siprd/wrf_real_input_nm.d' // dom_str // '.' //& setup_info%current_date(1:19) ENDIF INQUIRE (FILE=WRFicFile, EXIST=haveic) IF (.NOT. haveic) THEN print *, 'WRF output requested but not created...big problem.' STOP ENDIF WRITE(syscmd,*) 'ncdump -h ' // TRIM(WRFicFILE) // ' > ' // TRIM(WRFcdlFile) print *, 'Creating CDL file: ', trim(syscmd) CALL SYSTEM(syscmd) INQUIRE(FILE=WRFcdlFile ,EXIST=havecdl) IF (.NOT. havecdl) THEN print *, 'Problem creating CDL file.' STOP ENDIF ENDIF ENDIF ENDIF ENDIF ! MOAD CHECK CALL geth_newdate( next_date , setup_info%current_date ,& setup_info%time_increment_second ) setup_info%current_date = next_date if (( .NOT.DryRun) .AND. ( (setup_info%output_file_type == 'BIN' .or.& setup_info%output_file_type == 'BOTH'))) then CLOSE (domfile_out) output_file_opened = .false. ENDIF END DO time_loop ! To be safe for future runs, delete the cdl file generated previously IF ((havecdl).and.(d .EQ. 1)) THEN WRITE(syscmd,*) 'rm ' // TRIM(WRFcdlFile) PRINT *, 'removing cdl: ', syscmd CALL SYSTEM(syscmd) ENDIF END DO domain_loop ! Update and write out the global metadata global_meta%vertical_coord = output_vcoord IF (output_vcoord .EQ. 'ZETA ') THEN global_meta%num_stagger_z = 2 global_meta%stagger_dir_z(1) = 0.5 global_meta%stagger_dir_z(2) = 0.0 ENDIF if(setup_info%output_file_type == 'BIN' .or. setup_info%output_file_type == 'BOTH') then CALL write_global_metadata(setup_info%output_prefix) endif PRINT '(A)', ' **** VINTERP COMPLETE *****' END PROGRAM vinterp