Rename `sat` module and types to `set`. Harmonized type names with module names. (7c671d11) · Commits · CAMS / CSO

oper/src/Makefile_deps

+5 −6

Original line number	Diff line number	Diff line
		@@ -2,21 +2,20 @@ cso_comm.o : cso_comm.F90 cso.inc cso_logging.o
		cso_datetime.o : cso_datetime.F90 cso.inc cso_string.o cso_logging.o
		cso_domains.o : cso_domains.F90 cso.inc cso_comm.o cso_logging.o
		cso_exchange.o : cso_exchange.F90 cso.inc cso_logging.o
		cso.o : cso.F90 cso.inc cso_ncfile.o cso_profile.o cso_grid.o cso_tools.o cso_series.o cso_sat.o cso_listing.o cso_rc.o cso_string.o cso_datetime.o cso_domains.o cso_logging.o cso_comm.o
		cso.o : cso.F90 cso.inc cso_ncfile.o cso_profile.o cso_grid.o cso_tools.o cso_series.o cso_set.o cso_listing.o cso_rc.o cso_string.o cso_datetime.o cso_domains.o cso_logging.o cso_comm.o
		cso_file.o : cso_file.F90 cso.inc cso_logging.o
		cso_grid.o : cso_grid.F90 cso.inc cso_ncfile.o cso_tools.o cso_parray.o cso_logging.o
		cso_listing.o : cso_listing.F90 cso.inc cso_comm.o cso_string.o cso_file.o cso_datetime.o cso_logging.o
		cso_logging.o : cso_logging.F90 cso.inc
		cso_mapping.o : cso_mapping.F90 cso.inc cso_parray.o cso_swapping.o cso_comm.o cso_logging.o
		cso_mapping.o : cso_mapping.F90 cso.inc cso_comm.o cso_parray.o cso_logging.o
		cso_ncfile.o : cso_ncfile.F90 cso.inc cso_string.o cso_file.o cso_comm.o cso_logging.o
		cso_parray.o : cso_parray.F90 cso.inc cso_logging.o
		cso_pixels.o : cso_pixels.F90 cso.inc cso_tools.o cso_profile.o cso_exchange.o cso_string.o cso_swapping.o cso_parray.o cso_domains.o cso_comm.o cso_ncfile.o cso_logging.o
		cso_pixels.o : cso_pixels.F90 cso.inc cso_tools.o cso_profile.o cso_exchange.o cso_string.o cso_domains.o cso_comm.o cso_ncfile.o cso_logging.o
		cso_profile.o : cso_profile.F90 cso.inc cso_logging.o
		cso_rc.o : cso_rc.F90 cso.inc cso_datetime.o cso_file.o cso_string.o cso_logging.o
		cso_sat.o : cso_sat.F90 cso.inc cso_file.o cso_datetime.o cso_string.o cso_rc.o cso_comm.o cso_domains.o cso_exchange.o cso_mapping.o cso_pixels.o cso_ncfile.o cso_logging.o
		cso_series.o : cso_series.F90 cso.inc cso_file.o cso_rc.o cso_datetime.o cso_sat.o cso_listing.o cso_logging.o
		cso_series.o : cso_series.F90 cso.inc cso_file.o cso_datetime.o cso_rc.o cso_set.o cso_listing.o cso_logging.o
		cso_set.o : cso_set.F90 cso.inc cso_file.o cso_string.o cso_rc.o cso_comm.o cso_datetime.o cso_domains.o cso_exchange.o cso_mapping.o cso_pixels.o cso_ncfile.o cso_logging.o
		cso_string.o : cso_string.F90 cso.inc cso_logging.o
		cso_swapping.o : cso_swapping.F90 cso.inc cso_parray.o cso_domains.o cso_comm.o cso_logging.o
		cso_tools.o : cso_tools.F90 cso.inc cso_logging.o
		tutorial_oper_adj-test.o : tutorial_oper_adj-test.F90 cso.inc cso.o
		tutorial_oper_simulate.o : tutorial_oper_simulate.F90 cso.inc cso.o

oper/src/cso.F90

+1 −1

