Context Navigation

iophy.F90 @ 5411

Last change on this file since 5411 was 4727, checked in by idelkadi, 14 months ago
Merged trunk changes -r4488:4726 LMDZ_ECRad branch
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:keywords set to `Id`
File size: 12.7 KB

Rev	Line
[1883]	1	!
[2097]	2	! $Id: iophy.F90 4727 2023-10-19 14:02:57Z evignon $
[1883]	3	!
	4	module iophy
	5
	6	! abd REAL,private,allocatable,dimension(:),save :: io_lat
	7	! abd REAL,private,allocatable,dimension(:),save :: io_lon
	8	REAL,allocatable,dimension(:),save :: io_lat
	9	REAL,allocatable,dimension(:),save :: io_lon
	10	INTEGER, save :: phys_domain_id
	11	INTEGER, save :: npstn
	12	INTEGER, allocatable, dimension(:), save :: nptabij
	13
	14
	15	! interfaces for both IOIPSL and XIOS
	16	INTERFACE histwrite_phy
	17	MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_xios,histwrite3d_xios
	18	END INTERFACE
	19
	20	! interfaces for both IOIPSL and XIOS
	21	INTERFACE histbeg_phy_all
	22	MODULE PROCEDURE histbeg_phy, histbeg_phyxios
	23	END INTERFACE
	24
	25	contains
	26
	27	subroutine init_iophy_new(rlat,rlon)
[1897]	28	USE dimphy, only: klon
	29	USE mod_phys_lmdz_para, only: gather, bcast, &
	30	jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
	31	mpi_size, mpi_rank, klon_mpi, &
[2588]	32	is_sequential, is_south_pole_dyn
[1897]	33	USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo
[2326]	34	USE print_control_mod, ONLY: lunout, prt_level
	35	USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
[1897]	36	#ifdef CPP_IOIPSL
	37	USE ioipsl, only: flio_dom_set
	38	#endif
[4727]	39	use wxios, only: wxios_domain_param, using_xios
[1883]	40	implicit none
	41	real,dimension(klon),intent(in) :: rlon
	42	real,dimension(klon),intent(in) :: rlat
	43
	44	REAL,dimension(klon_glo) :: rlat_glo
	45	REAL,dimension(klon_glo) :: rlon_glo
	46
	47	INTEGER,DIMENSION(2) :: ddid
	48	INTEGER,DIMENSION(2) :: dsg
	49	INTEGER,DIMENSION(2) :: dsl
	50	INTEGER,DIMENSION(2) :: dpf
	51	INTEGER,DIMENSION(2) :: dpl
	52	INTEGER,DIMENSION(2) :: dhs
	53	INTEGER,DIMENSION(2) :: dhe
	54	INTEGER :: i
[1897]	55	integer :: data_ibegin,data_iend
[1883]	56
	57	CALL gather(rlat,rlat_glo)
	58	CALL bcast(rlat_glo)
	59	CALL gather(rlon,rlon_glo)
	60	CALL bcast(rlon_glo)
	61
	62	!$OMP MASTER
[2326]	63	ALLOCATE(io_lat(nbp_lat))
[1883]	64	io_lat(1)=rlat_glo(1)
[2326]	65	io_lat(nbp_lat)=rlat_glo(klon_glo)
	66	IF ((nbp_lon*nbp_lat) > 1) then
	67	DO i=2,nbp_lat-1
	68	io_lat(i)=rlat_glo(2+(i-2)*nbp_lon)
[1883]	69	ENDDO
	70	ENDIF
	71
[2326]	72	ALLOCATE(io_lon(nbp_lon))
	73	IF ((nbp_lon*nbp_lat) > 1) THEN
	74	io_lon(:)=rlon_glo(2:nbp_lon+1)
	75	ELSE
	76	io_lon(1)=rlon_glo(1)
	77	ENDIF
[1883]	78	!! (I) dtnb : total number of domains
	79	!! (I) dnb : domain number
	80	!! (I) did(:) : distributed dimensions identifiers
	81	!! (up to 5 dimensions are supported)
	82	!! (I) dsg(:) : total number of points for each dimension
	83	!! (I) dsl(:) : local number of points for each dimension
	84	!! (I) dpf(:) : position of first local point for each dimension
	85	!! (I) dpl(:) : position of last local point for each dimension
	86	!! (I) dhs(:) : start halo size for each dimension
	87	!! (I) dhe(:) : end halo size for each dimension
	88	!! (C) cdnm : Model domain definition name.
	89	!! The names actually supported are :
	90	!! "BOX", "APPLE", "ORANGE".
	91	!! These names are case insensitive.
	92	ddid=(/ 1,2 /)
