Context Navigation

call_calfis_mod.F90 @ 3548

Last change on this file since 3548 was 3435, checked in by Laurent Fairhead, 6 years ago

"Historic" :-) commit merging the physics branch used for DYNAMICO with the LMDZ trunk.
The same physics branch can now be used seamlessly with the traditional lon-lat LMDZ
dynamical core and DYNAMICO.
Testing consisted in running a lon-lat LMDZ bucket simulation with the NPv6.1 physics package
with the original trunk sources and the merged sources. Tests were succesful in the sense that
numeric continuity was preserved in the restart files from both simulation. Further tests
included running both versions of the physics codes for one year in a LMDZOR setting in which
the restart files also came out identical.

Caution:

as the physics package now manages unstructured grids, grid information needs to be transmitted

to the surface scheme ORCHIDEE. This means that the interface defined in surf_land_orchidee_mod.F90
is only compatible with ORCHIDEE version orchidee2.1 and later versions. If previous versions of
ORCHIDEE need to be used, the CPP key ORCHIDEE_NOUNSTRUCT needs to be set at compilation time.
This is done automatically if makelmdz/makelmdz_fcm are called with the veget orchidee2.0 switch

due to a limitation in XIOS, the time at which limit conditions will be read in by DYNAMICO will be

delayed by one physic timestep with respect to the time it is read in by the lon-lat model. This is caused
by the line

IF (MOD(itime-1, lmt_pas) == 0 .OR. (jour_lu /= jour .AND. grid_type /= unstructured)) THEN ! time to read

in limit_read_mod.F90

Work still needed on COSP integration and XML files for DYNAMICO

EM, YM, LF

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

File size: 12.0 KB

Rev	Line
[1632]	1	!#define DEBUG_IO
	2	MODULE call_calfis_mod
	3
	4	REAL,POINTER,SAVE :: ucov(:,:)
	5	REAL,POINTER,SAVE :: vcov(:,:)
	6	REAL,POINTER,SAVE :: teta(:,:)
	7	REAL,POINTER,SAVE :: masse(:,:)
	8	REAL,POINTER,SAVE :: ps(:)
	9	REAL,POINTER,SAVE :: phis(:)
	10	REAL,POINTER,SAVE :: q(:,:,:)
	11	REAL,POINTER,SAVE :: flxw(:,:)
	12
	13	REAL,POINTER,SAVE :: p(:,:)
	14	REAL,POINTER,SAVE :: pks(:)
	15	REAL,POINTER,SAVE :: pk(:,:)
	16	REAL,POINTER,SAVE :: pkf(:,:)
	17	REAL,POINTER,SAVE :: phi(:,:)
	18	REAL,POINTER,SAVE :: du(:,:)
	19	REAL,POINTER,SAVE :: dv(:,:)
	20	REAL,POINTER,SAVE :: dteta(:,:)
	21	REAL,POINTER,SAVE :: dq(:,:,:)
	22	REAL,POINTER,SAVE :: dufi(:,:)
	23	REAL,POINTER,SAVE :: dvfi(:,:)
	24	REAL,POINTER,SAVE :: dtetafi(:,:)
	25	REAL,POINTER,SAVE :: dqfi(:,:,:)
	26	REAL,POINTER,SAVE :: dpfi(:)
	27
	28
	29
	30
	31
	32	CONTAINS
	33
	34	SUBROUTINE call_calfis_allocate
	35	USE bands
[1810]	36	USE allocate_field_mod
[1823]	37	USE parallel_lmdz
[1810]	38	USE dimensions_mod
[1632]	39	USE infotrac
	40	IMPLICIT NONE
	41	TYPE(distrib),POINTER :: d
	42	d=>distrib_physic
	43
	44	CALL allocate_u(ucov,llm,d)
	45	CALL allocate_v(vcov,llm,d)
	46	CALL allocate_u(teta,llm,d)
	47	CALL allocate_u(masse,llm,d)
	48	CALL allocate_u(ps,d)
	49	CALL allocate_u(phis,d)
	50	CALL allocate_u(q,llm,nqtot,d)
	51	CALL allocate_u(flxw,llm,d)
	52	CALL allocate_u(p,llmp1,d)
	53	CALL allocate_u(pks,d)