Original line number	Diff line number	Diff line
		@@ -31,7 +31,7 @@ module CSO
		use CSO_String
		use CSO_Rc
		use CSO_Listing
		use CSO_Sat
		use CSO_Set
		use CSO_Series
		use CSO_Tools
		use CSO_Grid

oper/src/cso_mapping.F90

+0 −128

Original line number	Diff line number	Diff line
		@@ -73,7 +73,6 @@ module CSO_Mapping
		!
		contains
		procedure :: Init => Mapping_Init
		procedure :: InitSwap => Mapping_InitSwap
		procedure :: Done => Mapping_Done
		procedure :: GetPixel => Mapping_GetPixel
		procedure :: SetPixel => Mapping_SetPixel
		@@ -130,133 +129,6 @@ contains
		! ***


		!
		! Init copy by swap.
		! - swp : swapping info for pixel arrays (npix)
		! - mswp : swapping info for mapping arrays (nmap)
		!

		subroutine Mapping_InitSwap( self, mapping, swp, mswp, status )

		use CSO_Comm , only : csoc
		use CSO_Swapping, only : T_Swapping

		! --- in/out ---------------------------------

		class(T_Mapping), intent(out) :: self
		class(T_Mapping), intent(in) :: mapping
		type(T_Swapping), intent(in) :: swp
		type(T_Swapping), intent(in) :: mswp
		integer, intent(out) :: status

		! --- const ----------------------------------

		character(len=*), parameter :: rname = mname//'/Mapping_InitSwap'

		! --- local ----------------------------------

		real, allocatable :: sendbuf(:,:) ! (4,nsend)
		real, allocatable :: recvbuf(:,:) ! (4,nrecv)
		integer :: k
		integer :: imap

		! --- begin ----------------------------------

		! init base:
		call self%Init( status )
		IF_NOT_OK_RETURN(status=1)

		!~ pixel arrays

		! logical size:
		self%npix = swp%nrecv

		! storage for array with number of overlapping cells per pixel:
		allocate( self%map_n(max(1,swp%nrecv)), source=0, stat=status )
		IF_NOT_OK_RETURN(status=1)
		! fill "swapped" values, not from "mapping%map_n",
		! but from the special array 'mswp%nwsend' with number of weights per swapped pixel;
		! do not use the 'swp%Swap' routine, since input is already "sorted" ..
		call csoc%AllToAllV( mswp%nwsend, swp%sendcounts, &
		self%map_n , swp%recvcounts, status )
		IF_NOT_OK_RETURN(status=1)
		! count:
		self%nmap = sum(self%map_n)

		! offset is cumulative sum:
		allocate( self%map_i0(max(1,swp%nrecv)), source=0, stat=status )
		IF_NOT_OK_RETURN(status=1)
		! fill:
		do k = 2, max(1,swp%nrecv)
		self%map_i0(k) = self%map_i0(k-1) + self%map_n(k-1)
		end do

		!~ mapping arrays

		! check ...
		if ( self%nmap /= mswp%nrecv ) then
		write (csol,'("nmap ",i0," while receiving ",i0," mapping elements")') self%nmap, mswp%nrecv; call csoErr
		TRACEBACK; status=1; return
		end if

		! storage for swapping mapping arrays:
		allocate( sendbuf(4,max(1,mswp%nsend)), stat=status )
		IF_NOT_OK_RETURN(status=1)
		allocate( recvbuf(4,max(1,mswp%nrecv)), stat=status )
		IF_NOT_OK_RETURN(status=1)

		! any to be send?
		if ( mswp%nsend > 0 ) then
		! loop over elements, in order of sending (grouped per pe):
		do k = 1, mswp%nsend
		! source element:
		imap = mswp%iimap(k)
		! fill:
		sendbuf(1,k) = mapping%map_iglb(imap)
		sendbuf(2,k) = mapping%map_ii (imap)
		sendbuf(3,k) = mapping%map_jj (imap)
		sendbuf(4,k) = mapping%map_ww (imap)
		end do ! sending elements
		end if

		! swap values:
		call csoc%AllToAllV( sendbuf, mswp%sendcounts, &
		recvbuf, mswp%recvcounts, status )
		IF_NOT_OK_RETURN(status=1)

		! any received?
		if ( mswp%nrecv > 0 ) then
		! storage:
		allocate( self%map_iglb(mswp%nrecv), stat=status )
		IF_NOT_OK_RETURN(status=1)
		allocate( self%map_ii(mswp%nrecv), stat=status )
		IF_NOT_OK_RETURN(status=1)
		allocate( self%map_jj(mswp%nrecv), stat=status )
		IF_NOT_OK_RETURN(status=1)
		allocate( self%map_ww(mswp%nrecv), stat=status )
		IF_NOT_OK_RETURN(status=1)
		! copy:
		self%map_iglb = nint(recvbuf(1,:))
		self%map_ii = nint(recvbuf(2,:))
		self%map_jj = nint(recvbuf(3,:))
		self%map_ww = recvbuf(4,:)
		end if ! nrecv > 0

		! clear:
		deallocate( sendbuf, stat=status )
		IF_NOT_OK_RETURN(status=1)
		deallocate( recvbuf, stat=status )
		IF_NOT_OK_RETURN(status=1)

		! ok
		status = 0

		end subroutine Mapping_InitSwap


		! ***


		subroutine Mapping_Done( self, status )

		! --- in/out ---------------------------------

