Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

solve_nmm.F @ 2759

Last change on this file since 2759 was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 95.8 KB

Line
1	!-----------------------------------------------------------------------
2	!
3	!NCEP_MESO:MEDIATION_LAYER:SOLVER
4	!
5	!-----------------------------------------------------------------------
6	#include "nmm_loop_basemacros.h"
7	#include "nmm_loop_macros.h"
8	!-----------------------------------------------------------------------
9	!
10	SUBROUTINE SOLVE_NMM(GRID,CONFIG_FLAGS &
11	!
12	#include "dummy_args.inc"
13	!
14	& )
15	!-----------------------------------------------------------------------
16	USE MODULE_DOMAIN, ONLY : DOMAIN, GET_IJK_FROM_GRID
17	USE MODULE_CONFIGURE, ONLY : GRID_CONFIG_REC_TYPE
18	USE MODULE_MODEL_CONSTANTS
19	USE MODULE_STATE_DESCRIPTION
20	USE MODULE_CTLBLK
21	!#ifdef DM_PARALLEL
22	! USE MODULE_DM
23	!#endif
24	USE MODULE_IGWAVE_ADJUST, ONLY: PDTE,PFDHT,DDAMP,VTOA
25	USE MODULE_ADVECTION, ONLY: ADVE,VAD2,HAD2,VAD2_SCAL,HAD2_SCAL
26	USE MODULE_NONHY_DYNAM, ONLY: EPS,VADZ,HADZ
27	USE MODULE_DIFFUSION_NMM, ONLY: HDIFF
28	USE MODULE_BNDRY_COND, ONLY: BOCOH,BOCOV
29	USE MODULE_PHYSICS_CALLS
30	USE MODULE_EXT_INTERNAL
31	USE MODULE_PRECIP_ADJUST
32	USE MODULE_NEST_UTIL ! USEs module_MPP (contains MYPE,NPES,MPI_COMM_COMP)
33	#ifdef WRF_CHEM
34	USE MODULE_INPUT_CHEM_DATA, ONLY: GET_LAST_GAS
35	#endif
36	!-----------------------------------------------------------------------
37	!
38	IMPLICIT NONE
39	!
40	!-----------------------------------------------------------------------
41	!
42	!*** INPUT DATA
43	!
44	!-----------------------------------------------------------------------
45	!
46	TYPE(DOMAIN),TARGET :: GRID
47	!
48	!*** DEFINITIONS OF DUMMY ARGUMENTS TO THIS ROUTINE (GENERATED FROM REGISTRY)
49	!
50	! NOTE, REGISTRY NO LONGER GENERATES DUMMY ARGUMENTS OR DUMMY ARGUMENT
51	! DECLARATIONS FOR RCONFIG ENTRIES. THEY ARE STILL PART OF STATE. ACCESS
52	! TO THESE VARIABLES IS NOW THROUGH GRID STRUCTURE, AS MODIFIED BELOW.
53	! AFFECTED VARIABLES: SIGMA, DT, NPHS, IDTAD, NRADS, NRADL, JULDAY,
54	! JULYR, NUM_SOIL_LAYERS, NCNVC, ENSDIM, DY, AND SPEC_BDY_WIDTH.
55	! JM, 20050819
56	!
57	!----------------------------
58	#include <dummy_decl.inc>
59	!----------------------------
60	!
61	!*** STRUCTURE THAT CONTAINS RUN-TIME CONFIGURATION (NAMELIST) DATA FOR DOMAIN
62	!
63	TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
64	#ifdef WRF_CHEM
65	INTEGER :: NUMGAS
66	#endif
67	!
68	!-----------------------------------------------------------------------
69	!
70	!*** LOCAL VARIABLES
71	!
72	!-----------------------------------------------------------------------
73	INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE &
74	& ,IMS,IME,JMS,JME,KMS,KME &
75	& ,IPS,IPE,JPS,JPE,KPS,KPE &
76	& ,ITS,ITE,JTS,JTE,KTS,KTE
77	!
78	INTEGER :: I,ICLTEND,IDF,IRTN,J,JC,JDF,K,KDF,LB,N_MOIST &
79	& ,NTSD_current,L
80	integer :: ierr
81	INTEGER,SAVE :: NTSD_restart
82	! INTEGER :: MPI_COMM_COMP,MYPE,MYPROC,NPES
83	INTEGER :: MYPROC
84	INTEGER :: KVH,NTSD_rad,RC
85	INTEGER :: NUM_OZMIXM,NUM_AEROSOLC
86	!
87	REAL :: DT_INV,FICE,FRAIN,GPS,QI,QR,QW,WC
88	!
89	LOGICAL :: LAST_TIME,OPERATIONAL_PHYSICS
90	!
91	CHARACTER(80) :: MESSAGE
92	!
93	!*** For precip assimilation:
94	INTEGER :: ISTAT
95	REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: PPTDAT
96	#ifdef WRF_CHEM
97	REAL,ALLOCATABLE,DIMENSION(:,:,:,:) :: CHEM_TRANS
98	#endif
99	!
100	!-----------------------------------------------------------------------
101	!*** For physics compatibility with other packages
102	!-----------------------------------------------------------------------
103	!
104	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: TTEN,QTEN
105	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: RTHRATEN,RTHBLTEN,RQVBLTEN
106	!
107	!-----------------------------------------------------------------------
108	!
109	LOGICAL wrf_dm_on_monitor
110	EXTERNAL wrf_dm_on_monitor
111	!
112	!-----------------------------------------------------------------------
113	!*** TIMING VARIABLES
114	!-----------------------------------------------------------------------
115	real,save :: solve_tim,exch_tim,pdte_tim,adve_tim,vtoa_tim &
116	&, vadz_tim,hadz_tim,eps_tim,vad2_tim,had2_tim &
117	&, radiation_tim,rdtemp_tim,turbl_tim,cltend_tim &
118	&, cucnvc_tim,gsmdrive_tim,hdiff_tim,bocoh_tim &
119	&, pfdht_tim,ddamp_tim,bocov_tim,uv_htov_tim,sum_tim &
120	&, adjppt_tim
121	real,save :: exch_tim_max
122	real :: btim,btimx
123	real :: et_max,this_tim
124	integer :: n_print_time
125	!
126	#ifdef RSL
127	integer rsl_internal_milliclock
128	external rsl_internal_milliclock
129	# define timef rsl_internal_milliclock
130	#else
131	real*8 :: timef
132	#endif
133	!-----------------------------------------------------------------------
134	!
135	#ifdef DEREF_KLUDGE
136	! SEE http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
137	INTEGER :: SM31,EM31,SM32,EM32,SM33,EM33
138	INTEGER :: SM31X,EM31X,SM32X,EM32X,SM33X,EM33X
139	INTEGER :: SM31Y,EM31Y,SM32Y,EM32Y,SM33Y,EM33Y
140	#endif
141	!
142	!-----------------------------------------------------------------------
143	!
144	! LIMIT THE NUMBER OF ARGUMENTS IF COMPILED WITH -DLIMIT_ARGS BY COPYING
145	! SCALAR (NON-ARRAY) ARGUMENTS OUT OF THE GRID DATA STRUCTURE INTO LOCALLY
146	! DEFINED COPIES (DEFINED IN EM_DUMMY_DECL.INC, ABOVE, AS THEY ARE IF THEY
147	! ARE ARGUMENTS). AN EQUIVALENT INCLUDE OF EM_SCALAR_DEREFS.INC APPEARS
148	! AT THE END OF THE ROUTINE TO COPY BACK ANY CHNAGED NON-ARRAY VALUES.
149	! THE DEFINITION OF COPY_IN OR COPY_OUT BEFORE THE INCLUDE DEFINES THE
150	! DIRECTION OF THE COPY. NMM_SCALAR_DEREFS IS GENERATED FROM REGISTRY.
151	!
152	!-----------------------------------------------------------------------
153	#define COPY_IN
154	#include <scalar_derefs.inc>
155	!-----------------------------------------------------------------------
156	!
157	! TRICK PROBLEMATIC COMPILERS INTO NOT PERFORMING COPY-IN/COPY-OUT BY ADDING
158	! INDICES TO ARRAY ARGUMENTS IN THE CALL STATEMENTS IN THIS ROUTINE.
159	! IT HAS THE EFFECT OF PASSING ONLY THE FIRST ELEMENT OF THE ARRAY, RATHER
160	! THAN THE ENTIRE ARRAY. SEE:
161	! http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
162	!
163	!-----------------------------------------------------------------------
164	#include "deref_kludge.h"
165	!-----------------------------------------------------------------------
166	!
167	! NEEDED BY SOME COMM LAYERS, E.G. RSL. IF NEEDED, nmm_data_calls.inc IS
168	! GENERATED FROM THE REGISTRY. THE DEFINITION OF REGISTER_I1 ALLOWS
169	! I1 DATA TO BE COMMUNICATED IN THIS ROUTINE IF NECESSARY.
170	!
171	!-----------------------------------------------------------------------
172	!-----------------------------------------------------------------------
173	!***********************************************************************
174	!***
175	!*** THE MAIN TIME INTEGRATION LOOP
176	!***
177	!-----------------------------------------------------------------------
178	!
179	!*** NTSD IS THE TIMESTEP COUNTER (Number of Time Steps Done)
180	!
181	!-----------------------------------------------------------------------
182	!***
183	!*** ADVANCE_count STARTS AT ZERO FOR ALL RUNS (REGULAR AND RESTART).
184	!***
185	!-----------------------------------------------------------------------
186	!
187	CALL DOMAIN_CLOCK_GET(GRID,ADVANCEcOUNT=NTSD_current)
188	!
189	IF(NTSD_current==0)THEN
190	IF(GRID%RESTART.AND.GRID%TSTART>0.)THEN
191	IHRST=NSTART_HOUR
192	NTSD_restart=NTSD
193	ELSE
194	IHRST=GRID%GMT
195	NSTART_HOUR=IHRST
196	NTSD_restart=0
197	ENDIF
198	ENDIF
199	!
200	NTSD=NTSD_restart+NTSD_current
201	LAST_TIME=domain_last_time_step(GRID)
202	!
203	!-----------------------------------------------------------------------
204	!
205	!!!!! IF(WRF_DM_ON_MONITOR() )THEN
206	WRITE(MESSAGE,125)NTSD,NTSD*GRID%DT/3600.
207	125 FORMAT(' SOLVE_NMM: TIMESTEP IS ',I5,' TIME IS ',F7.3,' HOURS')
208	CALL WRF_MESSAGE(TRIM(MESSAGE))
209	!!!! ENDIF
210	!
211	!-----------------------------------------------------------------------
212	CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
213	CALL WRF_GET_NPROC(NPES)
214	CALL WRF_GET_MYPROC(MYPROC)
215	MYPE=MYPROC
216	!-----------------------------------------------------------------------
217	!
218	!*** OBTAIN DIMENSION INFORMATION STORED IN THE GRID DATA STRUCTURE.
219	!
220	CALL GET_IJK_FROM_GRID(GRID &
221	& ,IDS,IDE,JDS,JDE,KDS,KDE &
222	& ,IMS,IME,JMS,JME,KMS,KME &
223	& ,IPS,IPE,JPS,JPE,KPS,KPE )
224	!-----------------------------------------------------------------------
225	!
226	!*** COMPUTE THESE STARTING AND STOPPING LOCATIONS FOR EACH TILE AND
227	!*** NUMBER OF TILES.
228	!*** SEE: http://www.mmm.ucar.edu/wrf/WG2/topics/settiles
229	!
230	CALL SET_TILES(GRID,IDS,IDE,JDS,JDE,IPS,IPE,JPS,JPE)
231	!
232	!-----------------------------------------------------------------------
233	!*** SET FLAG FOR THE OPERATIONAL PHYSICS SUITE.
234	!*** THIS WILL BE USED TO SAVE CLOCKTIME BY SKIPPING
235	!*** FREQUENT UPDATES OF THE MOIST ARRAY AND INSTEAD
236	!*** UPDATE IT ONLY WHEN IT IS NEEDED FOR PHYSICS.
237	!-----------------------------------------------------------------------
238	!
239	OPERATIONAL_PHYSICS=.FALSE.
240	!
241	IF(CONFIG_FLAGS%RA_SW_PHYSICS ==GFDLSWSCHEME.AND. &
242	& CONFIG_FLAGS%RA_LW_PHYSICS ==GFDLLWSCHEME.AND. &
243	& CONFIG_FLAGS%SF_SFCLAY_PHYSICS==MYJSFCSCHEME.AND. &
244	& CONFIG_FLAGS%BL_PBL_PHYSICS ==MYJPBLSCHEME.AND. &
245	& CONFIG_FLAGS%CU_PHYSICS ==BMJSCHEME.AND. &
246	& CONFIG_FLAGS%MP_PHYSICS ==ETAMPNEW)THEN
247	!
248	OPERATIONAL_PHYSICS=.TRUE.
249	!
250	ENDIF
251	!
252	!-----------------------------------------------------------------------
253	!
254	!*** TTEN, QTEN are used by GD convection scheme
255	!
256	ALLOCATE(TTEN(IMS:IME,KMS:KME,JMS:JME),STAT=ISTAT)
257	ALLOCATE(QTEN(IMS:IME,KMS:KME,JMS:JME),STAT=ISTAT)
258	ALLOCATE(RTHBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=ISTAT)
259	ALLOCATE(RQVBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=ISTAT)
260	ALLOCATE(RTHRATEN(IMS:IME,KMS:KME,JMS:JME),STAT=ISTAT)
261	#ifdef WRF_CHEM
262	ALLOCATE(CHEM_TRANS(IMS:IME,JMS:JME,KMS:KME,1:NUM_CHEM),STAT=ISTAT)
263	NUMGAS = GET_LAST_GAS(CONFIG_FLAGS%CHEM_OPT)
264	#endif
265	!
266	IF(CONFIG_FLAGS%CU_PHYSICS==GDSCHEME)THEN
267	DO J=JMS,JME
268	DO K=KMS,KME
269	DO I=IMS,IME
270	TTEN(I,K,J)=T(I,J,K)
271	QTEN(I,K,J)=Q(I,J,K)
272	ENDDO
273	ENDDO
274	ENDDO
275	ENDIF
276	!
277	GRID%SIGMA=1
278	HYDRO=.FALSE.
279	!
280	!
281	IDF=IDE-1
282	JDF=JDE-1
283	KDF=KDE-1
284	!
285	!-----------------------------------------------------------------------
286	!
287	!*** FOR NOW SET CONTROLS FOR TILES TO PATCHES
288	!
289	!-----------------------------------------------------------------------
290	ITS=IPS
291	ITE=MIN(IPE,IDF)
292	JTS=JPS
293	JTE=MIN(JPE,JDF)
294	KTS=KPS
295	KTE=MIN(KPE,KDF)
296	if(ntsd==0)then
297	write(0,*)' its=',its,' ite=',ite
298	write(0,*)' jts=',jts,' jte=',jte
299	write(0,*)' kts=',kts,' kte=',kte
300	endif
301	!-----------------------------------------------------------------------
302	!*** SET TIMING VARIABLES TO ZERO AT START OF FORECAST.
303	!-----------------------------------------------------------------------
304	if(ntsd==0)then
305	solve_tim=0.
306	exch_tim=0.
307	pdte_tim=0.
308	adve_tim=0.
309	vtoa_tim=0.
310	vadz_tim=0.
311	hadz_tim=0.
312	eps_tim=0.
313	vad2_tim=0.
314	had2_tim=0.
315	radiation_tim=0.
316	rdtemp_tim=0.
317	turbl_tim=0.
318	cltend_tim=0.
319	cucnvc_tim=0.
320	gsmdrive_tim=0.
321	hdiff_tim=0.
322	bocoh_tim=0.
323	pfdht_tim=0.
324	ddamp_tim=0.
325	bocov_tim=0.
326	uv_htov_tim=0.
327	exch_tim_max=0.
328	adjppt_tim=0.
329	endif
330	!-----------------------------------------------------------------------
331	N_MOIST=NUM_MOIST
332	!
333	DO J=MYJS_P4,MYJE_P4
334	IHEG(J)=MOD(J+1,2)
335	IHWG(J)=IHEG(J)-1
336	IVEG(J)=MOD(J,2)
337	IVWG(J)=IVEG(J)-1
338	ENDDO
339
340	DO J=MYJS_P4,MYJE_P4
341	IVW(J)=IVWG(J)
342	IVE(J)=IVEG(J)
343	IHE(J)=IHEG(J)
344	IHW(J)=IHWG(J)
345	ENDDO
346	!
347	!*** LATERAL POINTS IN THE BOUNDARY ARRAYS
348	!
349	LB=2*(IDF-IDS+1)+(JDF-JDS+1)-3
350	!
351	!*** APPROXIMATE GRIDPOINT SPACING (METERS)
352	!
353	JC=JMS+(JME-JMS)/2
354	GPS=SQRT(DX_NMM(IMS,JC)2+DY_NMM2)
355	!
356	!*** TIMESTEPS PER HOUR
357	!
358	TSPH=3600./GRID%DT
359	!
360	n_print_time=nint(3600./grid%dt) ! Print stats once per hour
361	!-----------------------------------------------------------------------
362	!
363	NBOCO=0
364	!
365	!-----------------------------------------------------------------------
366	!
367	#if (NMM_NEST == 1)
368	!-----------------------------------------------------------------------------
369	!*** PATCHING NESTED BOUNDARIES.
370	!-----------------------------------------------------------------------------
371	!
372	CALL wrf_debug ( 100 , 'nmm: in patch' )
373
374	btimx=timef()
375	#ifdef DM_PARALLEL
376	# include "HALO_NMM_ZZ.inc"
377	#endif
378
379	IF(GRID%ID/=1)THEN
380	!
381	CALL NESTBC_PATCH (PD_BXS,PD_BXE,PD_BYS,PD_BYE,T_BXS,T_BXE,T_BYS,T_BYE,Q_BXS,Q_BXE &
382	,Q_BYS,Q_BYE,U_BXS,U_BXE,U_BYS,U_BYE,V_BXS,V_BXE,V_BYS,V_BYE &
383	,Q2_BXS,Q2_BXE,Q2_BYS,Q2_BYE,CWM_BXS,CWM_BXE,CWM_BYS,CWM_BYE &
384	,PD_BTXS,PD_BTXE,PD_BTYS,PD_BTYE,T_BTXS,T_BTXE,T_BTYS,T_BTYE &
385	,Q_BTXS,Q_BTXE,Q_BTYS,Q_BTYE,U_BTXS,U_BTXE,U_BTYS,U_BTYE &
386	,V_BTXS,V_BTXE,V_BTYS,V_BTYE,Q2_BTXS,Q2_BTXE,Q2_BTYS,Q2_BTYE &
387	,CWM_BTXS,CWM_BTXE,CWM_BTYS,CWM_BTYE,PDNEST_B,TNEST_B,QNEST_B,UNEST_B &
388	,VNEST_B,Q2NEST_B,CWMNEST_B,PDNEST_BT,TNEST_BT,QNEST_BT &
389	,UNEST_BT,VNEST_BT,Q2NEST_BT,CWMNEST_BT &
390	,GRID%SPEC_BDY_WIDTH &
391	,IDS,IDF,JDS,JDF,KDS,KDE &
392	,IMS,IME,JMS,JME,KMS,KME &
393	,ITS,ITE,JTS,JTE,KTS,KTE )
394
395	CALL wrf_debug ( 100 , 'nmm: out of patch' )
396	!
397	#ifdef MOVE_NESTS
398
399	IF(GRID%ID/=1.AND.MOD(NTSD,1)==0.AND.GRID%NUM_MOVES==-99)THEN
400	XLOC_1=(IDE-1)/2 ! This maneuvers the storm to the center of the nest quickly
401	YLOC_1=(JDE-1)/2 ! This maneuvers the storm to the center of the nest quickly
402	ENDIF
403	#endif
404
405	ENDIF
406	#endif
407	!
408	!-----------------------------------------------------------------------
409	!*** ALLOCATE PPTDAT ARRAY (PRECIP ASSIM):
410	!-----------------------------------------------------------------------
411	!
412	IF(GRID%PCPFLG.AND..NOT.ALLOCATED(PPTDAT))THEN
413	ALLOCATE(PPTDAT(IMS:IME,JMS:JME,3),STAT=ISTAT)
414	ENDIF
415	!
416	!-----------------------------------------------------------------------
417	!***
418	!*** Call READPCP to
419	!*** 1) READ IN PRECIPITATION FOR HOURS 1, 2 and 3;
420	!*** 2) Initialize DDATA to 999. (this is the amount
421	!*** of input precip allocated to each physics time step
422	!*** in ADJPPT; TURBL/SURFCE, which uses DDATA, is called
423	!*** before ADJPPT)
424	!*** 3) Initialize LSPA to zero
425	!***
426	!-----------------------------------------------------------------------
427	IF (NTSD==0) THEN
428	IF (GRID%PCPFLG) THEN
429	CALL READPCP(PPTDAT,DDATA,LSPA &
430	& ,IDS,IDE,JDS,JDE,KDS,KDE &
431	& ,IMS,IME,JMS,JME,KMS,KME &
432	& ,ITS,ITE,JTS,JTE,KTS,KTE)
433	ENDIF
434	ENDIF
435	!-----------------------------------------------------------------------
436	!
437	btim=timef()
438	!
439	!-----------------------------------------------------------------------
440	!*** ZERO OUT ACCUMULATED QUANTITIES WHEN NEEDED.
441	!-----------------------------------------------------------------------
442	!
443	CALL BUCKETS(NTSD,NPREC,NSRFC,NRDSW,NRDLW &
444	& ,GRID%RESTART,GRID%TSTART &
445	& ,NCLOD,NHEAT,GRID%NPHS,TSPH &
446	& ,ACPREC,CUPREC,ACSNOW,ACSNOM,SSROFF,BGROFF &
447	& ,SFCEVP,POTEVP,SFCSHX,SFCLHX,SUBSHX,SNOPCX &
448	& ,SFCUVX,POTFLX &
449	& ,ARDSW,ASWIN,ASWOUT,ASWTOA &
450	& ,ARDLW,ALWIN,ALWOUT,ALWTOA &
451	& ,ACFRST,NCFRST,ACFRCV,NCFRCV &
452	& ,AVCNVC,AVRAIN,TCUCN,TRAIN &
453	& ,ASRFC &
454	& ,T,TLMAX,TLMIN,TSHLTR,PSHLTR,QSHLTR &
455	& ,T02_MAX,T02_MIN,RH02_MAX,RH02_MIN &
456	& ,IDS,IDE,JDS,JDE,KDS,KDE &
457	& ,IMS,IME,JMS,JME,KMS,KME &
458	& ,ITS,ITE,JTS,JTE,KTS,KTE)
459	!-----------------------------------------------------------------------
460	!
461	IF(NTSD==0)THEN
462	FIRST=.TRUE.
463	! call hpm_init()
464	btimx=timef()
465	!
466	!-----------------------------------------------------------------------
467	#ifdef DM_PARALLEL
468	# include "HALO_NMM_A.inc"
469	#endif
470	!
471	!-----------------------------------------------------------------------
472	#ifdef DM_PARALLEL
473	IF(CONFIG_FLAGS%MP_PHYSICS/=ETAMPNEW)THEN
474	# include "HALO_NMM_A_3.inc"
475	ENDIF
476	#endif
477	!-----------------------------------------------------------------------
478	!
479	!*** Only for chemistry:
480	!
481	#ifdef WRF_CHEM
482	#ifdef DM_PARALLEL
483	# include "HALO_NMM_A_2.inc"
484	#endif
485	#endif
486	!
487	!-----------------------------------------------------------------------
488	!*** USE THE FOLLOWING VARIABLES TO KEEP TRACK OF EXCHANGE TIMES.
489	!-----------------------------------------------------------------------
490	exch_tim=exch_tim+timef()-btimx
491	! this_tim=timef()-btimx
492	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
493	! & ,mpi_comm_comp,irtn)
494	! exch_tim_max=exch_tim_max+et_max
495	!-----------------------------------------------------------------------
496	!
497	GO TO 2003
498	ENDIF
499	!
500	!-----------------------------------------------------------------------
501	!-----------------------------------------------------------------------
502	2000 CONTINUE
503	!-----------------------------------------------------------------------
504	!-----------------------------------------------------------------------
505	!
506	!-----------------------------------------------------------------------
507	!*** PRESSURE TENDENCY, SIGMA DOT, VERTICAL PART OF OMEGA-ALPHA
508	!-----------------------------------------------------------------------
509	!
510	btimx=timef()
511	!-----------------
512	#ifdef DM_PARALLEL
513	# include "HALO_NMM_D.inc"
514	#endif
515	!-----------------
516	exch_tim=exch_tim+timef()-btimx
517	! this_tim=timef()-btimx
518	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
519	! & ,mpi_comm_comp,irtn)
520	! exch_tim_max=exch_tim_max+et_max
521	!
522	btimx=timef()
523	!
524	CALL PDTE( &
525	#ifdef DM_PARALLEL
526	& GRID,MYPE,MPI_COMM_COMP, &
527	#endif
528	& NTSD,GRID%DT,PT,ETA2,RES,HYDRO,HBM2 &
529	& ,PD,PDSL,PDSLO &
530	& ,PETDT,DIV,PSDT &
531	& ,IHE,IHW,IVE,IVW &
532	& ,IDS,IDF,JDS,JDF,KDS,KDE &
533	& ,IMS,IME,JMS,JME,KMS,KME &
534	& ,ITS,ITE,JTS,JTE,KTS,KTE)
535
536	pdte_tim=pdte_tim+timef()-btimx
537	!
538	!-----------------------------------------------------------------------
539	!*** ADVECTION OF T, U, AND V
540	!-----------------------------------------------------------------------
541	!
542	btimx=timef()
543	!-----------------
544	#ifdef DM_PARALLEL
545	# include "HALO_NMM_F.inc"
546	# include "HALO_NMM_F1.inc"
547	#endif
548	!-----------------
549	exch_tim=exch_tim+timef()-btimx
550	! this_tim=timef()-btimx
551	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
552	! & ,mpi_comm_comp,irtn)
553	! exch_tim_max=exch_tim_max+et_max
554	btimx=timef()
555	!
556	CALL ADVE(NTSD,GRID%DT,DETA1,DETA2,PDTOP &
557	& ,CURV,F,FAD,F4D,EM_LOC,EMT_LOC,EN,ENT,DX_NMM,DY_NMM &
558	& ,HBM2,VBM2 &
559	& ,T,U,V,PDSLO,TOLD,UOLD,VOLD &
560	& ,PETDT,UPSTRM &
561	& ,FEW,FNS,FNE,FSE &
562	& ,ADT,ADU,ADV &
563	& ,N_IUP_H,N_IUP_V &
564	& ,N_IUP_ADH,N_IUP_ADV &
565	& ,IUP_H,IUP_V,IUP_ADH,IUP_ADV &
566	& ,IHE,IHW,IVE,IVW &
567	& ,IDS,IDF,JDS,JDF,KDS,KDE &
568	& ,IMS,IME,JMS,JME,KMS,KME &
569	& ,ITS,ITE,JTS,JTE,KTS,KTE)
570	!
571	adve_tim=adve_tim+timef()-btimx
572	!
573	!-----------------------------------------------------------------------
574	!*** PRESSURE TENDENCY, ETA/SIGMADOT, VERTICAL PART OF OMEGA-ALPHA TERM
575	!-----------------------------------------------------------------------
576	!
577	btimx=timef()
578	!
579	CALL VTOA( &
580	#ifdef DM_PARALLEL
581	& GRID, &
582	#endif
583	& NTSD,GRID%DT,PT,ETA2 &
584	& ,HBM2,EF4T &
585	& ,T,DWDT,RTOP,OMGALF &
586	& ,PINT,DIV,PSDT,RES &
587	& ,IHE,IHW,IVE,IVW &
588	& ,IDS,IDF,JDS,JDF,KDS,KDE &
589	& ,IMS,IME,JMS,JME,KMS,KME &
590	& ,ITS,ITE,JTS,JTE,KTS,KTE)
591	!
592	vtoa_tim=vtoa_tim+timef()-btimx
593	!
594	!-----------------------------------------------------------------------
595	!*** VERTICAL ADVECTION OF HEIGHT
596	!-----------------------------------------------------------------------
597	!
598	btimx=timef()
599	!
600	CALL VADZ(NTSD,GRID%DT,FIS,GRID%SIGMA,DFL,HBM2 &
601	& ,DETA1,DETA2,PDTOP &
602	& ,PINT,PDSL,PDSLO,PETDT &
603	& ,RTOP,T,Q,CWM,Z,W,DWDT,PDWDT &
604	& ,IHE,IHW,IVE,IVW &
605	& ,IDS,IDF,JDS,JDF,KDS,KDE &
606	& ,IMS,IME,JMS,JME,KMS,KME &
607	& ,ITS,ITE,JTS,JTE,KTS,KTE)
608
609	vadz_tim=vadz_tim+timef()-btimx
610	!
611	!-----------------------------------------------------------------------
612	!*** HORIZONTAL ADVECTION OF HEIGHT
613	!-----------------------------------------------------------------------
614	!
615	btimx=timef()
616	!-----------------
617	#ifdef DM_PARALLEL
618	# include "HALO_NMM_G.inc"
619	#endif
620	!-----------------
621	exch_tim=exch_tim+timef()-btimx
622	! this_tim=timef()-btimx
623	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
624	! & ,mpi_comm_comp,irtn)
625	! exch_tim_max=exch_tim_max+et_max
626	!
627	btimx=timef()
628	!
629	CALL HADZ(NTSD,GRID%DT,HYDRO,HBM2,DETA1,DETA2,PDTOP &
630	& ,DX_NMM,DY_NMM,FAD &
631	& ,FEW,FNS,FNE,FSE &
632	& ,PDSL,U,V,W,Z &
633	& ,IHE,IHW,IVE,IVW &
634	& ,IDS,IDF,JDS,JDF,KDS,KDE &
635	& ,IMS,IME,JMS,JME,KMS,KME &
636	& ,ITS,ITE,JTS,JTE,KTS,KTE)
637	!
638	hadz_tim=hadz_tim+timef()-btimx
639	!
640	!-----------------------------------------------------------------------
641	!*** ADVECTION OF W
642	!-----------------------------------------------------------------------
643	!
644	btimx=timef()
645	!-----------------
646	#ifdef DM_PARALLEL
647	# include "HALO_NMM_H.inc"
648	#endif
649	!-----------------
650	exch_tim=exch_tim+timef()-btimx
651	! this_tim=timef()-btimx
652	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
653	! & ,mpi_comm_comp,irtn)
654	! exch_tim_max=exch_tim_max+et_max
655	!
656	btimx=timef()
657	!
658	CALL EPS(NTSD,GRID%DT,HYDRO,DX_NMM,DY_NMM,FAD &
659	& ,DETA1,DETA2,PDTOP,PT &
660	& ,HBM2,HBM3 &
661	& ,PDSL,PDSLO,PINT,RTOP,PETDT,PDWDT &
662	& ,DWDT,DWDTMN,DWDTMX &
663	& ,FNS,FEW,FNE,FSE &
664	& ,T,U,V,W,Q,CWM &
665	& ,IHE,IHW,IVE,IVW &
666	& ,IDS,IDF,JDS,JDF,KDS,KDE &
667	& ,IMS,IME,JMS,JME,KMS,KME &
668	& ,ITS,ITE,JTS,JTE,KTS,KTE)
669	!
670	eps_tim=eps_tim+timef()-btimx
671	!
672	!-----------------------------------------------------------------------
673	!*** VERTICAL ADVECTION OF Q, TKE, AND CLOUD WATER
674	!-----------------------------------------------------------------------
675	!
676	IF(MOD(NTSD,GRID%IDTAD)==0)THEN
677	btimx=timef()
678	!
679	vad2_micro_check: IF(CONFIG_FLAGS%MP_PHYSICS==ETAMPNEW)THEN
680	CALL VAD2(NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM &
681	& ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP,HBM2 &
682	& ,Q,Q2,CWM,PETDT &
683	& ,N_IUP_H,N_IUP_V &
684	& ,N_IUP_ADH,N_IUP_ADV &
685	& ,IUP_H,IUP_V,IUP_ADH,IUP_ADV &
686	& ,IHE,IHW,IVE,IVW &
687	& ,IDS,IDF,JDS,JDF,KDS,KDE &
688	& ,IMS,IME,JMS,JME,KMS,KME &
689	& ,ITS,ITE,JTS,JTE,KTS,KTE)
690	!
691	ELSE vad2_micro_check
692	CALL VAD2_SCAL(NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM &
693	& ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP &
694	& ,HBM2 &
695	& ,Q2,PETDT &
696	& ,N_IUP_H,N_IUP_V &
697	& ,N_IUP_ADH,N_IUP_ADV &
698	& ,IUP_H,IUP_V,IUP_ADH,IUP_ADV &
699	& ,IHE,IHW,IVE,IVW &
700	& ,1,1 &
701	& ,IDS,IDF,JDS,JDF,KDS,KDE &
702	& ,IMS,IME,JMS,JME,KMS,KME &
703	& ,ITS,ITE,JTS,JTE,KTS,KTE)
704
705	CALL VAD2_SCAL(NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM &
706	& ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP &
707	& ,HBM2 &
708	& ,MOIST,PETDT &
709	& ,N_IUP_H,N_IUP_V &
710	& ,N_IUP_ADH,N_IUP_ADV &
711	& ,IUP_H,IUP_V,IUP_ADH,IUP_ADV &
712	& ,IHE,IHW,IVE,IVW &
713	& ,NUM_MOIST,2 &
714	& ,IDS,IDF,JDS,JDF,KDS,KDE &
715	& ,IMS,IME,JMS,JME,KMS,KME &
716	& ,ITS,ITE,JTS,JTE,KTS,KTE)
717	!
718	CALL VAD2_SCAL(NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM &
719	& ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP &
720	& ,HBM2 &
721	& ,SCALAR,PETDT &
722	& ,N_IUP_H,N_IUP_V &
723	& ,N_IUP_ADH,N_IUP_ADV &
724	& ,IUP_H,IUP_V,IUP_ADH,IUP_ADV &
725	& ,IHE,IHW,IVE,IVW &
726	& ,NUM_SCALAR,2 &
727	& ,IDS,IDF,JDS,JDF,KDS,KDE &
728	& ,IMS,IME,JMS,JME,KMS,KME &
729	& ,ITS,ITE,JTS,JTE,KTS,KTE)
730	!
731
732	DO K=KTS,KTE
733	DO J=MYJS,MYJE
734	DO I=MYIS,MYIE
735	Q(I,J,K)=MOIST(I,J,K,P_QV)/(1.+MOIST(I,J,K,P_QV))
736	ENDDO
737	ENDDO
738	ENDDO
739	!
740	ENDIF vad2_micro_check
741	!
742	vad2_tim=vad2_tim+timef()-btimx
743	!
744	ENDIF
745	!
746	!-----------------------------------------------------------------------
747	!*** VERTICAL ADVECTION OF CHEMISTRY
748	!-----------------------------------------------------------------------
749	!
750	#ifdef WRF_CHEM
751	IF(MOD(NTSD,GRID%IDTAD)==0)THEN
752	#ifdef IBM
753	btimx=timef()
754	#endif
755	!
756	DO L=1,NUM_CHEM
757	DO K=KMS,KME
758	DO J=JMS,JME
759	DO I=IMS,IME
760	CHEM_TRANS(I,J,K,L)=CHEM(I,K,J,L)
761	ENDDO
762	ENDDO
763	ENDDO
764	ENDDO
765
766
767	CALL VAD2_SCAL(NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM &
768	& ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP &
769	& ,HBM2 &
770	& ,CHEM_TRANS,PETDT &
771	& ,N_IUP_H,N_IUP_V &
772	& ,N_IUP_ADH,N_IUP_ADV &
773	& ,IUP_H,IUP_V,IUP_ADH,IUP_ADV &
774	& ,IHE,IHW,IVE,IVW &
775	& ,NUM_CHEM,1 &
776	& ,IDS,IDF,JDS,JDF,KDS,KDE &
777	& ,IMS,IME,JMS,JME,KMS,KME &
778	& ,ITS,ITE,JTS,JTE,KTS,KTE)
779	!
780	ENDIF
781	#endif
782	!
783	!-----------------------------------------------------------------------
784	!*** HORIZONTAL ADVECTION OF Q, TKE, AND CLOUD WATER
785	!-----------------------------------------------------------------------
786	!
787	IF(MOD(NTSD,GRID%IDTAD)==0)THEN
788	btimx=timef()
789	!-----------------
790	#ifdef DM_PARALLEL
791	# include "HALO_NMM_I.inc"
792	#endif
793	!
794	#ifdef DM_PARALLEL
795	IF(CONFIG_FLAGS%MP_PHYSICS/=ETAMPNEW)THEN
796	# include "HALO_NMM_I_3.inc"
797	ENDIF
798	#endif
799	!
800	!-----------------
801	exch_tim=exch_tim+timef()-btimx
802	! this_tim=timef()-btimx
803	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
804	! & ,mpi_comm_comp,irtn)
805	! exch_tim_max=exch_tim_max+et_max
806	!
807	btimx=timef()
808	!
809	!-----------------------------------------------------------------------
810	had2_micro_check: IF(CONFIG_FLAGS%MP_PHYSICS==ETAMPNEW)THEN
811	!-----------------------------------------------------------------------
812	!
813	CALL HAD2( &
814	#if defined(DM_PARALLEL)
815	& GRID%DOMDESC, &
816	#endif
817	& NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM &
818	& ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP &
819	& ,HBM2,HBM3 &
820	& ,Q,Q2,CWM,U,V,Z,HYDRO &
821	& ,N_IUP_H,N_IUP_V &
822	& ,N_IUP_ADH,N_IUP_ADV &
823	& ,IUP_H,IUP_V,IUP_ADH,IUP_ADV &
824	& ,IHE,IHW,IVE,IVW &
825	& ,IDS,IDF,JDS,JDF,KDS,KDE &
826	& ,IMS,IME,JMS,JME,KMS,KME &
827	& ,ITS,ITE,JTS,JTE,KTS,KTE)
828	!
829	!*** UPDATE MOIST ARRAY.
830	!*** REMEMBER THAT MOIST IS ONLY USED WITH THE PHYSICS AND THUS
831	!*** THE P_QV SLOT (=2) IS MIXING RATIO, NOT SPECIFIC HUMIDITY.
832	!*** ALTHOUGH MOIST IS ONLY USED FOR PHYSICS IN OPERATIONS, IT IS
833	!*** UPDATED HERE FROM Q EVERY ADVECTION TIMESTEP FOR NON-OPERATIONAL
834	!*** CONFIGURATIONS WHERE IT MAY BE USED OUTSIDE OF THE PHYSICS.
835	!
836	IF(.NOT.OPERATIONAL_PHYSICS)THEN
837	DO K=KTS,KTE
838	DO J=MYJS,MYJE
839	DO I=MYIS,MYIE
840	MOIST(I,J,K,P_QV)=Q(I,J,K)/(1.-Q(I,J,K))
841	WC = CWM(I,J,K)
842	QI = 0.
843	QR = 0.
844	QW = 0.
845	FICE=F_ICE(I,K,J)
846	FRAIN=F_RAIN(I,K,J)
847	!
848	IF(FICE>=1.)THEN
849	QI=WC
850	ELSEIF(FICE<=0.)THEN
851	QW=WC
852	ELSE
853	QI=FICE*WC
854	QW=WC-QI
855	ENDIF
856	!
857	IF(QW>0..AND.FRAIN>0.)THEN
858	IF(FRAIN>=1.)THEN
859	QR=QW
860	QW=0.
861	ELSE
862	QR=FRAIN*QW
863	QW=QW-QR
864	ENDIF
865	ENDIF
866	!
867	MOIST(I,J,K,P_QC)=QW
868	MOIST(I,J,K,P_QR)=QR
869	MOIST(I,J,K,P_QI)=0.
870	MOIST(I,J,K,P_QS)=QI
871	MOIST(I,J,K,P_QG)=0.
872	ENDDO
873	ENDDO
874	ENDDO
875	ENDIF
876	!
877	!-----------------------------------------------------------------------
878	ELSE had2_micro_check
879	!-----------------------------------------------------------------------
880	!
881	CALL HAD2_SCAL( &
882	#if defined(DM_PARALLEL)
883	& GRID%DOMDESC, &
884	#endif
885	& NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM &
886	& ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP &
887	& ,HBM2,HBM3 &
888	& ,Q2,U,V,Z,HYDRO &
889	& ,N_IUP_H,N_IUP_V &
890	& ,N_IUP_ADH,N_IUP_ADV &
891	& ,IUP_H,IUP_V,IUP_ADH,IUP_ADV &
892	& ,IHE,IHW,IVE,IVW &
893	& ,1,1 &
894	& ,IDS,IDF,JDS,JDF,KDS,KDE &
895	& ,IMS,IME,JMS,JME,KMS,KME &
896	& ,ITS,ITE,JTS,JTE,KTS,KTE)
897	!
898	CALL HAD2_SCAL( &
899	#if defined(DM_PARALLEL)
900	& GRID%DOMDESC, &
901	#endif
902	& NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM &
903	& ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP &
904	& ,HBM2,HBM3 &
905	& ,MOIST,U,V,Z,HYDRO &
906	& ,N_IUP_H,N_IUP_V &
907	& ,N_IUP_ADH,N_IUP_ADV &
908	& ,IUP_H,IUP_V,IUP_ADH,IUP_ADV &
909	& ,IHE,IHW,IVE,IVW &
910	& ,NUM_MOIST,2 &
911	& ,IDS,IDF,JDS,JDF,KDS,KDE &
912	& ,IMS,IME,JMS,JME,KMS,KME &
913	& ,ITS,ITE,JTS,JTE,KTS,KTE)
914	!
915	CALL HAD2_SCAL( &
916	#if defined(DM_PARALLEL)
917	& GRID%DOMDESC, &
918	#endif
919	& NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM &
920	& ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP &
921	& ,HBM2,HBM3 &
922	& ,SCALAR,U,V,Z,HYDRO &
923	& ,N_IUP_H,N_IUP_V &
924	& ,N_IUP_ADH,N_IUP_ADV &
925	& ,IUP_H,IUP_V,IUP_ADH,IUP_ADV &
926	& ,IHE,IHW,IVE,IVW &
927	& ,NUM_SCALAR,2 &
928	& ,IDS,IDF,JDS,JDF,KDS,KDE &
929	& ,IMS,IME,JMS,JME,KMS,KME &
930	& ,ITS,ITE,JTS,JTE,KTS,KTE)
931	!
932	DO K=KTS,KTE
933	DO J=MYJS,MYJE
934	DO I=MYIS,MYIE
935	Q(I,J,K)=MOIST(I,J,K,P_QV)/(1.+MOIST(I,J,K,P_QV))
936	ENDDO
937	ENDDO
938	ENDDO
939	!
940	!-----------------------------------------------------------------------
941	ENDIF had2_micro_check
942	!-----------------------------------------------------------------------
943	!
944	had2_tim=had2_tim+timef()-btimx
945	ENDIF
946	!
947	!-----------------------------------------------------------------------
948	!*** HORIZONTAL ADVECTION OF CHEMISTRY
949	!-----------------------------------------------------------------------
950	!
951	#ifdef WRF_CHEM
952	IF(MOD(NTSD,GRID%IDTAD)==0)THEN
953	btimx=timef()
954	#ifdef DM_PARALLEL
955	# include "HALO_NMM_I_2.inc"
956	#endif
957	exch_tim=exch_tim+timef()-btimx
958	! this_tim=timef()-btimx
959	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
960	! & ,mpi_comm_comp,irtn)
961	! exch_tim_max=exch_tim_max+et_max
962	!
963	btimx=timef()
964	!
965	CALL HAD2_SCAL( &
966	#if defined(DM_PARALLEL)
967	& GRID%DOMDESC, &
968	#endif
969	& NTSD,GRID%DT,GRID%IDTAD,DX_NMM,DY_NMM &
970	& ,AETA1,AETA2,DETA1,DETA2,PDSL,PDTOP &
971	& ,HBM2,HBM3 &
972	& ,CHEM_TRANS,U,V,Z,HYDRO &
973	& ,N_IUP_H,N_IUP_V &
974	& ,N_IUP_ADH,N_IUP_ADV &
975	& ,IUP_H,IUP_V,IUP_ADH,IUP_ADV &
976	& ,IHE,IHW,IVE,IVW &
977	& ,NUM_CHEM,1 &
978	& ,IDS,IDF,JDS,JDF,KDS,KDE &
979	& ,IMS,IME,JMS,JME,KMS,KME &
980	& ,ITS,ITE,JTS,JTE,KTS,KTE)
981
982	ENDIF
983	DO L=1,NUM_CHEM
984	DO J=JMS,JME
985	DO K=KMS,KME
986	DO I=IMS,IME
987	CHEM(I,K,J,L)=CHEM_TRANS(I,J,K,L)
988	ENDDO
989	ENDDO
990	ENDDO
991	ENDDO
992	#endif
993
994	!
995	!----------------------------------------------------------------------
996	!*** RADIATION
997	!----------------------------------------------------------------------
998	!
999	!*** When allocating CAM radiation 4d arrays (ozmixm, aerosolc),
1000	!*** the following two scalars are not needed.
1001	!
1002	NUM_OZMIXM=1
1003	NUM_AEROSOLC=1
1004	!
1005	IF(NTSD<=0)THEN
1006	NTSD_rad=NTSD
1007	ELSE
1008	!
1009	!*** Call radiation just BEFORE the top of the hour
1010	!*** so that updated fields are written to history files.
1011	!
1012	NTSD_rad=NTSD+1
1013	ENDIF
1014	!
1015	IF(MOD(NTSD_rad,GRID%NRADS)==0.OR. &
1016	& MOD(NTSD_rad,GRID%NRADL)==0)THEN
1017	!
1018	btimx=timef()
1019	IF(OPERATIONAL_PHYSICS)THEN
1020	CALL UPDATE_MOIST(MOIST,Q,CWM,F_ICE,F_RAIN,N_MOIST &
1021	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1022	& ,IMS,IME,JMS,JME,KMS,KME &
1023	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1024	ENDIF
1025	!
1026	CALL RADIATION(NTSD_rad,GRID%DT,GRID%JULDAY,GRID%JULYR &
1027	& ,GRID%XTIME,GRID%JULIAN &
1028	& ,IHRST,GRID%NPHS &
1029	& ,GLAT,GLON,GRID%NRADS,GRID%NRADL &
1030	& ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2,PDTOP,PT &
1031	& ,PD,RES,PINT,T,Q,MOIST,THS,ALBEDO,EPSR &
1032	& ,F_ICE,F_RAIN &
1033	#ifdef WRF_CHEM
1034	& ,GD_CLOUD,GD_CLOUD2 &
1035	#endif
1036	& ,SM,HBM2,CLDFRA,N_MOIST,RESTRT &
1037	& ,RLWTT,RSWTT,RLWIN,RSWIN,RSWINC,RSWOUT &
1038	& ,RLWTOA,RSWTOA,CZMEAN &
1039	& ,CFRACL,CFRACM,CFRACH,SIGT4 &
1040	& ,ACFRST,NCFRST,ACFRCV,NCFRCV &
1041	& ,CUPPT,VEGFRC,SNO,HTOP,HBOT &
1042	& ,Z,SICE,NUM_AEROSOLC,NUM_OZMIXM &
1043	& ,GRID,CONFIG_FLAGS &
1044	& ,RTHRATEN &
1045	#ifdef WRF_CHEM
1046	& ,PM2_5_DRY, PM2_5_WATER, PM2_5_DRY_EC &
1047	& ,TAUAER1, TAUAER2, TAUAER3, TAUAER4 &
1048	& ,GAER1, GAER2, GAER3, GAER4 &
1049	& ,WAER1, WAER2, WAER3, WAER4 &
1050	#endif
1051	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1052	& ,IMS,IME,JMS,JME,KMS,KME &
1053	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1054	!
1055	DO J=JMS,JME
1056	DO I=IMS,IME
1057	GSW(I,J)=RSWIN(I,J)-RSWOUT(I,J)
1058	ENDDO
1059	ENDDO
1060	!
1061	! * NOTE *
1062	! RLWIN/RSWIN - downward longwave/shortwave at the surface (formerly TOTLWDN/TOTSWDN)
1063	! RSWINC - CLEAR-SKY downward shortwave at the surface (new for AQ)
1064	! * NOTE *
1065	!
1066	radiation_tim=radiation_tim+timef()-btimx
1067	ENDIF
1068	!
1069	!----------------------------------------------------------------------
1070	!*** APPLY TEMPERATURE TENDENCY DUE TO RADIATION
1071	!----------------------------------------------------------------------
1072	!
1073	btimx=timef()
1074	!
1075	! Pass in XTIME (elapsed time from start of parent) to compute
1076	! the time passed into the zenith angle code consistently between
1077	! RDTEMP and RADIATION.
1078
1079	CALL RDTEMP(NTSD,GRID%DT,GRID%JULDAY,GRID%JULYR &
1080	& ,GRID%XTIME,IHRST,GLAT,GLON &
1081	& ,CZEN,CZMEAN,T,RSWTT,RLWTT,HBM2 &
1082	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1083	& ,IMS,IME,JMS,JME,KMS,KME &
1084	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1085	!
1086	rdtemp_tim=rdtemp_tim+timef()-btimx
1087	!
1088	!----------------------------------------------------------------------
1089	!*** TURBULENT PROCESSES
1090	!----------------------------------------------------------------------
1091	!
1092	IF(MOD(NTSD,GRID%NPHS)==0)THEN
1093	!
1094	btimx=timef()
1095	!
1096	IF(OPERATIONAL_PHYSICS &
1097	& .AND.MOD(NTSD_rad,GRID%NRADS)/=0 &
1098	& .AND.MOD(NTSD_rad,GRID%NRADL)/=0)THEN
1099	CALL UPDATE_MOIST(MOIST,Q,CWM,F_ICE,F_RAIN,N_MOIST &
1100	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1101	& ,IMS,IME,JMS,JME,KMS,KME &
1102	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1103	ENDIF
1104	!
1105	CALL TURBL(NTSD,GRID%DT,GRID%NPHS,RESTRT &
1106	& ,N_MOIST,GRID%NUM_SOIL_LAYERS,SLDPTH,DZSOIL &
1107	& ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2,PDTOP,PT &
1108	& ,SM,HBM2,VBM2,DX_NMM,DFRLG &
1109	& ,CZEN,CZMEAN,SIGT4,RLWIN,RSWIN,RADOT &
1110	& ,PD,RES,PINT,T,Q,CWM,F_ICE,F_RAIN,SR &
1111	& ,Q2,U,V,THS,NMM_TSK,SST,PREC,SNO &
1112	& ,FIS,Z0,Z0BASE,USTAR,PBLH,LPBL,EL_MYJ &
1113	& ,MOIST,RMOL,MOL &
1114	& ,EXCH_H,AKHS,AKMS,AKHS_OUT,AKMS_OUT &
1115	& ,THZ0,QZ0,UZ0,VZ0,QSH,MAVAIL &
1116	& ,STC,SMC,CMC,SMSTAV,SMSTOT,SSROFF,BGROFF &
1117	& ,IVGTYP,ISLTYP,VEGFRC,SHDMIN,SHDMAX,GRNFLX &
1118	& ,SFCEXC,ACSNOW,ACSNOM,SNOPCX,SICE,TG,SOILTB &
1119	& ,ALBASE,MXSNAL,ALBEDO,SH2O,SI,EPSR,EMBCK &
1120	& ,U10,V10,TH10,Q10,TSHLTR,QSHLTR,PSHLTR &
1121	& ,T2,QSG,QVG,QCG,SOILT1,TSNAV,SMFR3D,KEEPFR3DFLAG &
1122	& ,TWBS,QWBS,SFCSHX,SFCLHX,SFCEVP &
1123	& ,POTEVP,POTFLX,SUBSHX &
1124	& ,APHTIM,ARDSW,ARDLW,ASRFC &
1125	& ,RSWOUT,RSWTOA,RLWTOA &
1126	& ,ASWIN,ASWOUT,ASWTOA,ALWIN,ALWOUT,ALWTOA &
1127	& ,UZ0H,VZ0H,DUDT,DVDT &
1128	& ,RTHBLTEN,RQVBLTEN &
1129	& ,GRID%PCPFLG,DDATA &
1130	& ,GRID,CONFIG_FLAGS &
1131	& ,IHE,IHW,IVE,IVW &
1132	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1133	& ,IMS,IME,JMS,JME,KMS,KME &
1134	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1135	!
1136	! * NOTE *
1137	! RLWIN/RSWIN - downward longwave/shortwave at the surface
1138	! * NOTE *
1139	!
1140	turbl_tim=turbl_tim+timef()-btimx
1141	!
1142	btimx=timef()
1143	!-----------------
1144	#ifdef DM_PARALLEL
1145	# include "HALO_NMM_TURBL_A.inc"
1146	#endif
1147	!-----------------
1148	#ifdef DM_PARALLEL
1149	# include "HALO_NMM_TURBL_B.inc"
1150	#endif
1151	!-----------------
1152	exch_tim=exch_tim+timef()-btimx
1153	! this_tim=timef()-btimx
1154	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
1155	! & ,mpi_comm_comp,irtn)
1156	! exch_tim_max=exch_tim_max+et_max
1157	!
1158	!*** INTERPOLATE WINDS FROM H POINTS BACK TO V POINTS.
1159	!
1160	btimx=timef()
1161	CALL UV_H_TO_V(NTSD,GRID%DT,GRID%NPHS,UZ0H,VZ0H,UZ0,VZ0 &
1162	& ,DUDT,DVDT,U,V,HBM2,IVE,IVW &
1163	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1164	& ,IMS,IME,JMS,JME,KMS,KME &
1165	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1166	uv_htov_tim=uv_htov_tim+timef()-btimx
1167	!
1168	!----------------------------------------------------------------------
1169	!*** STORE ORIGINAL TEMPERATURE ARRAY
1170	!----------------------------------------------------------------------
1171	!
1172	btimx=timef()
1173	!-----------------
1174	#ifdef DM_PARALLEL
1175	# include "HALO_NMM_J.inc"
1176	#endif
1177	!
1178	#ifdef DM_PARALLEL
1179	IF(CONFIG_FLAGS%MP_PHYSICS/=ETAMPNEW)THEN
1180	# include "HALO_NMM_J_3.inc"
1181	ENDIF
1182	#endif
1183	!
1184	#ifdef WRF_CHEM
1185	#ifdef DM_PARALLEL
1186	# include "HALO_NMM_J_2.inc"
1187	#endif
1188	#endif
1189	!-----------------
1190	exch_tim=exch_tim+timef()-btimx
1191	! this_tim=timef()-btimx
1192	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
1193	! & ,mpi_comm_comp,irtn)
1194	! exch_tim_max=exch_tim_max+et_max
1195	!
1196	ICLTEND=-1
1197	btimx=timef()
1198	!
1199	CALL CLTEND(ICLTEND,GRID%NPHS,T,T_OLD,T_ADJ &
1200	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1201	& ,IMS,IME,JMS,JME,KMS,KME &
1202	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1203	!
1204	cltend_tim=cltend_tim+timef()-btimx
1205	ENDIF
1206	!
1207	!----------------------------------------------------------------------
1208	!*** CONVECTIVE PRECIPITATION
1209	!----------------------------------------------------------------------
1210	!
1211	IF(MOD(NTSD,GRID%NCNVC)==0.AND. &
1212	& CONFIG_FLAGS%CU_PHYSICS==KFETASCHEME)THEN
1213	!
1214	btimx=timef()
1215	!-----------------
1216	#ifdef DM_PARALLEL
1217	# include "HALO_NMM_C.inc"
1218	#endif
1219	!-----------------
1220	exch_tim=exch_tim+timef()-btimx
1221	! this_tim=timef()-btimx
1222	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
1223	! & ,mpi_comm_comp,irtn)
1224	! exch_tim_max=exch_tim_max+et_max
1225	ENDIF
1226	!
1227	convection: IF(CONFIG_FLAGS%CU_PHYSICS/=0)THEN
1228	btimx=timef()
1229	!
1230	!*** GET TENDENCIES FOR GD SCHEME.
1231	!
1232	IF(CONFIG_FLAGS%CU_PHYSICS==GDSCHEME)THEN
1233	DT_INV=1./GRID%DT
1234	DO J=JMS,JME
1235	DO K=KMS,KME
1236	DO I=IMS,IME
1237	TTEN(I,K,J)=(T(I,J,K)-TTEN(I,K,J))*DT_INV
1238	QTEN(I,K,J)=(Q(I,J,K)-QTEN(I,K,J))*DT_INV
1239	ENDDO
1240	ENDDO
1241	ENDDO
1242	ENDIF
1243	!
1244	!*** UPDATE THE MOIST ARRAY IF NEEDED.
1245	!
1246	IF(OPERATIONAL_PHYSICS &
1247	& .AND.MOD(NTSD_rad,GRID%NRADS)/=0 &
1248	& .AND.MOD(NTSD_rad,GRID%NRADL)/=0 &
1249	& .AND.MOD(NTSD,GRID%NPHS)/=0)THEN
1250	CALL UPDATE_MOIST(MOIST,Q,CWM,F_ICE,F_RAIN,N_MOIST &
1251	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1252	& ,IMS,IME,JMS,JME,KMS,KME &
1253	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1254	ENDIF
1255	!
1256	!----------------------------------------------------------------------
1257	CALL CUCNVC(NTSD,GRID%DT,GRID%NCNVC,GRID%NRADS,GRID%NRADL &
1258	& ,GPS,RESTRT,HYDRO,CLDEFI,N_MOIST,GRID%ENSDIM &
1259	& ,MOIST &
1260	& ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2 &
1261	& ,F_ICE,F_RAIN &
1262	!*** Changes for other cu schemes, most for GD scheme
1263	& ,APR_GR,APR_W,APR_MC,TTEN,QTEN &
1264	& ,APR_ST,APR_AS,APR_CAPMA &
1265	& ,APR_CAPME,APR_CAPMI &
1266	& ,MASS_FLUX,XF_ENS &
1267	& ,PR_ENS,GSW &
1268	#ifdef WRF_CHEM
1269	& ,GD_CLOUD,GD_CLOUD2,RAINCV &
1270	#endif
1271	!
1272	& ,PDTOP,PT,PD,RES,PINT,T,Q,CWM,TCUCN &
1273	& ,OMGALF,U,V,W,Z,FIS,W0AVG &
1274	& ,PREC,ACPREC,CUPREC,CUPPT,CPRATE &
1275	& ,SM,HBM2,LPBL,CNVBOT,CNVTOP &
1276	& ,HTOP,HBOT,HTOPD,HBOTD,HTOPS,HBOTS &
1277	& ,RTHBLTEN,RQVBLTEN,RTHRATEN &
1278	& ,AVCNVC,ACUTIM,IHE,IHW &
1279	& ,GRID,CONFIG_FLAGS &
1280	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1281	& ,IMS,IME,JMS,JME,KMS,KME &
1282	& ,IPS,IPE,JPS,JPE,KPS,KPE &
1283	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1284	!----------------------------------------------------------------------
1285	!
1286	cucnvc_tim=cucnvc_tim+timef()-btimx
1287	!
1288	ENDIF convection
1289	!
1290	!----------------------------------------------------------------------
1291	!*** GRIDSCALE MICROPHYSICS (CONDENSATION & PRECIPITATION)
1292	!----------------------------------------------------------------------
1293	!
1294	IF(MOD(NTSD,GRID%NPHS)==0)THEN
1295	btimx=timef()
1296	!
1297	CALL GSMDRIVE(NTSD,GRID%DT,GRID%NPHS,N_MOIST &
1298	& ,DX_NMM(ITS,JC),GRID%DY,SM,HBM2,FIS &
1299	& ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2 &
1300	& ,PDTOP,PT,PD,RES,PINT,T,Q,CWM,TRAIN &
1301	& ,MOIST,SCALAR,NUM_SCALAR &
1302	& ,F_ICE,F_RAIN,F_RIMEF,SR &
1303	& ,PREC,ACPREC,AVRAIN &
1304	& ,MP_RESTART_STATE &
1305	& ,TBPVS_STATE &
1306	& ,TBPVS0_STATE &
1307	& ,GRID,CONFIG_FLAGS &
1308	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1309	& ,IMS,IME,JMS,JME,KMS,KME &
1310	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1311	!
1312	gsmdrive_tim=gsmdrive_tim+timef()-btimx
1313	!
1314	!-----------------------------------------------------------------------
1315	!---------PRECIPITATION ASSIMILATION------------------------------------
1316	!-----------------------------------------------------------------------
1317	!
1318	IF (GRID%PCPFLG) THEN
1319	btimx=timef()
1320	!
1321	CALL CHKSNOW(NTSD,GRID%DT,GRID%NPHS,SR,PPTDAT &
1322	& ,IDS,IDE,JDS,JDE,KDS,KDE &
1323	& ,IMS,IME,JMS,JME,KMS,KME &
1324	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1325	CALL ADJPPT(NTSD,GRID%DT,GRID%NPHS,PREC,LSPA,PPTDAT,DDATA &
1326	& ,IDS,IDE,JDS,JDE,KDS,KDE &
1327	& ,IMS,IME,JMS,JME,KMS,KME &
1328	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1329	!
1330	adjppt_tim=adjppt_tim+timef()-btimx
1331	ENDIF
1332	!
1333	!----------------------------------------------------------------------
1334	!*** CALCULATE TEMP TENDENCIES AND RESTORE ORIGINAL TEMPS
1335	!----------------------------------------------------------------------
1336	!
1337	ICLTEND=0
1338	btimx=timef()
1339	!
1340	CALL CLTEND(ICLTEND,GRID%NPHS,T,T_OLD,T_ADJ &
1341	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1342	& ,IMS,IME,JMS,JME,KMS,KME &
1343	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1344	!
1345	cltend_tim=cltend_tim+timef()-btimx
1346	ENDIF
1347	!
1348	!----------------------------------------------------------------------
1349	!*** UPDATE TEMP TENDENCIES FROM CLOUD PROCESSES EVERY TIME STEP
1350	!----------------------------------------------------------------------
1351	!
1352	ICLTEND=1
1353	btimx=timef()
1354	!
1355	CALL CLTEND(ICLTEND,GRID%NPHS,T,T_OLD,T_ADJ &
1356	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1357	& ,IMS,IME,JMS,JME,KMS,KME &
1358	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1359	!
1360	cltend_tim=cltend_tim+timef()-btimx
1361	!
1362	!----------------------------------------------------------------------
1363	!*** LATERAL DIFFUSION
1364	!----------------------------------------------------------------------
1365	!
1366	btimx=timef()
1367	!-----------------
1368	#ifdef DM_PARALLEL
1369	# include "HALO_NMM_K.inc"
1370	#endif
1371	!-----------------
1372	exch_tim=exch_tim+timef()-btimx
1373	! this_tim=timef()-btimx
1374	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
1375	! & ,mpi_comm_comp,irtn)
1376	! exch_tim_max=exch_tim_max+et_max
1377	!
1378	btimx=timef()
1379	!
1380	CALL HDIFF(NTSD,GRID%DT,FIS,DY_NMM,HDAC,HDACV &
1381	& ,HBM2,DETA1,GRID%SIGMA &
1382	& ,T,Q,U,V,Q2,Z,W,SM,SICE &
1383	& ,IHE,IHW,IVE,IVW &
1384	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1385	& ,IMS,IME,JMS,JME,KMS,KME &
1386	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1387	!
1388	IF(.NOT.OPERATIONAL_PHYSICS)THEN
1389	DO K=KTS,KTE
1390	DO J=MYJS,MYJE
1391	DO I=MYIS,MYIE
1392	!!! MOIST(I,J,K,P_QV)=MAX(0.,Q(I,J,K)/(1.-Q(I,J,K)))
1393	MOIST(I,J,K,P_QV)=Q(I,J,K)/(1.-Q(I,J,K)) !<-- Update mixing ratio
1394	ENDDO
1395	ENDDO
1396	ENDDO
1397	ENDIF
1398	!
1399	hdiff_tim=hdiff_tim+timef()-btimx
1400	!
1401	!----------------------------------------------------------------------
1402	!*** UPDATING BOUNDARY VALUES AT HEIGHT POINTS
1403	!----------------------------------------------------------------------
1404	!
1405	btimx=timef()
1406	!-----------------
1407	#ifdef DM_PARALLEL
1408	# include "HALO_NMM_L.inc"
1409	#endif
1410	!
1411	#ifdef DM_PARALLEL
1412	# include "HALO_NMM_L_3.inc"
1413	#endif
1414	!
1415	#ifdef WRF_CHEM
1416	#ifdef DM_PARALLEL
1417	# include "HALO_NMM_L_2.inc"
1418	#endif
1419	#endif
1420	!-----------------
1421	exch_tim=exch_tim+timef()-btimx
1422	! this_tim=timef()-btimx
1423	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
1424	! & ,mpi_comm_comp,irtn)
1425	! exch_tim_max=exch_tim_max+et_max
1426	!
1427	btimx=timef()
1428	!
1429	CALL BOCOH(GRID%ID,NTSD,GRID%DT,NEST,NUNIT_NBC,NBOCO,LAST_TIME,TSPH &
1430	& ,LB,ETA1,ETA2,PDTOP,PT,RES &
1431	& ,PD_BXS,PD_BXE,PD_BYS,PD_BYE,T_BXS,T_BXE,T_BYS,T_BYE &
1432	& ,Q_BXS,Q_BXE,Q_BYS,Q_BYE,U_BXS,U_BXE,U_BYS,U_BYE,V_BXS &
1433	& ,V_BXE,V_BYS,V_BYE,Q2_BXS,Q2_BXE,Q2_BYS,Q2_BYE,CWM_BXS &
1434	& ,CWM_BXE,CWM_BYS,CWM_BYE,PD_BTXS,PD_BTXE,PD_BTYS &
1435	& ,PD_BTYE,T_BTXS,T_BTXE,T_BTYS,T_BTYE,Q_BTXS,Q_BTXE &
1436	& ,Q_BTYS,Q_BTYE,U_BTXS,U_BTXE,U_BTYS,U_BTYE,V_BTXS &
1437	& ,V_BTXE,V_BTYS,V_BTYE,Q2_BTXS,Q2_BTXE,Q2_BTYS,Q2_BTYE &
1438	& ,CWM_BTXS,CWM_BTXE,CWM_BTYS,CWM_BTYE,PD,T,Q,Q2,CWM,PINT &
1439	& ,MOIST,N_MOIST,SCALAR,NUM_SCALAR &
1440	#ifdef WRF_CHEM
1441	& ,CHEM,NUMGAS,CONFIG_FLAGS &
1442	#endif
1443	& ,GRID%SPEC_BDY_WIDTH,Z &
1444	& ,IHE,IHW,IVE,IVW &
1445	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1446	& ,IMS,IME,JMS,JME,KMS,KME &
1447	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1448
1449
1450	!
1451	bocoh_tim=bocoh_tim+timef()-btimx
1452	! if(mod(ntsd,n_print_time)==0)then
1453	! call twr(t,0,'t',ntsd,mype,npes,mpi_comm_comp &
1454	! & ,ids,ide,jds,jde,kds,kde &
1455	! & ,ims,ime,jms,jme,kms,kme &
1456	! & ,its,ite,jts,jte,kts,kte)
1457	! endif
1458	!
1459	!----------------------------------------------------------------------
1460	!*** IS IT TIME FOR A CHECK POINT ON THE MODEL HISTORY FILE?
1461	!----------------------------------------------------------------------
1462	!
1463	2003 CONTINUE
1464	!
1465	!----------------------------------------------------------------------
1466	!*** PRESSURE GRD, CORIOLIS, DIVERGENCE, AND HORIZ PART OF OMEGA-ALPHA
1467	!----------------------------------------------------------------------
1468	!
1469	btimx=timef()
1470	!-----------------
1471	#ifdef DM_PARALLEL
1472	# include "HALO_NMM_A.inc"
1473	#endif
1474	!
1475	#ifdef DM_PARALLEL
1476	IF(CONFIG_FLAGS%MP_PHYSICS/=ETAMPNEW)THEN
1477	# include "HALO_NMM_A_3.inc"
1478	ENDIF
1479	#endif
1480	!
1481	#ifdef WRF_CHEM
1482	#ifdef DM_PARALLEL
1483	# include "HALO_NMM_A_2.inc"
1484	#endif
1485	#endif
1486	!-----------------
1487	exch_tim=exch_tim+timef()-btimx
1488	! this_tim=timef()-btimx
1489	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
1490	! & ,mpi_comm_comp,irtn)
1491	! exch_tim_max=exch_tim_max+et_max
1492	!
1493	btimx=timef()
1494	!
1495	CALL PFDHT(NTSD,LAST_TIME,PT,DETA1,DETA2,PDTOP,RES,FIS &
1496	& ,HYDRO,GRID%SIGMA,FIRST,DX_NMM,DY_NMM &
1497	& ,HBM2,VBM2,VBM3 &
1498	& ,FDIV,FCP,WPDAR,DFL,CPGFU,CPGFV &
1499	& ,PD,PDSL,T,Q,U,V,CWM,OMGALF,PINT,DWDT &
1500	& ,RTOP,DIV,FEW,FNS,FNE,FSE &
1501	& ,IHE,IHW,IVE,IVW &
1502	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1503	& ,IMS,IME,JMS,JME,KMS,KME &
1504	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1505
1506	!
1507	pfdht_tim=pfdht_tim+timef()-btimx
1508	!
1509	!----------------------------------------------------------------------
1510	!*** DIVERGENCE DAMPING
1511	!----------------------------------------------------------------------
1512	!
1513	btimx=timef()
1514	!-----------------
1515	#ifdef DM_PARALLEL
1516	# include "HALO_NMM_B.inc"
1517	#endif
1518	!-----------------
1519	exch_tim=exch_tim+timef()-btimx
1520	! this_tim=timef()-btimx
1521	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
1522	! & ,mpi_comm_comp,irtn)
1523	! exch_tim_max=exch_tim_max+et_max
1524	!
1525	btimx=timef()
1526	!
1527	CALL DDAMP(NTSD,GRID%DT,DETA1,DETA2,PDSL,PDTOP,DIV,HBM2 &
1528	& ,T,U,V,DDMPU,DDMPV &
1529	& ,IHE,IHW,IVE,IVW &
1530	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1531	& ,IMS,IME,JMS,JME,KMS,KME &
1532	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1533	!
1534	ddamp_tim=ddamp_tim+timef()-btimx
1535	!
1536	!----------------------------------------------------------------------
1537	!----------------------------------------------------------------------
1538	!
1539	IF(FIRST.AND.NTSD==0)THEN
1540	FIRST=.FALSE.
1541	btimx=timef()
1542	!-----------------
1543	#ifdef DM_PARALLEL
1544	# include "HALO_NMM_A.inc"
1545	#endif
1546	#ifdef WRF_CHEM
1547	#ifdef DM_PARALLEL
1548	# include "HALO_NMM_A_2.inc"
1549	#endif
1550	#endif
1551	!-----------------
1552	exch_tim=exch_tim+timef()-btimx
1553	! this_tim=timef()-btimx
1554	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
1555	! & ,mpi_comm_comp,irtn)
1556	! exch_tim_max=exch_tim_max+et_max
1557	!
1558	GO TO 2000
1559	ENDIF
1560	!
1561	!----------------------------------------------------------------------
1562	!*** UPDATING BOUNDARY VALUES AT VELOCITY POINTS
1563	!----------------------------------------------------------------------
1564	!
1565	btimx=timef()
1566	!-----------------
1567	#ifdef DM_PARALLEL
1568	# include "HALO_NMM_C.inc"
1569	#endif
1570	!-----------------
1571	exch_tim=exch_tim+timef()-btimx
1572	! this_tim=timef()-btimx
1573	! call mpi_allreduce(this_tim,et_max,1,mpi_real,mpi_max &
1574	! & ,mpi_comm_comp,irtn)
1575	! exch_tim_max=exch_tim_max+et_max
1576	!
1577	btimx=timef()
1578	!
1579	CALL BOCOV(GRID%ID,NTSD,GRID%DT,LB,U_BXS,U_BXE,U_BYS,U_BYE,V_BXS &
1580	& ,V_BXE,V_BYS,V_BYE,U_BTXS,U_BTXE,U_BTYS,U_BTYE,V_BTXS &
1581	& ,V_BTXE,V_BTYS,V_BTYE,U,V &
1582	& ,GRID%SPEC_BDY_WIDTH &
1583	& ,IHE,IHW,IVE,IVW &
1584	& ,IDS,IDF,JDS,JDF,KDS,KDE &
1585	& ,IMS,IME,JMS,JME,KMS,KME &
1586	& ,ITS,ITE,JTS,JTE,KTS,KTE )
1587
1588	!
1589	bocov_tim=bocov_tim+timef()-btimx
1590	!
1591	!----------------------------------------------------------------------
1592	!*** COPY THE NMM VARIABLE Q2 TO THE WRF VARIABLE TKE_MYJ
1593	!----------------------------------------------------------------------
1594	!
1595	DO K=KTS,KTE
1596	DO J=JTS,JTE
1597	DO I=ITS,ITE
1598	TKE_MYJ(I,J,K)=0.5*Q2(I,J,K) !TKE is q squared over 2
1599	ENDDO
1600	ENDDO
1601	ENDDO
1602	!
1603	!----------------------------------------------------------------------
1604	!
1605	IF(LAST_TIME.AND.ALLOCATED(PPTDAT))THEN
1606	DEALLOCATE(PPTDAT,STAT=ISTAT)
1607	ENDIF
1608	!
1609	!----------------------------------------------------------------------
1610	!
1611	solve_tim=solve_tim+timef()-btim
1612	!
1613	!----------------------------------------------------------------------
1614	!*** PRINT TIMING VARIABLES WHEN DESIRED.
1615	!----------------------------------------------------------------------
1616	!
1617	sum_tim=pdte_tim+adve_tim+vtoa_tim+vadz_tim+hadz_tim+eps_tim &
1618	& +vad2_tim+had2_tim+radiation_tim+rdtemp_tim+turbl_tim &
1619	& +cltend_tim+cucnvc_tim+gsmdrive_tim+hdiff_tim &
1620	& +bocoh_tim+pfdht_tim+ddamp_tim+bocov_tim+uv_htov_tim &
1621	& +exch_tim+adjppt_tim
1622	!
1623	if(mod(ntsd,n_print_time)==0)then
1624	write(0,)' ntsd=',ntsd,' solve_tim=',solve_tim1.e-3 &
1625	& ,' sum_tim=',sum_tim*1.e-3
1626	write(0,)' pdte_tim=',pdte_tim1.e-3,' pct=',pdte_tim/sum_tim*100.
1627	write(0,)' adve_tim=',adve_tim1.e-3,' pct=',adve_tim/sum_tim*100.
1628	write(0,)' vtoa_tim=',vtoa_tim1.e-3,' pct=',vtoa_tim/sum_tim*100.
1629	write(0,)' vadz_tim=',vadz_tim1.e-3,' pct=',vadz_tim/sum_tim*100.
1630	write(0,)' hadz_tim=',hadz_tim1.e-3,' pct=',hadz_tim/sum_tim*100.
1631	write(0,)' eps_tim=',eps_tim1.e-3,' pct=',eps_tim/sum_tim*100.
1632	write(0,)' vad2_tim=',vad2_tim1.e-3,' pct=',vad2_tim/sum_tim*100.
1633	write(0,)' had2_tim=',had2_tim1.e-3,' pct=',had2_tim/sum_tim*100.
1634	write(0,)' radiation_tim=',radiation_tim1.e-3,' pct=',radiation_tim/sum_tim*100.
1635	write(0,)' rdtemp_tim=',rdtemp_tim1.e-3,' pct=',rdtemp_tim/sum_tim*100.
1636	write(0,)' turbl_tim=',turbl_tim1.e-3,' pct=',turbl_tim/sum_tim*100.
1637	write(0,)' cltend_tim=',cltend_tim1.e-3,' pct=',cltend_tim/sum_tim*100.
1638	write(0,)' cucnvc_tim=',cucnvc_tim1.e-3,' pct=',cucnvc_tim/sum_tim*100.
1639	write(0,)' gsmdrive_tim=',gsmdrive_tim1.e-3,' pct=',gsmdrive_tim/sum_tim*100.
1640	write(0,)' adjppt_tim=',adjppt_tim1.e-3,' pct=',adjppt_tim/sum_tim*100.
1641	write(0,)' hdiff_tim=',hdiff_tim1.e-3,' pct=',hdiff_tim/sum_tim*100.
1642	write(0,)' bocoh_tim=',bocoh_tim1.e-3,' pct=',bocoh_tim/sum_tim*100.
1643	write(0,)' pfdht_tim=',pfdht_tim1.e-3,' pct=',pfdht_tim/sum_tim*100.
1644	write(0,)' ddamp_tim=',ddamp_tim1.e-3,' pct=',ddamp_tim/sum_tim*100.
1645	write(0,)' bocov_tim=',bocov_tim1.e-3,' pct=',bocov_tim/sum_tim*100.
1646	write(0,)' uv_h_to_v_tim=',uv_htov_tim1.e-3,' pct=',uv_htov_tim/sum_tim*100.
1647	write(0,)' exch_tim=',exch_tim1.e-3,' pct=',exch_tim/sum_tim*100.
1648	! call time_stats(exch_tim,'exchange',ntsd,mype,npes,mpi_comm_comp)
1649	! write(0,)' exch_tim_max=',exch_tim_max1.e-3
1650	!
1651	call field_stats(t,mype,mpi_comm_comp &
1652	& ,ids,ide,jds,jde,kds,kde &
1653	& ,ims,ime,jms,jme,kms,kme &
1654	& ,its,ite,jts,jte,kts,kte)
1655	endif
1656	!
1657	! if(last_time)then
1658	DEALLOCATE(TTEN,STAT=ISTAT)
1659	DEALLOCATE(QTEN,STAT=ISTAT)
1660	DEALLOCATE(RTHRATEN,STAT=ISTAT)
1661	DEALLOCATE(RTHBLTEN,STAT=ISTAT)
1662	DEALLOCATE(RQVBLTEN,STAT=ISTAT)
1663	#ifdef WRF_CHEM
1664	DEALLOCATE(CHEM_TRANS,STAT=ISTAT)
1665	#endif
1666	!
1667	#define COPY_OUT
1668	#include <scalar_derefs.inc>
1669	Return
1670	!----------------------------------------------------------------------
1671	!**********************************************************************
1672	!**********************************************************************
1673	!*********** EXIT FROM THE TIME LOOP ************************
1674	!**********************************************************************
1675	!**********************************************************************
1676	!----------------------------------------------------------------------
1677	END SUBROUTINE SOLVE_NMM
1678	!----------------------------------------------------------------------
1679	!**********************************************************************
1680	!----------------------------------------------------------------------
1681	SUBROUTINE TWR(ARRAY,KK,FIELD,NTSD,MYPE,NPES,MPI_COMM_COMP &
1682	& ,IDS,IDE,JDS,JDE,KDS,KDE &
1683	& ,IMS,IME,JMS,JME,KMS,KME &
1684	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1685	!----------------------------------------------------------------------
1686	!**********************************************************************
1687	USE MODULE_EXT_INTERNAL
1688	!
1689	IMPLICIT NONE
1690	#if defined(DM_PARALLEL) && !defined(STUBMPI)
1691	INCLUDE "mpif.h"
1692	#endif
1693	!----------------------------------------------------------------------
1694	!----------------------------------------------------------------------
1695	INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
1696	& ,IMS,IME,JMS,JME,KMS,KME &
1697	& ,ITS,ITE,JTS,JTE,KTS,KTE &
1698	& ,KK,MPI_COMM_COMP,MYPE,NPES,NTSD
1699	!
1700	REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME+KK),INTENT(IN) :: ARRAY
1701	!
1702	CHARACTER(*),INTENT(IN) :: FIELD
1703	!
1704	!*** LOCAL VARIABLES
1705	!
1706	#if defined(DM_PARALLEL) && !defined(STUBMPI)
1707	INTEGER,DIMENSION(MPI_STATUS_SIZE) :: JSTAT
1708	INTEGER,DIMENSION(MPI_STATUS_SIZE,4) :: STATUS_ARRAY
1709	#endif
1710	INTEGER,DIMENSION(2) :: IM_REM,JM_REM,IT_REM,JT_REM
1711	!
1712	INTEGER :: I,IENDX,IER,IPE,IRECV,IRTN,ISEND,IUNIT &
1713	& ,J,K,N,NLEN,NSIZE
1714	INTEGER :: ITS_REM,ITE_REM,JTS_REM,JTE_REM
1715	!
1716	REAL,DIMENSION(IDS:IDE,JDS:JDE) :: TWRITE
1717	REAL,ALLOCATABLE,DIMENSION(:) :: VALUES
1718	CHARACTER(5) :: TIMESTEP
1719	CHARACTER(6) :: FMT
1720	CHARACTER(12) :: FILENAME
1721	!----------------------------------------------------------------------
1722	!**********************************************************************
1723	!----------------------------------------------------------------------
1724	!
1725	IF(NTSD<=9)THEN
1726	FMT='(I1.1)'
1727	NLEN=1
1728	ELSEIF(NTSD<=99)THEN
1729	FMT='(I2.2)'
1730	NLEN=2
1731	ELSEIF(NTSD<=999)THEN
1732	FMT='(I3.3)'
1733	NLEN=3
1734	ELSEIF(NTSD<=9999)THEN
1735	FMT='(I4.4)'
1736	NLEN=4
1737	ELSEIF(NTSD<=99999)THEN
1738	FMT='(I5.5)'
1739	NLEN=5
1740	ENDIF
1741	WRITE(TIMESTEP,FMT)NTSD
1742	FILENAME=FIELD//'_'//TIMESTEP(1:NLEN)
1743	!
1744	IF(MYPE==0)THEN
1745	CALL INT_GET_FRESH_HANDLE(IUNIT)
1746	CLOSE(IUNIT)
1747	OPEN(UNIT=IUNIT,FILE=FILENAME,FORM='UNFORMATTED',IOSTAT=IER)
1748	ENDIF
1749	!
1750	!----------------------------------------------------------------------
1751	!!!! DO 500 K=KTS,KTE+KK !Unflipped
1752	!!!! DO 500 K=KTE+KK,KTS,-1
1753	DO 500 K=KDE-1,KDS,-1 !Write LM layers top down for checking
1754	!----------------------------------------------------------------------
1755	!
1756	#if defined(DM_PARALLEL) && !defined(STUBMPI)
1757	IF(MYPE==0)THEN
1758	DO J=JTS,JTE
1759	DO I=ITS,ITE
1760	TWRITE(I,J)=ARRAY(I,J,K)
1761	ENDDO
1762	ENDDO
1763	!
1764	DO IPE=1,NPES-1
1765	CALL MPI_RECV(IT_REM,2,MPI_INTEGER,IPE,IPE &
1766	& ,MPI_COMM_COMP,JSTAT,IRECV)
1767	CALL MPI_RECV(JT_REM,2,MPI_INTEGER,IPE,IPE &
1768	& ,MPI_COMM_COMP,JSTAT,IRECV)
1769	!
1770	ITS_REM=IT_REM(1)
1771	ITE_REM=IT_REM(2)
1772	JTS_REM=JT_REM(1)
1773	JTE_REM=JT_REM(2)
1774	!
1775	NSIZE=(ITE_REM-ITS_REM+1)*(JTE_REM-JTS_REM+1)
1776	ALLOCATE(VALUES(1:NSIZE))
1777	!
1778	CALL MPI_RECV(VALUES,NSIZE,MPI_REAL,IPE,IPE &
1779	& ,MPI_COMM_COMP,JSTAT,IRECV)
1780	N=0
1781	DO J=JTS_REM,JTE_REM
1782	DO I=ITS_REM,ITE_REM
1783	N=N+1
1784	TWRITE(I,J)=VALUES(N)
1785	ENDDO
1786	ENDDO
1787	!
1788	DEALLOCATE(VALUES)
1789	!
1790	ENDDO
1791	!
1792	!----------------------------------------------------------------------
1793	ELSE
1794	NSIZE=(ITE-ITS+1)*(JTE-JTS+1)
1795	ALLOCATE(VALUES(1:NSIZE))
1796	!
1797	N=0
1798	DO J=JTS,JTE
1799	DO I=ITS,ITE
1800	N=N+1
1801	VALUES(N)=ARRAY(I,J,K)
1802	ENDDO
1803	ENDDO
1804	!
1805	IT_REM(1)=ITS
1806	IT_REM(2)=ITE
1807	JT_REM(1)=JTS
1808	JT_REM(2)=JTE
1809	!
1810	CALL MPI_SEND(IT_REM,2,MPI_INTEGER,0,MYPE &
1811	& ,MPI_COMM_COMP,ISEND)
1812	CALL MPI_SEND(JT_REM,2,MPI_INTEGER,0,MYPE &
1813	& ,MPI_COMM_COMP,ISEND)
1814	!
1815	CALL MPI_SEND(VALUES,NSIZE,MPI_REAL,0,MYPE &
1816	& ,MPI_COMM_COMP,ISEND)
1817	!
1818	DEALLOCATE(VALUES)
1819	!
1820	ENDIF
1821	!----------------------------------------------------------------------
1822	!
1823	CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
1824	!
1825	IF(MYPE==0)THEN
1826	!
1827	DO J=JDS,JDE-1
1828	IENDX=IDE-1
1829	IF(MOD(J,2)==0)IENDX=IENDX-1
1830	WRITE(IUNIT)(TWRITE(I,J),I=1,IENDX)
1831	ENDDO
1832	!
1833	ENDIF
1834	#else
1835
1836	DO J=JDS,JDE-1
1837	IENDX=IDE-1
1838	IF(MOD(J,2)==0)IENDX=IENDX-1
1839	WRITE(IUNIT)(ARRAY(I,K,J),I=1,IENDX)
1840	ENDDO
1841
1842	#endif
1843
1844	!
1845	!----------------------------------------------------------------------
1846	500 CONTINUE
1847	!
1848	IF(MYPE==0)CLOSE(IUNIT)
1849	!----------------------------------------------------------------------
1850	!
1851	END SUBROUTINE TWR
1852	!----------------------------------------------------------------------
1853	!**********************************************************************
1854	!----------------------------------------------------------------------
1855	SUBROUTINE VWR(ARRAY,KK,FIELD,NTSD,MYPE,NPES,MPI_COMM_COMP &
1856	& ,IDS,IDE,JDS,JDE,KDS,KDE &
1857	& ,IMS,IME,JMS,JME,KMS,KME &
1858	& ,ITS,ITE,JTS,JTE,KTS,KTE)
1859	!----------------------------------------------------------------------
1860	!**********************************************************************
1861	USE MODULE_EXT_INTERNAL
1862	!
1863	IMPLICIT NONE
1864	#if defined(DM_PARALLEL) && !defined(STUBMPI)
1865	INCLUDE "mpif.h"
1866	#endif
1867	!----------------------------------------------------------------------
1868	!----------------------------------------------------------------------
1869	INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
1870	& ,IMS,IME,JMS,JME,KMS,KME &
1871	& ,ITS,ITE,JTS,JTE,KTS,KTE &
1872	& ,KK,MPI_COMM_COMP,MYPE,NPES,NTSD
1873	!
1874	REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME+KK),INTENT(IN) :: ARRAY
1875	!
1876	CHARACTER(*),INTENT(IN) :: FIELD
1877	!
1878	!*** LOCAL VARIABLES
1879	!
1880	#if defined(DM_PARALLEL) && !defined(STUBMPI)
1881	INTEGER,DIMENSION(MPI_STATUS_SIZE) :: JSTAT
1882	INTEGER,DIMENSION(MPI_STATUS_SIZE,4) :: STATUS_ARRAY
1883	#endif
1884	INTEGER,DIMENSION(2) :: IM_REM,JM_REM,IT_REM,JT_REM
1885	!
1886	INTEGER :: I,IENDX,IER,IPE,IRECV,IRTN,ISEND,IUNIT &
1887	& ,J,K,L,N,NLEN,NSIZE
1888	INTEGER :: ITS_REM,ITE_REM,JTS_REM,JTE_REM
1889	!
1890	REAL,DIMENSION(IDS:IDE,JDS:JDE) :: TWRITE
1891	REAL,ALLOCATABLE,DIMENSION(:) :: VALUES
1892	CHARACTER(5) :: TIMESTEP
1893	CHARACTER(6) :: FMT
1894	CHARACTER(12) :: FILENAME
1895	LOGICAL :: OPENED
1896	!----------------------------------------------------------------------
1897	!**********************************************************************
1898	!----------------------------------------------------------------------
1899	!
1900	IF(NTSD<=9)THEN
1901	FMT='(I1.1)'
1902	NLEN=1
1903	ELSEIF(NTSD<=99)THEN
1904	FMT='(I2.2)'
1905	NLEN=2
1906	ELSEIF(NTSD<=999)THEN
1907	FMT='(I3.3)'
1908	NLEN=3
1909	ELSEIF(NTSD<=9999)THEN
1910	FMT='(I4.4)'
1911	NLEN=4
1912	ELSEIF(NTSD<=99999)THEN
1913	FMT='(I5.5)'
1914	NLEN=5
1915	ENDIF
1916	WRITE(TIMESTEP,FMT)NTSD
1917	FILENAME=FIELD//'_'//TIMESTEP(1:NLEN)
1918	!
1919	IF(MYPE==0)THEN
1920	CALL INT_GET_FRESH_HANDLE(IUNIT)
1921	CLOSE(IUNIT)
1922	OPEN(UNIT=IUNIT,FILE=FILENAME,FORM='UNFORMATTED',IOSTAT=IER)
1923	ENDIF
1924	! IF(MYPE==0)THEN
1925	! OPEN_UNIT: DO L=51,99
1926	! INQUIRE(L,OPENED=OPENED)
1927	! IF(.NOT.OPENED)THEN
1928	! IUNIT=L
1929	! OPEN(UNIT=IUNIT,FILE=FILENAME,STATUS='NEW' &
1930	! ,FORM='UNFORMATTED',IOSTAT=IER)
1931	! IF(IER/=0)THEN
1932	! WRITE(0,*)' Opening file error=',IER
1933	! WRITE(6,*)' Opening file error=',IER
1934	! ENDIF
1935	! EXIT OPEN_UNIT
1936	! ENDIF
1937	! ENDDO OPEN_UNIT
1938	! ENDIF
1939	!
1940	!----------------------------------------------------------------------
1941	!!!! DO 500 K=KTS,KTE+KK !Unflipped
1942	!!!! DO 500 K=KTE+KK,KTS,-1
1943	DO 500 K=KDE-1,KDS,-1 !Write LM layers top down for checking
1944	!----------------------------------------------------------------------
1945	!
1946	#if defined(DM_PARALLEL) && !defined(STUBMPI)
1947	IF(MYPE==0)THEN
1948	DO J=JTS,JTE
1949	DO I=ITS,ITE
1950	TWRITE(I,J)=ARRAY(I,J,K)
1951	ENDDO
1952	ENDDO
1953	!
1954	DO IPE=1,NPES-1
1955	CALL MPI_RECV(IT_REM,2,MPI_INTEGER,IPE,IPE &
1956	& ,MPI_COMM_COMP,JSTAT,IRECV)
1957	CALL MPI_RECV(JT_REM,2,MPI_INTEGER,IPE,IPE &
1958	& ,MPI_COMM_COMP,JSTAT,IRECV)
1959	!
1960	ITS_REM=IT_REM(1)
1961	ITE_REM=IT_REM(2)
1962	JTS_REM=JT_REM(1)
1963	JTE_REM=JT_REM(2)
1964	!
1965	NSIZE=(ITE_REM-ITS_REM+1)*(JTE_REM-JTS_REM+1)
1966	ALLOCATE(VALUES(1:NSIZE))
1967	!
1968	CALL MPI_RECV(VALUES,NSIZE,MPI_REAL,IPE,IPE &
1969	& ,MPI_COMM_COMP,JSTAT,IRECV)
1970	N=0
1971	DO J=JTS_REM,JTE_REM
1972	DO I=ITS_REM,ITE_REM
1973	N=N+1
1974	TWRITE(I,J)=VALUES(N)
1975	ENDDO
1976	ENDDO
1977	!
1978	DEALLOCATE(VALUES)
1979	!
1980	ENDDO
1981	!
1982	!----------------------------------------------------------------------
1983	ELSE
1984	NSIZE=(ITE-ITS+1)*(JTE-JTS+1)
1985	ALLOCATE(VALUES(1:NSIZE))
1986	!
1987	N=0
1988	DO J=JTS,JTE
1989	DO I=ITS,ITE
1990	N=N+1
1991	VALUES(N)=ARRAY(I,J,K)
1992	ENDDO
1993	ENDDO
1994	!
1995	IT_REM(1)=ITS
1996	IT_REM(2)=ITE
1997	JT_REM(1)=JTS
1998	JT_REM(2)=JTE
1999	!
2000	CALL MPI_SEND(IT_REM,2,MPI_INTEGER,0,MYPE &
2001	& ,MPI_COMM_COMP,ISEND)
2002	CALL MPI_SEND(JT_REM,2,MPI_INTEGER,0,MYPE &
2003	& ,MPI_COMM_COMP,ISEND)
2004	!
2005	CALL MPI_SEND(VALUES,NSIZE,MPI_REAL,0,MYPE &
2006	& ,MPI_COMM_COMP,ISEND)
2007	!
2008	DEALLOCATE(VALUES)
2009	!
2010	ENDIF
2011	!----------------------------------------------------------------------
2012	!
2013	CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
2014	!
2015	IF(MYPE==0)THEN
2016	!
2017	DO J=JDS,JDE-1
2018	IENDX=IDE-1
2019	IF(MOD(J,2)==1)IENDX=IENDX-1
2020	WRITE(IUNIT)(TWRITE(I,J),I=1,IENDX)
2021	ENDDO
2022	!
2023	ENDIF
2024	#else
2025
2026	DO J=JDS,JDE-1
2027	IENDX=IDE-1
2028	IF(MOD(J,2)==0)IENDX=IENDX-1
2029	WRITE(IUNIT)(ARRAY(I,K,J),I=1,IENDX)
2030	ENDDO
2031
2032	#endif
2033	!
2034	!----------------------------------------------------------------------
2035	500 CONTINUE
2036	!
2037	IF(MYPE==0)CLOSE(IUNIT)
2038	!----------------------------------------------------------------------
2039	!
2040	END SUBROUTINE VWR
2041	!----------------------------------------------------------------------
2042	!**********************************************************************
2043	!----------------------------------------------------------------------
2044	SUBROUTINE EXIT(NAME,PINT,T,Q,U,V,Q2,W &
2045	& ,NTSD,MYPE,MPI_COMM_COMP &
2046	& ,IDS,IDE,JDS,JDE,KDS,KDE &
2047	& ,IMS,IME,JMS,JME,KMS,KME &
2048	& ,ITS,ITE,JTS,JTE,KTS,KTE)
2049	!----------------------------------------------------------------------
2050	!**********************************************************************
2051	USE MODULE_EXT_INTERNAL
2052	!
2053	!----------------------------------------------------------------------
2054	IMPLICIT NONE
2055	!----------------------------------------------------------------------
2056	#if defined(DM_PARALLEL) && !defined(STUBMPI)
2057	INCLUDE "mpif.h"
2058	#endif
2059	!----------------------------------------------------------------------
2060	INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
2061	& ,IMS,IME,JMS,JME,KMS,KME &
2062	& ,ITS,ITE,JTS,JTE,KTS,KTE &
2063	& ,MYPE,MPI_COMM_COMP,NTSD
2064	!
2065	REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: PINT,T,Q &
2066	,U,V,Q2,W
2067	CHARACTER(*),INTENT(IN) :: NAME
2068	!
2069	INTEGER :: I,J,K,IEND,IERR,IRET
2070	CHARACTER(256) :: ERRMESS
2071	LOGICAL :: E_BDY,S_BDY
2072	!----------------------------------------------------------------------
2073	IRET=0
2074	100 FORMAT(' EXIT ',A,' AT NTSD=',I5)
2075	IEND=ITE
2076	S_BDY=(JTS==JDS)
2077	E_BDY=(ITE==IDE-1)
2078	!
2079	DO K=KTS,KTE
2080	DO J=JTS,JTE
2081	IEND=ITE
2082	IF(E_BDY.AND.MOD(J,2)==0)IEND=ITE-1
2083	!
2084	DO I=ITS,IEND
2085	IF(T(I,J,K)>330..OR.T(I,J,K)<180..OR.T(I,J,K)/=T(I,J,K))THEN
2086	WRITE(0,100)NAME,NTSD
2087	WRITE(0,200)I,J,K,T(I,J,K),MYPE,NTSD
2088	200 FORMAT(' BAD VALUE I=',I3,' J=',I3,' K=',I2,' T=',E12.5 &
2089	&, ' MYPE=',I3,' NTSD=',I5)
2090	IRET=666
2091	return
2092	! WRITE(ERRMESS,205)NAME,T(I,J,K),I,J,K,MYPE
2093	205 FORMAT(' EXIT ',A,' TEMPERATURE=',E12.5 &
2094	&, ' AT (',I3,',',I2,',',I3,')',' MYPE=',I3)
2095	! CALL WRF_ERROR_FATAL(ERRMESS)
2096	! CALL MPI_ABORT(MPI_COMM_WORLD,1,IERR)
2097	ELSEIF(Q(I,J,K)<-1.E-4.OR.Q(I,J,K)>30.E-3 &
2098	& .OR.Q(I,J,K)/=Q(I,J,K))THEN
2099	WRITE(0,100)NAME,NTSD
2100	WRITE(0,300)I,J,K,Q(I,J,K),MYPE,NTSD
2101	300 FORMAT(' BAD VALUE I=',I3,' J=',I3,' K=',I2,' Q=',E12.5 &
2102	&, ' MYPE=',I3,' NTSD=',I5)
2103	IRET=666
2104	return
2105	! WRITE(ERRMESS,305)NAME,Q(I,J,K),I,J,K,MYPE
2106	305 FORMAT(' EXIT ',A,' SPEC HUMIDITY=',E12.5 &
2107	&, ' AT (',I3,',',I2,',',I3,')',' MYPE=',I3)
2108	! CALL WRF_ERROR_FATAL(ERRMESS)
2109	! CALL MPI_ABORT(MPI_COMM_WORLD,1,IERR)
2110	ELSEIF(PINT(I,J,K)<0..OR.PINT(I,J,K)/=PINT(I,J,K))THEN
2111	WRITE(0,100)NAME,NTSD
2112	WRITE(0,315)I,J,K,PINT(I,J,K),MYPE,NTSD
2113	315 FORMAT(' BAD VALUE I=',I3,' J=',I3,' K=',I2,' PINT=',E12.5 &
2114	&, ' MYPE=',I3,' NTSD=',I5)
2115	IRET=666
2116	return
2117	! CALL WRF_ERROR_FATAL(ERRMESS)
2118	! CALL MPI_ABORT(MPI_COMM_WORLD,1,IERR)
2119	ELSEIF(W(I,J,K)/=W(I,J,K))THEN
2120	WRITE(0,100)NAME,NTSD
2121	WRITE(0,325)I,J,K,W(I,J,K),MYPE,NTSD
2122	325 FORMAT(' BAD VALUE I=',I3,' J=',I3,' K=',I2,' W=',E12.5 &
2123	&, ' MYPE=',I3,' NTSD=',I5)
2124	IRET=666
2125	return
2126	! CALL WRF_ERROR_FATAL(ERRMESS)
2127	! CALL MPI_ABORT(MPI_COMM_WORLD,1,IERR)
2128	ENDIF
2129	ENDDO
2130	ENDDO
2131	ENDDO
2132	!
2133	DO K=KTS,KTE
2134	DO J=JTS,JTE
2135	IEND=ITE
2136	IF(E_BDY.AND.MOD(J,2)==1)IEND=ITE-1
2137	DO I=ITS,IEND
2138	IF(ABS(U(I,J,K))>125..OR.ABS(V(I,J,K))>125. &
2139	& .OR.U(I,J,K)/=U(I,J,K).OR.V(I,J,K)/=V(I,J,K))THEN
2140	WRITE(0,100)NAME,NTSD
2141	WRITE(0,400)I,J,K,U(I,J,K),V(I,J,K),MYPE,NTSD
2142	400 FORMAT(' BAD VALUE I=',I3,' J=',I3,' K=',I2,' U=',E12.5 &
2143	&, ' V=',E12.5,' MYPE=',I3,' NTSD=',I5)
2144	IRET=666
2145	return
2146	! WRITE(ERRMESS,405)NAME,U(I,J,K),V(I,J,K),I,J,K,MYPE
2147	405 FORMAT(' EXIT ',A,' U=',E12.5,' V=',E12.5 &
2148	&, ' AT (',I3,',',I2,',',I3,')',' MYPE=',I3)
2149	! CALL WRF_ERROR_FATAL(ERRMESS)
2150	! CALL MPI_ABORT(MPI_COMM_WORLD,1,IERR)
2151	ENDIF
2152	ENDDO
2153	ENDDO
2154	ENDDO
2155	!----------------------------------------------------------------------
2156	END SUBROUTINE EXIT
2157	!----------------------------------------------------------------------
2158	!**********************************************************************
2159	!----------------------------------------------------------------------
2160	SUBROUTINE TIME_STATS(TIME_LCL,NAME,NTSD,MYPE,NPES,MPI_COMM_COMP)
2161	!----------------------------------------------------------------------
2162	!**********************************************************************
2163	USE MODULE_EXT_INTERNAL
2164	!
2165	!----------------------------------------------------------------------
2166	IMPLICIT NONE
2167	!----------------------------------------------------------------------
2168	#if defined(DM_PARALLEL) && !defined(STUBMPI)
2169	INCLUDE "mpif.h"
2170	#endif
2171	!----------------------------------------------------------------------
2172	INTEGER,INTENT(IN) :: MPI_COMM_COMP,MYPE,NPES,NTSD
2173	REAL,INTENT(IN) :: TIME_LCL
2174	!
2175	CHARACTER(*),INTENT(IN) :: NAME
2176	!
2177	!*** LOCAL VARIABLES
2178	!
2179	#if defined(DM_PARALLEL) && !defined(STUBMPI)
2180	INTEGER,DIMENSION(MPI_STATUS_SIZE) :: JSTAT
2181	INTEGER,DIMENSION(MPI_STATUS_SIZE,4) :: STATUS_ARRAY
2182	#endif
2183	INTEGER,ALLOCATABLE,DIMENSION(:) :: ID_PE,IPE_SORT
2184	!
2185	INTEGER :: IPE,IPE_MAX,IPE_MEDIAN,IPE_MIN,IRECV,IRTN,ISEND &
2186	& ,N,N_MEDIAN,NLEN
2187	!
2188	REAL,ALLOCATABLE,DIMENSION(:) :: TIME,SORT_TIME
2189	REAL,DIMENSION(2) :: REMOTE
2190	REAL :: TIME_MAX,TIME_MEAN,TIME_MEDIAN,TIME_MIN
2191	!
2192	CHARACTER(5) :: TIMESTEP
2193	CHARACTER(6) :: FMT
2194	CHARACTER(25) :: TITLE
2195	!----------------------------------------------------------------------
2196	!**********************************************************************
2197	!----------------------------------------------------------------------
2198	!
2199	IF(NTSD<=9)THEN
2200	FMT='(I1.1)'
2201	NLEN=1
2202	ELSEIF(NTSD<=99)THEN
2203	FMT='(I2.2)'
2204	NLEN=2
2205	ELSEIF(NTSD<=999)THEN
2206	FMT='(I3.3)'
2207	NLEN=3
2208	ELSEIF(NTSD<=9999)THEN
2209	FMT='(I4.4)'
2210	NLEN=4
2211	ELSEIF(NTSD<=99999)THEN
2212	FMT='(I5.5)'
2213	NLEN=5
2214	ENDIF
2215	WRITE(TIMESTEP,FMT)NTSD
2216	TITLE=NAME//'_'//TIMESTEP(1:NLEN)
2217	!
2218	!----------------------------------------------------------------------
2219	!
2220	#if defined(DM_PARALLEL) && !defined(STUBMPI)
2221	IF(MYPE==0)THEN
2222	ALLOCATE(TIME(1:NPES))
2223	ALLOCATE(SORT_TIME(1:NPES))
2224	ALLOCATE(ID_PE(1:NPES))
2225	ALLOCATE(IPE_SORT(1:NPES))
2226	!
2227	TIME(1)=TIME_LCL
2228	ID_PE(1)=MYPE
2229	!
2230	!*** COLLECT TIMES AND PE VALUES FROM OTHER PEs
2231	!
2232	DO IPE=1,NPES-1
2233	CALL MPI_RECV(REMOTE,2,MPI_REAL,IPE,IPE &
2234	& ,MPI_COMM_COMP,JSTAT,IRECV)
2235	!
2236	TIME(IPE+1)=REMOTE(1)
2237	ID_PE(IPE+1)=NINT(REMOTE(2))
2238	ENDDO
2239	!
2240	!*** NOW GET STATS.
2241	!*** FIRST THE MAX, MIN, AND MEAN TIMES.
2242	!
2243	TIME_MEAN=0.
2244	TIME_MAX=-1.
2245	TIME_MIN=1.E10
2246	IPE_MAX=-1
2247	IPE_MIN=-1
2248	!
2249	DO N=1,NPES
2250	TIME_MEAN=TIME_MEAN+TIME(N)
2251	!
2252	IF(TIME(N)>TIME_MAX)THEN
2253	TIME_MAX=TIME(N)
2254	IPE_MAX=ID_PE(N)
2255	ENDIF
2256	!
2257	IF(TIME(N)<TIME_MIN)THEN
2258	TIME_MIN=TIME(N)
2259	IPE_MIN=ID_PE(N)
2260	ENDIF
2261	!
2262	ENDDO
2263	!
2264	TIME_MAX=TIME_MAX*1.E-3
2265	TIME_MIN=TIME_MIN*1.E-3
2266	TIME_MEAN=TIME_MEAN*1.E-3/REAL(NPES)
2267	!
2268	!*** THEN THE MEDIAN TIME.
2269	!
2270	CALL SORT(TIME,NPES,SORT_TIME,IPE_SORT)
2271	N_MEDIAN=(NPES+1)/2
2272	TIME_MEDIAN=SORT_TIME(N_MEDIAN)*1.E-3
2273	IPE_MEDIAN=IPE_SORT(N_MEDIAN)
2274	!
2275	!----------------------------------------------------------------------
2276	ELSE
2277	!
2278	!*** SEND TIME AND PE VALUE TO PE0.
2279	!
2280	REMOTE(1)=TIME_LCL
2281	REMOTE(2)=REAL(MYPE)
2282	!
2283	CALL MPI_SEND(REMOTE,2,MPI_REAL,0,MYPE,MPI_COMM_COMP,ISEND)
2284	!
2285	ENDIF
2286	!----------------------------------------------------------------------
2287	!
2288	CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
2289	!
2290	!*** WRITE RESULTS
2291	!
2292	IF(MYPE==0)THEN
2293	WRITE(0,100)TITLE
2294	WRITE(0,105)TIME_MAX,IPE_MAX
2295	WRITE(0,110)TIME_MIN,IPE_MIN
2296	WRITE(0,115)TIME_MEDIAN,IPE_MEDIAN
2297	WRITE(0,120)TIME_MEAN
2298	100 FORMAT(' Time for ',A)
2299	105 FORMAT(' Maximum=',G11.5,' for PE ',I2.2)
2300	110 FORMAT(' Minimum=',G11.5,' for PE ',I2.2)
2301	115 FORMAT(' Median =',G11.5,' for PE ',I2.2)
2302	120 FORMAT(' Mean =',G11.5)
2303	ENDIF
2304	!----------------------------------------------------------------------
2305	!
2306	#endif
2307	END SUBROUTINE TIME_STATS
2308	!
2309	!----------------------------------------------------------------------
2310	!**********************************************************************
2311	!----------------------------------------------------------------------
2312	SUBROUTINE SORT(DATA,NPES,DATA_SORTED,IPE_SORTED)
2313	!----------------------------------------------------------------------
2314	!***
2315	!*** SORT DATA FROM MULTIPLE PEs. SEND BACK THE SORTED DATA ITEMS
2316	!*** ALONG WITH THE ASSOCIATED TASK IDs.
2317	!***
2318	!----------------------------------------------------------------------
2319	IMPLICIT NONE
2320	!----------------------------------------------------------------------
2321	INTEGER,INTENT(IN) :: NPES
2322	REAL,DIMENSION(NPES),INTENT(IN) :: DATA
2323	!
2324	INTEGER,DIMENSION(NPES),INTENT(OUT) :: IPE_SORTED
2325	REAL,DIMENSION(NPES),INTENT(OUT) :: DATA_SORTED
2326	!----------------------------------------------------------------------
2327	TYPE :: DATA_LINK
2328	REAL :: VALUE
2329	INTEGER :: IPE
2330	TYPE(DATA_LINK),POINTER :: NEXT_VALUE
2331	END TYPE
2332	!----------------------------------------------------------------------
2333	!
2334	!*** LOCAL VARIABLES
2335	!
2336	!----------------------------------------------------------------------
2337	INTEGER :: ISTAT,N
2338	!
2339	TYPE(DATA_LINK),POINTER :: HEAD,TAIL ! Smallest, largest
2340	TYPE(DATA_LINK),POINTER :: PTR_NEW ! Each new value
2341	TYPE(DATA_LINK),POINTER :: PTR1,PTR2 ! Working pointers
2342	!----------------------------------------------------------------------
2343	!**********************************************************************
2344	!----------------------------------------------------------------------
2345	pe_loop: DO N=1,NPES
2346	ALLOCATE(PTR_NEW,STAT=ISTAT) ! Location for next data items
2347	PTR_NEW%VALUE=DATA(N)
2348	PTR_NEW%IPE=N-1
2349	!
2350	!----------------------------------------------------------------------
2351	!*** DETERMINE WHERE IN LIST TO INSERT VALUE.
2352	!*** FIRST THE INITIAL DATA VALUE.
2353	!----------------------------------------------------------------------
2354	!
2355	! main: IF(.NOT.ASSOCIATED(HEAD))THEN
2356	main: IF(N==1)THEN
2357	HEAD=>PTR_NEW
2358	TAIL=>HEAD
2359	NULLIFY(PTR_NEW%NEXT_VALUE)
2360	!
2361	!----------------------------------------------------------------------
2362	!*** THE NEW VALUE IS LESS THAN THE SMALLEST VALUE ALREADY SORTED.
2363	!----------------------------------------------------------------------
2364	!
2365	ELSE
2366	check: IF(PTR_NEW%VALUE<HEAD%VALUE)THEN
2367	PTR_NEW%NEXT_VALUE=>HEAD
2368	HEAD=>PTR_NEW
2369	!
2370	!----------------------------------------------------------------------
2371	!*** THE NEW VALUE IS GREATER THAN THE LARGEST VALUE ALREADY SORTED.
2372	!----------------------------------------------------------------------
2373	!
2374	ELSEIF(PTR_NEW%VALUE>=TAIL%VALUE)THEN
2375	TAIL%NEXT_VALUE=>PTR_NEW ! This is what connects the former
2376	! final value in the list to
2377	! the new value being appended.
2378	TAIL=>PTR_NEW
2379	NULLIFY(TAIL%NEXT_VALUE)
2380	!
2381	!----------------------------------------------------------------------
2382	!*** THE NEW VALUE IS IN BETWEEN VALUES ALREADY SORTED.
2383	!----------------------------------------------------------------------
2384	!
2385	ELSE
2386	PTR1=>HEAD
2387	PTR2=>PTR1%NEXT_VALUE
2388	!
2389	search: DO
2390	IF((PTR_NEW%VALUE>=PTR1%VALUE).AND. &
2391	& (PTR_NEW%VALUE<PTR2%VALUE))THEN
2392	PTR_NEW%NEXT_VALUE=>PTR2
2393	PTR1%NEXT_VALUE=>PTR_NEW
2394	EXIT search
2395	ENDIF
2396	!
2397	PTR1=>PTR2
2398	PTR2=>PTR2%NEXT_VALUE
2399	ENDDO search
2400	!
2401	ENDIF check
2402	!
2403	ENDIF main
2404	!
2405	ENDDO pe_loop
2406	!
2407	!----------------------------------------------------------------------
2408	!*** COLLECT THE SORTED NUMBERS FROM THE LINKED LIST.
2409	!----------------------------------------------------------------------
2410	!
2411	PTR1=>HEAD
2412	!
2413	DO N=1,NPES
2414	! IF(.NOT.ASSOCIATED(PTR_NEW))EXIT
2415	DATA_SORTED(N)=PTR1%VALUE
2416	IPE_SORTED(N)=PTR1%IPE
2417	PTR1=>PTR1%NEXT_VALUE
2418	ENDDO
2419	!
2420	DEALLOCATE(PTR_NEW)
2421	NULLIFY (HEAD,TAIL,PTR1,PTR2)
2422	!----------------------------------------------------------------------
2423	END SUBROUTINE SORT
2424	!----------------------------------------------------------------------
2425	!**********************************************************************
2426	!----------------------------------------------------------------------
2427	SUBROUTINE FIELD_STATS(FIELD,MYPE,MPI_COMM_COMP &
2428	& ,IDS,IDE,JDS,JDE,KDS,KDE &
2429	& ,IMS,IME,JMS,JME,KMS,KME &
2430	& ,ITS,ITE,JTS,JTE,KTS,KTE)
2431	!----------------------------------------------------------------------
2432	!***
2433	!*** GENERATE STANDARD LAYER STATISTICS FOR THE DESIRED FIELD.
2434	!***
2435	!----------------------------------------------------------------------
2436	IMPLICIT NONE
2437	!----------------------------------------------------------------------
2438	#if defined(DM_PARALLEL) && !defined(STUBMPI)
2439	INCLUDE "mpif.h"
2440	#endif
2441	!----------------------------------------------------------------------
2442	!
2443	INTEGER,INTENT(IN) :: MPI_COMM_COMP,MYPE
2444	INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
2445	& ,IMS,IME,JMS,JME,KMS,KME &
2446	& ,ITS,ITE,JTS,JTE,KTS,KTE
2447	!
2448	REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: FIELD
2449	!
2450	!----------------------------------------------------------------------
2451	!*** LOCAL
2452	!----------------------------------------------------------------------
2453	!
2454	INTEGER,PARAMETER :: DOUBLE=SELECTED_REAL_KIND(15,300)
2455	!
2456	INTEGER :: I,IEND,IRTN,I_BY_J,J,K,KFLIP
2457	!
2458	REAL :: FIKJ,FMAXK,FMINK
2459	REAL(KIND=DOUBLE) :: F_MEAN,POINTS,RMS,ST_DEV,SUMFK,SUMF2K
2460	REAL,DIMENSION(KTS:KTE) :: FMAX,FMAX_0,FMIN,FMIN_0
2461	REAL(KIND=DOUBLE),DIMENSION(KTS:KTE) :: SUMF,SUMF_0,SUMF2,SUMF2_0
2462	!----------------------------------------------------------------------
2463	!
2464	I_BY_J=(IDE-IDS)*(JDE-JDS)-(JDE-JDS-1)/2 ! This assumes that
2465	! IDE and JDE are each
2466	! one greater than the
2467	! true grid size.
2468	#if defined(DM_PARALLEL) && !defined(STUBMPI)
2469	!
2470	layer_loop: DO K=KTS,KTE
2471	!
2472	FMAXK=-1.E10
2473	FMINK=1.E10
2474	SUMFK=0.
2475	SUMF2K=0.
2476	!
2477	DO J=JTS,JTE
2478	IEND=MIN(ITE,IDE-1)
2479	IF(MOD(J,2)==0.AND.ITE==IDE-1)IEND=IEND-1
2480	DO I=ITS,IEND
2481	FIKJ=FIELD(I,J,K)
2482	FMAXK=MAX(FMAXK,FIKJ)
2483	FMINK=MIN(FMINK,FIKJ)
2484	SUMFK=SUMFK+FIKJ
2485	SUMF2K=SUMF2K+FIKJ*FIKJ
2486	ENDDO
2487	ENDDO
2488	!
2489	FMAX(K)=FMAXK
2490	FMIN(K)=FMINK
2491	SUMF(K)=SUMFK
2492	SUMF2(K)=SUMF2K
2493	!
2494	ENDDO layer_loop
2495	!
2496	!----------------------------------------------------------------------
2497	!*** GLOBAL STATS
2498	!----------------------------------------------------------------------
2499	!
2500	CALL MPI_REDUCE(SUMF,SUMF_0,KTE,MPI_REAL8,MPI_SUM,0 &
2501	& ,MPI_COMM_COMP,IRTN)
2502	CALL MPI_REDUCE(SUMF2,SUMF2_0,KTE,MPI_REAL8,MPI_SUM,0 &
2503	& ,MPI_COMM_COMP,IRTN)
2504	CALL MPI_REDUCE(FMAX,FMAX_0,KTE,MPI_REAL,MPI_MAX,0 &
2505	& ,MPI_COMM_COMP,IRTN)
2506	CALL MPI_REDUCE(FMIN,FMIN_0,KTE,MPI_REAL,MPI_MIN,0 &
2507	& ,MPI_COMM_COMP,IRTN)
2508	!
2509	IF(MYPE==0)THEN
2510	POINTS=I_BY_J
2511	DO K=KTE,KTS,-1
2512	F_MEAN=SUMF_0(K)/POINTS
2513	ST_DEV=SQRT((POINTSSUMF2_0(K)-SUMF_0(K)SUMF_0(K))/ &
2514	& (POINTS*(POINTS-1)))
2515	RMS=SQRT(SUMF2_0(K)/POINTS)
2516	KFLIP=KTE-K+1
2517	WRITE(0,101)KFLIP,FMAX_0(K),FMIN_0(K)
2518	WRITE(0,102)F_MEAN,ST_DEV,RMS
2519	101 FORMAT(' LAYER=',I2,' MAX=',E13.6,' MIN=',E13.6)
2520	102 FORMAT(9X,' MEAN=',E13.6,' STDEV=',E13.6,' RMS=',E13.6)
2521	ENDDO
2522	ENDIF
2523	#endif
2524	!----------------------------------------------------------------------
2525	END SUBROUTINE FIELD_STATS
2526	!----------------------------------------------------------------------
2527	FUNCTION TIMEF()
2528	REAL*8 TIMEF
2529	INTEGER :: IC,IR
2530	CALL SYSTEM_CLOCK(COUNT=IC,COUNT_RATE=IR)
2531	TIMEF=REAL(IC)/REAL(IR)*1000.0
2532	END

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

Download in other formats:

Original Format