Context Navigation

call_calfis_mod.F90 @ 4794

Last change on this file since 4794 was 4056, checked in by dcugnet, 3 years ago

Most of the changes are intended to help to eventually remove the constraints about the tracers assumptions, in particular water tracers.

Remove index tables itr_indice and niadv, replaced by tracers(:)%isAdvected and tracers(:)%isH2OFamily. Most of the loops are now from 1 to nqtot:
- DO iq=nqo+1,nqtot loops are replaced with: DO iq=1,nqtot

IF(tracers(iq)%isH2Ofamily) CYCLE

DO it=1,nbtr; iq=niadv(it+nqo)

and DO it=1,nqtottr; iq=itr_indice(it) loops are replaced with:

it = 0
DO iq = 1, nqtot

IF(.NOT.tracers(iq)%isAdvected .OR. tracers(iq)%isH2Ofamily) CYCLE
it = it+1

Move some StratAer? related code from infotrac to infotrac_phy
Remove "nqperes" variable:

DO iq=1,nqpere loops are replaced with:
DO iq=1,nqtot

IF(tracers(iq)%parent/='air') CYCLE

Cosmetic changes (justification, SELECT CASE instead of multiple IF...) mostly in advtrac* routines.

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
[4050]	39	USE infotrac, ONLY: nqtot
[1632]	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
[4050]	82	USE infotrac, ONLY: nqtot
[1632]	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 )
[4056]	115	INTEGER :: ijb,ije,l,iq
[1632]	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)
[4056]	124	DO iq=1,nqtot
	125	CALL WriteField_u('qfi'//trim(int2str(iq)),q(:,:,iq))
[1632]	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)
[4056]	225	DO iq=1,nqtot
	226	CALL WriteField_u('qfi'//trim(int2str(iq)),q(:,:,iq))
[1632]	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
[4056]	269	DO iq=1,nqtot
	270	CALL Register_Hallo_u(dqfi(:,:,iq),llm,1,0,0,1,Request_physic)
[1632]	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)
[4056]	307	DO iq=1,nqtot
	308	CALL WriteField_u('dqfi'//trim(int2str(iq)),dqfi(:,:,iq))
[1632]	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)
[4056]	321	DO iq=1,nqtot
	322	CALL WriteField_u('qfi'//trim(int2str(iq)),q(:,:,iq))
[1632]	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)
[4056]	331	DO iq=1,nqtot
	332	CALL WriteField_u('qfi'//trim(int2str(iq)),q(:,:,iq))
[1632]	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)
[4056]	356	DO iq=1,nqtot
	357	CALL WriteField_u('qfi'//trim(int2str(iq)),q(:,:,iq))
[1632]	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)
[4056]	403	DO iq=1,nqtot
	404	CALL WriteField_u('qfi'//trim(int2str(iq)),q_dyn(:,:,iq))
[1632]	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