Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

read_nmm.F @ 3709

Last change on this file since 3709 was 11, checked in by aslmd, 15 years ago
spiga@svn-planeto:ajoute le modele meso-echelle martien
File size: 28.9 KB

Line
1	!WRF:MEDIATION_LAYER:
2	!
3
4	SUBROUTINE med_read_nmm ( grid , config_flags , ntsd, dt_from_file, tstart_from_file, tend_from_file &
5	!
6	#include <nmm_dummy_args.inc>
7	!
8	)
9	! Driver layer
10	USE module_domain
11	USE module_io_domain
12	! Model layer
13	USE module_configure
14	USE module_bc_time_utilities
15	!----------------------------------------------------------------------
16
17	IMPLICIT NONE
18
19	!----------------------------------------------------------------------
20
21	! Arguments
22	TYPE(domain) :: grid
23	TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
24
25	#include <nmm_dummy_decl.inc>
26
27	!----------------------------------------------------------------------
28	! Local
29
30	REAL, DIMENSION(1:2*NMM_MAX_DIM,2) :: PDB
31	REAL, DIMENSION(1:2*NMM_MAX_DIM,grid%sd32:grid%ed32-1,2) :: TB,QB,UB,VB,Q2B,CWMB
32
33	INTEGER :: NUNIT_PARMETA=10,NUNIT_FCSTDATA=11 &
34	,NUNIT_NHB=12,NUNIT_CO2=14,NUNIT_Z0=22
35	INTEGER :: NMAP,NRADSH,NRADLH,NTDDMP
36	INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE
37	INTEGER :: IPS,IPE,JPS,JPE,KPS,KPE
38	INTEGER :: IMS,IME,JMS,JME,KMS,KME
39	INTEGER :: IM,JM,LM,NROOT,INPES,JNPES,NFCST,NUNIT_NBC,LISTB
40	!!!INTEGER :: I,J,K,IHRST,JAM,NTSD,IHRSTB,IHH,IHL
41	INTEGER :: I,J,K,IHRST,JAM,IHRSTB,IHH,IHL
42	INTEGER :: KBI,KBI2,LRECBC
43	INTEGER :: N,ISTART,LB,NREC
44	! Addition, JM 20050819
45	! Rconfig variables no longer passed through dummy arg list or declared
46	! in nmm_dummy_decl. Declare them local here.
47	INTEGER :: NSOIL,NPHS,NCNVC,IDTAD,SIGMA,NRADS,NRADL
48	REAL :: DT
49	! End addition, JM 20050819
50	INTEGER,DIMENSION(3) :: IDAT,IDATB
51	LOGICAL :: RESTRT,SINGLRST,NEST,RUN,RUNB
52	REAL :: TSTART,TEND,TPREC,THEAT,TCLOD,TRDSW,TRDLW,TSRFC
53	REAL :: BCHR,TSTEPS,TSPH,TBOCO
54	REAL,DIMENSION(39) :: SPL
55	REAL,DIMENSION(99) :: TSHDE
56	REAL,ALLOCATABLE,DIMENSION(:) :: TEMP1
57	REAL,ALLOCATABLE,DIMENSION(:,:) :: TEMP
58	INTEGER,ALLOCATABLE,DIMENSION(:,:) :: ITEMP
59	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: HOLD
60	REAL :: TDDAMP &
61	,ETA
62	REAL :: PLQ,RDPQ,RDTHEQ,STHEQ,THE0Q
63	REAL :: ROS,CS,DS,ROI,CI,DI &
64	,PL,THL,RDQ,RDTH,RDP,RDTHE &
65	,QS0,SQS,STHE,THE0
66	!!!tlb REAL :: PTBL,TTBL &
67	REAL :: WBD,SBD,TLM0D,TPH0D,R, CMLD,DP30 &
68	,X1P,Y1P,IXM,IYM
69	INTEGER :: NN, mype
70	REAL :: dt_from_file
71	REAL :: tstart_from_file, tend_from_file
72	real :: dtx
73	#ifdef DEREF_KLUDGE
74	! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
75	INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
76	INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x
77	INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y
78	#endif
79
80
81
82
83	!**********************************************************************
84	!
85	!*** Temporary fix for reading in lookup tables
86	!
87	INTEGER,PARAMETER :: ITB=76,JTB=134,ITBQ=152,JTBQ=440
88	REAL,DIMENSION(ITB,JTB) :: PTBL
89	REAL,DIMENSION(JTB,ITB) :: TTBL
90	REAL,DIMENSION(JTBQ,ITBQ) :: TTBLQ
91	!**********************************************************************
92	CHARACTER*256 mess
93	!----------------------------------------------------------------------
94	! small file with global dimensions
95	NAMELIST /PARMNMM/ IM,JM,LM,NSOIL,NROOT,INPES,JNPES
96	!
97	! another small file with forecast parameters
98	NAMELIST /FCSTDATA/ &
99	TSTART,TEND,RESTRT,SINGLRST,NMAP,TSHDE,SPL &
100	,NPHS,NCNVC,NRADSH,NRADLH,NTDDMP &
101	,TPREC,THEAT,TCLOD,TRDSW,TRDLW,TSRFC &
102	,NEST,HYDRO
103	!----------------------------------------------------------------------
104	!**********************************************************************
105	!----------------------------------------------------------------------
106	#include "deref_kludge.h"
107	#define COPY_IN
108	#include <nmm_scalar_derefs.inc>
109	#ifdef DM_PARALLEL
110	# include <nmm_data_calls.inc>
111	#endif
112
113	!
114	REWIND NUNIT_PARMETA
115	READ(NUNIT_PARMETA,PARMNMM)
116	NSOIL=4
117	write(0,*)' assigned nsoil=',nsoil
118	CALL wrf_debug ( 100 , 'nmm: read global dimensions file' )
119
120	! temporarily produce array limits here
121	! IDS=1
122	! IDE=IM
123	! JDS=1
124	! JDE=JM
125	! KDS=1
126	! KDE=LM
127
128	!----------------------------------------------------------------------
129	CALL get_ijk_from_grid ( grid , &
130	ids, ide, jds, jde, kds, kde, &
131	ims, ime, jms, jme, kms, kme, &
132	ips, ipe, jps, jpe, kps, kpe )
133
134	! GLOBAL GRID DIMS ARE WHAT WRF CONSIDERS UNSTAGGERED
135	ide = ide - 1
136	jde = jde - 1
137	kde = kde - 1
138	NSOIL=4
139
140	CALL wrf_debug(100,'in mediation_read_nmm')
141	WRITE(mess,*)'ids,ide,jds,jde,kds,kde ',ids,ide,jds,jde,kds,kde
142	CALL wrf_debug(100,mess)
143
144	!----------------------------------------------------------------------
145	! read constants file
146	write(0,*)' before allocates and nhb nsoil=',nsoil
147	ALLOCATE(TEMP1(1:NSOIL),STAT=I)
148	ALLOCATE(ITEMP(IDS:IDE,JDS:JDE),STAT=I)
149	ALLOCATE(TEMP(IDS:IDE,JDS:JDE),STAT=I)
150	ALLOCATE(HOLD(IDS:IDE,JDS:JDE,KDS:KDE),STAT=I)
151	!
152	!----------------------------------------------------------------------
153	! read z0 file
154	READ(NUNIT_Z0)TEMP
155	DO J=JDS,JDE
156	DO I=IDS,IDE
157	Z0(I,J)=TEMP(I,J)
158	ENDDO
159	ENDDO
160	!----------------------------------------------------------------------
161	!
162	READ(NUNIT_NHB) NFCST,NUNIT_NBC,LISTB,DT,IDTAD,SIGMA
163	write(0,*)' read_nmm sigma=',sigma
164	dt_from_file = dt
165	WRITE( mess, * ) 'NFCST = ',NFCST,' DT = ',DT
166	WRITE( 0, * ) 'NFCST = ',NFCST,' DT = ',DT,' NHB=',NUNIT_NHB
167	CALL wrf_debug(100, mess)
168	!----------------------------------------------------------------------
169	READ(NUNIT_NHB) ITEMP
170	DO J=JDS,JDE
171	DO I=IDS,IDE
172	LMH(I,J)=ITEMP(I,J)
173	ENDDO
174	ENDDO
175	!----------------------------------------------------------------------
176	READ(NUNIT_NHB) ITEMP
177	DO J=JDS,JDE
178	DO I=IDS,IDE
179	LMV(I,J)=ITEMP(I,J)
180	ENDDO
181	ENDDO
182	!----------------------------------------------------------------------
183	READ(NUNIT_NHB) TEMP
184	DO J=JDS,JDE
185	DO I=IDS,IDE
186	HBM2(I,J)=TEMP(I,J)
187	ENDDO
188	ENDDO
189	!----------------------------------------------------------------------
190	DO J=JDS,JDE
191	DO I=IDS,IDE
192	HBM3(I,J)=0.
193	ENDDO
194	ENDDO
195	!
196	DO J=JDS,JDE
197	IHWG(J)=MOD(J+1,2)-1
198	IF(J.GE.JDS+3.AND.J.LE.JDE-3)THEN
199	IHL=2-IHWG(J)
200	! IHWG=MOD(J+1,2)-1
201	! IHL=2-IHWG
202	IHL=2-IHWG(J)
203	IHH=IDE-2
204	DO I=IDS,IDE
205	IF(I.GE.IHL.AND.I.LE.IHH)HBM3(I,J)=1.
206	ENDDO
207	ENDIF
208	ENDDO
209	!----------------------------------------------------------------------
210	READ(NUNIT_NHB) TEMP
211	DO J=JDS,JDE
212	DO I=IDS,IDE
213	VBM2(I,J)=TEMP(I,J)
214	ENDDO
215	ENDDO
216	!----------------------------------------------------------------------
217	READ(NUNIT_NHB) TEMP
218	DO J=JDS,JDE
219	DO I=IDS,IDE
220	VBM3(I,J)=TEMP(I,J)
221	ENDDO
222	ENDDO
223	!----------------------------------------------------------------------
224	READ(NUNIT_NHB) TEMP
225	DO J=JDS,JDE
226	DO I=IDS,IDE
227	SM(I,J)=TEMP(I,J)
228	ENDDO
229	ENDDO
230	!----------------------------------------------------------------------
231	READ(NUNIT_NHB) TEMP
232	DO J=JDS,JDE
233	DO I=IDS,IDE
234	SICE(I,J)=TEMP(I,J)
235	ENDDO
236	ENDDO
237	!----------------------------------------------------------------------
238	DO K=KDE,KDS,-1
239	READ(NUNIT_NHB)((HOLD(I,J,K),I=IDS,IDE),J=JDS,JDE)
240	ENDDO
241	CALL wrf_debug ( 100 , 'nmm: read HTM into HOLD' )
242	DO K=KDS,KDE
243	DO J=JDS,JDE
244	DO I=IDS,IDE
245	HTM(I,K,J)=HOLD(I,J,K)
246	ENDDO
247	ENDDO
248	ENDDO
249	CALL wrf_debug ( 100 , 'nmm: read of record' )
250	!----------------------------------------------------------------------
251	DO K=KDE,KDS,-1
252	READ(NUNIT_NHB)((HOLD(I,J,K),I=IDS,IDE),J=JDS,JDE)
253	ENDDO
254	CALL wrf_debug ( 100 , 'nmm: read VTM into HOLD' )
255	DO K=KDS,KDE
256	DO J=JDS,JDE
257	DO I=IDS,IDE
258	VTM(I,K,J)=HOLD(I,J,K)
259	ENDDO
260	ENDDO
261	ENDDO
262	CALL wrf_debug ( 100 , 'nmm: read VTM' )
263	!----------------------------------------------------------------------
264	JAM=6+2*(JDE-JDS-9)
265	READ(NUNIT_NHB)DY_NMM,CPGFV,EN,ENT,R,PT,TDDAMP &
266	,F4D,F4Q,EF4T,PDTOP &
267	,(DETA(KME-K),K=KMS,KME-1) &
268	,(AETA(KME-K),K=KMS,KME-1) &
269	,(F4Q2(KME-K),K=KMS,KME-1) &
270	,(ETAX(KME+1-K),K=KMS,KME) &
271	,(DFL(KME+1-K),K=KMS,KME) &
272	,(DETA1(KME-K),K=KMS,KME-1) &
273	,(AETA1(KME-K),K=KMS,KME-1) &
274	,(ETA1(KME+1-K),K=KMS,KME) &
275	,(DETA2(KME-K),K=KMS,KME-1) &
276	,(AETA2(KME-K),K=KMS,KME-1) &
277	,(ETA2(KME+1-K),K=KMS,KME) &
278	,(EM(K),K=1,JAM) &
279	,(EMT(K),K=1,JAM)
280	CALL wrf_debug ( 100 , 'nmm: read NMM_DX_NMM' )
281	!----------------------------------------------------------------------
282	READ(NUNIT_NHB) TEMP
283	DO J=JDS,JDE
284	DO I=IDS,IDE
285	DX_NMM(I,J)=TEMP(I,J)
286	ENDDO
287	ENDDO
288	!----------------------------------------------------------------------
289	CALL wrf_debug ( 100 , 'nmm: read NMM_WPDAR' )
290	READ(NUNIT_NHB) TEMP
291	DO J=JDS,JDE
292	DO I=IDS,IDE
293	WPDAR(I,J)=TEMP(I,J)
294	ENDDO
295	ENDDO
296	!----------------------------------------------------------------------
297	CALL wrf_debug ( 100 , 'nmm: read NMM_CPGFU' )
298	READ(NUNIT_NHB) TEMP
299	DO J=JDS,JDE
300	DO I=IDS,IDE
301	CPGFU(I,J)=TEMP(I,J)
302	ENDDO
303	ENDDO
304	!----------------------------------------------------------------------
305	CALL wrf_debug ( 100 , 'nmm: read NMM_CURV' )
306	READ(NUNIT_NHB) TEMP
307	DO J=JDS,JDE
308	DO I=IDS,IDE
309	CURV(I,J)=TEMP(I,J)
310	ENDDO
311	ENDDO
312	!----------------------------------------------------------------------
313	CALL wrf_debug ( 100 , 'nmm: read NMM_FCP' )
314	READ(NUNIT_NHB) TEMP
315	DO J=JDS,JDE
316	DO I=IDS,IDE
317	FCP(I,J)=TEMP(I,J)
318	ENDDO
319	ENDDO
320	!----------------------------------------------------------------------
321	READ(NUNIT_NHB) TEMP
322	CALL wrf_debug ( 100 , 'nmm: read NMM_FDIV' )
323	DO J=JDS,JDE
324	DO I=IDS,IDE
325	FDIV(I,J)=TEMP(I,J)
326	ENDDO
327	ENDDO
328	!----------------------------------------------------------------------
329	READ(NUNIT_NHB) TEMP
330	CALL wrf_debug ( 100 , 'nmm: read NMM_FAD' )
331	DO J=JDS,JDE
332	DO I=IDS,IDE
333	FAD(I,J)=TEMP(I,J)
334	ENDDO
335	ENDDO
336	!----------------------------------------------------------------------
337	CALL wrf_debug ( 100 , 'nmm: read NMM_F' )
338	READ(NUNIT_NHB) TEMP
339	DO J=JDS,JDE
340	DO I=IDS,IDE
341	F(I,J)=TEMP(I,J)
342	ENDDO
343	ENDDO
344	!----------------------------------------------------------------------
345	CALL wrf_debug ( 100 , 'nmm: read NMM_DDMPU' )
346	READ(NUNIT_NHB) TEMP
347	DO J=JDS,JDE
348	DO I=IDS,IDE
349	DDMPU(I,J)=TEMP(I,J)
350	ENDDO
351	ENDDO
352	!----------------------------------------------------------------------
353	CALL wrf_debug ( 100 , 'nmm: read NMM_DDMPV' )
354	READ(NUNIT_NHB) TEMP
355	DO J=JDS,JDE
356	DO I=IDS,IDE
357	DDMPV(I,J)=TEMP(I,J)
358	ENDDO
359	ENDDO
360	!----------------------------------------------------------------------
361	CALL wrf_debug ( 100 , 'nmm: read NMM_GLAT' )
362	READ(NUNIT_NHB) PT, TEMP
363	DO J=JDS,JDE
364	DO I=IDS,IDE
365	GLAT(I,J)=TEMP(I,J)
366	ENDDO
367	ENDDO
368	!----------------------------------------------------------------------
369	CALL wrf_debug ( 100 , 'nmm: read NMM_GLON' )
370	READ(NUNIT_NHB) TEMP
371	DO J=JDS,JDE
372	DO I=IDS,IDE
373	GLON(I,J)=-TEMP(I,J)
374	ENDDO
375	ENDDO
376	!----------------------------------------------------------------------
377	CALL wrf_debug ( 100 , 'nmm: read PLQ,RDPQ,RDTHEQ,STHEQ,THE0Q' )
378	READ(NUNIT_NHB)PLQ,RDPQ,RDTHEQ,STHEQ,THE0Q
379	! ,(STHEQ(K),K=1,ITBQ) &
380	! ,(THE0Q(K),K=1,ITBQ)
381	!----------------------------------------------------------------------
382	CALL wrf_debug ( 100 , 'nmm: read ROS,CS,DS,ROI,CI,DI' )
383	READ(NUNIT_NHB)ROS,CS,DS,ROI,CI,DI &
384	,PL,THL,RDQ,RDTH,RDP,RDTHE &
385	,(DETA(KME-K),K=KMS,KME-1) &
386	,(AETA(KME-K),K=KMS,KME-1) &
387	,(DFRLG(KME+1-K),K=KMS,KME) &
388	,(DETA1(KME-K),K=KMS,KME-1) &
389	,(AETA1(KME-K),K=KMS,KME-1) &
390	,(DETA2(KME-K),K=KMS,KME-1) &
391	,(AETA2(KME-K),K=KMS,KME-1) &
392	,QS0,SQS,STHE,THE0
393	! ,(QS0(K),K=1,JTB) &
394	! ,(SQS(K),K=1,JTB) &
395	! ,(STHE(K),K=1,ITB) &
396	! ,(THE0(K),K=1,ITB)
397	!----------------------------------------------------------------------
398	READ(NUNIT_NHB) TEMP
399	DO J=JDS,JDE
400	DO I=IDS,IDE
401	MXSNAL(I,J)=TEMP(I,J)
402	ENDDO
403	ENDDO
404	!----------------------------------------------------------------------
405	READ(NUNIT_NHB) TEMP
406	DO J=JDS,JDE
407	DO I=IDS,IDE
408	EPSR(I,J)=TEMP(I,J)
409	ENDDO
410	ENDDO
411	!----------------------------------------------------------------------
412	READ(NUNIT_NHB) TEMP
413	DO J=JDS,JDE
414	DO I=IDS,IDE
415	TG(I,J)=TEMP(I,J)
416	ENDDO
417	ENDDO
418	!----------------------------------------------------------------------
419	READ(NUNIT_NHB) TEMP
420	DO J=JDS,JDE
421	DO I=IDS,IDE
422	GFFC(I,J)=TEMP(I,J)
423	ENDDO
424	ENDDO
425	!----------------------------------------------------------------------
426	READ(NUNIT_NHB) TEMP
427	DO J=JDS,JDE
428	DO I=IDS,IDE
429	SST(I,J)=TEMP(I,J)
430	ENDDO
431	ENDDO
432	!----------------------------------------------------------------------
433	READ(NUNIT_NHB) TEMP
434	DO J=JDS,JDE
435	DO I=IDS,IDE
436	ALBASE(I,J)=TEMP(I,J)
437	ENDDO
438	ENDDO
439	!----------------------------------------------------------------------
440	READ(NUNIT_NHB) TEMP
441	DO J=JDS,JDE
442	DO I=IDS,IDE
443	HDAC(I,J)=TEMP(I,J)
444	ENDDO
445	ENDDO
446	!----------------------------------------------------------------------
447	READ(NUNIT_NHB) TEMP
448	DO J=JDS,JDE
449	DO I=IDS,IDE
450	HDACV(I,J)=TEMP(I,J)
451	ENDDO
452	ENDDO
453	!----------------------------------------------------------------------
454	!!!tlb READ(NUNIT_NHB) TEMP
455	READ(NUNIT_NHB) TTBLQ
456	! DO J=JDS,JDE
457	! DO I=IDS,IDE
458	! TTBLQ(I,J)=TEMP(I,J)
459	! ENDDO
460	! ENDDO
461	!----------------------------------------------------------------------
462	CALL wrf_debug ( 100 , 'nmm: read PTBL,TTBL' )
463	READ(NUNIT_NHB)PTBL,TTBL &
464	,R,PT,TSPH &
465	,WBD,SBD,TLM0D,TPH0D,DLMD,DPHD,CMLD,DP30 &
466	,X1P,Y1P,IXM,IYM &
467	,(DETA(KME-K),K=KMS,KME-1) &
468	,(AETA(KME-K),K=KMS,KME-1) &
469	,(ETAX(KME+1-K),K=KMS,KME) &
470	,(DETA1(KME-K),K=KMS,KME-1) &
471	,(AETA1(KME-K),K=KMS,KME-1) &
472	,(ETA1(KME+1-K),K=KMS,KME) &
473	,(DETA2(KME-K),K=KMS,KME-1) &
474	,(AETA2(KME-K),K=KMS,KME-1) &
475	,(ETA2(KME+1-K),K=KMS,KME)
476	!----------------------------------------------------------------------
477	READ(NUNIT_NHB) ITEMP
478	DO J=JDS,JDE
479	DO I=IDS,IDE
480	IVGTYP(I,J)=ITEMP(I,J)
481	ENDDO
482	ENDDO
483	!----------------------------------------------------------------------
484	READ(NUNIT_NHB) ITEMP
485	DO J=JDS,JDE
486	DO I=IDS,IDE
487	ISLTYP(I,J)=ITEMP(I,J)
488	ENDDO
489	ENDDO
490	!----------------------------------------------------------------------
491	READ(NUNIT_NHB) ITEMP
492	DO J=JDS,JDE
493	DO I=IDS,IDE
494	ISLOPE(I,J)=ITEMP(I,J)
495	ENDDO
496	ENDDO
497	!----------------------------------------------------------------------
498	READ(NUNIT_NHB) TEMP
499	DO J=JDS,JDE
500	DO I=IDS,IDE
501	VEGFRC(I,J)=TEMP(I,J)
502	ENDDO
503	ENDDO
504	!----------------------------------------------------------------------
505	READ(NUNIT_NHB) (SLDPTH(N),N=1,NSOIL)
506	!----------------------------------------------------------------------
507	READ(NUNIT_NHB) (RTDPTH(N),N=1,NSOIL)
508	!----------------------------------------------------------------------
509	CALL wrf_debug ( 100 , 'nmm: read constants file' )
510
511	REWIND NUNIT_FCSTDATA
512	READ(NUNIT_FCSTDATA,FCSTDATA)
513	tstart_from_file = tstart
514	tend_from_file = tend
515	CALL wrf_debug ( 100 , 'nmm: read forecast parameters file' )
516	!----------------------------------------------------------------------
517
518	nrads = nint(nradsh*tsph)
519	nradl = nint(nradlh*tsph)
520	!----------------------------------------------------------------------
521	!
522	! INITIAL CONDITIONS
523	!
524	!----------------------------------------------------------------------
525	REWIND NFCST
526	READ(NFCST)RUN,IDAT,IHRST,NTSD
527	IF(NTSD.EQ.1)NTSD=0
528	!----------------------------------------------------------------------
529	READ(NFCST) TEMP
530	DO J=JDS,JDE
531	DO I=IDS,IDE
532	PD(I,J)=TEMP(I,J)
533	ENDDO
534	ENDDO
535	!----------------------------------------------------------------------
536	READ(NFCST) TEMP
537	DO J=JDS,JDE
538	DO I=IDS,IDE
539	RES(I,J)=TEMP(I,J)
540	ENDDO
541	ENDDO
542	!----------------------------------------------------------------------
543	READ(NFCST) TEMP
544	DO J=JDS,JDE
545	DO I=IDS,IDE
546	FIS(I,J)=TEMP(I,J)
547	ENDDO
548	ENDDO
549	CALL wrf_debug ( 100 , 'nmm: read FIS' )
550	!----------------------------------------------------------------------
551	DO K=KDE,KDS,-1
552	READ(NFCST)((HOLD(I,J,K),I=IDS,IDE),J=JDS,JDE)
553	ENDDO
554	CALL wrf_debug ( 100 , 'nmm: read U into HOLD' )
555	DO K=KDS,KDE
556	DO J=JDS,JDE
557	DO I=IDS,IDE
558	U(I,K,J)=HOLD(I,J,K)
559	ENDDO
560	ENDDO
561	ENDDO
562	CALL wrf_debug ( 100 , 'nmm: read U' )
563	!----------------------------------------------------------------------
564	DO K=KDE,KDS,-1
565	READ(NFCST)((HOLD(I,J,K),I=IDS,IDE),J=JDS,JDE)
566	ENDDO
567	DO K=KDS,KDE
568	DO J=JDS,JDE
569	DO I=IDS,IDE
570	V(I,K,J)=HOLD(I,J,K)
571	ENDDO
572	ENDDO
573	ENDDO
574	CALL wrf_debug ( 100 , 'nmm: read V' )
575	!----------------------------------------------------------------------
576	DO K=KDE,KDS,-1
577	READ(NFCST)((HOLD(I,J,K),I=IDS,IDE),J=JDS,JDE)
578	ENDDO
579	DO K=KDS,KDE
580	DO J=JDS,JDE
581	DO I=IDS,IDE
582	T(I,K,J)=HOLD(I,J,K)
583	ENDDO
584	ENDDO
585	ENDDO
586	CALL wrf_debug ( 100 , 'nmm: read T' )
587	!----------------------------------------------------------------------
588	DO K=KDE,KDS,-1
589	READ(NFCST)((HOLD(I,J,K),I=IDS,IDE),J=JDS,JDE)
590	ENDDO
591	DO K=KDS,KDE
592	DO J=JDS,JDE
593	DO I=IDS,IDE
594	Q(I,K,J)=HOLD(I,J,K)
595	ENDDO
596	ENDDO
597	ENDDO
598	CALL wrf_debug ( 100 , 'nmm: read Q' )
599	!----------------------------------------------------------------------
600	READ(NFCST)((SI(I,J),I=IDS,IDE),J=JDS,JDE)
601	READ(NFCST)((SNO(I,J),I=IDS,IDE),J=JDS,JDE)
602	! READ(NFCST)(((SMC(I,J,N),I=IDS,IDE),J=JDS,JDE),N=1,NSOIL)
603	READ(NFCST)(((hold(I,J,N),I=IDS,IDE),J=JDS,JDE),N=1,NSOIL)
604	do k=1,nsoil
605	do j=jds,jde
606	do i=ids,ide
607	smc(i,k,j)=hold(i,j,k)
608	enddo
609	enddo
610	enddo
611	READ(NFCST)((CMC(I,J),I=IDS,IDE),J=JDS,JDE)
612	! READ(NFCST)(((STC(I,J,N),I=IDS,IDE),J=JDS,JDE),N=1,NSOIL)
613	READ(NFCST)(((hold(I,J,N),I=IDS,IDE),J=JDS,JDE),N=1,NSOIL)
614	do k=1,nsoil
615	do j=jds,jde
616	do i=ids,ide
617	stc(i,k,j)=hold(i,j,k)
618	enddo
619	enddo
620	enddo
621	! READ(NFCST)(((SH2O(I,J,N),I=IDS,IDE),J=JDS,JDE),N=1,NSOIL)
622	READ(NFCST)(((hold(I,J,N),I=IDS,IDE),J=JDS,JDE),N=1,NSOIL)
623	do k=1,nsoil
624	do j=jds,jde
625	do i=ids,ide
626	sh2o(i,k,j)=hold(i,j,k)
627	! sh2o(i,k,j)=0.05
628	enddo
629	enddo
630	enddo
631	CALL wrf_debug ( 100 , 'nmm: read initial conditions file' )
632
633
634	!!!!!!!!!!!!!!!!!!!!!!!!!!
635	ENTRY med_read_nmm_bdy ( grid , config_flags , ntsd , dt_from_file, tstart_from_file, tend_from_file &
636	!
637	#include <nmm_dummy_args.inc>
638	!
639	)
640	!!!!!!!!!!!!!!!!!!!!!!!!!!
641
642
643
644	!----------------------------------------------------------------------
645	!*** READ BOUNDARY CONDITIONS.
646	!----------------------------------------------------------------------
647	!
648	DT = dt_from_file
649	CALL get_ijk_from_grid ( grid , &
650	ids, ide, jds, jde, kds, kde, &
651	ims, ime, jms, jme, kms, kme, &
652	ips, ipe, jps, jpe, kps, kpe )
653
654	! GLOBAL GRID DIMS ARE WHAT WRF CONSIDERS UNSTAGGERED
655	ide = ide - 1
656	jde = jde - 1
657	kde = kde - 1
658	NSOIL=4
659
660	CALL wrf_debug(100,'in mediation_read_nmm')
661	WRITE(mess,*)'ids,ide,jds,jde,kds,kde ',ids,ide,jds,jde,kds,kde
662	CALL wrf_debug(100,mess)
663
664	mype = 0
665	IF(MYPE.EQ.0)THEN
666	IF(NEST)THEN
667	KBI=2*IM+JM-3
668	KBI2=KBI-4
669	#ifdef DEC_ALPHA
670	LRECBC=(1+(1+6LM)KBI2+(KBI+KBI2)(LM+1))
671	#else
672	LRECBC=4(1+(1+6LM)KBI2+(KBI+KBI2)*(LM+1))
673	#endif
674	OPEN(UNIT=NUNIT_NBC,ACCESS='DIRECT',RECL=LRECBC)
675	read(nunit_nbc,rec=2) bchr
676	ENDIF
677	!
678	IF(.NOT.NEST)REWIND NUNIT_NBC
679	!
680	#ifdef DP_REAL
681	IF(NEST)THEN
682	READ(NUNIT_NBC,REC=1)RUNBX,IDATBX,IHRSTBX,TBOCO
683	ELSE
684	READ(NUNIT_NBC)RUNBX,IDATBX,IHRSTBX,TBOCO
685	ENDIF
686	!
687	RUNB=RUNBX
688	IDATB=IDATBX
689	IHRSTB=IHRSTBX
690	#else
691	IF(NEST)THEN
692	READ(NUNIT_NBC,REC=1)RUNB,IDATB,IHRSTB,TBOCO
693	ELSE
694	READ(NUNIT_NBC)RUNB,IDATB,IHRSTB,TBOCO
695	ENDIF
696	#endif
697	ENDIF
698	!
699	! CALL MPI_BCAST(RUNB,1,MPI_LOGICAL,0,MPI_COMM_COMP,IRTN)
700	! CALL MPI_BCAST(IDATB,3,MPI_INTEGER,0,MPI_COMM_COMP,IRTN)
701	! CALL MPI_BCAST(IHRSTB,1,MPI_INTEGER,0,MPI_COMM_COMP,IRTN)
702	! CALL MPI_BCAST(TBOCO,1,MPI_REAL,0,MPI_COMM_COMP,IRTN)
703	!
704	! CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
705	!
706	ISTART=NINT(TSTART)
707	LB=2*(IDE-IDS+1)+(JDE-JDS+1)-3
708	!
709
710	IF(MYPE.EQ.0.AND..NOT.NEST)THEN
711	!
712	READ(NUNIT_NBC)BCHR
713	205 READ(NUNIT_NBC)((PDB(N,I),N=1,LB),I=1,2)
714	READ(NUNIT_NBC)(((TB(N,K,I),N=1,LB),K=KDE,KDS,-1),I=1,2)
715	READ(NUNIT_NBC)(((QB(N,K,I),N=1,LB),K=KDE,KDS,-1),I=1,2)
716	READ(NUNIT_NBC)(((UB(N,K,I),N=1,LB),K=KDE,KDS,-1),I=1,2)
717	READ(NUNIT_NBC)(((VB(N,K,I),N=1,LB),K=KDE,KDS,-1),I=1,2)
718	READ(NUNIT_NBC)(((Q2B(N,K,I),N=1,LB),K=KDE,KDS,-1),I=1,2)
719	READ(NUNIT_NBC)(((CWMB(N,K,I),N=1,LB),K=KDE,KDS,-1),I=1,2)
720	!
721	IF(ISTART.EQ.NINT(BCHR))THEN
722	IF(ISTART.GT.0)READ(NUNIT_NBC)BCHR
723	GO TO 215
724	ELSE
725	READ(NUNIT_NBC)BCHR
726	ENDIF
727	!
728	write(0,*)' read_nmm istart=',istart,' bchr=',bchr,' tsph=',tsph
729	IF(ISTART.GE.NINT(BCHR))THEN
730	GO TO 205
731	ELSEIF(ISTART.LT.NINT(BCHR))THEN
732	TSTEPS=ISTART*TSPH
733	!
734	DO N=1,LB
735	if(n==5.or.n==6)then
736	write(0,*)' read_nmm i=',i,' pdb(1)=',pdb(n,1),' pdb(2)=',pdb(n,2),' dt=',dt,' tsteps=',tsteps
737	endif
738	PDB(N,1)=PDB(N,1)+PDB(N,2)DTTSTEPS
739	ENDDO
740	!
741	DO K=1,LM
742	DO N=1,LB
743	TB(N,K,1)=TB(N,K,1)+TB(N,K,2)DTTSTEPS
744	QB(N,K,1)=QB(N,K,1)+QB(N,K,2)DTTSTEPS
745	UB(N,K,1)=UB(N,K,1)+UB(N,K,2)DTTSTEPS
746	VB(N,K,1)=VB(N,K,1)+VB(N,K,2)DTTSTEPS
747	Q2B(N,K,1)=Q2B(N,K,1)+Q2B(N,K,2)DTTSTEPS
748	CWMB(N,K,1)=CWMB(N,K,1)+CWMB(N,K,2)DTTSTEPS
749	ENDDO
750	ENDDO
751	GO TO 215
752	ENDIF
753	ENDIF
754	!
755	IF(MYPE.EQ.0.AND.NEST)THEN
756	NREC=1
757	!
758	210 NREC=NREC+1
759	READ(NUNIT_NBC,REC=NREC)BCHR
760	!
761	IF(ISTART.EQ.NINT(BCHR))THEN
762	!!!!! IF(ISTART.GT.0)READ(NUNIT_NBC,REC=NREC+1)BCHR
763	GO TO 215
764	ELSE
765	GO TO 210
766	ENDIF
767	ENDIF
768	!
769	215 CONTINUE
770
771	IF(NTSD.EQ.0)THEN
772	IF(MYPE.EQ.0.AND..NOT.NEST.AND.ISTART.GE.NINT(BCHR))THEN
773	BACKSPACE NUNIT_NBC
774	BACKSPACE NUNIT_NBC
775	BACKSPACE NUNIT_NBC
776	BACKSPACE NUNIT_NBC
777	BACKSPACE NUNIT_NBC
778	BACKSPACE NUNIT_NBC
779	BACKSPACE NUNIT_NBC
780	! WRITE(LIST,*)' BACKSPACE UNIT NBC=',NUNIT_NBC
781	ENDIF
782	ENDIF
783
784	IF(MYPE.EQ.0.AND.NEST)THEN
785	NREC=NINT(((NTSD-1)*DT)/3600.)+2
786	READ(NUNIT_NBC,REC=NREC)BCHR &
787	,((PDB(N,NN),N=1,LB),NN=1,2) &
788	,(((TB(N,K,NN),N=1,LB),K=KDE,KDS,-1),NN=1,2) &
789	,(((QB(N,K,NN),N=1,LB),K=KDE,KDS,-1),NN=1,2) &
790	,(((UB(N,K,NN),N=1,LB),K=KDE,KDS,-1),NN=1,2) &
791	,(((VB(N,K,NN),N=1,LB),K=KDE,KDS,-1),NN=1,2) &
792	,(((Q2B(N,K,NN),N=1,LB),K=KDE,KDS,-1),NN=1,2) &
793	,(((CWMB(N,K,NN),N=1,LB),K=KDE,KDS,-1),NN=1,2)
794	ENDIF
795
796	! Copy the bounary into the WRF framework boundary data structs
797
798	N=1
799	!
800	!*** SOUTH BOUNDARY
801	!
802	DO I=1,IDE
803	PD_B(I,1,1,P_YSB) = PDB(N,1)
804	PD_BT(I,1,1,P_YSB) = PDB(N,2)
805	N=N+1
806	ENDDO
807	!
808	!*** NORTH BOUNDARY
809	!
810	DO I=1,IDE
811	PD_B(I,1,1,P_YEB) = PDB(N,1)
812	PD_BT(I,1,1,P_YEB) = PDB(N,2)
813	N=N+1
814	ENDDO
815	!
816	!*** WEST BOUNDARY
817	!
818	DO J=3,JDE-2,2
819	PD_B(J,1,1,P_XSB) = PDB(N,1)
820	PD_BT(J,1,1,P_XSB) = PDB(N,2)
821	N=N+1
822	ENDDO
823	!
824	!*** EAST BOUNDARY
825	!
826	DO J=3,JDE-2,2
827	PD_B(J,1,1,P_XEB) = PDB(N,1)
828	PD_BT(J,1,1,P_XEB) = PDB(N,2)
829	N=N+1
830	ENDDO
831	!
832	DO K=KDS,KDE
833	N=1
834	!
835	!*** SOUTH BOUNDARY
836	!
837	DO I=1,IDE
838	T_B(I,k,1,P_YSB) = TB(N,k,1)
839	T_BT(I,k,1,P_YSB) = TB(N,k,2)
840	Q_B(I,k,1,P_YSB) = QB(N,k,1)
841	Q_BT(I,k,1,P_YSB) = QB(N,k,2)
842	Q2_B(I,k,1,P_YSB) = Q2B(N,k,1)
843	Q2_BT(I,k,1,P_YSB) = Q2B(N,k,2)
844	CWM_B(I,k,1,P_YSB) = CWMB(N,k,1)
845	CWM_BT(I,k,1,P_YSB) = CWMB(N,k,2)
846	N=N+1
847	ENDDO
848	!
849	!*** NORTH BOUNDARY
850	!
851	DO I=1,IDE
852	T_B(I,k,1,P_YEB) = TB(N,k,1)
853	T_BT(I,k,1,P_YEB) = TB(N,k,2)
854	Q_B(I,k,1,P_YEB) = QB(N,k,1)
855	Q_BT(I,k,1,P_YEB) = QB(N,k,2)
856	Q2_B(I,k,1,P_YEB) = Q2B(N,k,1)
857	Q2_BT(I,k,1,P_YEB) = Q2B(N,k,2)
858	CWM_B(I,k,1,P_YEB) = CWMB(N,k,1)
859	CWM_BT(I,k,1,P_YEB) = CWMB(N,k,2)
860	N=N+1
861	ENDDO
862	!
863	!*** WEST BOUNDARY
864	!
865	DO J=3,JDE-2,2
866	T_B(J,k,1,P_XSB) = TB(N,k,1)
867	T_BT(J,k,1,P_XSB) = TB(N,k,2)
868	Q_B(J,k,1,P_XSB) = QB(N,k,1)
869	Q_BT(J,k,1,P_XSB) = QB(N,k,2)
870	Q2_B(J,k,1,P_XSB) = Q2B(N,k,1)
871	Q2_BT(J,k,1,P_XSB) = Q2B(N,k,2)
872	CWM_B(J,k,1,P_XSB) = CWMB(N,k,1)
873	CWM_BT(J,k,1,P_XSB) = CWMB(N,k,2)
874	N=N+1
875	ENDDO
876	!
877	!*** EAST BOUNDARY
878	!
879	DO J=3,JDE-2,2
880	T_B(J,k,1,P_XEB) = TB(N,k,1)
881	T_BT(J,k,1,P_XEB) = TB(N,k,2)
882	if(k.eq.1.and.j.eq.79)then
883	write(0,62510)ntsd,nrec
884	write(0,62511)p_xeb,t_b(j,k,1,p_xeb),t_bt(j,k,1,p_xeb)
885	62510 format(' ntsd=',i5,' nrec=',i5)
886	62511 format(' p_xeb=',i2,' t_b=',z8,' t_bt=',z8)
887	endif
888	Q_B(J,k,1,P_XEB) = QB(N,k,1)
889	Q_BT(J,k,1,P_XEB) = QB(N,k,2)
890	Q2_B(J,k,1,P_XEB) = Q2B(N,k,1)
891	Q2_BT(J,k,1,P_XEB) = Q2B(N,k,2)
892	CWM_B(J,k,1,P_XEB) = CWMB(N,k,1)
893	CWM_BT(J,k,1,P_XEB) = CWMB(N,k,2)
894	N=N+1
895	ENDDO
896	ENDDO
897
898	DO K=KDS,KDE
899	N=1
900	!
901	!*** SOUTH BOUNDARY
902	!
903	DO I=1,IDE-1
904	U_B(I,k,1,P_YSB) = UB(N,k,1)
905	U_BT(I,k,1,P_YSB) = UB(N,k,2)
906	V_B(I,k,1,P_YSB) = VB(N,k,1)
907	V_BT(I,k,1,P_YSB) = VB(N,k,2)
908	N=N+1
909	ENDDO
910	!
911	!*** NORTH BOUNDARY
912	!
913	DO I=1,IDE-1
914	U_B(I,k,1,P_YEB) = UB(N,k,1)
915	U_BT(I,k,1,P_YEB) = UB(N,k,2)
916	V_B(I,k,1,P_YEB) = VB(N,k,1)
917	V_BT(I,k,1,P_YEB) = VB(N,k,2)
918	N=N+1
919	ENDDO
920	!
921	!*** WEST BOUNDARY
922	!
923	DO J=2,JDE-1,2
924	U_B(J,k,1,P_XSB) = UB(N,k,1)
925	U_BT(J,k,1,P_XSB) = UB(N,k,2)
926	V_B(J,k,1,P_XSB) = VB(N,k,1)
927	V_BT(J,k,1,P_XSB) = VB(N,k,2)
928	N=N+1
929	ENDDO
930	!
931	!*** EAST BOUNDARY
932	!
933	DO J=2,JDE-1,2
934	U_B(J,k,1,P_XEB) = UB(N,k,1)
935	U_BT(J,k,1,P_XEB) = UB(N,k,2)
936	V_B(J,k,1,P_XEB) = VB(N,k,1)
937	V_BT(J,k,1,P_XEB) = VB(N,k,2)
938	N=N+1
939	ENDDO
940	ENDDO
941
942	!
943	! CALL MPI_BCAST(BCHR,1,MPI_REAL,0,MPI_COMM_COMP,IRTN)
944	!
945	! CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
946	!
947	! IF(MYPE.EQ.0)WRITE(LIST,*)' READ UNIT NBC=',NUNIT_NBC
948	!
949	!***
950	!*** COMPUTE THE 1ST TIME FOR BOUNDARY CONDITION READ
951	!***
952	!
953	! NBOCO=NINT(BCHR*TSPH)
954	!
955
956	!
957
958	DEALLOCATE(TEMP1,STAT=I)
959	DEALLOCATE(ITEMP,STAT=I)
960	DEALLOCATE(TEMP,STAT=I)
961	DEALLOCATE(HOLD,STAT=I)
962
963	CALL wrf_debug ( 100 , 'nmm: returnomatic' )
964
965	#define COPY_OUT
966	#include <nmm_scalar_derefs.inc>
967
968	RETURN
969	END SUBROUTINE med_read_nmm
970

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

Download in other formats:

Original Format