[2326]	93	dsg=(/ nbp_lon, nbp_lat /)
	94	dsl=(/ nbp_lon, jj_nb /)
[1883]	95	dpf=(/ 1,jj_begin /)
[2326]	96	dpl=(/ nbp_lon, jj_end /)
[1883]	97	dhs=(/ ii_begin-1,0 /)
	98	if (mpi_rank==mpi_size-1) then
	99	dhe=(/0,0/)
	100	else
[2326]	101	dhe=(/ nbp_lon-ii_end,0 /)
[1883]	102	endif
	103
[2097]	104	#ifndef CPP_IOIPSL_NO_OUTPUT
[1883]	105	call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
	106	'APPLE',phys_domain_id)
	107	#endif
[4727]	108	IF (using_xios) THEN
	109	! Set values for the mask:
	110	IF (mpi_rank == 0) THEN
	111	data_ibegin = 0
	112	ELSE
	113	data_ibegin = ii_begin - 1
	114	END IF
[1883]	115
[4727]	116	IF (mpi_rank == mpi_size-1) THEN
	117	data_iend = nbp_lon
	118	ELSE
	119	data_iend = ii_end + 1
	120	END IF
[1883]	121
[4727]	122	if (prt_level>=10) then
	123	write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end
	124	write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
	125	write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
	126	write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
	127	write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole=",is_south_pole_dyn
	128	endif
[1883]	129
[4727]	130	! Initialize the XIOS domain coreesponding to this process:
	131	CALL wxios_domain_param("dom_glo", is_sequential, nbp_lon, jj_nb, nbp_lon, nbp_lat, &
	132	1, nbp_lon, ii_begin, ii_end, jj_begin, jj_end, &
	133	klon_mpi+2*(nbp_lon-1), data_ibegin, data_iend, &
	134	io_lat, io_lon,is_south_pole_dyn,mpi_rank)
	135	ENDIF
[1883]	136	!$OMP END MASTER
	137
	138	END SUBROUTINE init_iophy_new
	139
	140	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	141
	142	subroutine histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day)
[1897]	143	USE mod_phys_lmdz_para, only: is_sequential, jj_begin, jj_end, jj_nb
	144	use ioipsl, only: histbeg
[2326]	145	USE print_control_mod, ONLY: prt_level, lunout
	146	USE mod_grid_phy_lmdz, ONLY: nbp_lon
[1883]	147	implicit none
	148
	149	character(), intent(IN) :: name
	150	integer, intent(in) :: itau0
	151	real,intent(in) :: zjulian
	152	real,intent(in) :: dtime
	153	integer,intent(out) :: nhori
	154	integer,intent(out) :: nid_day
	155
	156	!$OMP MASTER
	157	if (is_sequential) then
[2326]	158	call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
	159	1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
[1883]	160	else
[2326]	161	call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
	162	1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
[1883]	163	endif
	164	!$OMP END MASTER
	165
	166	end subroutine histbeg_phy
	167
	168	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	169
	170
	171	! SUBROUTINE histbeg_phyxios(name,itau0,zjulian,dtime,ffreq,lev,nhori,nid_day)
	172	SUBROUTINE histbeg_phyxios(name,ffreq,lev)
[1897]	173	USE mod_phys_lmdz_para, only: is_using_mpi, is_mpi_root
	174	use wxios, only: wxios_add_file
[1883]	175	IMPLICIT NONE
	176
	177	character(), INTENT(IN) :: name
	178	! integer, INTENT(IN) :: itau0
	179	! REAL,INTENT(IN) :: zjulian
	180	! REAL,INTENT(IN) :: dtime
	181	character(LEN=*), INTENT(IN) :: ffreq
	182	INTEGER,INTENT(IN) :: lev
	183	! integer,intent(out) :: nhori
	184	! integer,intent(out) :: nid_day
	185
	186	!$OMP MASTER
	187
	188	! ug OMP en chantier...
	189	IF((.NOT. is_using_mpi) .OR. is_mpi_root) THEN
	190	! ug Création du fichier
	191	CALL wxios_add_file(name, ffreq, lev)
	192	END IF
	193
	194	!$OMP END MASTER
	195
	196	END SUBROUTINE histbeg_phyxios
	197
	198
	199	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	200
	201	subroutine histwrite2d_phy(nid,lpoint,name,itau,field)