[3435]	54	pks(:)=0
[1632]	55	CALL allocate_u(pk,llm,d)
[3435]	56	pk(:,:)=0
[1632]	57	CALL allocate_u(pkf,llm,d)
	58	CALL allocate_u(phi,llm,d)
	59	CALL allocate_u(du,llm,d)
	60	CALL allocate_v(dv,llm,d)
	61	CALL allocate_u(dteta,llm,d)
	62	CALL allocate_u(dq,llm,nqtot,d)
	63	CALL allocate_u(dufi,llm,d)
	64	CALL allocate_v(dvfi,llm,d)
	65	CALL allocate_u(dtetafi,llm,d)
	66	CALL allocate_u(dqfi,llm,nqtot,d)
	67	CALL allocate_u(dpfi,d)
	68
	69	END SUBROUTINE call_calfis_allocate
	70
	71
[2221]	72	SUBROUTINE call_calfis(itau,lafin,ucov_dyn,vcov_dyn,teta_dyn,masse_dyn,ps_dyn, &
[1632]	73	phis_dyn,q_dyn,flxw_dyn)
[1810]	74	USE dimensions_mod
[2021]	75	use exner_hyb_loc_m, only: exner_hyb_loc
	76	use exner_milieu_loc_m, only: exner_milieu_loc
[1823]	77	USE parallel_lmdz
[1632]	78	USE times
	79	USE mod_hallo
	80	USE Bands
	81	USE vampir
	82	USE infotrac
	83	USE control_mod
	84	USE write_field_loc
	85	USE write_field
[2597]	86	USE comconst_mod, ONLY: dtphys
[2603]	87	USE logic_mod, ONLY: leapf, forward, ok_strato
[2600]	88	USE comvert_mod, ONLY: ap, bp, pressure_exner
[2601]	89	USE temps_mod, ONLY: day_ini, day_ref, jd_ref, jh_ref, start_time
[2600]	90
[1632]	91	IMPLICIT NONE
	92	INCLUDE "iniprint.h"
	93
[1987]	94	INTEGER,INTENT(IN) :: itau ! (time) iteration step number
	95	LOGICAL,INTENT(IN) :: lafin ! .true. if final time step
	96	REAL,INTENT(INOUT) :: ucov_dyn(ijb_u:ije_u,llm) ! covariant zonal wind
	97	REAL,INTENT(INOUT) :: vcov_dyn(ijb_v:ije_v,llm) ! covariant meridional wind
	98	REAL,INTENT(INOUT) :: teta_dyn(ijb_u:ije_u,llm) ! potential temperature
	99	REAL,INTENT(INOUT) :: masse_dyn(ijb_u:ije_u,llm) ! air mass
	100	REAL,INTENT(INOUT) :: ps_dyn(ijb_u:ije_u) ! surface pressure
	101	REAL,INTENT(INOUT) :: phis_dyn(ijb_u:ije_u) ! surface geopotential
	102	REAL,INTENT(INOUT) :: q_dyn(ijb_u:ije_u,llm,nqtot) ! advected tracers
	103	REAL,INTENT(INOUT) :: flxw_dyn(ijb_u:ije_u,llm) ! vertical mass flux
[1632]	104
	105	REAL :: dufi_tmp(iip1,llm)
	106	REAL :: dvfi_tmp(iip1,llm)
	107	REAL :: dtetafi_tmp(iip1,llm)
	108	REAL :: dpfi_tmp(iip1)
	109	REAL :: dqfi_tmp(iip1,llm,nqtot)
	110
	111	REAL :: jD_cur, jH_cur
	112	CHARACTER(LEN=15) :: ztit
[1848]	113	TYPE(Request),SAVE :: Request_physic
	114	!$OMP THREADPRIVATE(Request_physic )
[1632]	115	INTEGER :: ijb,ije,l,j
	116
	117
	118	#ifdef DEBUG_IO
	119	CALL WriteField_u('ucovfi',ucov)
	120	CALL WriteField_v('vcovfi',vcov)
	121	CALL WriteField_u('tetafi',teta)
	122	CALL WriteField_u('pfi',p)
	123	CALL WriteField_u('pkfi',pk)
	124	DO j=1,nqtot
	125	CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
	126	ENDDO
	127	#endif
	128
	129	!
	130	! ....... Ajout P.Le Van ( 17/04/96 ) ...........
	131	!
	132
	133
	134	!$OMP MASTER
	135	CALL suspend_timer(timer_caldyn)