oper/src/cso_pixels.F90

+0 −142

Original line number	Diff line number	Diff line
		@@ -172,7 +172,6 @@ module CSO_Pixels
		!
		contains
		procedure :: Init => PixelDatas_Init
		procedure :: InitSwap => PixelDatas_InitSwap
		procedure :: Done => PixelDatas_Done
		procedure :: InqID => PixelDatas_InqID
		procedure :: Get => PixelDatas_Get
		@@ -2690,147 +2689,6 @@ contains
		end subroutine PixelDatas_Init


		! ***


		subroutine PixelDatas_InitSwap( self, pd, swp, status )

		use CSO_Comm , only : csoc
		use CSO_Domains , only : T_CSO_Domains
		use CSO_PArray , only : CSO_PArray_Init, CSO_PArray_Done, CSO_PArray_Reshape
		use CSO_Swapping, only : T_Swapping

		! --- in/out ---------------------------------

		class(T_PixelDatas), intent(out) :: self
		type(T_PixelDatas), intent(in) :: pd
		type(T_Swapping), intent(in) :: swp
		integer, intent(out) :: status

		! --- const ----------------------------------

		character(len=*), parameter :: rname = mname//'/PixelDatas_InitSwap'

		! --- local ----------------------------------

		integer :: ndim, idim
		character(len=32) :: dimname
		integer :: dimlen
		integer :: i
		character(len=64) :: vname
		character(len=256) :: dnames
		character(len=16) :: xtype
		logical :: glb
		integer :: ivar
		integer :: nval
		real, allocatable :: sendbuf(:,:) ! (nval,nsend)
		real, allocatable :: recvbuf(:,:) ! (nval,nrecv)


		!! testing ...
		!integer, allocatable :: to_npe(:) ! (npix)

		! --- begin ----------------------------------

		! To swap data, first experiments used a new "MPI type" to collect pixels.
		! However, this requires that the compiler aligns the variables contigeously,
		! but that was found to be dificult to ensure for some compilers ..
		! Therefore here we simply copy the data into arrays and swap
		! these to the other domains.

		!! testing ...
		!print *, '---- swap pixel data ...'

		! init base:
		call self%Init( status )
		IF_NOT_OK_RETURN(status=1)

		! copy dimensions;
		! get number of original dimensions:
		call pd%Get( status, ndim=ndim )
		IF_NOT_OK_RETURN(status=1)
		! loop:
		do idim = 1, ndim
		! get name and length:
		call pd%GetDim( idim, status, name=dimname, length=dimlen )
		IF_NOT_OK_RETURN(status=1)
		!! testing ...
		!print *, 'xxx1 copy dim ', trim(dimname), dimlen
		! set:
		call self%ncdims%Append( dimname, dimlen, status )
		IF_NOT_OK_RETURN(status=1)
		end do

		! copy global sets:
		call self%CopyGlb( pd, status )
		IF_NOT_OK_RETURN(status=1)

		! initialize new dataset;
		! loop over original datasets:
		do i = 1, pd%n
		! info on current variable:
		call pd%values(i)%p%Get( status, name=vname, dnames=dnames, xtype=xtype, glb=glb )
		IF_NOT_OK_RETURN(status=1)
		! skip global, already copied:
		if ( glb ) cycle
		!! testing ...
		!print *, 'xxx2 define var ', trim(vname), ' ; ', trim(dnames), ' ; ', trim(xtype)
		! define new variable, no data yet:
		call self%Def( vname, dnames, ivar, status, xtype=xtype, glb=glb )
		IF_NOT_OK_RETURN(status=1)
		! copy attributes:
		call self%values(ivar)%p%attrs%InitCopy( pd%values(i)%p%attrs, status )
		IF_NOT_OK_RETURN(status=1)
		end do
		!! testing ...
		!print *, 'xxx3 nrecv = ', swp%nrecv
		! allocate data sets using new number of pixels:
		call self%EndDef( swp%nrecv, status )
		IF_NOT_OK_RETURN(status=1)

		! ~

		! number of data values per pixel:
		call pd%Get( status, nval=nval )
		IF_NOT_OK_RETURN(status=1)

		! storage for data to be send and received:
		allocate( sendbuf(nval,max(1,swp%nsend)), stat=status )
		IF_NOT_OK_RETURN(status=1)
		allocate( recvbuf(nval,max(1,swp%nrecv)), stat=status )
		IF_NOT_OK_RETURN(status=1)

		! any data to be send?
		if ( swp%nsend > 0 ) then
		! extract data in order of sending:
		call pd%GetSelection( swp%iipix, sendbuf, status )
		IF_NOT_OK_RETURN(status=1)
		end if

		! swap values:
		call csoc%AllToAllV( sendbuf, swp%sendcounts, &
		recvbuf, swp%recvcounts, &
		status )
		IF_NOT_OK_RETURN(status=1)

		! any data to be stored?
		if ( swp%nrecv > 0 ) then
		! store data:
		call self%SetValues( recvbuf, status )
		IF_NOT_OK_RETURN(status=1)
		end if

		! clear:
		deallocate( recvbuf, stat=status )
		IF_NOT_OK_RETURN(status=1)
		deallocate( sendbuf, stat=status )
		IF_NOT_OK_RETURN(status=1)

		! ok
		status = 0

		end subroutine PixelDatas_InitSwap


		! ***

