read_nmm.F
References to this file elsewhere.
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+6*LM)*KBI*2+(KBI+KBI2)*(LM+1))
671 #else
672 LRECBC=4*(1+(1+6*LM)*KBI*2+(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)*DT*TSTEPS
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)*DT*TSTEPS
744 QB(N,K,1)=QB(N,K,1)+QB(N,K,2)*DT*TSTEPS
745 UB(N,K,1)=UB(N,K,1)+UB(N,K,2)*DT*TSTEPS
746 VB(N,K,1)=VB(N,K,1)+VB(N,K,2)*DT*TSTEPS
747 Q2B(N,K,1)=Q2B(N,K,1)+Q2B(N,K,2)*DT*TSTEPS
748 CWMB(N,K,1)=CWMB(N,K,1)+CWMB(N,K,2)*DT*TSTEPS
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