[1897]	202	USE dimphy, only: klon
	203	USE mod_phys_lmdz_para, only: Gather_omp, grid1Dto2D_mpi, &
	204	is_sequential, klon_mpi_begin, klon_mpi_end, &
	205	jj_nb, klon_mpi
	206	USE ioipsl, only: histwrite
[2326]	207	USE mod_grid_phy_lmdz, ONLY: nbp_lon
[1883]	208	implicit none
	209
	210	integer,intent(in) :: nid
	211	logical,intent(in) :: lpoint
	212	character(), intent(IN) :: name
	213	integer, intent(in) :: itau
	214	real,dimension(:),intent(in) :: field
	215	REAL,dimension(klon_mpi) :: buffer_omp
	216	INTEGER, allocatable, dimension(:) :: index2d
[2326]	217	REAL :: Field2d(nbp_lon,jj_nb)
[1883]	218
	219	integer :: ip
	220	real,allocatable,dimension(:) :: fieldok
	221
[2311]	222	IF (size(field)/=klon) CALL abort_physic('iophy::histwrite2d','Field first dimension not equal to klon',1)
[1883]	223
	224	CALL Gather_omp(field,buffer_omp)
	225	!$OMP MASTER
	226	CALL grid1Dto2D_mpi(buffer_omp,Field2d)
	227	if(.NOT.lpoint) THEN
[2326]	228	ALLOCATE(index2d(nbp_lon*jj_nb))
	229	ALLOCATE(fieldok(nbp_lon*jj_nb))
	230	CALL histwrite(nid,name,itau,Field2d,nbp_lon*jj_nb,index2d)
[1883]	231	else
	232	ALLOCATE(fieldok(npstn))
	233	ALLOCATE(index2d(npstn))
	234
	235	if(is_sequential) then
	236	! klon_mpi_begin=1
	237	! klon_mpi_end=klon
	238	DO ip=1, npstn
	239	fieldok(ip)=buffer_omp(nptabij(ip))
	240	ENDDO
	241	else
	242	DO ip=1, npstn
	243	! print*,'histwrite2d is_sequential npstn ip name nptabij',npstn,ip,name,nptabij(ip)
	244	IF(nptabij(ip).GE.klon_mpi_begin.AND. &
	245	nptabij(ip).LE.klon_mpi_end) THEN
	246	fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
	247	ENDIF
	248	ENDDO
	249	endif
	250	CALL histwrite(nid,name,itau,fieldok,npstn,index2d)
	251	!
	252	endif
	253	deallocate(index2d)
	254	deallocate(fieldok)
	255	!$OMP END MASTER
	256	end subroutine histwrite2d_phy
	257
	258	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	259
	260	subroutine histwrite3d_phy(nid,lpoint,name,itau,field)
[1897]	261	USE dimphy, only: klon
	262	USE mod_phys_lmdz_para, only: Gather_omp, grid1Dto2D_mpi, &
	263	is_sequential, klon_mpi_begin, klon_mpi_end, &
	264	jj_nb, klon_mpi
	265	USE ioipsl, only: histwrite
[2326]	266	USE mod_grid_phy_lmdz, ONLY: nbp_lon
[1883]	267	implicit none
	268
	269	integer,intent(in) :: nid
	270	logical,intent(in) :: lpoint
	271	character(), intent(IN) :: name
	272	integer, intent(in) :: itau
	273	real,dimension(:,:),intent(in) :: field ! --> field(klon,:)
	274	REAL,dimension(klon_mpi,size(field,2)) :: buffer_omp
[2326]	275	REAL :: Field3d(nbp_lon,jj_nb,size(field,2))
[1883]	276	INTEGER :: ip, n, nlev
	277	INTEGER, ALLOCATABLE, dimension(:) :: index3d
	278	real,allocatable, dimension(:,:) :: fieldok
	279