[1987]	136	IF (prt_level >= 10) THEN
	137	WRITE(lunout,*) 'leapfrog_p: Entree dans la physique : Iteration No ',itau
	138	ENDIF
[1632]	139	!$OMP END MASTER
	140
[1673]	141	jD_cur = jD_ref + day_ini - day_ref &
[2375]	142	& + (itau+1)/day_step
[1676]	143
	144	IF (planet_type .eq."generic") THEN
	145	! AS: we make jD_cur to be pday
	146	jD_cur = int(day_ini + itau/day_step)
	147	ENDIF
	148
[1673]	149	jH_cur = jH_ref + start_time + &
[2375]	150	& mod(itau+1,day_step)/float(day_step)
[1673]	151	if (jH_cur > 1.0 ) then
	152	jD_cur = jD_cur +1.
	153	jH_cur = jH_cur -1.
	154	endif
[1632]	155
	156	! Inbterface avec les routines de phylmd (phymars ... )
	157	! -----------------------------------------------------
	158
	159	!+jld
	160
	161	! Diagnostique de conservation de l'energie : initialisation
	162
	163	!-jld
	164	!$OMP BARRIER
	165	!$OMP MASTER
	166	CALL VTb(VThallo)
	167	!$OMP END MASTER
	168
	169	#ifdef DEBUG_IO
	170	CALL WriteField_u('ucovfi',ucov)
	171	CALL WriteField_v('vcovfi',vcov)
	172	CALL WriteField_u('tetafi',teta)
	173	CALL WriteField_u('pfi',p)
	174	CALL WriteField_u('pkfi',pk)
	175	#endif
	176
	177	CALL SetTag(Request_physic,800)
	178	CALL Register_SwapField_u(ucov_dyn,ucov,distrib_physic,Request_physic,up=2,down=2)
	179	CALL Register_SwapField_v(vcov_dyn,vcov,distrib_physic,Request_physic,up=2,down=2)
	180	CALL Register_SwapField_u(teta_dyn,teta,distrib_physic,Request_physic,up=2,down=2)
	181	CALL Register_SwapField_u(masse_dyn,masse,distrib_physic,Request_physic,up=1,down=2)
	182	CALL Register_SwapField_u(ps_dyn,ps,distrib_physic,Request_physic,up=2,down=2)
	183	CALL Register_SwapField_u(phis_dyn,phis,distrib_physic,Request_physic,up=2,down=2)
	184	CALL Register_SwapField_u(q_dyn,q,distrib_physic,Request_physic,up=2,down=2)
	185	CALL Register_SwapField_u(flxw_dyn,flxw,distrib_physic,Request_physic,up=2,down=2)
	186
	187	CALL SendRequest(Request_Physic)
	188	!$OMP BARRIER
	189	CALL WaitRequest(Request_Physic)
	190
	191	!$OMP BARRIER
	192	!$OMP MASTER
	193	CALL Set_Distrib(distrib_Physic)
	194	CALL VTe(VThallo)
	195
	196	CALL VTb(VTphysiq)
	197	!$OMP END MASTER
	198	!$OMP BARRIER
	199
	200	CALL pression_loc ( ip1jmp1, ap, bp, ps, p )
	201
	202	!$OMP BARRIER
[2021]	203	CALL exner_hyb_loc( ip1jmp1, ps, p, pks, pk, pkf )
[1632]	204	!$OMP BARRIER
	205	CALL geopot_loc ( ip1jmp1, teta , pk , pks, phis , phi )
	206
	207
	208	CALL Register_Hallo_u(p,llmp1,2,2,2,2,Request_physic)
	209	CALL Register_Hallo_u(pk,llm,2,2,2,2,Request_physic)
	210	CALL Register_Hallo_u(phi,llm,2,2,2,2,Request_physic)
	211
	212	CALL SendRequest(Request_Physic)
	213	!$OMP BARRIER
	214	CALL WaitRequest(Request_Physic)
	215
	216	!$OMP BARRIER
	217
	218
	219	#ifdef DEBUG_IO
	220	CALL WriteField_u('ucovfi',ucov)
	221	CALL WriteField_v('vcovfi',vcov)
	222	CALL WriteField_u('tetafi',teta)
	223	CALL WriteField_u('pfi',p)
	224	CALL WriteField_u('pkfi',pk)
	225	DO j=1,nqtot
	226	CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
	227	ENDDO
	228	#endif
	229
	230	!$OMP BARRIER
	231