oper/src/cso_series.F90

+38 −96

Original line number	Diff line number	Diff line
		@@ -26,9 +26,8 @@ module CSO_Series

		use CSO_Logging , only : csol, csoPr, csoErr
		use CSO_Listing , only : T_CSO_Listing
		use CSO_Sat , only : T_CSO_Data_Set
		use CSO_Sat , only : T_CSO_State_Set
		use CSO_DateTimes , only : T_CSO_DateTime
		use CSO_Set , only : P_CSO_Set_Data
		use CSO_Set , only : P_CSO_Set_State

		implicit none

		@@ -37,8 +36,8 @@ module CSO_Series

		private

		public :: T_CSO_Data_Series
		public :: T_CSO_State_Series
		public :: T_CSO_Series_Data
		public :: T_CSO_Series_State


		! --- const ------------------------------
		@@ -64,32 +63,7 @@ module CSO_Series

		! --- types --------------------------------

		! ~ pointer structure

		type P_CSO_Sat_Data
		! pointer to data:
		type(T_CSO_Data_Set), pointer :: p
		! orbit filename:
		character(len=1024) :: filename
		character(len=1024) :: basename
		! timestamp, used for output dir:
		type(T_CSO_DateTime) :: tstamp
		contains
		procedure :: InitCopy => CSO_Sat_Data_InitCopy
		end type P_CSO_Sat_Data

		! ~

		type P_CSO_Sat_State
		! pointer to state:
		type(T_CSO_State_Set), pointer :: p
		! part of filename:
		character(len=32) :: name
		end type P_CSO_Sat_State

		! ~ series

		type T_CSO_Data_Series
		type T_CSO_Series_Data
		! name that might be used in output files etc:
		character(len=64) :: name
		! storage for list of orbit file names:
		@@ -100,7 +74,7 @@ module CSO_Series
		character(len=64) :: output_subdir
		! pointers to data:
		integer :: nrec
		type(P_CSO_Sat_Data), allocatable :: psdata(:) ! (nrec)
		type(P_CSO_Set_Data), allocatable :: psdata(:) ! (nrec)
		! status flag:
		integer, allocatable :: stat(:) ! (nrec)
		! index list for currently open data sets:
		@@ -126,11 +100,11 @@ module CSO_Series
		procedure :: PostProc => CSO_Series_Data_PostProc
		procedure :: PutOut => CSO_Series_Data_PutOut
		procedure :: Finish => CSO_Series_Data_Finish
		end type T_CSO_Data_Series
		end type T_CSO_Series_Data

		!~

		type T_CSO_State_Series
		type T_CSO_Series_State
		! name, used for output files:
		character(len=64) :: name
		! output dir:
		@@ -141,7 +115,7 @@ module CSO_Series
		! attribute:
		character(len=512) :: description
		! pointers to open states:
		type(P_CSO_Sat_State), pointer :: psstate(:) ! (n)
		type(P_CSO_Set_State), pointer :: psstate(:) ! (n)
		!
		contains
		procedure :: Init => CSO_Series_State_Init
		@@ -151,49 +125,13 @@ module CSO_Series
		procedure :: Close => CSO_Series_State_Close
		procedure :: PostProc => CSO_Series_State_PostProc
		procedure :: PutOut => CSO_Series_State_PutOut
		end type T_CSO_State_Series
		end type T_CSO_Series_State



		contains


		! ====================================================================
		! ===
		! === pointer object
		! ===
		! ====================================================================


		subroutine CSO_Sat_Data_InitCopy( self, source, status )

		! --- in/out ---------------------------------

		class(P_CSO_Sat_Data), intent(out) :: self
		class(P_CSO_Sat_Data), intent(in) :: source
		integer, intent(out) :: status

		! --- const ----------------------------------

		character(len=*), parameter :: rname = mname//'/CSO_Sat_Data_InitCopy'

		! --- local ----------------------------------

		! --- begin ----------------------------------

		! assign:
		self%p => source%p
		! copy:
		self%filename = trim(source%filename)
		self%basename = trim(source%basename)
		self%tstamp = source%tstamp

		! ok
		status = 0

		end subroutine CSO_Sat_Data_InitCopy


		! ====================================================================
		! ===
		! === Series of Data objects
		@@ -206,7 +144,7 @@ contains

		! --- in/out ---------------------------------

		class(T_CSO_Data_Series), intent(out) :: self
		class(T_CSO_Series_Data), intent(out) :: self
		character(len=*), intent(in) :: listing_filename
		integer, intent(out) :: status
		logical, intent(in), optional :: output_enabled
		@@ -302,7 +240,7 @@ contains

		! --- in/out ---------------------------------

		class(T_CSO_Data_Series), intent(inout) :: self
		class(T_CSO_Series_Data), intent(inout) :: self
		integer, intent(out) :: status

		! --- const ----------------------------------
		@@ -353,9 +291,11 @@ contains
		iset, inew, ifin, &
		sdata, isnew )

		use CSO_Set, only : T_CSO_Set_Data

		! --- in/out ---------------------------------

		class(T_CSO_Data_Series), intent(inout) :: self
		class(T_CSO_Series_Data), intent(inout) :: self
		integer, intent(out) :: status
		integer, intent(out), optional :: nset
		integer, intent(out), optional :: nnew
		@@ -363,7 +303,7 @@ contains
		integer, intent(in), optional :: iset
		integer, intent(in), optional :: inew
		integer, intent(in), optional :: ifin
		type(T_CSO_Data_Set), pointer, optional :: sdata
		type(T_CSO_Set_Data), pointer, optional :: sdata
		logical, intent(out), optional :: isnew

		! --- const ----------------------------------
		@@ -461,7 +401,7 @@ contains

		! --- in/out ---------------------------------

		class(T_CSO_Data_Series), intent(inout) :: self
		class(T_CSO_Series_Data), intent(inout) :: self
		type(T_CSO_RcFile), intent(in) :: rcF
		character(len=*), intent(in) :: rcbase
		type(T_CSO_DateTime), intent(in) :: t1, t2
		@@ -674,7 +614,7 @@ contains

		! --- in/out ---------------------------------

		class(T_CSO_Data_Series), intent(inout) :: self
		class(T_CSO_Series_Data), intent(inout) :: self
		integer, intent(out) :: status

		! --- const ----------------------------------
		@@ -755,7 +695,7 @@ contains

		! --- in/out ---------------------------------

		class(T_CSO_Data_Series), intent(inout) :: self
		class(T_CSO_Series_Data), intent(inout) :: self
		integer, intent(out) :: status

		! --- const ----------------------------------
		@@ -804,7 +744,7 @@ contains

		! --- in/out ---------------------------------

		class(T_CSO_Data_Series), intent(inout) :: self
		class(T_CSO_Series_Data), intent(inout) :: self
		integer, intent(out) :: status

		! --- const ----------------------------------
		@@ -856,7 +796,7 @@ contains

		! --- in/out ---------------------------------

		class(T_CSO_Data_Series), intent(inout) :: self
		class(T_CSO_Series_Data), intent(inout) :: self
		integer, intent(out) :: status

		! --- const ----------------------------------
		@@ -913,8 +853,8 @@ contains

		! --- in/out ---------------------------------

		class(T_CSO_State_Series), intent(out) :: self
		class(T_CSO_Data_Series), intent(in) :: dser
		class(T_CSO_Series_State), intent(out) :: self
		class(T_CSO_Series_Data), intent(in) :: dser
		character(len=*), intent(in) :: name
		integer, intent(out) :: status
		character(len=*), intent(in), optional :: description
		@@ -983,8 +923,8 @@ contains

		! --- in/out ---------------------------------

		class(T_CSO_State_Series), intent(inout) :: self
		class(T_CSO_Data_Series), intent(in) :: dser
		class(T_CSO_Series_State), intent(inout) :: self
		class(T_CSO_Series_Data), intent(in) :: dser
		integer, intent(out) :: status

		! --- const ----------------------------------
		@@ -1020,13 +960,15 @@ contains

		subroutine CSO_Series_State_Get( self, dser, status, iset, sstate )

		use CSO_Set, only : T_CSO_Set_State

		! --- in/out ---------------------------------

		class(T_CSO_State_Series), intent(inout) :: self
		class(T_CSO_Data_Series), intent(in) :: dser
		class(T_CSO_Series_State), intent(inout) :: self
		class(T_CSO_Series_Data), intent(in) :: dser
		integer, intent(out) :: status
		integer, intent(in), optional :: iset
		type(T_CSO_State_Set), pointer, optional :: sstate
		type(T_CSO_Set_State), pointer, optional :: sstate

		! --- const ----------------------------------

		@@ -1085,8 +1027,8 @@ contains

		! --- in/out ---------------------------------

		class(T_CSO_State_Series), intent(inout) :: self
		class(T_CSO_Data_Series), intent(in) :: dser
		class(T_CSO_Series_State), intent(inout) :: self
		class(T_CSO_Series_Data), intent(in) :: dser
		type(T_CSO_RcFile), intent(in) :: rcF
		character(len=*), intent(in) :: rcbase
		integer, intent(out) :: status
		@@ -1193,8 +1135,8 @@ contains

		! --- in/out ---------------------------------

		class(T_CSO_State_Series), intent(inout) :: self
		class(T_CSO_Data_Series), intent(in) :: dser
		class(T_CSO_Series_State), intent(inout) :: self
		class(T_CSO_Series_Data), intent(in) :: dser
		integer, intent(out) :: status

		! --- const ----------------------------------
		@@ -1235,8 +1177,8 @@ contains

		! --- in/out ---------------------------------

		class(T_CSO_State_Series), intent(inout) :: self
		class(T_CSO_Data_Series), intent(in) :: dser
		class(T_CSO_Series_State), intent(inout) :: self
		class(T_CSO_Series_Data), intent(in) :: dser
		integer, intent(out) :: status

		! --- const ----------------------------------
		@@ -1288,8 +1230,8 @@ contains

		! --- in/out ---------------------------------

		class(T_CSO_State_Series), intent(inout) :: self
		class(T_CSO_Data_Series), intent(in) :: dser
		class(T_CSO_Series_State), intent(inout) :: self
		class(T_CSO_Series_Data), intent(in) :: dser
		integer, intent(out) :: status

		! --- const ----------------------------------