!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! !! !! GNU General Public License !! !! !! !! This file is part of the Flexible Modeling System (FMS). !! !! !! !! FMS is free software; you can redistribute it and/or modify !! !! it and are expected to follow the terms of the GNU General Public !! !! License as published by the Free Software Foundation. !! !! !! !! FMS is distributed in the hope that it will be useful, !! !! but WITHOUT ANY WARRANTY; without even the implied warranty of !! !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !! !! GNU General Public License for more details. !! !! !! !! You should have received a copy of the GNU General Public License !! !! along with FMS; if not, write to: !! !! Free Software Foundation, Inc. !! !! 59 Temple Place, Suite 330 !! !! Boston, MA 02111-1307 USA !! !! or see: !! !! http://www.gnu.org/licenses/gpl.txt !! !! !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! module column_diagnostics_mod use mpp_io_mod, only: mpp_io_init, mpp_open, MPP_ASCII, & MPP_OVERWR, MPP_SEQUENTIAL, & MPP_MULTI, mpp_close use fms_mod, only: fms_init, mpp_pe, mpp_root_pe, & file_exist, check_nml_error, & error_mesg, FATAL, NOTE, WARNING, & close_file, open_namelist_file, & stdlog, write_version_number use time_manager_mod, only: time_manager_init, month_name, & get_date, time_type use constants_mod, only: constants_init, PI, RADIAN !------------------------------------------------------------------- implicit none private !--------------------------------------------------------------------- ! module to locate and mark desired diagnostic columns ! ! !-------------------------------------------------------------------- !--------------------------------------------------------------------- !----------- ****** VERSION NUMBER ******* --------------------------- character(len=128) :: version = '$Id: column_diagnostics.F90,v 17.0 2009/07/21 03:18:24 fms Exp $' character(len=128) :: tag = '$Name: mom4p1_pubrel_dec2009_nnz $' !--------------------------------------------------------------------- !------- interfaces -------- public column_diagnostics_init, & initialize_diagnostic_columns, & column_diagnostics_header, & close_column_diagnostics_units !private !-------------------------------------------------------------------- !---- namelist ----- real :: crit_xdistance = 4.0 ! model grid points must be within crit_xdistance in ! longitude of the requested diagnostics point ! coordinates in order to be flagged as the desired ! point ! [ degrees ] real :: crit_ydistance = 4.0 ! model grid points must be within crit_ydistance in ! latitude of the requested diagnostics point ! coordinates in order to be flagged as the desired ! point ! [ degrees ] namelist / column_diagnostics_nml / & crit_xdistance, & crit_ydistance !-------------------------------------------------------------------- !-------- public data ----- !-------------------------------------------------------------------- !------ private data ------ logical :: module_is_initialized = .false. !------------------------------------------------------------------- !------------------------------------------------------------------- contains !#################################################################### subroutine column_diagnostics_init !-------------------------------------------------------------------- ! column_diagnostics_init is the constructor for ! column_diagnostics_mod. !-------------------------------------------------------------------- !-------------------------------------------------------------------- ! local variables: ! integer :: unit, ierr, io !-------------------------------------------------------------------- ! local variables: ! ! unit unit number for nml file ! ierr error return flag ! io error return code ! !--------------------------------------------------------------------- !-------------------------------------------------------------------- ! if routine has already been executed, return. !-------------------------------------------------------------------- if (module_is_initialized) return !--------------------------------------------------------------------- ! verify that all modules used by this module have been initialized. !---------------------------------------------------------------------- call mpp_io_init call fms_init call time_manager_init call constants_init !--------------------------------------------------------------------- ! read namelist. !--------------------------------------------------------------------- if (file_exist('input.nml')) then unit = open_namelist_file ( ) ierr=1; do while (ierr /= 0) read (unit, nml=column_diagnostics_nml, iostat=io, end=10) ierr = check_nml_error (io, 'column_diagnostics_nml') enddo 10 call close_file (unit) endif !--------------------------------------------------------------------- ! write version number and namelist to logfile. !--------------------------------------------------------------------- call write_version_number (version, tag) if (mpp_pe() == mpp_root_pe()) then unit = stdlog() write (unit, nml=column_diagnostics_nml) endif !-------------------------------------------------------------------- module_is_initialized = .true. end subroutine column_diagnostics_init !#################################################################### subroutine initialize_diagnostic_columns & (module, num_diag_pts_latlon, num_diag_pts_ij, & global_i , global_j , global_lat_latlon, & global_lon_latlon, lonb_in, latb_in, & do_column_diagnostics, & diag_lon, diag_lat, diag_i, diag_j, diag_units) !--------------------------------------------------------------------- ! initialize_diagnostic_columns returns the (i, j, lat, lon) coord- ! inates of any diagnostic columns that are located on the current ! processor. !---------------------------------------------------------------------- !--------------------------------------------------------------------- character(len=*), intent(in) :: module integer, intent(in) :: num_diag_pts_latlon, & num_diag_pts_ij integer, dimension(:), intent(in) :: global_i, global_j real , dimension(:), intent(in) :: global_lat_latlon, & global_lon_latlon real, dimension(:,:), intent(in) :: lonb_in, latb_in logical, dimension(:,:), intent(out) :: do_column_diagnostics integer, dimension(:), intent(inout) :: diag_i, diag_j real , dimension(:), intent(out) :: diag_lat, diag_lon integer, dimension(:), intent(out) :: diag_units !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! intent(in) variables: ! ! module module calling this subroutine ! num_diag_pts_latlon number of diagnostic columns specified ! by lat-lon coordinates ! num_diag_pts_ij number of diagnostic columns specified ! by global (i,j) coordinates ! global_i specified global i coordinates ! global_j specified global j coordinates ! global_lat_latlon specified global lat coordinates ! global_lon_latlon specified global lon coordinates ! ! intent(out) variables: ! ! do_column_diagnostics is a diagnostic column in this jrow ? ! diag_i processor i indices of diagnstic columns ! diag_j processor j indices of diagnstic columns ! diag_lat latitudes of diagnostic columns ! [ degrees ] ! diag_lon longitudes of diagnostic columns ! [ degrees ] ! diag_units unit number for each diagnostic column ! !--------------------------------------------------------------------- !-------------------------------------------------------------------- ! local variables: real, dimension(size(diag_i,1)) :: global_lat, global_lon real, dimension(size(latb_in,1)-1, size(latb_in,2)-1) :: & distance, distance_x, distance_y, & distance_x2, distance2 real, dimension(size(latb_in,1), size(latb_in,2)) :: latb_deg real, dimension(size(lonb_in,1), size(lonb_in,2)) :: lonb_deg real :: dellat, dellon real :: latb_max, latb_min, lonb_max, lonb_min integer :: num_diag_pts integer :: i, j, nn real :: ref_lat real :: current_distance character(len=8) :: char character(len=32) :: filename logical :: allow_ij_input logical :: open_file !-------------------------------------------------------------------- ! local variables: ! ! global_lat latitudes for all diagnostic columns [ degrees ] ! global_lon longitudes for all diagnostic columns ! [ degrees ] ! num_diag_pts total number of diagnostic columns ! i, j, nn do loop indices ! char character string for diaganostic column index ! filename filename for output file for diagnostic column ! !--------------------------------------------------------------------- if (.not. module_is_initialized) call column_diagnostics_init !-------------------------------------------------------------------- ! save the input lat and lon fields. define the delta of latitude ! and longitude. !-------------------------------------------------------------------- latb_deg = latb_in*RADIAN lonb_deg = lonb_in*RADIAN dellat = latb_in(1,2) - latb_in(1,1) dellon = lonb_in(2,1) - lonb_in(1,1) latb_max = MAXVAL (latb_deg(:,:)) latb_min = MINVAL (latb_deg(:,:)) lonb_max = MAXVAL (lonb_deg(:,:)) lonb_min = MINVAL (lonb_deg(:,:)) if (lonb_min < 10.0 .or. lonb_max > 350.) then lonb_min = 0. lonb_max = 360.0 endif allow_ij_input = .true. ref_lat = latb_in(1,1) do i =2,size(latb_in,1) if (latb_in(i,1) /= ref_lat) then allow_ij_input = .false. exit endif end do if ( .not. allow_ij_input .and. num_diag_pts_ij /= 0) then call error_mesg ('column_diagnostics_mod', & 'cannot specify column diagnostics column with (i,j) & &coordinates when using cubed sphere -- must specify & & lat/lon coordinates', FATAL) endif !---------------------------------------------------------------------- ! initialize column_diagnostics flag and diag unit numbers. define ! total number of diagnostic columns. !---------------------------------------------------------------------- do_column_diagnostics = .false. diag_units(:) = -1 diag_i(:) = -99 diag_j(:) = -99 diag_lat(:) = -999. diag_lon(:) = -999. num_diag_pts = size(diag_i(:)) !-------------------------------------------------------------------- ! define an array of lat-lon values for all diagnostic columns. !-------------------------------------------------------------------- do nn = 1, num_diag_pts_latlon global_lat(nn) = global_lat_latlon(nn) global_lon(nn) = global_lon_latlon(nn) end do do nn = 1, num_diag_pts_ij global_lat(nn+num_diag_pts_latlon) = & ((-0.5*acos(-1.0) + 0.5*dellat) + & (global_j (nn)-1) *dellat)*RADIAN global_lon(nn+num_diag_pts_latlon) = (0.5*dellon + & (global_i (nn)-1)*dellon)*RADIAN end do !---------------------------------------------------------------------- ! loop over all diagnostic points to check for their presence on ! this processor. !---------------------------------------------------------------------- do nn=1,num_diag_pts open_file = .false. !---------------------------------------------------------------------- ! verify that the values of lat and lon are valid. !---------------------------------------------------------------------- if (global_lon(nn) >= 0. .and. global_lon(nn) <= 360.0) then else call error_mesg ('column_diagnostics_mod', & ' invalid longitude', FATAL) endif if (global_lat(nn) >= -90.0 .and. global_lat(nn) <= 90.0) then else call error_mesg ('column_diagnostics_mod', & ' invalid latitude', FATAL) endif !-------------------------------------------------------------------- ! if the desired diagnostics column is within the current ! processor's domain, define the total and coordinate distances from ! each of the processor's grid points to the diagnostics point. !-------------------------------------------------------------------- if (global_lat(nn) .ge. latb_min .and. & global_lat(nn) .le. latb_max) then if (global_lon(nn) .ge. lonb_min .and.& global_lon(nn) .le. lonb_max) then do j=1,size(latb_deg,2) - 1 do i=1,size(lonb_deg,1) - 1 distance_y(i,j) = ABS(global_lat(nn) - latb_deg(i,j)) distance_x(i,j) = ABS(global_lon(nn) - lonb_deg(i,j)) distance_x2(i,j) = ABS((global_lon(nn)-360.) - & lonb_deg(i,j)) distance(i,j) = (global_lat(nn) - latb_deg(i,j))**2 + & (global_lon(nn) - lonb_deg(i,j))**2 distance2(i,j) = (global_lat(nn) - latb_deg(i,j))**2 + & ((global_lon(nn)-360.) - & lonb_deg(i,j))**2 end do end do !-------------------------------------------------------------------- ! find the grid point on the processor that is within the specified ! critical distance and also closest to the requested diagnostics ! column. save the (i,j) coordinates and (lon,lat) of this model ! grid point. set a flag indicating that a disgnostics file should ! be opened on this processor for this diagnostic point. !-------------------------------------------------------------------- current_distance = distance(1,1) do j=1,size(latb_deg,2) - 1 do i=1,size(lonb_deg,1) - 1 if (distance_x(i,j) <= crit_xdistance .and. & distance_y(i,j) <= crit_ydistance ) then if (distance(i,j) < current_distance) then current_distance = distance(i,j) do_column_diagnostics(i,j) = .true. diag_j(nn) = j diag_i(nn) = i diag_lon(nn) = lonb_deg(i,j) diag_lat(nn) = latb_deg(i,j) open_file = .true. endif endif !--------------------------------------------------------------------- ! check needed because of the 0.0 / 360.0 longitude periodicity. !--------------------------------------------------------------------- if (distance_x2(i,j) <= crit_xdistance .and. & distance_y(i,j) <= crit_ydistance ) then if (distance2(i,j) < current_distance) then current_distance = distance2(i,j) do_column_diagnostics(i,j) = .true. diag_j(nn) = j diag_i(nn) = i diag_lon(nn) = lonb_deg(i,j) diag_lat(nn) = latb_deg(i,j) open_file = .true. endif endif end do end do !-------------------------------------------------------------------- ! if the point has been found on this processor, open a diagnostics ! file. !-------------------------------------------------------------------- if (open_file) then write (char, '(i2)') nn filename = trim(module) // '_point' // & trim(adjustl(char)) // '.out' call mpp_open (diag_units(nn), filename, & form=MPP_ASCII, & action=MPP_OVERWR, & access=MPP_SEQUENTIAL, & threading=MPP_MULTI, nohdrs=.true.) endif ! (open_file) endif endif end do !--------------------------------------------------------------------- end subroutine initialize_diagnostic_columns !#################################################################### subroutine column_diagnostics_header & (module, diag_unit, Time, nn, diag_lon, & diag_lat, diag_i, diag_j) !-------------------------------------------------------------------- ! column_diagnostics_header writes out information concerning ! time and location of following data into the column_diagnostics ! output file. !-------------------------------------------------------------------- !-------------------------------------------------------------------- character(len=*), intent(in) :: module type(time_type), intent(in) :: Time integer, intent(in) :: diag_unit integer, intent(in) :: nn real, dimension(:), intent(in) :: diag_lon, diag_lat integer, dimension(:), intent(in) :: diag_i, diag_j !-------------------------------------------------------------------- ! intent(in) variables ! ! module module name calling this subroutine ! Time current model time [ time_type ] ! diag_unit unit number for column_diagnostics output ! nn index of diagnostic column currently active ! diag_lon longitude of current diagnostic column [ degrees ] ! diag_lat latitude of current diagnostic column [ degrees ] ! diag_i i coordinate of current diagnostic column ! diag_j j coordinate of current diagnostic column ! !--------------------------------------------------------------------- !-------------------------------------------------------------------- ! local variables: integer :: year, month, day, hour, minute, second character(len=8) :: mon character(len=64) :: header !-------------------------------------------------------------------- ! local variables: ! ! year, month, day, hour, minute, seconds ! integers defining the current time ! mon character string for the current month ! header title for the output ! !-------------------------------------------------------------------- if (.not. module_is_initialized) call column_diagnostics_init !-------------------------------------------------------------------- ! convert the time type to a date and time for printing. convert ! month to a character string. !-------------------------------------------------------------------- call get_date (Time, year, month, day, hour, minute, second) mon = month_name(month) !--------------------------------------------------------------------- ! write timestamp and column location information to the diagnostic ! columns output unit. !--------------------------------------------------------------------- write (diag_unit,'(a)') ' ' write (diag_unit,'(a)') ' ' write (diag_unit,'(a)') & '======================================================' write (diag_unit,'(a)') ' ' header = ' PRINTING ' // module // ' DIAGNOSTICS' write (diag_unit,'(a)') header write (diag_unit,'(a)') ' ' write (diag_unit,'(a, i6,2x, a,i4,i4,i4,i4)') ' time stamp:', & year, trim(mon), day, & hour, minute, second write (diag_unit,'(a, i4)') & ' DIAGNOSTIC POINT COORDINATES, point #', nn write (diag_unit,'(a)') ' ' write (diag_unit,'(a,f8.3,a,f8.3)') ' longitude = ', & diag_lon(nn), ' latitude = ', diag_lat(nn) write (diag_unit,'(a, i6, a,i6,a,i6)') & ' on processor # ', mpp_pe(), & ' : processor i =', diag_i(nn), & ' , processor j =', diag_j(nn) write (diag_unit,'(a)') ' ' !--------------------------------------------------------------------- end subroutine column_diagnostics_header !###################################################################### subroutine close_column_diagnostics_units (diag_units) !--------------------------------------------------------------------- ! close_column_diagnostics_units closes any open column_diagnostics ! files associated with the calling module. !---------------------------------------------------------------------- !---------------------------------------------------------------------- integer, dimension(:), intent(in) :: diag_units !---------------------------------------------------------------------- !-------------------------------------------------------------------- ! intent(in) variable: ! ! diag_units array of column diagnostic unit numbers ! !-------------------------------------------------------------------- !-------------------------------------------------------------------- ! local variable integer :: nn ! do loop index !-------------------------------------------------------------------- ! close the unit associated with each diagnostic column. !-------------------------------------------------------------------- do nn=1, size(diag_units(:)) if (diag_units(nn) /= -1) then call mpp_close (diag_units(nn)) endif end do !--------------------------------------------------------------------- end subroutine close_column_diagnostics_units !##################################################################### end module column_diagnostics_mod