[2311]	280	IF (size(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first dimension not equal to klon',1)
[1883]	281	nlev=size(field,2)
	282
	283	CALL Gather_omp(field,buffer_omp)
	284	!$OMP MASTER
	285	CALL grid1Dto2D_mpi(buffer_omp,field3d)
	286	if(.NOT.lpoint) THEN
[2326]	287	ALLOCATE(index3d(nbp_lonjj_nbnlev))
	288	ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
	289	CALL histwrite(nid,name,itau,Field3d,nbp_lonjj_nbnlev,index3d)
[1883]	290	else
	291	nlev=size(field,2)
	292	ALLOCATE(index3d(npstn*nlev))
	293	ALLOCATE(fieldok(npstn,nlev))
	294
	295	if(is_sequential) then
	296	! klon_mpi_begin=1
	297	! klon_mpi_end=klon
	298	DO n=1, nlev
	299	DO ip=1, npstn
	300	fieldok(ip,n)=buffer_omp(nptabij(ip),n)
	301	ENDDO
	302	ENDDO
	303	else
	304	DO n=1, nlev
	305	DO ip=1, npstn
	306	IF(nptabij(ip).GE.klon_mpi_begin.AND. &
	307	nptabij(ip).LE.klon_mpi_end) THEN
	308	fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
	309	ENDIF
	310	ENDDO
	311	ENDDO
	312	endif
	313	CALL histwrite(nid,name,itau,fieldok,npstn*nlev,index3d)
	314	endif
	315	deallocate(index3d)
	316	deallocate(fieldok)
	317	!$OMP END MASTER
	318	end subroutine histwrite3d_phy
	319
	320	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	321
	322	! VERSION DES HISTWRITE DEDIEES AU TOUT-XIOS-XML DEJA UTILISEE DANS PHYDEV
[4727]	323
[1883]	324	SUBROUTINE histwrite2d_xios(field_name,field)
[1897]	325	USE dimphy, only: klon
	326	USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
	327	jj_nb, klon_mpi
[4727]	328	USE lmdz_xios, only: xios_send_field
[2326]	329	USE print_control_mod, ONLY: prt_level, lunout
	330	USE mod_grid_phy_lmdz, ONLY: nbp_lon
[1883]	331	IMPLICIT NONE
	332
	333	CHARACTER(LEN=*), INTENT(IN) :: field_name
	334	REAL, DIMENSION(:), INTENT(IN) :: field
	335
	336	REAL,DIMENSION(klon_mpi) :: buffer_omp
[2326]	337	REAL :: Field2d(nbp_lon,jj_nb)
[1883]	338
[1897]	339	IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',trim(field_name)
[1883]	340
[2311]	341	IF (SIZE(field)/=klon) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon',1)
[1883]	342
	343	CALL Gather_omp(field,buffer_omp)
	344	!$OMP MASTER
	345	CALL grid1Dto2D_mpi(buffer_omp,Field2d)
	346
[2002]	347	CALL xios_send_field(field_name, Field2d)
[1883]	348	!$OMP END MASTER
	349
[1897]	350	IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',trim(field_name)
[1883]	351	END SUBROUTINE histwrite2d_xios
	352
	353	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	354
	355	! VERSION DES HISTWRITE DEDIEES AU TOUT-XIOS-XML DEJA UTILISEE DANS PHYDEV
[4727]	356
[1883]	357	SUBROUTINE histwrite3d_xios(field_name, field)
[1897]	358	USE dimphy, only: klon, klev
	359	USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
	360	jj_nb, klon_mpi
[4727]	361	USE lmdz_xios, only: xios_send_field
[2326]	362	USE print_control_mod, ONLY: prt_level,lunout
	363	USE mod_grid_phy_lmdz, ONLY: nbp_lon
[1883]	364
	365	IMPLICIT NONE
	366
	367	CHARACTER(LEN=*), INTENT(IN) :: field_name
	368	REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
	369
	370	REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
[2326]	371	REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
[1883]	372	INTEGER :: ip, n, nlev
	373
[1897]	374	IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d_xios ',trim(field_name)
[1883]	375
	376	!Et on.... écrit
[2311]	377	IF (SIZE(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
[1883]	378	nlev=SIZE(field,2)
	379
	380
	381	CALL Gather_omp(field,buffer_omp)
	382	!$OMP MASTER
	383	CALL grid1Dto2D_mpi(buffer_omp,field3d)
	384
[2002]	385	CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
[1883]	386	!$OMP END MASTER
	387
[1897]	388	IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',trim(field_name)
[1883]	389	END SUBROUTINE histwrite3d_xios
	390
	391	end module iophy

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format