module write_met_module use module_debug use misc_definitions_module use met_data_module ! State variables? integer :: output_unit character (len=MAX_FILENAME_LEN) :: met_out_filename contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Name: write_met_init ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine write_met_init(fg_source, source_is_constant, datestr, istatus) implicit none ! Arguments integer, intent(out) :: istatus logical, intent(in) :: source_is_constant character (len=*), intent(in) :: fg_source character (len=*), intent(in) :: datestr ! Local variables integer :: io_status logical :: is_used istatus = 0 ! 1) BUILD FILENAME BASED ON TIME met_out_filename = ' ' if (.not. source_is_constant) then write(met_out_filename, '(a)') trim(fg_source)//':'//trim(datestr) else write(met_out_filename, '(a)') trim(fg_source) end if ! 2) OPEN FILE do output_unit=10,100 inquire(unit=output_unit, opened=is_used) if (.not. is_used) exit end do call mprintf((output_unit > 100),ERROR,'In write_met_init(), couldn''t find an available Fortran unit.') open(unit=output_unit, file=trim(met_out_filename), status='unknown', form='unformatted', iostat=io_status) if (io_status > 0) istatus = 1 return end subroutine write_met_init !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Name: write_next_met_field ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine write_next_met_field(fg_data, istatus) implicit none ! Arguments type (met_data), intent(in) :: fg_data integer, intent(out) :: istatus ! Local variables character (len=8) :: startloc character (len=9) :: local_field istatus = 1 ! 1) WRITE FORMAT VERSION write(unit=output_unit) fg_data % version local_field = fg_data % field if (local_field == 'GHT ') local_field = 'HGT ' ! PREGRID if (fg_data % version == 3) then ! Cylindrical equidistant if (fg_data % iproj == PROJ_LATLON) then write(unit=output_unit) fg_data % hdate, & fg_data % xfcst, & local_field, & fg_data % units, & fg_data % desc, & fg_data % xlvl, & fg_data % nx, & fg_data % ny, & 0 write(unit=output_unit) fg_data % startlat, & fg_data % startlon, & fg_data % deltalat, & fg_data % deltalon ! Mercator else if (fg_data % iproj == PROJ_MERC) then write(unit=output_unit) fg_data % hdate, & fg_data % xfcst, & local_field, & fg_data % units, & fg_data % desc, & fg_data % xlvl, & fg_data % nx, & fg_data % ny, & 1 write(unit=output_unit) fg_data % startlat, & fg_data % startlon, & fg_data % dx, & fg_data % dy, & fg_data % truelat1 ! Lambert conformal else if (fg_data % iproj == PROJ_LC) then write(unit=output_unit) fg_data % hdate, & fg_data % xfcst, & local_field, & fg_data % units, & fg_data % desc, & fg_data % xlvl, & fg_data % nx, & fg_data % ny, & 3 write(unit=output_unit) fg_data % startlat, & fg_data % startlon, & fg_data % dx, & fg_data % dy, & fg_data % xlonc, & fg_data % truelat1, & fg_data % truelat2 ! Polar stereographic else if (fg_data % iproj == PROJ_PS) then write(unit=output_unit) fg_data % hdate, & fg_data % xfcst, & local_field, & fg_data % units, & fg_data % desc, & fg_data % xlvl, & fg_data % nx, & fg_data % ny, & 5 write(unit=output_unit) fg_data % startlat, & fg_data % startlon, & fg_data % dx, & fg_data % dy, & fg_data % xlonc, & fg_data % truelat1 ! ????????? else call mprintf(.true.,ERROR,'Unrecognized projection code %i when reading from %s.', & i1=fg_data % iproj,s1=met_out_filename) end if write(unit=output_unit) fg_data % slab istatus = 0 ! GRIB_PREP else if (fg_data % version == 4) then if (fg_data % starti == 1.0 .and. fg_data % startj == 1.0) then startloc='SWCORNER' else startloc='CENTER ' end if ! Cylindrical equidistant if (fg_data % iproj == PROJ_LATLON) then write(unit=output_unit) fg_data % hdate, & fg_data % xfcst, & fg_data % map_source, & local_field, & fg_data % units, & fg_data % desc, & fg_data % xlvl, & fg_data % nx, & fg_data % ny, & 0 write(unit=output_unit) startloc, & fg_data % startlat, & fg_data % startlon, & fg_data % deltalat, & fg_data % deltalon ! Mercator else if (fg_data % iproj == PROJ_MERC) then write(unit=output_unit) fg_data % hdate, & fg_data % xfcst, & fg_data % map_source, & local_field, & fg_data % units, & fg_data % desc, & fg_data % xlvl, & fg_data % nx, & fg_data % ny, & 1 write(unit=output_unit) startloc, & fg_data % startlat, & fg_data % startlon, & fg_data % dx, & fg_data % dy, & fg_data % truelat1 ! Lambert conformal else if (fg_data % iproj == PROJ_LC) then write(unit=output_unit) fg_data % hdate, & fg_data % xfcst, & fg_data % map_source, & local_field, & fg_data % units, & fg_data % desc, & fg_data % xlvl, & fg_data % nx, & fg_data % ny, & 3 write(unit=output_unit) startloc, & fg_data % startlat, & fg_data % startlon, & fg_data % dx, & fg_data % dy, & fg_data % xlonc, & fg_data % truelat1, & fg_data % truelat2 ! Polar stereographic else if (fg_data % iproj == PROJ_PS) then write(unit=output_unit) fg_data % hdate, & fg_data % xfcst, & fg_data % map_source, & local_field, & fg_data % units, & fg_data % desc, & fg_data % xlvl, & fg_data % nx, & fg_data % ny, & 5 write(unit=output_unit) startloc, & fg_data % startlat, & fg_data % startlon, & fg_data % dx, & fg_data % dy, & fg_data % xlonc, & fg_data % truelat1 ! ????????? else call mprintf(.true.,ERROR,'Unrecognized projection code %i when reading from %s.', & i1=fg_data % iproj,s1=met_out_filename) end if write(unit=output_unit) fg_data % slab istatus = 0 ! WPS else if (fg_data % version == 5) then if (fg_data % starti == 1.0 .and. fg_data % startj == 1.0) then startloc='SWCORNER' else startloc='CENTER ' end if ! Cylindrical equidistant if (fg_data % iproj == PROJ_LATLON) then write(unit=output_unit) fg_data % hdate, & fg_data % xfcst, & fg_data % map_source, & local_field, & fg_data % units, & fg_data % desc, & fg_data % xlvl, & fg_data % nx, & fg_data % ny, & 0 write(unit=output_unit) startloc, & fg_data % startlat, & fg_data % startlon, & fg_data % deltalat, & fg_data % deltalon, & fg_data % earth_radius ! Mercator else if (fg_data % iproj == PROJ_MERC) then write(unit=output_unit) fg_data % hdate, & fg_data % xfcst, & fg_data % map_source, & local_field, & fg_data % units, & fg_data % desc, & fg_data % xlvl, & fg_data % nx, & fg_data % ny, & 1 write(unit=output_unit) startloc, & fg_data % startlat, & fg_data % startlon, & fg_data % dx, & fg_data % dy, & fg_data % truelat1, & fg_data % earth_radius ! Lambert conformal else if (fg_data % iproj == PROJ_LC) then write(unit=output_unit) fg_data % hdate, & fg_data % xfcst, & fg_data % map_source, & local_field, & fg_data % units, & fg_data % desc, & fg_data % xlvl, & fg_data % nx, & fg_data % ny, & 3 write(unit=output_unit) startloc, & fg_data % startlat, & fg_data % startlon, & fg_data % dx, & fg_data % dy, & fg_data % xlonc, & fg_data % truelat1, & fg_data % truelat2, & fg_data % earth_radius ! Gaussian else if (fg_data % iproj == PROJ_GAUSS) then write(unit=output_unit) fg_data % hdate, & fg_data % xfcst, & fg_data % map_source, & local_field, & fg_data % units, & fg_data % desc, & fg_data % xlvl, & fg_data % nx, & fg_data % ny, & 4 write(unit=output_unit) startloc, & fg_data % startlat, & fg_data % startlon, & fg_data % deltalat, & fg_data % deltalon, & fg_data % earth_radius ! Polar stereographic else if (fg_data % iproj == PROJ_PS) then write(unit=output_unit) fg_data % hdate, & fg_data % xfcst, & fg_data % map_source, & local_field, & fg_data % units, & fg_data % desc, & fg_data % xlvl, & fg_data % nx, & fg_data % ny, & 5 write(unit=output_unit) startloc, & fg_data % startlat, & fg_data % startlon, & fg_data % dx, & fg_data % dy, & fg_data % xlonc, & fg_data % truelat1, & fg_data % earth_radius ! ????????? else call mprintf(.true.,ERROR,'Unrecognized projection code %i when reading from %s.', & i1=fg_data % iproj,s1=met_out_filename) end if write(unit=output_unit) fg_data % is_wind_grid_rel write(unit=output_unit) fg_data % slab istatus = 0 else call mprintf(.true.,ERROR,'Didn''t recognize format number %i.', i1=fg_data % version) end if return end subroutine write_next_met_field !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Name: write_met_close ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine write_met_close() implicit none close(unit=output_unit) met_out_filename = 'UNINITIALIZED_FILENAME' end subroutine write_met_close end module write_met_module