4244
4245
4246
4247
4248
4249
4250
4251 USE module_domain, ONLY : domain
4252# ifdef WRF_TIMEAVG
4254# endif
4255
4256
4257
4258 integer, intent(out) :: rc
4259
4260 TYPE (domain), intent(in) :: grid
4261 TYPE (ESMF_GridComp) :: model
4262
4263
4264
4265 integer :: ifld, i, is, j, ng
4266 integer :: Istr, Iend, Jstr, Jend
4267 integer :: year, month, day, hour, minutes, seconds, sN, SD
4268 integer :: LakeValue, LandValue
4269 integer :: ExportCount
4270 integer :: localDE, localDEcount, localPET, PETcount
4271# ifdef WRF_TIMEAVG
4272 integer :: mean_interval
4273# endif
4274
4275 real (dp), parameter :: eps = 1.0e-10_dp
4276 real (dp), parameter :: StBolt = 5.67051e-8_dp
4277 real (dp), parameter :: z1 = 3.0_dp
4278
4279 real (dp) :: Fseconds, TimeInDays, Time_Current
4280 real (dp) :: cff1, cff2, cff3, f1, scale
4281 real (dp) :: MyFmax(1), MyFmin(1), Fmin(1), Fmax(1), Fval
4282
4283 real (dp), pointer :: ptr2d(:,:) => null()
4284
4285 character (len=22) :: Time_CurrentString
4286# ifdef WRF_TIMEAVG
4287 character (len=35) :: Istring
4288# endif
4289 character (len=*), parameter :: MyFile = &
4290 & __FILE__//", WRF_Export"
4291
4292 character (ESMF_MAXSTR) :: cname, ofile
4293 character (ESMF_MAXSTR), allocatable :: ExportNameList(:)
4294
4295 TYPE (ESMF_Clock) :: clock
4296 TYPE (ESMF_Field) :: field
4297 TYPE (ESMF_State) :: ExportState
4298 TYPE (ESMF_Time) :: CurrentTime
4299 TYPE (ESMF_VM) :: vm
4300
4301
4302
4303
4304
4305 IF (esm_track) THEN
4306 WRITE (trac,'(a,a,i0)') '==> Entering WRF_Export', &
4307 & ', PET', petrank
4308 FLUSH (trac)
4309 END IF
4310 rc=esmf_success
4311
4312
4313
4314
4315
4316 CALL esmf_gridcompget (model, &
4317 & exportstate=exportstate, &
4318 & clock=clock, &
4319 & localpet=localpet, &
4320 & petcount=petcount, &
4321 & vm=vm, &
4322 & name=cname, &
4323 & rc=rc)
4324 IF (esmf_logfounderror(rctocheck=rc, &
4325 & msg=esmf_logerr_passthru, &
4326 & line=__line__, &
4327 & file=myfile)) THEN
4328 RETURN
4329 END IF
4330 ng=grid%grid_id
4331
4332
4333
4334
4335
4336 CALL esmf_gridget (models(iatmos)%grid(ng), &
4337 & localdecount=localdecount, &
4338 & rc=rc)
4339 IF (esmf_logfounderror(rctocheck=rc, &
4340 & msg=esmf_logerr_passthru, &
4341 & line=__line__, &
4342 & file=myfile)) THEN
4343 RETURN
4344 END IF
4345
4346
4347
4348
4349
4350
4351 lakevalue=1
4352 landvalue=1
4353
4354
4355
4356
4357
4358 CALL esmf_clockget (clock, &
4359 & currtime=currenttime, &
4360 & rc=rc)
4361 IF (esmf_logfounderror(rctocheck=rc, &
4362 & msg=esmf_logerr_passthru, &
4363 & line=__line__, &
4364 & file=myfile)) THEN
4365 RETURN
4366 END IF
4367
4368 CALL esmf_timeget (currenttime, &
4369 & yy=year, &
4370 & mm=month, &
4371 & dd=day, &
4372 & h =hour, &
4373 & m =minutes, &
4374 & s =seconds, &
4375 & sn=sn, &
4376 & sd=sd, &
4377 & rc=rc)
4378 IF (esmf_logfounderror(rctocheck=rc, &
4379 & msg=esmf_logerr_passthru, &
4380 & line=__line__, &
4381 & file=myfile)) THEN
4382 RETURN
4383 END IF
4384
4385 CALL esmf_timeget (currenttime, &
4386 & s_r8=time_current, &
4387 & timestring=time_currentstring, &
4388 & rc=rc)
4389 IF (esmf_logfounderror(rctocheck=rc, &
4390 & msg=esmf_logerr_passthru, &
4391 & line=__line__, &
4392 & file=myfile)) THEN
4393 RETURN
4394 END IF
4395 fseconds=real(seconds,dp)+real(sn,dp)/real(sd,dp)
4396 timeindays=time_current/86400.0_dp
4397 is=index(time_currentstring, 'T')
4398 IF (is.gt.0) time_currentstring(is:is)=' '
4399
4400# ifdef WRF_TIMEAVG
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426 IF (grid%mean_diag.ne.1) THEN
4427 IF (localpet.eq.0) THEN
4428 WRITE (cplout,10) 'namelist &time_control, mean_diag = ', &
4429 & grid%mean_diag,
uppercase(
'wrf_timeavg')
4430 END IF
4431 rc=esmf_rc_not_valid
4432 IF (esmf_logfounderror(rctocheck=rc, &
4433 & msg=esmf_logerr_passthru, &
4434 & line=__line__, &
4435 & file=myfile)) THEN
4436 RETURN
4437 END IF
4438
4439
4440
4441
4442 ELSE
4443 IF (grid%mean_diag_interval.gt.0) THEN
4444 istring='namelist: mean_diag_interval = '
4445 mean_interval=grid%mean_diag_interval*60
4446 ELSE IF (grid%mean_diag_interval_s.gt.0) THEN
4447 istring='namelist: mean_diag_interval_s = '
4448 mean_interval=grid%mean_diag_interval_s
4449 ELSE IF (grid%mean_diag_interval_m.gt.0) THEN
4450 istring='namelist: mean_diag_interval_m = '
4451 mean_interval=grid%mean_diag_interval_m*60
4452 ELSE IF (grid%mean_diag_interval_h.gt.0) THEN
4453 istring='namelist: mean_diag_interval_h = '
4454 mean_interval=grid%mean_diag_interval_h*3600
4455 ELSE IF (grid%mean_diag_interval_d.gt.0) THEN
4456 istring='namelist: mean_diag_interval_d = '
4457 mean_interval=grid%mean_diag_interval_d*86400
4458 ELSE IF (grid%mean_diag_interval_mo.gt.0) THEN
4459 istring='namelist: mean_diag_interval_mo = '
4460 mean_interval=grid%mean_diag_interval_mo*30*86400
4461 END IF
4462
4463 IF (mean_interval.ne.int(clockinfo(iatmos)%Time_Step)) THEN
4464 IF (localpet.eq.0) THEN
4465 WRITE (cplout,20) trim(istring), &
4466 & mean_interval, &
4467 & trim(cinpname), &
4468 & int(clockinfo(iatmos)%Time_Step)
4469 END IF
4470 rc=esmf_rc_val_wrong
4471 IF (esmf_logfounderror(rctocheck=rc, &
4472 & msg=esmf_logerr_passthru, &
4473 & line=__line__, &
4474 & file=myfile)) THEN
4475 RETURN
4476 END IF
4477 END IF
4478 END IF
4479# endif
4480
4481
4482
4483
4484
4485 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
4486 & itemcount=exportcount, &
4487 & rc=rc)
4488 IF (esmf_logfounderror(rctocheck=rc, &
4489 & msg=esmf_logerr_passthru, &
4490 & line=__line__, &
4491 & file=myfile)) THEN
4492 RETURN
4493 END IF
4494
4495 IF (.not. allocated(exportnamelist)) THEN
4496 allocate ( exportnamelist(exportcount) )
4497 END IF
4498 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
4499 & itemnamelist=exportnamelist, &
4500 & rc=rc)
4501 IF (esmf_logfounderror(rctocheck=rc, &
4502 & msg=esmf_logerr_passthru, &
4503 & line=__line__, &
4504 & file=myfile)) THEN
4505 RETURN
4506 END IF
4507
4508
4509
4510
4511
4512 fld_loop : DO ifld=1,exportcount
4513
4514
4515
4516 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
4517 & trim(exportnamelist(ifld)), &
4518 & field, &
4519 & rc=rc)
4520 IF (esmf_logfounderror(rctocheck=rc, &
4521 & msg=esmf_logerr_passthru, &
4522 & line=__line__, &
4523 & file=myfile)) THEN
4524 RETURN
4525 END IF
4526
4527
4528
4529
4530 de_loop : DO localde=0,localdecount-1
4531 CALL esmf_fieldget (field, &
4532 & localde=localde, &
4533 & farrayptr=ptr2d, &
4534 & rc=rc)
4535 IF (esmf_logfounderror(rctocheck=rc, &
4536 & msg=esmf_logerr_passthru, &
4537 & line=__line__, &
4538 & file=myfile)) THEN
4539 RETURN
4540 END IF
4541 istr=lbound(ptr2d,1)
4542 iend=ubound(ptr2d,1)
4543 jstr=lbound(ptr2d,2)
4544 jend=ubound(ptr2d,2)
4545
4546
4547
4548 ptr2d=missing_dp
4549
4550
4551
4552
4553
4554
4555
4556
4557 SELECT CASE (trim(adjustl(exportnamelist(ifld))))
4558
4559
4560
4561
4562 CASE ('psfc', 'Pair')
4563 myfmin(1)= missing_dp
4564 myfmax(1)=-missing_dp
4565 DO j=jstr,jend
4566 DO i=istr,iend
4567# ifdef WRF_TIMEAVG
4568 fval=real(grid%psfc_mean(i,j),dp)* &
4569 & exp((9.81_dp*real(grid%ht(i,j),dp))/ &
4570 & (287.0_dp*real(grid%t2_mean(i,j),dp)* &
4571 & (1.0_dp+0.61_dp*real(grid%q2_mean(i,j),dp))))
4572# else
4573 fval=real(grid%psfc(i,j),dp)* &
4574 & exp((9.81_dp*real(grid%ht(i,j),dp))/ &
4575 & (287.0_dp*real(grid%t2(i,j),dp)* &
4576 & (1.0_dp+0.61_dp*real(grid%q2(i,j),dp))))
4577# endif
4578 myfmin(1)=min(myfmin(1),fval)
4579 myfmax(1)=max(myfmax(1),fval)
4580 ptr2d(i,j)=fval
4581 END DO
4582 END DO
4583
4584
4585
4586 CASE ('tsfc', 'Tair')
4587 myfmin(1)= missing_dp
4588 myfmax(1)=-missing_dp
4589 DO j=jstr,jend
4590 DO i=istr,iend
4591# ifdef WRF_TIMEAVG
4592 fval=real(grid%t2_mean(i,j),dp)
4593# else
4594 fval=real(grid%t2(i,j),dp)
4595# endif
4596 myfmin(1)=min(myfmin(1),fval)
4597 myfmax(1)=max(myfmax(1),fval)
4598 ptr2d(i,j)=fval
4599 END DO
4600 END DO
4601
4602
4603
4604
4605
4606
4607
4608 CASE ('Hair')
4609 myfmin(1)= missing_dp
4610 myfmax(1)=-missing_dp
4611 DO j=jstr,jend
4612 DO i=istr,iend
4613# ifdef WRF_TIMEAVG
4614 cff1=real(grid%psfc_mean(i,j),dp)/ &
4615 & (exp((9.81_dp*2.0_dp)/ &
4616 & (287.0_dp*real(grid%t2_mean(i,j),dp))))
4617 fval=real(grid%q2_mean(i,j),dp)*cff1/ &
4618 & (real(grid%q2_mean(i,j),dp)* &
4619 & (1.0_dp-0.622_dp)+0.622_dp)
4620# else
4621 cff1=real(grid%psfc(i,j),dp)/ &
4622 & (exp((9.81_dp*2.0_dp)/ &
4623 & (287.0_dp*real(grid%t2(i,j),dp))))
4624 fval=real(grid%q2(i,j),dp)*cff1/ &
4625 & (real(grid%q2(i,j),dp)* &
4626 & (1.0_dp-0.622_dp)+0.622_dp)
4627# endif
4628 myfmin(1)=min(myfmin(1),fval)
4629 myfmax(1)=max(myfmax(1),fval)
4630 ptr2d(i,j)=fval
4631 END DO
4632 END DO
4633
4634
4635
4636
4637
4638
4639 CASE ('qsfc', 'Qair')
4640 myfmin(1)= missing_dp
4641 myfmax(1)=-missing_dp
4642 DO j=jstr,jend
4643 DO i=istr,iend
4644# ifdef WRF_TIMEAVG
4645 cff1=real(grid%psfc_mean(i,j),dp)/ &
4646 & (exp((9.81_dp*2.0_dp)/ &
4647 & (287.0_dp*real(grid%t2_mean(i,j),dp))))
4648 cff2=real(grid%q2_mean(i,j),dp)*cff1/ &
4649 & (real(grid%q2_mean(i,j),dp)* &
4650 & (1.0_dp-0.622_dp)+0.622_dp)
4651 cff3=6.112_dp* &
4652 & exp((17.67_dp*(real(grid%t2_mean(i,j),dp)- &
4653 & 273.15_dp))/ &
4654 & ((real(grid%t2_mean(i,j),dp)-273.15_dp)+ &
4655 & 243.5_dp))
4656# else
4657 cff1=real(grid%psfc(i,j),dp)/ &
4658 & (exp((9.81_dp*2.0_dp)/ &
4659 & (287.0_dp*real(grid%t2(i,j),dp))))
4660 cff2=real(grid%q2(i,j),dp)*cff1/ &
4661 & (real(grid%q2(i,j),dp)* &
4662 & (1.0_dp-0.622_dp)+0.622_dp)
4663 cff3=6.112_dp* &
4664 & exp((17.67_dp*(real(grid%t2(i,j),dp)- &
4665 & 273.15_dp))/ &
4666 & ((real(grid%t2(i,j),dp)-273.15_dp)+ &
4667 & 243.5_dp))
4668# endif
4669 fval=cff2/cff3
4670 myfmin(1)=min(myfmin(1),fval)
4671 myfmax(1)=max(myfmax(1),fval)
4672 ptr2d(i,j)=fval
4673 END DO
4674 END DO
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714 CASE ('nflx', 'shflux')
4715 myfmin(1)= missing_dp
4716 myfmax(1)=-missing_dp
4717
4718
4719 DO j=jstr,jend
4720 DO i=istr,iend
4721# ifdef WRF_TIMEAVG
4722 fval=(real(grid%swdnb_mean(i,j),dp)- &
4723 REAL(grid%swupb_mean(i,j),dp))+ &
4724 & (REAL(grid%glw_mean(i,j),dp)- &
4725 & REAL(grid%lwupb_mean(i,j),dp))- &
4726 & REAL(grid%lh_mean (i,j),dp)- &
4727 & REAL(grid%hfx_mean(i,j),dp)
4728# else
4729 fval=(real(grid%swdnb(i,j),dp)- &
4730 & real(grid%swupb(i,j),dp))+ &
4731 & (real(grid%glw(i,j),dp)- &
4732 & real(grid%lwupb(i,j),dp))- &
4733 & real(grid%lh (i,j),dp)- &
4734 & real(grid%hfx(i,j),dp)
4735# endif
4736# ifdef ONLY_OCEAN_FLUXES
4737 IF ((int(grid%landmask(i,j)).ne.landvalue)) THEN
4738 myfmin(1)=min(myfmin(1),fval)
4739 myfmax(1)=max(myfmax(1),fval)
4740 ptr2d(i,j)=fval
4741 ELSE
4742 ptr2d(i,j)=missing_dp
4743 END IF
4744# else
4745 myfmin(1)=min(myfmin(1),fval)
4746 myfmax(1)=max(myfmax(1),fval)
4747 ptr2d(i,j)=fval
4748# endif
4749 END DO
4750 END DO
4751
4752
4753
4754
4755 CASE ('lwrd', 'LWrad')
4756 myfmin(1)= missing_dp
4757 myfmax(1)=-missing_dp
4758 DO j=jstr,jend
4759 DO i=istr,iend
4760# ifdef WRF_TIMEAVG
4761 fval=real(grid%glw_mean(i,j),dp)- &
4762 & real(grid%lwupb_mean(i,j),dp)
4763# else
4764 fval=real(grid%glw(i,j),dp)- &
4765 & real(grid%lwupb(i,j),dp)
4766# endif
4767 myfmin(1)=min(myfmin(1),fval)
4768 myfmax(1)=max(myfmax(1),fval)
4769 ptr2d(i,j)=fval
4770 END DO
4771 END DO
4772
4773
4774
4775 CASE ('dlwrd', 'dLWrad', 'lwrad_down')
4776 myfmin(1)= missing_dp
4777 myfmax(1)=-missing_dp
4778 DO j=jstr,jend
4779 DO i=istr,iend
4780# ifdef WRF_TIMEAVG
4781 fval=real(grid%glw_mean(i,j),dp)
4782# else
4783 fval=real(grid%glw(i,j),dp)
4784# endif
4785 myfmin(1)=min(myfmin(1),fval)
4786 myfmax(1)=max(myfmax(1),fval)
4787 ptr2d(i,j)=fval
4788 END DO
4789 END DO
4790
4791
4792
4793
4794 CASE ('swrd', 'SWrad')
4795 myfmin(1)= missing_dp
4796 myfmax(1)=-missing_dp
4797 DO j=jstr,jend
4798 DO i=istr,iend
4799# ifdef WRF_TIMEAVG
4800 fval=real(grid%swdnb_mean(i,j),dp)- &
4801 & real(grid%swupb_mean(i,j),dp)
4802# else
4803 fval=real(grid%swdnb(i,j),dp)- &
4804 & real(grid%swupb(i,j),dp)
4805# endif
4806 myfmin(1)=min(myfmin(1),fval)
4807 myfmax(1)=max(myfmax(1),fval)
4808 ptr2d(i,j)=fval
4809 END DO
4810 END DO
4811
4812
4813
4814 CASE ('dswrd', 'dSWrad')
4815 myfmin(1)= missing_dp
4816 myfmax(1)=-missing_dp
4817 DO j=jstr,jend
4818 DO i=istr,iend
4819# ifdef WRF_TIMEAVG
4820 fval=real(grid%swdnb_mean(i,j),dp)
4821# else
4822 fval=real(grid%swdnb(i,j),dp)
4823# endif
4824 myfmin(1)=min(myfmin(1),fval)
4825 myfmax(1)=max(myfmax(1),fval)
4826 ptr2d(i,j)=fval
4827 END DO
4828 END DO
4829
4830
4831
4832 CASE ('lhfx', 'LHfx')
4833 myfmin(1)= missing_dp
4834 myfmax(1)=-missing_dp
4835# ifndef BULK_FLUXES
4836 scale=-1.0_dp
4837# else
4838 scale=1.0_dp
4839# endif
4840 DO j=jstr,jend
4841 DO i=istr,iend
4842# ifdef WRF_TIMEAVG
4843 fval=scale*real(grid%lh_mean(i,j),dp)
4844# else
4845 fval=scale*real(grid%lh(i,j),dp)
4846# endif
4847 myfmin(1)=min(myfmin(1),fval)
4848 myfmax(1)=max(myfmax(1),fval)
4849 ptr2d(i,j)=fval
4850 END DO
4851 END DO
4852
4853
4854
4855 CASE ('shfx', 'SHfx')
4856 myfmin(1)= missing_dp
4857 myfmax(1)=-missing_dp
4858# ifndef BULK_FLUXES
4859 scale=-1.0_dp
4860# else
4861 scale=1.0_dp
4862# endif
4863 DO j=jstr,jend
4864 DO i=istr,iend
4865# ifdef WRF_TIMEAVG
4866 fval=scale*real(grid%hfx_mean(i,j),dp)
4867# else
4868 fval=scale*real(grid%hfx(i,j),dp)
4869# endif
4870 myfmin(1)=min(myfmin(1),fval)
4871 myfmax(1)=max(myfmax(1),fval)
4872 ptr2d(i,j)=fval
4873 END DO
4874 END DO
4875
4876
4877
4878 CASE ('swflux')
4879 myfmin(1)= missing_dp
4880 myfmax(1)=-missing_dp
4881 DO j=jstr,jend
4882 DO i=istr,iend
4883 fval=real(grid%qfx(i,j),dp)- &
4884 & (real(grid%raincv(i,j),dp)+ &
4885 & real(grid%rainncv(i,j),dp))/real(grid%dt,dp)
4886 myfmin(1)=min(myfmin(1),fval)
4887 myfmax(1)=max(myfmax(1),fval)
4888 ptr2d(i,j)=fval
4889 END DO
4890 END DO
4891
4892
4893
4894 CASE ('rain')
4895 myfmin(1)= missing_dp
4896 myfmax(1)=-missing_dp
4897 DO j=jstr,jend
4898 DO i=istr,iend
4899 fval=(real(grid%raincv(i,j),dp)+ &
4900 & real(grid%rainncv(i,j),dp))/real(grid%dt,dp)
4901 myfmin(1)=min(myfmin(1),fval)
4902 myfmax(1)=max(myfmax(1),fval)
4903 ptr2d(i,j)=fval
4904 END DO
4905 END DO
4906
4907
4908
4909
4910 CASE ('evap')
4911 myfmin(1)= missing_dp
4912 myfmax(1)=-missing_dp
4913 DO j=jstr,jend
4914 DO i=istr,iend
4915 fval=real(grid%qfx(i,j),dp)
4916 myfmin(1)=min(myfmin(1),fval)
4917 myfmax(1)=max(myfmax(1),fval)
4918 ptr2d(i,j)=fval
4919 END DO
4920 END DO
4921
4922
4923
4924 CASE ('cloud')
4925 myfmin(1)= missing_dp
4926 myfmax(1)=-missing_dp
4927 DO j=jstr,jend
4928 DO i=istr,iend
4929 fval=real(grid%cldfra(i,1,j),dp)
4930 myfmin(1)=min(myfmin(1),fval)
4931 myfmax(1)=max(myfmax(1),fval)
4932 ptr2d(i,j)=fval
4933 END DO
4934 END DO
4935
4936
4937
4938
4939
4940
4941
4942 CASE ('taux', 'taux10', 'sustr')
4943 myfmin(1)= missing_dp
4944 myfmax(1)=-missing_dp
4945 DO j=jstr,jend
4946 DO i=istr,iend
4947 cff1=1.0_dp/(real(grid%alt(i,1,j),dp)+eps)
4948 cff2=1.0_dp/ &
4949 & (sqrt((0.5_dp* &
4950 & (real(grid%u_2(i ,1,j ),dp)+ &
4951 & real(grid%u_2(i+1,1,j ),dp)))**2+ &
4952 & (0.5_dp* &
4953 & (real(grid%v_2(i ,1,j ),dp)+ &
4954 & real(grid%v_2(i ,1,j+1),dp)))**2)+ &
4955 & eps)
4956 cff3=0.5_dp*((real(grid%u_2(i ,1,j ),dp)+ &
4957 & real(grid%u_2(i+1,1,j ),dp))* &
4958 & real(grid%cosa(i,j),dp)- &
4959 & (real(grid%v_2(i ,1,j ),dp)+ &
4960 & real(grid%v_2(i ,1,j+1),dp))* &
4961 & real(grid%sina(i,j),dp))
4962 fval=cff1*cff2*(real(grid%ust(i,j),dp)**2)*cff3
4963# ifdef ONLY_OCEAN_FLUXES
4964 IF ((int(grid%landmask(i,j)).ne.landvalue)) THEN
4965 myfmin(1)=min(myfmin(1),fval)
4966 myfmax(1)=max(myfmax(1),fval)
4967 ptr2d(i,j)=fval
4968 ELSE
4969 ptr2d(i,j)=missing_dp
4970 END IF
4971# else
4972 myfmin(1)=min(myfmin(1),fval)
4973 myfmax(1)=max(myfmax(1),fval)
4974 ptr2d(i,j)=fval
4975# endif
4976 END DO
4977 END DO
4978
4979
4980
4981 CASE ('tauy', 'tauy10', 'svstr')
4982 myfmin(1)= missing_dp
4983 myfmax(1)=-missing_dp
4984 DO j=jstr,jend
4985 DO i=istr,iend
4986 cff1=1.0_dp/(real(grid%alt(i,1,j),dp)+eps)
4987 cff2=1.0_dp/ &
4988 & (sqrt((0.5_dp* &
4989 & (real(grid%u_2(i ,1,j),dp)+ &
4990 & real(grid%u_2(i+1,1,j),dp)))**2+ &
4991 & (0.5_dp* &
4992 & (real(grid%v_2(i,1,j ),dp)+ &
4993 & real(grid%v_2(i,1,j+1),dp)))**2)+ &
4994 & eps)
4995 cff3=0.5_dp*((real(grid%v_2(i,1,j ),dp)+ &
4996 & real(grid%v_2(i,1,j+1),dp))* &
4997 & real(grid%cosa(i,j),dp)+ &
4998 & (real(grid%u_2(i ,1,j),dp)+ &
4999 & real(grid%u_2(i+1,1,j),dp))* &
5000 & real(grid%sina(i,j),dp))
5001 fval=cff1*cff2*(real(grid%ust(i,j),dp)**2)*cff3
5002# ifdef ONLY_OCEAN_FLUXES
5003 IF ((int(grid%landmask(i,j)).ne.landvalue)) THEN
5004 myfmin(1)=min(myfmin(1),fval)
5005 myfmax(1)=max(myfmax(1),fval)
5006 ptr2d(i,j)=fval
5007 ELSE
5008 ptr2d(i,j)=missing_dp
5009 END IF
5010# else
5011 myfmin(1)=min(myfmin(1),fval)
5012 myfmax(1)=max(myfmax(1),fval)
5013 ptr2d(i,j)=fval
5014# endif
5015 END DO
5016 END DO
5017
5018
5019
5020 CASE ('RhoAir')
5021 myfmin(1)= missing_dp
5022 myfmax(1)=-missing_dp
5023 DO j=jstr,jend
5024 DO i=istr,iend
5025 fval=1.0_dp/(real(grid%alt(i,1,j),dp)+eps)
5026 myfmin(1)=min(myfmin(1),fval)
5027 myfmax(1)=max(myfmax(1),fval)
5028 ptr2d(i,j)=fval
5029 END DO
5030 END DO
5031
5032
5033
5034
5035 CASE ('Uwind_sbl', 'u_2')
5036 myfmin(1)= missing_dp
5037 myfmax(1)=-missing_dp
5038 DO j=jstr,jend
5039 DO i=istr,iend
5040 fval=0.5_dp*((real(grid%u_2(i ,1,j ),dp)+ &
5041 & real(grid%u_2(i+1,1,j ),dp))* &
5042 & real(grid%cosa(i,j),dp)- &
5043 & (real(grid%v_2(i ,1,j ),dp)+ &
5044 & real(grid%v_2(i ,1,j+1),dp))* &
5045 & real(grid%sina(i,j),dp))
5046 myfmin(1)=min(myfmin(1),fval)
5047 myfmax(1)=max(myfmax(1),fval)
5048 ptr2d(i,j)=fval
5049 END DO
5050 END DO
5051
5052
5053
5054
5055 CASE ('Vwind_sbl', 'v_2')
5056 myfmin(1)= missing_dp
5057 myfmax(1)=-missing_dp
5058 DO j=jstr,jend
5059 DO i=istr,iend
5060 fval=0.5_dp*((real(grid%v_2(i,1,j ),dp)+ &
5061 & real(grid%v_2(i,1,j+1),dp))* &
5062 & real(grid%cosa(i,j),dp)+ &
5063 & (real(grid%u_2(i ,1,j),dp)+ &
5064 & real(grid%u_2(i+1,1,j),dp))* &
5065 & real(grid%sina(i,j),dp))
5066 myfmin(1)=min(myfmin(1),fval)
5067 myfmax(1)=max(myfmax(1),fval)
5068 ptr2d(i,j)=fval
5069 END DO
5070 END DO
5071
5072
5073
5074
5075 CASE ('Uwind', 'u10', 'wndu')
5076 myfmin(1)= missing_dp
5077 myfmax(1)=-missing_dp
5078 DO j=jstr,jend
5079 DO i=istr,iend
5080# ifdef WRF_TIMEAVG
5081 fval=real(grid%u10_mean(i,j),dp)* &
5082 & real(grid%cosa(i,j),dp)- &
5083 & real(grid%v10_mean(i,j),dp)* &
5084 & real(grid%sina(i,j),dp)
5085# else
5086 fval=real(grid%u10(i,j),dp)* &
5087 & real(grid%cosa(i,j),dp)- &
5088 & real(grid%v10(i,j),dp)* &
5089 & real(grid%sina(i,j),dp)
5090# endif
5091 myfmin(1)=min(myfmin(1),fval)
5092 myfmax(1)=max(myfmax(1),fval)
5093 ptr2d(i,j)=fval
5094 END DO
5095 END DO
5096
5097
5098
5099
5100 CASE ('Vwind', 'v10', 'wndv')
5101 myfmin(1)= missing_dp
5102 myfmax(1)=-missing_dp
5103 DO j=jstr,jend
5104 DO i=istr,iend
5105# ifdef WRF_TIMEAVG
5106 fval=real(grid%v10_mean(i,j),dp)* &
5107 & real(grid%cosa(i,j),dp)+ &
5108 & real(grid%u10_mean(i,j),dp)* &
5109 & real(grid%sina(i,j),dp)
5110# else
5111 fval=real(grid%v10(i,j),dp)* &
5112 & real(grid%cosa(i,j),dp)+ &
5113 & real(grid%u10(i,j),dp)* &
5114 & real(grid%sina(i,j),dp)
5115# endif
5116 myfmin(1)=min(myfmin(1),fval)
5117 myfmax(1)=max(myfmax(1),fval)
5118 ptr2d(i,j)=fval
5119 END DO
5120 END DO
5121
5122
5123
5124
5125 CASE ('Wstar')
5126 myfmin(1)= missing_dp
5127 myfmax(1)=-missing_dp
5128 DO j=jstr,jend
5129 DO i=istr,iend
5130 fval=real(grid%ust(i,j),dp)
5131# ifdef ONLY_OCEAN_FLUXES
5132 IF ((int(grid%landmask(i,j)).ne.landvalue)) THEN
5133 myfmin(1)=min(myfmin(1),fval)
5134 myfmax(1)=max(myfmax(1),fval)
5135 ptr2d(i,j)=fval
5136 ELSE
5137 ptr2d(i,j)=missing_dp
5138 END IF
5139# else
5140 myfmin(1)=min(myfmin(1),fval)
5141 myfmax(1)=max(myfmax(1),fval)
5142 ptr2d(i,j)=fval
5143# endif
5144 END DO
5145 END DO
5146
5147
5148
5149 CASE DEFAULT
5150 IF (localpet.eq.0) THEN
5151 WRITE (cplout,30) trim(adjustl(exportnamelist(ifld))), &
5152 & trim(cinpname)
5153 END IF
5154 rc=esmf_rc_not_found
5155 IF (esmf_logfounderror(rctocheck=rc, &
5156 & msg=esmf_logerr_passthru, &
5157 & line=__line__, &
5158 & file=myfile)) THEN
5159 RETURN
5160 END IF
5161 END SELECT
5162
5163
5164
5165
5166 IF (associated(ptr2d)) nullify (ptr2d)
5167 END DO de_loop
5168
5169
5170
5171 CALL esmf_vmallreduce (vm, &
5172 & senddata=myfmin, &
5173 & recvdata=fmin, &
5174 & count=1, &
5175 & reduceflag=esmf_reduce_min, &
5176 & rc=rc)
5177 IF (esmf_logfounderror(rctocheck=rc, &
5178 & msg=esmf_logerr_passthru, &
5179 & line=__line__, &
5180 & file=myfile)) THEN
5181 RETURN
5182 END IF
5183
5184 CALL esmf_vmallreduce (vm, &
5185 & senddata=myfmax, &
5186 & recvdata=fmax, &
5187 & count=1, &
5188 & reduceflag=esmf_reduce_max, &
5189 & rc=rc)
5190 IF (esmf_logfounderror(rctocheck=rc, &
5191 & msg=esmf_logerr_passthru, &
5192 & line=__line__, &
5193 & file=myfile)) THEN
5194 RETURN
5195 END IF
5196
5197
5198
5199 IF ((debuglevel.ge.0).and.(localpet.eq.0)) THEN
5200 WRITE (cplout,40) trim(exportnamelist(ifld)), &
5201 & trim(time_currentstring), ng, &
5202 & fmin(1), fmax(1)
5203 END IF
5204
5205
5206
5207 IF ((debuglevel.ge.3).and. &
5208 & models(iatmos)%ExportField(ifld)%debug_write) THEN
5209 WRITE (ofile,50) ng, trim(exportnamelist(ifld)), &
5210 & year, month, day, hour, minutes, seconds
5211 CALL esmf_fieldwrite (field, &
5212 & trim(ofile), &
5213 & overwrite=.true., &
5214 & rc=rc)
5215 IF (esmf_logfounderror(rctocheck=rc, &
5216 & msg=esmf_logerr_passthru, &
5217 & line=__line__, &
5218 & file=myfile)) THEN
5219 RETURN
5220 END IF
5221 END IF
5222 END DO fld_loop
5223
5224
5225
5226 IF (allocated(exportnamelist)) deallocate(exportnamelist)
5227
5228
5229
5230 IF (exportcount.gt.0) THEN
5231 models(iatmos)%ExportCalls=models(iatmos)%ExportCalls+1
5232 END IF
5233
5234 IF (esm_track) THEN
5235 WRITE (trac,'(a,a,i0)') '<== Exiting WRF_Export', &
5236 & ', PET', petrank
5237 FLUSH (trac)
5238 END IF
5239 IF (debuglevel.gt.0) FLUSH (cplout)
5240
5241# ifdef WRF_TIMEAVG
5242 10 FORMAT (/,5x,'WRF_Export - illegal configuration: ',a, &
5243 & /,18x,a,' CPP option requires ''mean_diag = 1'' in ', &
5244 & 'input ''namelist''',/,18x,'for time-averaged fluxes.')
5245 20 FORMAT (/,5x,'WRF_Export - inconsistent input parameters:', &
5246 & /,18x,a,1x,i0,/,18x,a,': TimeStep = ',i0)
5247# endif
5248 30 FORMAT (/,5x,'WRF_Export - unable to find option to export: ', &
5249 & a,/,18x,'check ''Export(atmos)'' in input script: ',a)
5250 40 FORMAT (5x,'WRF_Export - ESMF: exporting field ''',a,'''', &
5251 & t72,a,2x,'Grid ',i2.2,/, &
5252 & 19x,'(OutMin = ', 1p,e15.8,0p,' OutMax = ',1p,e15.8,0p, &
5253 & ')')
5254 50 FORMAT ('wrf_',i2.2,'_export_',a,'_',i4.4,2('-',i2.2),'_', &
5255 & i2.2,2('.',i2.2),'.nc')
5256
5257 RETURN
character(len(sinp)) function, public uppercase(sinp)