[2239]	232	#ifdef CPP_PHYS
[1632]	233	CALL calfis_loc(lafin ,jD_cur, jH_cur, &
	234	ucov,vcov,teta,q,masse,ps,p,pk,phis,phi , &
	235	du,dv,dteta,dq, &
[2221]	236	flxw, dufi,dvfi,dtetafi,dqfi,dpfi )
[2239]	237	#endif
[1632]	238	ijb=ij_begin
	239	ije=ij_end
	240	IF ( .not. pole_nord) THEN
	241
	242	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	243	DO l=1,llm
	244	dufi_tmp(1:iip1,l) = dufi(ijb:ijb+iim,l)
	245	dvfi_tmp(1:iip1,l) = dvfi(ijb:ijb+iim,l)
	246	dtetafi_tmp(1:iip1,l)= dtetafi(ijb:ijb+iim,l)
	247	dqfi_tmp(1:iip1,l,:) = dqfi(ijb:ijb+iim,l,:)
	248	ENDDO
	249	!$OMP END DO NOWAIT
	250
	251	!$OMP MASTER
	252	dpfi_tmp(1:iip1) = dpfi(ijb:ijb+iim)
	253	!$OMP END MASTER
	254
	255	ENDIF ! of if ( .not. pole_nord)
	256
	257	!$OMP BARRIER
	258	!$OMP MASTER
	259	CALL Set_Distrib(distrib_Physic_bis)
	260	CALL VTb(VThallo)
	261	!$OMP END MASTER
	262	!$OMP BARRIER
	263
	264	CALL Register_Hallo_u(dufi,llm,1,0,0,1,Request_physic)
	265	CALL Register_Hallo_v(dvfi,llm,1,0,0,1,Request_physic)
	266	CALL Register_Hallo_u(dtetafi,llm,1,0,0,1,Request_physic)
	267	CALL Register_Hallo_u(dpfi,1,1,0,0,1,Request_physic)
	268
	269	DO j=1,nqtot
	270	CALL Register_Hallo_u(dqfi(:,:,j),llm,1,0,0,1,Request_physic)
	271	ENDDO
	272
	273	CALL SendRequest(Request_Physic)
	274	!$OMP BARRIER
	275	CALL WaitRequest(Request_Physic)
	276
	277	!$OMP BARRIER
	278	!$OMP MASTER
	279	CALL VTe(VThallo)
	280	CALL Set_Distrib(distrib_Physic)
	281	!$OMP END MASTER
	282	!$OMP BARRIER
	283	ijb=ij_begin
	284	IF (.not. pole_nord) THEN
	285
	286	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	287	DO l=1,llm
	288	dufi(ijb:ijb+iim,l) = dufi(ijb:ijb+iim,l)+dufi_tmp(1:iip1,l)
	289	dvfi(ijb:ijb+iim,l) = dvfi(ijb:ijb+iim,l)+dvfi_tmp(1:iip1,l)
	290	dtetafi(ijb:ijb+iim,l) = dtetafi(ijb:ijb+iim,l)+dtetafi_tmp(1:iip1,l)
	291	dqfi(ijb:ijb+iim,l,:) = dqfi(ijb:ijb+iim,l,:) + dqfi_tmp(1:iip1,l,:)
	292	ENDDO
	293	!$OMP END DO NOWAIT
	294
	295	!$OMP MASTER
	296	dpfi(ijb:ijb+iim) = dpfi(ijb:ijb+iim)+ dpfi_tmp(1:iip1)
	297	!$OMP END MASTER
	298
	299	endif ! of if (.not. pole_nord)
	300
	301
	302	#ifdef DEBUG_IO
	303	CALL WriteField_u('dufi',dufi)
	304	CALL WriteField_v('dvfi',dvfi)
	305	CALL WriteField_u('dtetafi',dtetafi)
	306	CALL WriteField_u('dpfi',dpfi)
	307	DO j=1,nqtot
	308	CALL WriteField_u('dqfi'//trim(int2str(j)),dqfi(:,:,j))
	309	ENDDO
	310	#endif
	311
	312	!$OMP BARRIER
	313
	314	! ajout des tendances physiques:
	315	! ------------------------------
	316	#ifdef DEBUG_IO
	317	CALL WriteField_u('ucovfi',ucov)
	318	CALL WriteField_v('vcovfi',vcov)
	319	CALL WriteField_u('tetafi',teta)
	320	CALL WriteField_u('psfi',ps)
	321	DO j=1,nqtot
	322	CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
	323	ENDDO
	324	#endif
	325
	326	#ifdef DEBUG_IO
	327	CALL WriteField_u('ucovfi',ucov)
	328	CALL WriteField_v('vcovfi',vcov)
	329	CALL WriteField_u('tetafi',teta)
	330	CALL WriteField_u('psfi',ps)
	331	DO j=1,nqtot
	332	CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
	333	ENDDO
	334	#endif
	335
	336	CALL addfi_loc( dtphys, leapf, forward , &
	337	ucov, vcov, teta , q ,ps , &
	338	dufi, dvfi, dtetafi , dqfi ,dpfi )
[1987]	339	! since addfi updates ps(), also update p(), masse() and pk()
	340	CALL pression_loc(ip1jmp1,ap,bp,ps,p)
	341	!$OMP BARRIER
	342	CALL massdair_loc(p,masse)
	343	!$OMP BARRIER
	344	if (pressure_exner) then
[2021]	345	CALL exner_hyb_loc(ijnb_u,ps,p,pks,pk,pkf)
[1987]	346	else
[2021]	347	CALL exner_milieu_loc(ijnb_u,ps,p,pks,pk,pkf)
[1987]	348	endif
	349	!$OMP BARRIER
[1632]	350
	351	#ifdef DEBUG_IO
	352	CALL WriteField_u('ucovfi',ucov)
	353	CALL WriteField_v('vcovfi',vcov)
	354	CALL WriteField_u('tetafi',teta)
	355	CALL WriteField_u('psfi',ps)
	356	DO j=1,nqtot
	357	CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
	358	ENDDO
	359	#endif
	360
[1793]	361	IF (ok_strato) THEN
	362	! CALL top_bound_loc( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
	363	CALL top_bound_loc(vcov,ucov,teta,masse,dtphys)
	364	ENDIF
	365
[1632]	366	!$OMP BARRIER
	367	!$OMP MASTER
	368	CALL VTe(VTphysiq)
	369	CALL VTb(VThallo)
	370	!$OMP END MASTER
	371
	372	CALL SetTag(Request_physic,800)
	373	CALL Register_SwapField_u(ucov,ucov_dyn,distrib_caldyn,Request_physic)
	374	CALL Register_SwapField_v(vcov,vcov_dyn,distrib_caldyn,Request_physic)
	375	CALL Register_SwapField_u(teta,teta_dyn,distrib_caldyn,Request_physic)
	376	CALL Register_SwapField_u(masse,masse_dyn,distrib_caldyn,Request_physic)
	377	CALL Register_SwapField_u(ps,ps_dyn,distrib_caldyn,Request_physic)
	378	CALL Register_SwapField_u(q,q_dyn,distrib_caldyn,Request_physic)
	379	CALL SendRequest(Request_Physic)
	380	!$OMP BARRIER
	381	CALL WaitRequest(Request_Physic)
	382
	383	!$OMP BARRIER
	384	!$OMP MASTER
	385	CALL VTe(VThallo)
	386	CALL set_distrib(distrib_caldyn)
	387	!$OMP END MASTER
	388	!$OMP BARRIER
	389
	390	!
	391	! Diagnostique de conservation de l'energie : difference
	392	IF (ip_ebil_dyn.ge.1 ) THEN
	393	ztit='bil phys'
[1857]	394	! CALL diagedyn(ztit,2,1,1,dtphys,ucov, vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
	395	write(lunout,*)"call_calfis: diagedyn disabled in dyn3dmem !!"
[1632]	396	ENDIF
	397
	398	#ifdef DEBUG_IO
	399	CALL WriteField_u('ucovfi',ucov_dyn)
	400	CALL WriteField_v('vcovfi',vcov_dyn)
	401	CALL WriteField_u('tetafi',teta_dyn)
	402	CALL WriteField_u('psfi',ps_dyn)
	403	DO j=1,nqtot
	404	CALL WriteField_u('qfi'//trim(int2str(j)),q_dyn(:,:,j))
	405	ENDDO
	406	#endif
	407
	408
	409	!-jld
	410	!$OMP MASTER
	411	CALL resume_timer(timer_caldyn)
	412	!$OMP END MASTER
	413
	414	END SUBROUTINE call_calfis
	415
	416	END MODULE call_calfis_mod

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

Download in other formats:

Original Format