105 character(len=50),
private,
allocatable ::
slevs(:)
152 integer,
intent(in) :: localpet
166 elseif (trim(
input_type) ==
"gaussian_netcdf")
then 182 elseif (trim(
input_type) ==
"gaussian_nemsio")
then 190 elseif (trim(
input_type) ==
"gfs_gaussian_nemsio")
then 222 integer,
intent(in) :: localpet
226 print*,
"- READ INPUT GRID NST DATA." 228 print*,
"- CALL FieldCreate FOR INPUT GRID C_D." 230 typekind=esmf_typekind_r8, &
231 staggerloc=esmf_staggerloc_center, rc=rc)
232 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
235 print*,
"- CALL FieldCreate FOR INPUT GRID C_0." 237 typekind=esmf_typekind_r8, &
238 staggerloc=esmf_staggerloc_center, rc=rc)
239 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
242 print*,
"- CALL FieldCreate FOR INPUT GRID D_CONV." 244 typekind=esmf_typekind_r8, &
245 staggerloc=esmf_staggerloc_center, rc=rc)
246 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
249 print*,
"- CALL FieldCreate FOR INPUT GRID DT_COOL." 251 typekind=esmf_typekind_r8, &
252 staggerloc=esmf_staggerloc_center, rc=rc)
253 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
256 print*,
"- CALL FieldCreate FOR INPUT GRID IFD." 258 typekind=esmf_typekind_r8, &
259 staggerloc=esmf_staggerloc_center, rc=rc)
260 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
263 print*,
"- CALL FieldCreate FOR INPUT GRID QRAIN." 265 typekind=esmf_typekind_r8, &
266 staggerloc=esmf_staggerloc_center, rc=rc)
267 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
270 print*,
"- CALL FieldCreate FOR INPUT GRID TREF." 272 typekind=esmf_typekind_r8, &
273 staggerloc=esmf_staggerloc_center, rc=rc)
274 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
277 print*,
"- CALL FieldCreate FOR INPUT GRID W_D." 279 typekind=esmf_typekind_r8, &
280 staggerloc=esmf_staggerloc_center, rc=rc)
281 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
284 print*,
"- CALL FieldCreate FOR INPUT GRID W_0." 286 typekind=esmf_typekind_r8, &
287 staggerloc=esmf_staggerloc_center, rc=rc)
288 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
291 print*,
"- CALL FieldCreate FOR INPUT GRID XS." 293 typekind=esmf_typekind_r8, &
294 staggerloc=esmf_staggerloc_center, rc=rc)
295 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
298 print*,
"- CALL FieldCreate FOR INPUT GRID XT." 300 typekind=esmf_typekind_r8, &
301 staggerloc=esmf_staggerloc_center, rc=rc)
302 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
305 print*,
"- CALL FieldCreate FOR INPUT GRID XU." 307 typekind=esmf_typekind_r8, &
308 staggerloc=esmf_staggerloc_center, rc=rc)
309 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
312 print*,
"- CALL FieldCreate FOR INPUT GRID XV." 314 typekind=esmf_typekind_r8, &
315 staggerloc=esmf_staggerloc_center, rc=rc)
316 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
319 print*,
"- CALL FieldCreate FOR INPUT GRID XZ." 321 typekind=esmf_typekind_r8, &
322 staggerloc=esmf_staggerloc_center, rc=rc)
323 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
326 print*,
"- CALL FieldCreate FOR INPUT GRID XTTS." 328 typekind=esmf_typekind_r8, &
329 staggerloc=esmf_staggerloc_center, rc=rc)
330 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
333 print*,
"- CALL FieldCreate FOR INPUT GRID XZTS." 335 typekind=esmf_typekind_r8, &
336 staggerloc=esmf_staggerloc_center, rc=rc)
337 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
340 print*,
"- CALL FieldCreate FOR INPUT GRID Z_C." 342 typekind=esmf_typekind_r8, &
343 staggerloc=esmf_staggerloc_center, rc=rc)
344 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
347 print*,
"- CALL FieldCreate FOR INPUT GRID ZM." 349 typekind=esmf_typekind_r8, &
350 staggerloc=esmf_staggerloc_center, rc=rc)
351 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
384 integer,
intent(in) :: localpet
401 "gaussian_netcdf")
then 409 elseif (trim(
input_type) ==
"gaussian_nemsio")
then 417 elseif (trim(
input_type) ==
"gfs_gaussian_nemsio")
then 450 print*,
"- INITIALIZE ATMOSPHERIC ESMF FIELDS." 452 print*,
"- CALL FieldCreate FOR INPUT GRID 3-D WIND." 454 typekind=esmf_typekind_r8, &
455 staggerloc=esmf_staggerloc_center, &
456 ungriddedlbound=(/1,1/), &
458 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
461 print*,
"- CALL FieldCreate FOR INPUT GRID SURFACE PRESSURE." 463 typekind=esmf_typekind_r8, &
464 staggerloc=esmf_staggerloc_center, rc=rc)
465 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
468 print*,
"- CALL FieldCreate FOR INPUT GRID TERRAIN." 470 typekind=esmf_typekind_r8, &
471 staggerloc=esmf_staggerloc_center, rc=rc)
472 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
475 print*,
"- CALL FieldCreate FOR INPUT GRID TEMPERATURE." 477 typekind=esmf_typekind_r8, &
478 staggerloc=esmf_staggerloc_center, &
479 ungriddedlbound=(/1/), &
481 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
487 print*,
"- CALL FieldCreate FOR INPUT GRID TRACER ", trim(
tracers_input(i))
489 typekind=esmf_typekind_r8, &
490 staggerloc=esmf_staggerloc_center, &
491 ungriddedlbound=(/1/), &
493 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
497 print*,
"- CALL FieldCreate FOR INPUT GRID DZDT." 499 typekind=esmf_typekind_r8, &
500 staggerloc=esmf_staggerloc_center, &
501 ungriddedlbound=(/1/), &
503 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
506 print*,
"- CALL FieldCreate FOR INPUT GRID U." 508 typekind=esmf_typekind_r8, &
509 staggerloc=esmf_staggerloc_center, &
510 ungriddedlbound=(/1/), &
512 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
515 print*,
"- CALL FieldCreate FOR INPUT GRID V." 517 typekind=esmf_typekind_r8, &
518 staggerloc=esmf_staggerloc_center, &
519 ungriddedlbound=(/1/), &
521 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
524 print*,
"- CALL FieldCreate FOR INPUT GRID PRESSURE." 526 typekind=esmf_typekind_r8, &
527 staggerloc=esmf_staggerloc_center, &
528 ungriddedlbound=(/1/), &
530 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
544 print*,
"- CALL FieldCreate FOR INPUT GRID LANDSEA MASK." 546 typekind=esmf_typekind_r8, &
547 staggerloc=esmf_staggerloc_center, rc=rc)
548 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
551 print*,
"- CALL FieldCreate FOR INPUT GRID Z0." 553 typekind=esmf_typekind_r8, &
554 staggerloc=esmf_staggerloc_center, rc=rc)
555 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
558 print*,
"- CALL FieldCreate FOR INPUT GRID VEGETATION TYPE." 560 typekind=esmf_typekind_r8, &
561 staggerloc=esmf_staggerloc_center, rc=rc)
562 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
565 print*,
"- CALL FieldCreate FOR INPUT GRID CANOPY MOISTURE CONTENT." 567 typekind=esmf_typekind_r8, &
568 staggerloc=esmf_staggerloc_center, rc=rc)
569 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
572 print*,
"- CALL FieldCreate FOR INPUT GRID SEAICE FRACTION." 574 typekind=esmf_typekind_r8, &
575 staggerloc=esmf_staggerloc_center, rc=rc)
576 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
579 print*,
"- CALL FieldCreate FOR INPUT GRID SEAICE DEPTH." 581 typekind=esmf_typekind_r8, &
582 staggerloc=esmf_staggerloc_center, rc=rc)
583 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
586 print*,
"- CALL FieldCreate FOR INPUT GRID SEAICE SKIN TEMPERATURE." 588 typekind=esmf_typekind_r8, &
589 staggerloc=esmf_staggerloc_center, rc=rc)
590 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
593 print*,
"- CALL FieldCreate FOR INPUT GRID SNOW DEPTH." 595 typekind=esmf_typekind_r8, &
596 staggerloc=esmf_staggerloc_center, rc=rc)
597 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
600 print*,
"- CALL FieldCreate FOR INPUT GRID SNOW LIQUID EQUIVALENT." 602 typekind=esmf_typekind_r8, &
603 staggerloc=esmf_staggerloc_center, rc=rc)
604 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
607 print*,
"- CALL FieldCreate FOR INPUT GRID T2M." 609 typekind=esmf_typekind_r8, &
610 staggerloc=esmf_staggerloc_center, rc=rc)
611 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
614 print*,
"- CALL FieldCreate FOR INPUT GRID Q2M." 616 typekind=esmf_typekind_r8, &
617 staggerloc=esmf_staggerloc_center, rc=rc)
618 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
621 print*,
"- CALL FieldCreate FOR INPUT GRID TPRCP." 623 typekind=esmf_typekind_r8, &
624 staggerloc=esmf_staggerloc_center, rc=rc)
625 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
628 print*,
"- CALL FieldCreate FOR INPUT GRID F10M." 630 typekind=esmf_typekind_r8, &
631 staggerloc=esmf_staggerloc_center, rc=rc)
632 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
635 print*,
"- CALL FieldCreate FOR INPUT GRID USTAR." 637 typekind=esmf_typekind_r8, &
638 staggerloc=esmf_staggerloc_center, rc=rc)
639 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
642 print*,
"- CALL FieldCreate FOR INPUT GRID FFMM." 644 typekind=esmf_typekind_r8, &
645 staggerloc=esmf_staggerloc_center, rc=rc)
646 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
649 print*,
"- CALL FieldCreate FOR INPUT GRID SRFLAG." 651 typekind=esmf_typekind_r8, &
652 staggerloc=esmf_staggerloc_center, rc=rc)
653 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
656 print*,
"- CALL FieldCreate FOR INPUT SKIN TEMPERATURE." 658 typekind=esmf_typekind_r8, &
659 staggerloc=esmf_staggerloc_center, rc=rc)
660 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
663 print*,
"- CALL FieldCreate FOR INPUT SOIL TYPE." 665 typekind=esmf_typekind_r8, &
666 staggerloc=esmf_staggerloc_center, rc=rc)
667 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
670 print*,
"- CALL FieldCreate FOR INPUT TERRAIN." 672 typekind=esmf_typekind_r8, &
673 staggerloc=esmf_staggerloc_center, rc=rc)
674 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
677 print*,
"- CALL FieldCreate FOR INPUT SOIL TEMPERATURE." 679 typekind=esmf_typekind_r8, &
680 staggerloc=esmf_staggerloc_center, &
681 ungriddedlbound=(/1/), &
683 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
686 print*,
"- CALL FieldCreate FOR INPUT TOTAL SOIL MOISTURE." 688 typekind=esmf_typekind_r8, &
689 staggerloc=esmf_staggerloc_center, &
690 ungriddedlbound=(/1/), &
692 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
695 print*,
"- CALL FieldCreate FOR INPUT LIQUID SOIL MOISTURE." 697 typekind=esmf_typekind_r8, &
698 staggerloc=esmf_staggerloc_center, &
699 ungriddedlbound=(/1/), &
701 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
707 print*,
"- CALL FieldCreate FOR INPUT VEGETATION GREENNESS." 709 typekind=esmf_typekind_r8, &
710 staggerloc=esmf_staggerloc_center, rc=rc)
711 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
716 print*,
"- CALL FieldCreate FOR INPUT MIN VEGETATION GREENNESS." 718 typekind=esmf_typekind_r8, &
719 staggerloc=esmf_staggerloc_center, rc=rc)
720 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
723 print*,
"- CALL FieldCreate FOR INPUT MAX VEGETATION GREENNESS." 725 typekind=esmf_typekind_r8, &
726 staggerloc=esmf_staggerloc_center, rc=rc)
727 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
732 print*,
"- CALL FieldCreate FOR INPUT LEAF AREA INDEX." 734 typekind=esmf_typekind_r8, &
735 staggerloc=esmf_staggerloc_center, rc=rc)
736 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
752 integer,
intent(in) :: localpet
754 character(len=300) :: the_file
756 integer(sigio_intkind) :: iret
757 integer :: rc, i, j, k
758 integer :: clb(3), cub(3)
760 real(esmf_kind_r8) :: ak, bk
761 real(esmf_kind_r8),
allocatable :: dummy2d(:,:)
762 real(esmf_kind_r8),
allocatable :: dummy3d(:,:,:)
763 real(esmf_kind_r8),
allocatable :: dummy3d2(:,:,:)
764 real(esmf_kind_r8),
pointer :: pptr(:,:,:), psptr(:,:)
765 real(esmf_kind_r8),
allocatable :: pi(:,:,:)
767 type(sigio_head) :: sighead
768 type(sigio_dbta) :: sigdata
772 print*,
"- ATMOSPHERIC DATA IN SIGIO FORMAT." 773 print*,
"- OPEN AND READ: ", trim(the_file)
775 call sigio_sropen(21, trim(the_file), iret)
780 call sigio_srhead(21, sighead, iret)
793 if (sighead%idvt == 0 .or. sighead%idvt == 21)
then 797 call error_handler(
"TRACERS SELECTED DO NOT MATCH FILE CONTENTS.", 99)
800 print*,
'- UNRECOGNIZED IDVT: ', sighead%idvt
810 if (localpet == 0)
then 815 allocate(dummy2d(0,0))
816 allocate(dummy3d(0,0,0))
817 allocate(dummy3d2(0,0,0))
820 if (localpet == 0)
then 821 call sigio_aldbta(sighead, sigdata, iret)
826 call sigio_srdbta(21, sighead, sigdata, iret)
831 call sptez(0,sighead%jcap,4,
i_input,
j_input, sigdata%ps, dummy2d, 1)
832 dummy2d = exp(dummy2d) * 1000.0
833 print*,
'surface pres ',maxval(dummy2d),minval(dummy2d)
836 print*,
"- CALL FieldScatter FOR SURFACE PRESSURE." 837 call esmf_fieldscatter(
ps_input_grid, dummy2d, rootpet=0, rc=rc)
838 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
841 if (localpet == 0)
then 842 call sptez(0,sighead%jcap,4,
i_input,
j_input, sigdata%hs, dummy2d, 1)
843 print*,
'terrain ',maxval(dummy2d),minval(dummy2d)
846 print*,
"- CALL FieldScatter FOR TERRAIN." 848 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
853 if (localpet == 0)
then 854 call sptezm(0,sighead%jcap,4,
i_input,
j_input,
lev_input, sigdata%q(:,:,k), dummy3d, 1)
855 print*,trim(
tracers_input(k)),maxval(dummy3d),minval(dummy3d)
858 print*,
"- CALL FieldScatter FOR INPUT ", trim(
tracers_input(k))
860 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
865 if (localpet == 0)
then 867 print*,
'temp ',maxval(dummy3d),minval(dummy3d)
870 print*,
"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." 872 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
880 if (localpet == 0)
then 881 print*,
"- NO VERTICAL VELOCITY RECORD. SET TO ZERO." 885 print*,
"- CALL FieldScatter FOR INPUT DZDT." 887 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
890 if (localpet == 0)
then 891 call sptezmv(0, sighead%jcap, 4,
i_input,
j_input,
lev_input, sigdata%d, sigdata%z, dummy3d, dummy3d2, 1)
892 print*,
'u ',maxval(dummy3d),minval(dummy3d)
893 print*,
'v ',maxval(dummy3d2),minval(dummy3d2)
896 print*,
"- CALL FieldScatter FOR INPUT U-WIND." 897 call esmf_fieldscatter(
u_input_grid, dummy3d, rootpet=0, rc=rc)
898 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
901 print*,
"- CALL FieldScatter FOR INPUT V-WIND." 902 call esmf_fieldscatter(
v_input_grid, dummy3d2, rootpet=0, rc=rc)
903 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
906 deallocate(dummy2d, dummy3d, dummy3d2)
908 if (localpet == 0)
call sigio_axdbta(sigdata, iret)
910 call sigio_sclose(21, iret)
922 print*,
"- COMPUTE 3-D PRESSURE." 924 print*,
"- CALL FieldGet FOR 3-D PRES." 927 computationallbound=clb, &
928 computationalubound=cub, &
929 farrayptr=pptr, rc=rc)
930 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
933 print*,
"- CALL FieldGet FOR SURFACE PRESSURE." 936 farrayptr=psptr, rc=rc)
937 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
944 allocate(pi(clb(1):cub(1),clb(2):cub(2),1:
levp1_input),stat=rc)
947 ak = sighead%vcoord(k,1)
948 bk = sighead%vcoord(k,2)
951 pi(i,j,k) = ak + bk*psptr(i,j)
956 if (localpet == 0)
then 957 print*,
'pres int ',psptr(clb(1),clb(2)),pi(clb(1),clb(2),:)
967 pptr(i,j,k) = (pi(i,j,k)+pi(i,j,k+1))/2.0_esmf_kind_r8
974 if (localpet == 0)
then 975 print*,
'pres ',psptr(clb(1),clb(2)),pptr(clb(1),clb(2),:)
989 integer,
intent(in) :: localpet
991 character(len=300) :: the_file
992 character(len=20) :: vlevtyp, vname
994 integer(nemsio_intkind) :: vlev, iret
995 integer :: i, j, k, n, rc
996 integer :: clb(3), cub(3)
998 real(nemsio_realkind),
allocatable :: vcoord(:,:,:)
999 real(nemsio_realkind),
allocatable :: dummy(:)
1000 real(esmf_kind_r8),
allocatable :: dummy2d(:,:)
1001 real(esmf_kind_r8),
allocatable :: dummy3d(:,:,:)
1002 real(esmf_kind_r8) :: ak, bk
1003 real(esmf_kind_r8),
allocatable :: pi(:,:,:)
1004 real(esmf_kind_r8),
pointer :: pptr(:,:,:), psptr(:,:)
1006 type(nemsio_gfile) :: gfile
1010 print*,
"- READ ATMOS DATA FROM SPECTRAL GFS NEMSIO FILE: ", trim(the_file)
1012 print*,
"- OPEN FILE." 1013 call nemsio_open(gfile, the_file,
"read", iret=iret)
1014 if (iret /= 0)
call error_handler(
"OPENING SPECTRAL GFS NEMSIO ATM FILE.", iret)
1016 print*,
"- READ NUMBER OF VERTICAL LEVELS." 1017 call nemsio_getfilehead(gfile, iret=iret, dimz=
lev_input)
1018 if (iret /= 0)
call error_handler(
"READING NUMBER OF VERTICAL LEVLES.", iret)
1024 print*,
"- READ VERTICAL COORDINATE INFO." 1025 call nemsio_getfilehead(gfile, iret=iret, vcoord=vcoord)
1026 if (iret /= 0)
call error_handler(
"READING VERTICAL COORDINATE INFO.", iret)
1034 if (localpet == 0)
then 1040 allocate(dummy2d(0,0))
1041 allocate(dummy3d(0,0,0))
1049 if (localpet == 0)
then 1050 print*,
"- READ TEMPERATURE." 1052 vlevtyp =
"mid layer" 1054 call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1055 if (iret /= 0)
call error_handler(
"READING TEMPERATURE RECORD.", iret)
1061 print*,
"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." 1063 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1068 if (localpet == 0)
then 1071 vlevtyp =
"mid layer" 1073 call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1074 if (iret /= 0)
call error_handler(
"READING TRACER RECORD.", iret)
1080 print*,
"- CALL FieldScatter FOR INPUT ", trim(
tracers_input(n))
1082 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1087 if (localpet == 0)
then 1088 print*,
"- READ U-WINDS." 1090 vlevtyp =
"mid layer" 1092 call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1093 if (iret /= 0)
call error_handler(
"READING U-WIND RECORD.", iret)
1099 print*,
"- CALL FieldScatter FOR INPUT U-WIND." 1100 call esmf_fieldscatter(
u_input_grid, dummy3d, rootpet=0, rc=rc)
1101 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1104 if (localpet == 0)
then 1105 print*,
"- READ V-WINDS." 1107 vlevtyp =
"mid layer" 1109 call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1110 if (iret /= 0)
call error_handler(
"READING V-WIND RECORD.", iret)
1116 print*,
"- CALL FieldScatter FOR INPUT V-WIND." 1117 call esmf_fieldscatter(
v_input_grid, dummy3d, rootpet=0, rc=rc)
1118 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1126 if (localpet == 0)
then 1127 print*,
"- NO VERTICAL VELOCITY RECORD. SET TO ZERO." 1131 print*,
"- CALL FieldScatter FOR INPUT DZDT." 1133 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1136 if (localpet == 0)
then 1137 print*,
"- READ HGT." 1141 call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1142 if (iret /= 0)
call error_handler(
"READING HGT RECORD.", iret)
1147 print*,
"- CALL FieldScatter FOR TERRAIN." 1149 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1152 if (localpet == 0)
then 1153 print*,
"- READ PRES." 1157 call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1158 if (iret /= 0)
call error_handler(
"READING PRES RECORD.", iret)
1163 print*,
"- CALL FieldScatter FOR SURFACE PRESSURE." 1164 call esmf_fieldscatter(
ps_input_grid, dummy2d, rootpet=0, rc=rc)
1165 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1168 call nemsio_close(gfile)
1170 deallocate(dummy, dummy2d, dummy3d)
1182 print*,
"- COMPUTE 3-D PRESSURE." 1184 print*,
"- CALL FieldGet FOR 3-D PRES." 1187 computationallbound=clb, &
1188 computationalubound=cub, &
1189 farrayptr=pptr, rc=rc)
1190 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1193 print*,
"- CALL FieldGet FOR SURFACE PRESSURE." 1196 farrayptr=psptr, rc=rc)
1197 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1204 allocate(pi(clb(1):cub(1),clb(2):cub(2),1:
levp1_input))
1209 do i= clb(1), cub(1)
1210 do j= clb(2), cub(2)
1211 pi(i,j,k) = ak + bk*psptr(i,j)
1223 do i= clb(1), cub(1)
1224 do j= clb(2), cub(2)
1225 pptr(i,j,k) = (pi(i,j,k)+pi(i,j,k+1))/2.0
1242 integer,
intent(in) :: localpet
1244 character(len=300) :: the_file
1245 character(len=20) :: vlevtyp, vname
1247 integer :: i, j, k, n
1248 integer :: rc, clb(3), cub(3)
1249 integer(nemsio_intkind) :: vlev, iret
1251 real(nemsio_realkind),
allocatable :: vcoord(:,:,:)
1252 real(nemsio_realkind),
allocatable :: dummy(:)
1253 real(esmf_kind_r8),
allocatable :: dummy2d(:,:)
1254 real(esmf_kind_r8),
allocatable :: dummy3d(:,:,:)
1255 real(esmf_kind_r8),
pointer :: presptr(:,:,:), psptr(:,:)
1256 real(esmf_kind_r8),
pointer :: dpresptr(:,:,:)
1257 real(esmf_kind_r8),
allocatable :: pres_interface(:)
1259 type(nemsio_gfile) :: gfile
1263 print*,
"- READ ATMOS DATA FROM GAUSSIAN NEMSIO FILE: ", trim(the_file)
1265 print*,
"- OPEN FILE." 1266 call nemsio_open(gfile, the_file,
"read", iret=iret)
1267 if (iret /= 0)
call error_handler(
"OPENING GAUSSIAN NEMSIO ATM FILE.", iret)
1269 print*,
"- READ NUMBER OF VERTICAL LEVELS." 1270 call nemsio_getfilehead(gfile, iret=iret, dimz=
lev_input)
1271 if (iret /= 0)
call error_handler(
"READING NUMBER OF VERTICAL LEVLES.", iret)
1277 print*,
"- READ VERTICAL COORDINATE INFO." 1278 call nemsio_getfilehead(gfile, iret=iret, vcoord=vcoord)
1279 if (iret /= 0)
call error_handler(
"READING VERTICAL COORDINATE INFO.", iret)
1287 print*,
"- CALL FieldCreate FOR INPUT DPRES." 1289 typekind=esmf_typekind_r8, &
1290 staggerloc=esmf_staggerloc_center, &
1291 ungriddedlbound=(/1/), &
1293 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1296 if (localpet == 0)
then 1302 allocate(dummy2d(0,0))
1303 allocate(dummy3d(0,0,0))
1311 if (localpet == 0)
then 1312 print*,
"- READ TEMPERATURE." 1314 vlevtyp =
"mid layer" 1316 call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1317 if (iret /= 0)
call error_handler(
"READING TEMPERATURE RECORD.", iret)
1319 print*,
'temp check after read ',vlev, dummy3d(1,1,vlev)
1323 print*,
"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." 1325 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1330 if (localpet == 0)
then 1333 vlevtyp =
"mid layer" 1335 call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1336 if (iret /= 0)
call error_handler(
"READING TRACER RECORD.", iret)
1337 print*,
'tracer ',vlev, maxval(dummy),minval(dummy)
1342 print*,
"- CALL FieldScatter FOR INPUT ", trim(
tracers_input(n))
1344 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1349 if (localpet == 0)
then 1350 print*,
"- READ U-WINDS." 1352 vlevtyp =
"mid layer" 1354 call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1355 if (iret /= 0)
call error_handler(
"READING U-WIND RECORD.", iret)
1356 print*,
'ugrd ',vlev, maxval(dummy),minval(dummy)
1361 print*,
"- CALL FieldScatter FOR INPUT U-WIND." 1362 call esmf_fieldscatter(
u_input_grid, dummy3d, rootpet=0, rc=rc)
1363 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1366 if (localpet == 0)
then 1367 print*,
"- READ V-WINDS." 1369 vlevtyp =
"mid layer" 1371 call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1372 if (iret /= 0)
call error_handler(
"READING V-WIND RECORD.", iret)
1373 print*,
'vgrd ',vlev, maxval(dummy),minval(dummy)
1378 print*,
"- CALL FieldScatter FOR INPUT V-WIND." 1379 call esmf_fieldscatter(
v_input_grid, dummy3d, rootpet=0, rc=rc)
1380 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1383 if (localpet == 0)
then 1384 print*,
"- READ DPRES." 1386 vlevtyp =
"mid layer" 1388 call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1389 if (iret /= 0)
call error_handler(
"READING DPRES RECORD.", iret)
1390 print*,
'dpres ',vlev, maxval(dummy),minval(dummy)
1395 print*,
"- CALL FieldScatter FOR INPUT DPRES." 1397 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1400 if (localpet == 0)
then 1401 print*,
"- READ DZDT." 1403 vlevtyp =
"mid layer" 1405 call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1406 if (iret /= 0)
call error_handler(
"READING DZDT RECORD.", iret)
1407 print*,
'dzdt ',vlev, maxval(dummy),minval(dummy)
1412 print*,
"- CALL FieldScatter FOR INPUT DZDT." 1414 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1417 if (localpet == 0)
then 1418 print*,
"- READ HGT." 1422 call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1423 if (iret /= 0)
call error_handler(
"READING HGT RECORD.", iret)
1424 print*,
'hgt ',vlev, maxval(dummy),minval(dummy)
1428 print*,
"- CALL FieldScatter FOR TERRAIN." 1430 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1433 call nemsio_close(gfile)
1435 deallocate(dummy, dummy2d, dummy3d)
1451 print*,
"- COMPUTE 3-D PRESSURE." 1453 print*,
"- CALL FieldGet FOR DELTA PRESSURE." 1456 computationallbound=clb, &
1457 computationalubound=cub, &
1458 farrayptr=dpresptr, rc=rc)
1459 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1462 print*,
"- CALL FieldGet FOR 3-D PRESSURE." 1465 farrayptr=presptr, rc=rc)
1466 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1469 print*,
"- CALL FieldGet FOR SURFACE PRESSURE." 1472 farrayptr=psptr, rc=rc)
1473 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1478 if (localpet == 0)
then 1479 do k = clb(3), cub(3)
1480 print*,
'dpres is ',cub(1),cub(2),k, dpresptr(cub(1),cub(2),k)
1484 do i = clb(1), cub(1)
1485 do j = clb(2), cub(2)
1488 pres_interface(k) = pres_interface(k+1) + dpresptr(i,j,k)
1490 psptr(i,j) = pres_interface(1)
1492 presptr(i,j,k) = (pres_interface(k) + pres_interface(k+1)) / 2.0_8
1499 if (localpet == 0)
then 1500 print*,
'psfc is ',clb(1),clb(2),psptr(clb(1),clb(2))
1501 print*,
'pres is ',clb(1),clb(2),presptr(clb(1),clb(2),:)
1504 print*,
'pres check 1',localpet,maxval(presptr(:,:,1)),minval(presptr(:,:,1))
1505 print*,
'pres check lev',localpet,maxval(presptr(:,:,
lev_input)),minval(presptr(:,:,
lev_input))
1507 deallocate(pres_interface)
1525 integer,
intent(in) :: localpet
1527 character(len=500) :: tilefile
1530 integer :: clb(3), cub(3)
1531 integer :: rc, tile, ncid, id_var
1532 integer :: error, id_dim
1534 real(esmf_kind_r8),
allocatable :: ak(:)
1535 real(esmf_kind_r8),
pointer :: presptr(:,:,:), psptr(:,:)
1536 real(esmf_kind_r8),
pointer :: dpresptr(:,:,:)
1537 real(esmf_kind_r8),
allocatable :: data_one_tile(:,:)
1538 real(esmf_kind_r8),
allocatable :: data_one_tile_3d(:,:,:)
1539 real(esmf_kind_r8),
allocatable :: pres_interface(:)
1546 print*,
"- READ ATM VERTICAL LEVELS FROM: ", trim(tilefile)
1547 error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
1548 call netcdf_err(error,
'opening: '//trim(tilefile) )
1550 error=nf90_inq_dimid(ncid,
'xaxis_1', id_dim)
1551 call netcdf_err(error,
'reading xaxis_1 id' )
1552 error=nf90_inquire_dimension(ncid,id_dim,len=
levp1_input)
1553 call netcdf_err(error,
'reading xaxis_1 value' )
1559 error=nf90_inq_varid(ncid,
'ak', id_var)
1561 error=nf90_get_var(ncid, id_var, ak)
1564 error = nf90_close(ncid)
1572 print*,
"- CALL FieldCreate FOR INPUT GRID DELTA PRESSURE." 1574 typekind=esmf_typekind_r8, &
1575 staggerloc=esmf_staggerloc_center, &
1576 ungriddedlbound=(/1/), &
1578 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1585 allocate(data_one_tile_3d(0,0,0))
1586 allocate(data_one_tile(0,0))
1592 print*,
"- READ ATMOSPHERIC CORE FILE: ", trim(tilefile)
1593 error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
1594 call netcdf_err(error,
'opening: '//trim(tilefile) )
1598 error=nf90_inq_varid(ncid,
'phis', id_var)
1600 error=nf90_get_var(ncid, id_var, data_one_tile)
1602 data_one_tile = data_one_tile / 9.806_8
1606 print*,
"- CALL FieldScatter FOR INPUT GRID TERRAIN for tile ",tile
1607 call esmf_fieldscatter(
terrain_input_grid, data_one_tile, rootpet=tile-1, tile=tile, rc=rc)
1608 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1620 data_one_tile_3d = 0.0_8
1624 print*,
"- CALL FieldScatter FOR INPUT GRID VERTICAL VELOCITY for tile ",tile
1625 call esmf_fieldscatter(
dzdt_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
1626 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1631 error=nf90_inq_varid(ncid,
'T', id_var)
1633 error=nf90_get_var(ncid, id_var, data_one_tile_3d)
1639 print*,
"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." 1640 call esmf_fieldscatter(
temp_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
1641 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1646 error=nf90_inq_varid(ncid,
'delp', id_var)
1648 error=nf90_get_var(ncid, id_var, data_one_tile_3d)
1654 print*,
"- CALL FieldScatter FOR INPUT DELTA PRESSURE." 1655 call esmf_fieldscatter(
dpres_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
1656 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1661 error=nf90_inq_varid(ncid,
'ua', id_var)
1663 error=nf90_get_var(ncid, id_var, data_one_tile_3d)
1669 print*,
"- CALL FieldScatter FOR INPUT GRID U." 1670 call esmf_fieldscatter(
u_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
1671 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1676 error=nf90_inq_varid(ncid,
'va', id_var)
1678 error=nf90_get_var(ncid, id_var, data_one_tile_3d)
1684 print*,
"- CALL FieldScatter FOR INPUT GRID V." 1685 call esmf_fieldscatter(
v_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
1686 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1695 print*,
"- READ ATMOSPHERIC TRACER FILE: ", trim(tilefile)
1696 error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
1697 call netcdf_err(error,
'opening: '//trim(tilefile) )
1705 error=nf90_get_var(ncid, id_var, data_one_tile_3d)
1711 print*,
"- CALL FieldScatter FOR INPUT ", trim(
tracers_input(i))
1712 call esmf_fieldscatter(
tracers_input_grid(i), data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
1713 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1731 print*,
"- CALL FieldGet FOR SURFACE PRESSURE." 1733 farrayptr=psptr, rc=rc)
1734 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1737 print*,
"- CALL FieldGet FOR PRESSURE." 1739 computationallbound=clb, &
1740 computationalubound=cub, &
1741 farrayptr=presptr, rc=rc)
1742 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1745 print*,
"- CALL FieldGet FOR DELTA PRESSURE." 1747 farrayptr=dpresptr, rc=rc)
1748 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1753 do i = clb(1), cub(1)
1754 do j = clb(2), cub(2)
1757 pres_interface(k) = pres_interface(k+1) + dpresptr(i,j,k)
1760 presptr(i,j,k) = (pres_interface(k) + pres_interface(k+1)) / 2.0_8
1762 psptr(i,j) = pres_interface(1)
1767 deallocate(pres_interface)
1771 deallocate(data_one_tile_3d, data_one_tile)
1786 integer,
intent(in) :: localpet
1788 character(len=500) :: tilefile
1790 integer :: start(3), count(3), iscnt
1791 integer :: error, ncid, num_tracers_file
1792 integer :: id_dim, idim_input, jdim_input
1793 integer :: id_var, rc, nprocs, max_procs
1794 integer :: kdim, remainder, myrank, i, j, k, n
1795 integer :: clb(3), cub(3)
1796 integer,
allocatable :: kcount(:), startk(:), displ(:)
1797 integer,
allocatable :: ircnt(:)
1799 real(esmf_kind_r8),
allocatable :: phalf(:)
1800 real(esmf_kind_r8),
allocatable :: pres_interface(:)
1801 real(kind=4),
allocatable :: dummy3d(:,:,:)
1802 real(kind=4),
allocatable :: dummy3dall(:,:,:)
1803 real(esmf_kind_r8),
allocatable :: dummy3dflip(:,:,:)
1804 real(esmf_kind_r8),
allocatable :: dummy(:,:)
1805 real(esmf_kind_r8),
pointer :: presptr(:,:,:), dpresptr(:,:,:)
1806 real(esmf_kind_r8),
pointer :: psptr(:,:)
1808 print*,
"- READ INPUT ATMOS DATA FROM GAUSSIAN NETCDF FILE." 1811 error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
1812 call netcdf_err(error,
'opening: '//trim(tilefile) )
1814 error=nf90_inq_dimid(ncid,
'grid_xt', id_dim)
1815 call netcdf_err(error,
'reading grid_xt id' )
1816 error=nf90_inquire_dimension(ncid,id_dim,len=idim_input)
1817 call netcdf_err(error,
'reading grid_xt value' )
1819 error=nf90_inq_dimid(ncid,
'grid_yt', id_dim)
1820 call netcdf_err(error,
'reading grid_yt id' )
1821 error=nf90_inquire_dimension(ncid,id_dim,len=jdim_input)
1822 call netcdf_err(error,
'reading grid_yt value' )
1825 call error_handler(
"DIMENSION MISMATCH BETWEEN SFC AND OROG FILES.", 2)
1828 error=nf90_inq_dimid(ncid,
'pfull', id_dim)
1830 error=nf90_inquire_dimension(ncid,id_dim,len=
lev_input)
1831 call netcdf_err(error,
'reading pfull value' )
1833 error=nf90_inq_dimid(ncid,
'phalf', id_dim)
1835 error=nf90_inquire_dimension(ncid,id_dim,len=
levp1_input)
1836 call netcdf_err(error,
'reading phalf value' )
1838 error=nf90_inq_varid(ncid,
'phalf', id_var)
1839 call netcdf_err(error,
'getting phalf varid' )
1840 error=nf90_get_var(ncid, id_var, phalf)
1841 call netcdf_err(error,
'reading phalf varid' )
1843 error=nf90_get_att(ncid, nf90_global,
'ncnsto', num_tracers_file)
1844 call netcdf_err(error,
'reading ntracer value' )
1846 call mpi_comm_size(mpi_comm_world, nprocs, error)
1847 print*,
'- Running with ', nprocs,
' processors' 1849 call mpi_comm_rank(mpi_comm_world, myrank, error)
1850 print*,
'- myrank/localpet is ',myrank,localpet
1858 remainder =
lev_input - (max_procs*kdim)
1860 allocate(kcount(0:nprocs-1))
1862 allocate(startk(0:nprocs-1))
1864 allocate(displ(0:nprocs-1))
1866 allocate(ircnt(0:nprocs-1))
1869 do k = 0, max_procs-2
1872 kcount(max_procs-1) = kdim + remainder
1875 do k = 1, max_procs-1
1876 startk(k) = startk(k-1) + kcount(k-1)
1879 ircnt(:) = idim_input * jdim_input * kcount(:)
1882 do k = 1, max_procs-1
1883 displ(k) = displ(k-1) + ircnt(k-1)
1886 iscnt=idim_input*jdim_input*kcount(myrank)
1890 if (myrank <= max_procs-1)
then 1891 allocate(dummy3d(idim_input,jdim_input,kcount(myrank)))
1893 allocate(dummy3d(0,0,0))
1896 if (myrank == 0)
then 1897 allocate(dummy3dall(idim_input,jdim_input,
lev_input))
1899 allocate(dummy3dflip(idim_input,jdim_input,
lev_input))
1901 allocate(dummy(idim_input,jdim_input))
1904 allocate(dummy3dall(0,0,0))
1905 allocate(dummy3dflip(0,0,0))
1906 allocate(dummy(0,0))
1915 print*,
"- CALL FieldCreate FOR INPUT GRID DELTA PRESSURE." 1917 typekind=esmf_typekind_r8, &
1918 staggerloc=esmf_staggerloc_center, &
1919 ungriddedlbound=(/1/), &
1921 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1926 if (myrank <= max_procs-1)
then 1927 start = (/1,1,startk(myrank)/)
1928 count = (/idim_input,jdim_input,kcount(myrank)/)
1929 error=nf90_inq_varid(ncid,
'tmp', id_var)
1930 call netcdf_err(error,
'reading tmp field id' )
1931 error=nf90_get_var(ncid, id_var, dummy3d, start=start, count=count)
1935 call mpi_gatherv(dummy3d, iscnt, mpi_real, &
1936 dummy3dall, ircnt, displ, mpi_real, &
1937 0, mpi_comm_world, error)
1938 if (error /= 0)
call error_handler(
"IN mpi_gatherv of temperature", error)
1940 if (myrank == 0)
then 1944 print*,
"- CALL FieldScatter FOR INPUT GRID TEMPERATURE " 1945 call esmf_fieldscatter(
temp_input_grid, dummy3dflip, rootpet=0, rc=rc)
1946 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1951 if (myrank <= max_procs-1)
then 1952 error=nf90_inq_varid(ncid,
'dpres', id_var)
1953 call netcdf_err(error,
'reading dpres field id' )
1954 error=nf90_get_var(ncid, id_var, dummy3d, start=start, count=count)
1955 call netcdf_err(error,
'reading dpres field' )
1958 call mpi_gatherv(dummy3d, iscnt, mpi_real, &
1959 dummy3dall, ircnt, displ, mpi_real, &
1960 0, mpi_comm_world, error)
1961 if (error /= 0)
call error_handler(
"IN mpi_gatherv of dpres", error)
1963 if (myrank == 0)
then 1967 print*,
"- CALL FieldScatter FOR INPUT GRID DPRES " 1969 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1974 if (myrank <= max_procs-1)
then 1975 error=nf90_inq_varid(ncid,
'ugrd', id_var)
1976 call netcdf_err(error,
'reading ugrd field id' )
1977 error=nf90_get_var(ncid, id_var, dummy3d, start=start, count=count)
1978 call netcdf_err(error,
'reading ugrd field' )
1981 call mpi_gatherv(dummy3d, iscnt, mpi_real, &
1982 dummy3dall, ircnt, displ, mpi_real, &
1983 0, mpi_comm_world, error)
1984 if (error /= 0)
call error_handler(
"IN mpi_gatherv of ugrd", error)
1986 if (myrank == 0)
then 1990 print*,
"- CALL FieldScatter FOR INPUT GRID UGRD " 1991 call esmf_fieldscatter(
u_input_grid, dummy3dflip, rootpet=0, rc=rc)
1992 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1997 if (myrank <= max_procs-1)
then 1998 error=nf90_inq_varid(ncid,
'vgrd', id_var)
1999 call netcdf_err(error,
'reading vgrd field id' )
2000 error=nf90_get_var(ncid, id_var, dummy3d, start=start, count=count)
2001 call netcdf_err(error,
'reading vgrd field' )
2004 call mpi_gatherv(dummy3d, iscnt, mpi_real, &
2005 dummy3dall, ircnt, displ, mpi_real, &
2006 0, mpi_comm_world, error)
2007 if (error /= 0)
call error_handler(
"IN mpi_gatherv of vgrd", error)
2009 if (myrank == 0)
then 2013 print*,
"- CALL FieldScatter FOR INPUT GRID VGRD " 2014 call esmf_fieldscatter(
v_input_grid, dummy3dflip, rootpet=0, rc=rc)
2015 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2022 if (myrank <= max_procs-1)
then 2024 call netcdf_err(error,
'reading tracer field id' )
2025 error=nf90_get_var(ncid, id_var, dummy3d, start=start, count=count)
2026 call netcdf_err(error,
'reading tracer field' )
2029 call mpi_gatherv(dummy3d, iscnt, mpi_real, &
2030 dummy3dall, ircnt, displ, mpi_real, &
2031 0, mpi_comm_world, error)
2032 if (error /= 0)
call error_handler(
"IN mpi_gatherv of tracer", error)
2034 if (myrank == 0)
then 2036 where(dummy3dflip < 0.0) dummy3dflip = 0.0
2039 print*,
"- CALL FieldScatter FOR INPUT GRID ",
tracers_input(n)
2041 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2048 if (myrank == 0)
then 2052 print*,
"- CALL FieldScatter FOR INPUT GRID DZDT" 2053 call esmf_fieldscatter(
dzdt_input_grid, dummy3dflip, rootpet=0, rc=rc)
2054 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2057 deallocate(dummy3dflip, dummy3dall, dummy3d)
2062 print*,
"- READ TERRAIN." 2063 error=nf90_inq_varid(ncid,
'hgtsfc', id_var)
2064 call netcdf_err(error,
'reading hgtsfc field id' )
2065 error=nf90_get_var(ncid, id_var, dummy)
2066 call netcdf_err(error,
'reading hgtsfc field' )
2069 print*,
"- CALL FieldScatter FOR INPUT GRID TERRAIN." 2071 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2077 print*,
"- READ SURFACE P." 2078 error=nf90_inq_varid(ncid,
'pressfc', id_var)
2079 call netcdf_err(error,
'reading pressfc field id' )
2080 error=nf90_get_var(ncid, id_var, dummy)
2081 call netcdf_err(error,
'reading pressfc field' )
2084 print*,
"- CALL FieldScatter FOR INPUT GRID SURFACE P." 2085 call esmf_fieldscatter(
ps_input_grid, dummy, rootpet=0, rc=rc)
2086 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2089 deallocate(kcount, startk, displ, ircnt, dummy)
2101 print*,
"- CALL FieldGet FOR PRESSURE." 2103 computationallbound=clb, &
2104 computationalubound=cub, &
2105 farrayptr=presptr, rc=rc)
2106 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2109 print*,
"- CALL FieldGet FOR DELTA PRESSURE." 2111 farrayptr=dpresptr, rc=rc)
2112 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2115 print*,
"- CALL FieldGet FOR SURFACE PRESSURE." 2117 farrayptr=psptr, rc=rc)
2118 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2136 do i = clb(1), cub(1)
2137 do j = clb(2), cub(2)
2140 pres_interface(k) = pres_interface(k+1) + dpresptr(i,j,k)
2142 psptr(i,j) = pres_interface(1)
2144 presptr(i,j,k) = (pres_interface(k) + pres_interface(k+1)) / 2.0_8
2149 deallocate(pres_interface, phalf)
2170 integer,
intent(in) :: localpet
2172 character(len=500) :: tilefile
2174 integer :: error, ncid, rc, tile
2175 integer :: id_dim, idim_input, jdim_input
2176 integer :: id_var, i, j, k, n
2177 integer :: clb(3), cub(3), num_tracers_file
2179 real(esmf_kind_r8),
allocatable :: data_one_tile(:,:)
2180 real(esmf_kind_r8),
allocatable :: data_one_tile_3d(:,:,:)
2181 real(esmf_kind_r8),
pointer :: presptr(:,:,:), dpresptr(:,:,:)
2182 real(esmf_kind_r8),
pointer :: psptr(:,:)
2183 real(esmf_kind_r8),
allocatable :: pres_interface(:), phalf(:)
2185 print*,
"- READ INPUT ATMOS DATA FROM TILED HISTORY FILES." 2188 error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
2189 call netcdf_err(error,
'opening: '//trim(tilefile) )
2191 error=nf90_inq_dimid(ncid,
'grid_xt', id_dim)
2192 call netcdf_err(error,
'reading grid_xt id' )
2193 error=nf90_inquire_dimension(ncid,id_dim,len=idim_input)
2194 call netcdf_err(error,
'reading grid_xt value' )
2196 error=nf90_inq_dimid(ncid,
'grid_yt', id_dim)
2197 call netcdf_err(error,
'reading grid_yt id' )
2198 error=nf90_inquire_dimension(ncid,id_dim,len=jdim_input)
2199 call netcdf_err(error,
'reading grid_yt value' )
2202 call error_handler(
"DIMENSION MISMATCH BETWEEN SFC AND OROG FILES.", 2)
2205 error=nf90_inq_dimid(ncid,
'pfull', id_dim)
2207 error=nf90_inquire_dimension(ncid,id_dim,len=
lev_input)
2208 call netcdf_err(error,
'reading pfull value' )
2210 error=nf90_inq_dimid(ncid,
'phalf', id_dim)
2212 error=nf90_inquire_dimension(ncid,id_dim,len=
levp1_input)
2213 call netcdf_err(error,
'reading phalf value' )
2215 error=nf90_inq_varid(ncid,
'phalf', id_var)
2216 call netcdf_err(error,
'getting phalf varid' )
2217 error=nf90_get_var(ncid, id_var, phalf)
2218 call netcdf_err(error,
'reading phalf varid' )
2220 error=nf90_get_att(ncid, nf90_global,
'ncnsto', num_tracers_file)
2221 call netcdf_err(error,
'reading ntracer value' )
2223 error = nf90_close(ncid)
2225 print*,
'- FILE HAS ', num_tracers_file,
' TRACERS.' 2234 print*,
"- CALL FieldCreate FOR INPUT GRID DELTA PRESSURE." 2236 typekind=esmf_typekind_r8, &
2237 staggerloc=esmf_staggerloc_center, &
2238 ungriddedlbound=(/1/), &
2240 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2247 allocate(data_one_tile(0,0))
2248 allocate(data_one_tile_3d(0,0,0))
2254 print*,
"- READ ATMOSPHERIC DATA FROM: ", trim(tilefile)
2255 error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
2256 call netcdf_err(error,
'opening: '//trim(tilefile) )
2269 data_one_tile_3d = 0.0_8
2273 print*,
"- CALL FieldScatter FOR INPUT GRID VERTICAL VELOCITY." 2274 call esmf_fieldscatter(
dzdt_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
2275 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2285 error=nf90_get_var(ncid, id_var, data_one_tile_3d)
2291 print*,
"- CALL FieldScatter FOR INPUT GRID TRACER ", trim(
tracers_input(n))
2292 call esmf_fieldscatter(
tracers_input_grid(n), data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
2293 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2300 print*,
"- READ TEMPERATURE." 2301 error=nf90_inq_varid(ncid,
'tmp', id_var)
2303 error=nf90_get_var(ncid, id_var, data_one_tile_3d)
2309 print*,
"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." 2310 call esmf_fieldscatter(
temp_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
2311 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2316 print*,
"- READ U-WIND." 2317 error=nf90_inq_varid(ncid,
'ugrd', id_var)
2319 error=nf90_get_var(ncid, id_var, data_one_tile_3d)
2325 print*,
"- CALL FieldScatter FOR INPUT GRID U." 2326 call esmf_fieldscatter(
u_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
2327 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2332 print*,
"- READ V-WIND." 2333 error=nf90_inq_varid(ncid,
'vgrd', id_var)
2335 error=nf90_get_var(ncid, id_var, data_one_tile_3d)
2341 print*,
"- CALL FieldScatter FOR INPUT GRID V." 2342 call esmf_fieldscatter(
v_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
2343 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2348 print*,
"- READ SURFACE PRESSURE." 2349 error=nf90_inq_varid(ncid,
'pressfc', id_var)
2351 error=nf90_get_var(ncid, id_var, data_one_tile)
2356 print*,
"- CALL FieldScatter FOR INPUT GRID SURFACE PRESSURE." 2357 call esmf_fieldscatter(
ps_input_grid, data_one_tile, rootpet=tile-1, tile=tile, rc=rc)
2358 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2363 print*,
"- READ TERRAIN." 2364 error=nf90_inq_varid(ncid,
'hgtsfc', id_var)
2366 error=nf90_get_var(ncid, id_var, data_one_tile)
2371 print*,
"- CALL FieldScatter FOR INPUT GRID TERRAIN." 2372 call esmf_fieldscatter(
terrain_input_grid, data_one_tile, rootpet=tile-1, tile=tile, rc=rc)
2373 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2378 print*,
"- READ DELTA PRESSURE." 2379 error=nf90_inq_varid(ncid,
'dpres', id_var)
2381 error=nf90_get_var(ncid, id_var, data_one_tile_3d)
2387 print*,
"- CALL FieldScatter FOR INPUT DELTA PRESSURE." 2388 call esmf_fieldscatter(
dpres_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
2389 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2395 deallocate(data_one_tile_3d, data_one_tile)
2407 print*,
"- CALL FieldGet FOR PRESSURE." 2409 computationallbound=clb, &
2410 computationalubound=cub, &
2411 farrayptr=presptr, rc=rc)
2412 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2415 print*,
"- CALL FieldGet FOR DELTA PRESSURE." 2417 farrayptr=dpresptr, rc=rc)
2418 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2421 print*,
"- CALL FieldGet FOR SURFACE PRESSURE." 2423 farrayptr=psptr, rc=rc)
2424 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2433 do i = clb(1), cub(1)
2434 do j = clb(2), cub(2)
2435 pres_interface(1) = psptr(i,j)
2437 pres_interface(k) = pres_interface(k-1) - dpresptr(i,j,k-1)
2440 presptr(i,j,k) = (pres_interface(k) + pres_interface(k+1)) / 2.0_8
2445 deallocate(pres_interface, phalf)
2464 integer,
intent(in) :: localpet
2466 integer,
parameter :: ntrac_max=14
2467 integer,
parameter :: max_levs=1000
2469 character(len=300) :: the_file
2470 character(len=20) :: vname, &
2471 trac_names_vmap(ntrac_max), &
2473 method, tracers_input_vmap(num_tracers_input), &
2474 tracers_default(ntrac_max)
2476 integer :: i, j, k, n
2478 integer :: rc, clb(3), cub(3)
2479 integer :: vlev, iret,varnum, o3n, pdt_num
2480 integer :: intrp_ier, done_print
2481 integer :: trac_names_oct10(ntrac_max)
2482 integer :: tracers_input_oct10(num_tracers_input)
2483 integer :: trac_names_oct11(ntrac_max)
2484 integer :: tracers_input_oct11(num_tracers_input)
2485 integer :: lugb, lugi, jdisc, jpdt(200), jgdt(200), iscale
2486 integer :: jids(200), jpdtn, jgdtn, octet_23, octet_29
2487 integer :: count_spfh, count_rh, count_icmr, count_scliwc
2488 integer :: count_cice, count_rwmr, count_scllwc, count
2490 logical :: conv_omega=.false., &
2493 use_rh=.false. , unpack, &
2494 all_empty, is_missing
2496 real(esmf_kind_r8),
allocatable :: dum2d_1(:,:)
2499 real(esmf_kind_r8) :: rlevs_hold(max_levs)
2500 real(esmf_kind_r8),
allocatable :: rlevs(:)
2501 real(esmf_kind_r4),
allocatable :: dummy2d(:,:)
2502 real(esmf_kind_r8),
allocatable :: dummy3d(:,:,:), dummy2d_8(:,:),&
2503 u_tmp_3d(:,:,:), v_tmp_3d(:,:,:)
2504 real(esmf_kind_r8),
pointer :: presptr(:,:,:), psptr(:,:),tptr(:,:,:), &
2505 qptr(:,:,:), wptr(:,:,:), &
2506 uptr(:,:,:), vptr(:,:,:)
2507 real(esmf_kind_r4) :: value
2508 real(esmf_kind_r8),
parameter :: p0 = 100000.0
2509 real(esmf_kind_r8),
allocatable :: dummy3d_col_in(:),dummy3d_col_out(:)
2510 real(esmf_kind_r8),
parameter :: intrp_missing = -999.0
2511 real(esmf_kind_r4),
parameter :: lev_no_tr_fill = 20000.0
2512 real(esmf_kind_r4),
parameter :: lev_no_o3_fill = 40000.0
2514 type(gribfield) :: gfld
2518 trac_names_oct10 = (/1, 1, 14, 1, 1, 1, 1, 6, 6, 1, 6, 13, 13, 2 /)
2519 trac_names_oct11 = (/0, 22, 192, 23, 24, 25, 32, 1, 29, 100, 28, 193, 192, 2 /)
2521 trac_names_vmap = (/
"sphum ",
"liq_wat ",
"o3mr ",
"ice_wat ", &
2522 "rainwat ",
"snowwat ",
"graupel ",
"cld_amt ",
"ice_nc ", &
2523 "rain_nc ",
"water_nc",
"liq_aero",
"ice_aero", &
2526 tracers_default = (/
"sphum ",
"liq_wat ",
"o3mr ",
"ice_wat ", &
2527 "rainwat ",
"snowwat ",
"graupel ",
"cld_amt ",
"ice_nc ", &
2528 "rain_nc ",
"water_nc",
"liq_aero",
"ice_aero", &
2533 print*,
"- READ ATMOS DATA FROM GRIB2 FILE: ", trim(the_file)
2535 if (localpet == 0)
then 2539 call baopenr(lugb,the_file,iret)
2540 if (iret /= 0)
call error_handler(
"ERROR OPENING GRIB2 FILE.", iret)
2551 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2552 unpack, k, gfld, iret)
2564 if (gfld%idsect(1) == 7 .and. gfld%idsect(2) == 2)
then 2565 print*,
'- THIS IS NCEP GEFS DATA.' 2590 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2591 unpack, k, gfld, iret)
2594 print*,
'- DATA IS ON HYBRID LEVELS.' 2599 print*,
'- DATA IS ON ISOBARIC LEVELS.' 2616 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2617 unpack, k, gfld, iret)
2621 if (gfld%discipline == 0)
then 2622 if (gfld%ipdtnum == pdt_num)
then 2623 if (gfld%ipdtmpl(1) == 2 .and. gfld%ipdtmpl(2) == 2)
then 2625 if (gfld%ipdtmpl(10) == octet_23 .and. gfld%ipdtmpl(13) == octet_29)
then 2629 iscale = 10 ** gfld%ipdtmpl(11)
2630 rlevs_hold(
lev_input) = float(gfld%ipdtmpl(12))/float(iscale)
2641 call mpi_barrier(mpi_comm_world, iret)
2642 call mpi_bcast(isnative,1,mpi_logical,0,mpi_comm_world,iret)
2643 call mpi_bcast(
lev_input,1,mpi_integer,0,mpi_comm_world,iret)
2644 call mpi_bcast(pdt_num,1,mpi_integer,0,mpi_comm_world,iret)
2645 call mpi_bcast(rlevs_hold, max_levs, mpi_integer,0,mpi_comm_world,iret)
2657 rlevs(i) = rlevs_hold(i)
2664 write(
slevs(i),
'(i6)') nint(rlevs(i))
2667 write(
slevs(i),
'(f11.2)') rlevs(i)
2672 if(localpet == 0)
then 2674 print*,
"- LEVEL AFTER SORT = ",trim(
slevs(i))
2680 if (localpet == 0)
then 2693 jpdt(12) = nint(rlevs(vlev))
2695 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2696 unpack, k, gfld, iret)
2699 count_spfh = count_spfh + 1
2709 jpdt(12) = nint(rlevs(vlev))
2711 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2712 unpack, k, gfld, iret)
2715 count_rh = count_rh + 1
2723 if (count_spfh == 0 .or. use_rh)
then 2724 if (count_rh == 0)
then 2725 call error_handler(
"READING ATMOSPHERIC WATER VAPOR VARIABLE.", 2)
2728 trac_names_oct10(1) = 1
2729 trac_names_oct11(1) = 1
2730 print*,
"- FILE CONTAINS RH." 2732 print*,
"- FILE CONTAINS SPFH." 2737 call mpi_barrier(mpi_comm_world, rc)
2738 call mpi_bcast(hasspfh,1,mpi_logical,0,mpi_comm_world,rc)
2742 if (localpet == 0)
then 2760 jpdt(12) = nint(rlevs(vlev))
2762 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2763 unpack, k, gfld, iret)
2766 count_icmr = count_icmr + 1
2772 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2773 unpack, k, gfld, iret)
2776 count_scliwc = count_scliwc + 1
2782 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2783 unpack, k, gfld, iret)
2786 count_cice = count_cice + 1
2792 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2793 unpack, k, gfld, iret)
2796 count_rwmr = count_rwmr + 1
2803 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2804 unpack, k, gfld, iret)
2807 count_scllwc = count_scllwc + 1
2812 if (count_icmr == 0)
then 2813 if (count_scliwc == 0)
then 2814 if (count_cice == 0)
then 2815 print*,
'- FILE DOES NOT CONTAIN CICE.' 2817 trac_names_oct10(4) = 6
2818 trac_names_oct11(4) = 0
2819 print*,
"- FILE CONTAINS CICE." 2822 trac_names_oct10(4) = 1
2823 trac_names_oct11(4) = 84
2824 print*,
"- FILE CONTAINS SCLIWC." 2827 print*,
"- FILE CONTAINS ICMR." 2830 if (count_rwmr == 0)
then 2831 if (count_scllwc == 0)
then 2832 print*,
"- FILE DOES NOT CONTAIN SCLLWC." 2834 trac_names_oct10(4) = 1
2835 trac_names_oct11(4) = 83
2837 print*,
"- FILE CONTAINS SCLLWC." 2840 print*,
"- FILE CONTAINS CLWMR." 2845 call mpi_barrier(mpi_comm_world, rc)
2846 call mpi_bcast(trac_names_oct10,ntrac_max,mpi_integer,0,mpi_comm_world,rc)
2847 call mpi_bcast(trac_names_oct11,ntrac_max,mpi_integer,0,mpi_comm_world,rc)
2849 print*,
"- COUNT NUMBER OF TRACERS TO BE READ IN BASED ON PHYSICS SUITE TABLE" 2850 do n = 1, num_tracers_input
2854 i = maxloc(merge(1.,0.,trac_names_vmap == vname),dim=1)
2856 tracers_input_vmap(n)=trac_names_vmap(i)
2858 if(trim(
tracers(n)) .eq.
"o3mr") o3n = n
2860 tracers_input_oct10(n) = trac_names_oct10(i)
2861 tracers_input_oct11(n) = trac_names_oct11(i)
2871 if (localpet == 0)
then 2877 allocate(dummy2d(0,0))
2878 allocate(dummy2d_8(0,0))
2879 allocate(dummy3d(0,0,0))
2880 allocate(dum2d_1(0,0))
2889 if (localpet == 0)
then 2891 print*,
"- READ TEMPERATURE." 2908 jpdt(12) = nint(rlevs(vlev))
2910 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2911 unpack, k, gfld, iret)
2918 dummy3d(:,:,vlev) = dum2d_1
2924 if (localpet == 0) print*,
"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." 2926 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2931 do n = 1, num_tracers_input
2933 if (localpet == 0) print*,
"- READ ", trim(tracers_input_vmap(n))
2935 vname = tracers_input_vmap(n)
2936 call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=
value, &
2937 this_field_var_name=tmpstr,loc=varnum)
2939 if (n==1 .and. .not. hasspfh)
then 2940 print*,
"- CALL FieldGather TEMPERATURE." 2941 call esmf_fieldgather(
temp_input_grid,dummy3d,rootpet=0, tile=1, rc=rc)
2942 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2946 if (localpet == 0)
then 2962 jpdt(1) = tracers_input_oct10(n)
2963 jpdt(2) = tracers_input_oct11(n)
2964 jpdt(12) = nint(rlevs(vlev))
2966 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2967 unpack, k, gfld, iret)
2983 is_missing = .false.
2989 jpdt(1) = tracers_input_oct10(n)
2990 jpdt(2) = tracers_input_oct11(n)
2991 jpdt(12) = nint(rlevs(vlev) )
2993 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2994 unpack, k, gfld, iret)
2999 if (trim(method) .eq.
'intrp' .and. .not.all_empty)
then 3000 dummy2d = intrp_missing
3005 if (.not.all_empty .and. n == o3n)
then 3006 if (rlevs(vlev) .lt. lev_no_o3_fill) &
3008 ". SET MISSING VARIABLE CONDITION TO 'INTRP' TO AVOID THIS ERROR", 1)
3009 elseif (.not.all_empty .and. n .ne. o3n)
then 3010 if (rlevs(vlev) .gt. lev_no_tr_fill) &
3012 ". SET MISSING VARIABLE CONDITION TO 'INTRP' TO AVOID THIS ERROR.", 1)
3015 if (trim(method) .eq.
'intrp' .and. all_empty) method=
'set_to_fill' 3019 if ( (tracers_input_oct10(n) == 1 .and. tracers_input_oct11(n) == 0) .or. &
3020 (tracers_input_oct10(n) == 1 .and. tracers_input_oct11(n) == 1) .or. &
3021 (tracers_input_oct10(n) == 14 .and. tracers_input_oct11(n) == 192) )
then 3023 //
". SET A FILL VALUE IN THE VARMAP TABLE IF THIS ERROR IS NOT DESIRABLE.",iret)
3029 if (n==1 .and. .not. hasspfh)
then 3031 print *,
'- CALL CALRH GFS' 3032 call rh2spfh_gfs(dummy2d,rlevs(vlev),dummy3d(:,:,vlev))
3034 print *,
'- CALL CALRH non-GFS' 3035 call rh2spfh(dummy2d,rlevs(vlev),dummy3d(:,:,vlev))
3039 dummy3d(:,:,vlev) =
real(dummy2d,esmf_kind_r8)
3044 if (is_missing .and. trim(method) .eq.
'intrp')
then 3045 print *,
'- INTERPOLATE TRACER '//trim(
tracers(n))
3049 dummy3d_col_in=dummy3d(ii,jj,:)
3050 call dint2p(rlevs,dummy3d_col_in,
lev_input,rlevs,dummy3d_col_out, &
3052 if (intrp_ier .gt. 0)
call error_handler(
"Interpolation failed.",intrp_ier)
3053 dummy3d(ii,jj,:)=dummy3d_col_out
3057 dummy2d = dummy3d(:,:,n)
3058 if (any(dummy2d .eq. intrp_missing))
then 3060 if (n == o3n .and. rlevs(vlev) .lt. lev_no_o3_fill)
then 3062 elseif (n .ne. o3n .and. rlevs(vlev) .gt. lev_no_tr_fill)
then 3065 if (done_print .eq. 0)
then 3066 print*,
"Pressure out of range of existing data. Defaulting to fill value." 3069 where(dummy2d .eq. intrp_missing) dummy2d =
value 3070 dummy3d(:,:,vlev) = dummy2d
3074 where(dummy3d(:,:,vlev) .lt. 0.0) dummy3d(:,:,vlev) = 0.0
3080 if (localpet == 0) print*,
"- CALL FieldScatter FOR INPUT ", trim(tracers_input_vmap(n))
3082 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3087 deallocate(dummy3d_col_in, dummy3d_col_out)
3089 call read_winds(u_tmp_3d,v_tmp_3d,localpet,octet_23,rlevs,lugb,pdt_num)
3091 if (localpet == 0) print*,
"- CALL FieldScatter FOR INPUT U-WIND." 3092 call esmf_fieldscatter(
u_input_grid, u_tmp_3d, rootpet=0, rc=rc)
3093 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3096 if (localpet == 0) print*,
"- CALL FieldScatter FOR INPUT V-WIND." 3097 call esmf_fieldscatter(
v_input_grid, v_tmp_3d, rootpet=0, rc=rc)
3098 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3101 if (localpet == 0)
then 3103 print*,
"- READ SURFACE PRESSURE." 3116 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
3117 unpack, k, gfld, iret)
3118 if (iret /= 0)
call error_handler(
"READING SURFACE PRESSURE RECORD.", iret)
3124 if (localpet == 0) print*,
"- CALL FieldScatter FOR INPUT GRID SURFACE PRESSURE." 3125 call esmf_fieldscatter(
ps_input_grid, dummy2d_8, rootpet=0, rc=rc)
3126 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3131 if (localpet == 0)
then 3133 print*,
"- READ DZDT." 3135 call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=
value, &
3153 jpdt(12) = nint(rlevs(vlev))
3155 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
3156 unpack, k, gfld, iret)
3159 print*,
"DZDT not available at level ", trim(
slevs(vlev)),
" so checking for VVEL" 3161 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
3162 unpack, k, gfld, iret)
3176 dummy3d(:,:,vlev) = dum2d_1
3182 call mpi_bcast(conv_omega,1,mpi_logical,0,mpi_comm_world,rc)
3184 if (localpet == 0) print*,
"- CALL FieldScatter FOR INPUT DZDT." 3186 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3191 if (localpet == 0)
then 3193 print*,
"- READ TERRAIN." 3206 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
3207 unpack, k, gfld, iret)
3208 if (iret /= 0)
call error_handler(
"READING TERRAIN HEIGHT RECORD.", iret)
3214 if (localpet == 0) print*,
"- CALL FieldScatter FOR INPUT GRID TERRAIN." 3216 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3219 deallocate(dummy2d, dummy2d_8)
3221 if (.not. isnative)
then 3228 if (localpet == 0) print*,
"- CALL FieldGet FOR SURFACE PRESSURE." 3231 farrayptr=psptr, rc=rc)
3232 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3236 if (localpet == 0) print*,
"- CALL FieldGet FOR 3-D PRESSURE." 3238 computationallbound=clb, &
3239 computationalubound=cub, &
3240 farrayptr=presptr, rc=rc)
3241 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3245 if (localpet == 0) print*,
"- CALL FieldGet TEMPERATURE." 3247 farrayptr=tptr, rc=rc)
3248 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3252 if (localpet == 0) print*,
"- CALL FieldGet FOR U" 3254 farrayptr=uptr, rc=rc)
3255 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3259 if (localpet == 0) print*,
"- CALL FieldGet FOR V" 3261 farrayptr=vptr, rc=rc)
3262 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3266 if (localpet == 0) print*,
"- CALL FieldGet FOR W" 3268 farrayptr=wptr, rc=rc)
3269 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3272 if (localpet == 0) print*,
"- CALL FieldGet FOR TRACERS." 3273 do n=1,num_tracers_input
3276 farrayptr=qptr, rc=rc)
3277 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3279 do i = clb(1),cub(1)
3280 do j = clb(2),cub(2)
3286 do i = clb(1),cub(1)
3287 do j = clb(2),cub(2)
3296 if (localpet == 0)
then 3297 print*,
'psfc is ',clb(1),clb(2),psptr(clb(1),clb(2))
3298 print*,
'pres is ',cub(1),cub(2),presptr(cub(1),cub(2),:)
3300 print*,
'pres check 1',localpet,maxval(presptr(clb(1):cub(1),clb(2):cub(2),1)), &
3301 minval(presptr(clb(1):cub(1),clb(2):cub(2),1))
3302 print*,
'pres check lev',localpet,maxval(presptr(clb(1):cub(1),clb(2):cub(2), &
3310 if (localpet == 0)
then 3312 print*,
"- READ PRESSURE." 3328 jpdt(12) = nint(rlevs(vlev))
3329 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
3330 unpack, k, gfld, iret)
3337 dummy3d(:,:,vlev) = dum2d_1
3343 if (localpet == 0) print*,
"- CALL FieldScatter FOR INPUT GRID PRESSURE." 3345 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3350 deallocate(dummy3d, dum2d_1)
3362 if (conv_omega)
then 3364 if (localpet == 0) print*,
"- CONVERT FROM OMEGA TO DZDT." 3367 if (localpet == 0) print*,
"- CALL FieldGet TEMPERATURE." 3369 farrayptr=tptr, rc=rc)
3370 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3374 if (localpet == 0) print*,
"- CALL FieldGet SPECIFIC HUMIDITY." 3376 computationallbound=clb, &
3377 computationalubound=cub, &
3378 farrayptr=qptr, rc=rc)
3379 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3383 if (localpet == 0) print*,
"- CALL FieldGet DZDT." 3385 computationallbound=clb, &
3386 computationalubound=cub, &
3387 farrayptr=wptr, rc=rc)
3388 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3393 farrayptr=presptr, rc=rc)
3394 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3401 if (localpet == 0)
call baclose(lugb, rc)
3418 integer,
intent(in) :: localpet
3420 character(len=300) :: the_file
3422 integer(sfcio_intkind) :: iret
3425 real(esmf_kind_r8),
allocatable :: dummy2d(:,:)
3426 real(esmf_kind_r8),
allocatable :: dummy3d(:,:,:)
3428 type(sfcio_head) :: sfchead
3429 type(sfcio_dbta) :: sfcdata
3433 print*,
"- READ SURFACE DATA IN SFCIO FORMAT." 3434 print*,
"- OPEN AND READ: ",trim(the_file)
3435 call sfcio_sropen(23, trim(the_file), iret)
3441 call sfcio_srhead(23, sfchead, iret)
3447 if (localpet == 0)
then 3448 call sfcio_aldbta(sfchead, sfcdata, iret)
3453 call sfcio_srdbta(23, sfchead, sfcdata, iret)
3461 allocate(dummy2d(0,0))
3462 allocate(dummy3d(0,0,0))
3465 if (localpet == 0) dummy2d = sfcdata%slmsk
3467 print*,
"- CALL FieldScatter FOR INPUT LANDSEA MASK." 3469 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3472 if (localpet == 0) dummy2d = sfcdata%zorl
3474 print*,
"- CALL FieldScatter FOR INPUT Z0." 3475 call esmf_fieldscatter(
z0_input_grid, dummy2d, rootpet=0, rc=rc)
3476 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3479 if (localpet == 0) dummy2d = nint(sfcdata%vtype)
3481 print*,
"- CALL FieldScatter FOR INPUT VEG TYPE." 3483 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3489 if (localpet == 0) dummy2d = sfcdata%canopy
3491 print*,
"- CALL FieldScatter FOR INPUT CANOPY MC." 3493 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3496 if (localpet == 0) dummy2d = sfcdata%fice
3498 print*,
"- CALL FieldScatter FOR INPUT ICE FRACTION." 3500 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3503 if (localpet == 0) dummy2d = sfcdata%hice
3505 print*,
"- CALL FieldScatter FOR INPUT ICE DEPTH." 3507 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3510 if (localpet == 0) dummy2d = sfcdata%tisfc
3512 print*,
"- CALL FieldScatter FOR INPUT ICE SKIN TEMP." 3514 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3517 if (localpet == 0) dummy2d = sfcdata%snwdph
3519 print*,
"- CALL FieldScatter FOR INPUT SNOW DEPTH." 3521 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3524 if (localpet == 0) dummy2d = sfcdata%sheleg
3526 print*,
"- CALL FieldScatter FOR INPUT SNOW LIQUID EQUIV." 3528 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3531 if (localpet == 0) dummy2d = sfcdata%t2m
3533 print*,
"- CALL FieldScatter FOR INPUT T2M." 3534 call esmf_fieldscatter(
t2m_input_grid, dummy2d, rootpet=0, rc=rc)
3535 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3538 if (localpet == 0) dummy2d = sfcdata%q2m
3540 print*,
"- CALL FieldScatter FOR INPUT Q2M." 3541 call esmf_fieldscatter(
q2m_input_grid, dummy2d, rootpet=0, rc=rc)
3542 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3545 if (localpet == 0) dummy2d = sfcdata%tprcp
3547 print*,
"- CALL FieldScatter FOR INPUT TPRCP." 3549 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3552 if (localpet == 0) dummy2d = sfcdata%f10m
3554 print*,
"- CALL FieldScatter FOR INPUT F10M." 3556 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3559 if (localpet == 0) dummy2d = sfcdata%uustar
3561 print*,
"- CALL FieldScatter FOR INPUT USTAR." 3563 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3566 if (localpet == 0) dummy2d = sfcdata%ffmm
3568 print*,
"- CALL FieldScatter FOR INPUT FFMM." 3570 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3573 if (localpet == 0) dummy2d = sfcdata%srflag
3575 print*,
"- CALL FieldScatter FOR INPUT SRFLAG." 3577 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3580 if (localpet == 0) dummy2d = sfcdata%tsea
3582 print*,
"- CALL FieldScatter FOR INPUT SKIN TEMP." 3584 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3587 if (localpet == 0) dummy2d = nint(sfcdata%stype)
3589 print*,
"- CALL FieldScatter FOR INPUT SOIL TYPE." 3591 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3594 if (localpet == 0) dummy2d = sfcdata%orog
3596 print*,
"- CALL FieldScatter FOR INPUT TERRAIN." 3598 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3601 if (localpet == 0) dummy3d = sfcdata%slc
3603 print*,
"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." 3605 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3608 if (localpet == 0) dummy3d = sfcdata%smc
3610 print*,
"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." 3612 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3615 if (localpet == 0) dummy3d = sfcdata%stc
3617 print*,
"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." 3619 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3622 deallocate(dummy2d, dummy3d)
3623 call sfcio_axdbta(sfcdata, iret)
3625 call sfcio_sclose(23, iret)
3640 integer,
intent(in) :: localpet
3642 character(len=300) :: the_file
3646 real(nemsio_realkind),
allocatable :: dummy(:)
3647 real(esmf_kind_r8),
allocatable :: dummy2d(:,:)
3648 real(esmf_kind_r8),
allocatable :: dummy3d(:,:,:)
3650 type(nemsio_gfile) :: gfile
3654 if (localpet == 0)
then 3658 print*,
"- OPEN FILE ", trim(the_file)
3659 call nemsio_open(gfile, the_file,
"read", iret=rc)
3662 allocate(dummy3d(0,0,0))
3663 allocate(dummy2d(0,0))
3667 if (localpet == 0)
then 3668 print*,
"- READ TERRAIN." 3669 call nemsio_readrecv(gfile,
"orog",
"sfc", 1, dummy, 0, iret=rc)
3672 print*,
'orog ',maxval(dummy2d),minval(dummy2d)
3675 print*,
"- CALL FieldScatter FOR INPUT TERRAIN." 3677 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3680 if (localpet == 0)
then 3681 print*,
"- READ LANDSEA MASK." 3682 call nemsio_readrecv(gfile,
"land",
"sfc", 1, dummy, 0, iret=rc)
3683 if (rc /= 0)
call error_handler(
"READING LANDSEA MASK.", rc)
3685 print*,
'landmask ',maxval(dummy2d),minval(dummy2d)
3688 print*,
"- CALL FieldScatter FOR INPUT LANDSEA MASK." 3690 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3693 if (localpet == 0)
then 3694 print*,
"- READ SEAICE FRACTION." 3695 call nemsio_readrecv(gfile,
"icec",
"sfc", 1, dummy, 0, iret=rc)
3696 if (rc /= 0)
call error_handler(
"READING SEAICE FRACTION.", rc)
3698 print*,
'icec ',maxval(dummy2d),minval(dummy2d)
3701 print*,
"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." 3703 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3706 if (localpet == 0)
then 3707 print*,
"- READ SEAICE DEPTH." 3708 call nemsio_readrecv(gfile,
"icetk",
"sfc", 1, dummy, 0, iret=rc)
3709 if (rc /= 0)
call error_handler(
"READING SEAICE DEPTH.", rc)
3711 print*,
'icetk ',maxval(dummy2d),minval(dummy2d)
3714 print*,
"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." 3716 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3719 if (localpet == 0)
then 3720 print*,
"- READ SEAICE SKIN TEMPERATURE." 3721 call nemsio_readrecv(gfile,
"tisfc",
"sfc", 1, dummy, 0, iret=rc)
3722 if (rc /= 0)
call error_handler(
"READING SEAICE SKIN TEMP.", rc)
3724 print*,
'ti ',maxval(dummy2d),minval(dummy2d)
3727 print*,
"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." 3729 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3732 if (localpet == 0)
then 3733 print*,
"- READ SNOW LIQUID EQUIVALENT." 3734 call nemsio_readrecv(gfile,
"weasd",
"sfc", 1, dummy, 0, iret=rc)
3735 if (rc /= 0)
call error_handler(
"READING SNOW LIQUID EQUIVALENT.", rc)
3737 print*,
'weasd ',maxval(dummy2d),minval(dummy2d)
3740 print*,
"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." 3742 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3745 if (localpet == 0)
then 3746 print*,
"- READ SNOW DEPTH." 3747 call nemsio_readrecv(gfile,
"snod",
"sfc", 1, dummy, 0, iret=rc)
3750 print*,
'snod ',maxval(dummy2d),minval(dummy2d)
3753 print*,
"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." 3755 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3758 if (localpet == 0)
then 3759 print*,
"- READ VEG TYPE." 3760 call nemsio_readrecv(gfile,
"vtype",
"sfc", 1, dummy, 0, iret=rc)
3763 print*,
'vtype ',maxval(dummy2d),minval(dummy2d)
3766 print*,
"- CALL FieldScatter FOR INPUT GRID VEG TYPE." 3768 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3771 if (localpet == 0)
then 3772 print*,
"- READ SOIL TYPE." 3773 call nemsio_readrecv(gfile,
"sotyp",
"sfc", 1, dummy, 0, iret=rc)
3776 print*,
'sotype ',maxval(dummy2d),minval(dummy2d)
3779 print*,
"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." 3781 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3784 if (localpet == 0)
then 3785 print*,
"- READ T2M." 3786 call nemsio_readrecv(gfile,
"tmp",
"2 m above gnd", 1, dummy, 0, iret=rc)
3789 print*,
't2m ',maxval(dummy2d),minval(dummy2d)
3792 print*,
"- CALL FieldScatter FOR INPUT GRID T2M." 3793 call esmf_fieldscatter(
t2m_input_grid, dummy2d, rootpet=0, rc=rc)
3794 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3797 if (localpet == 0)
then 3798 print*,
"- READ Q2M." 3799 call nemsio_readrecv(gfile,
"spfh",
"2 m above gnd", 1, dummy, 0, iret=rc)
3802 print*,
'q2m ',maxval(dummy2d),minval(dummy2d)
3805 print*,
"- CALL FieldScatter FOR INPUT GRID Q2M." 3806 call esmf_fieldscatter(
q2m_input_grid, dummy2d, rootpet=0, rc=rc)
3807 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3810 if (localpet == 0)
then 3811 print*,
"- READ TPRCP." 3812 call nemsio_readrecv(gfile,
"tprcp",
"sfc", 1, dummy, 0, iret=rc)
3815 print*,
'tprcp ',maxval(dummy2d),minval(dummy2d)
3818 print*,
"- CALL FieldScatter FOR INPUT GRID TPRCP." 3820 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3823 if (localpet == 0)
then 3824 print*,
"- READ FFMM." 3825 call nemsio_readrecv(gfile,
"ffmm",
"sfc", 1, dummy, 0, iret=rc)
3828 print*,
'ffmm ',maxval(dummy2d),minval(dummy2d)
3831 print*,
"- CALL FieldScatter FOR INPUT GRID FFMM" 3833 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3836 if (localpet == 0)
then 3837 print*,
"- READ USTAR." 3838 call nemsio_readrecv(gfile,
"fricv",
"sfc", 1, dummy, 0, iret=rc)
3841 print*,
'fricv ',maxval(dummy2d),minval(dummy2d)
3844 print*,
"- CALL FieldScatter FOR INPUT GRID USTAR" 3846 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3849 if (localpet == 0) dummy2d = 0.0
3850 print*,
"- CALL FieldScatter FOR INPUT GRID SRFLAG" 3852 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3855 if (localpet == 0)
then 3856 print*,
"- READ SKIN TEMPERATURE." 3857 call nemsio_readrecv(gfile,
"tmp",
"sfc", 1, dummy, 0, iret=rc)
3858 if (rc /= 0)
call error_handler(
"READING SKIN TEMPERATURE.", rc)
3860 print*,
'tmp ',maxval(dummy2d),minval(dummy2d)
3863 print*,
"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" 3865 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3868 if (localpet == 0)
then 3869 print*,
"- READ F10M." 3870 call nemsio_readrecv(gfile,
"f10m",
"10 m above gnd", 1, dummy, 0, iret=rc)
3873 print*,
'f10m ',maxval(dummy2d),minval(dummy2d)
3876 print*,
"- CALL FieldScatter FOR INPUT GRID F10M." 3878 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3881 if (localpet == 0)
then 3882 print*,
"- READ CANOPY MOISTURE CONTENT." 3883 call nemsio_readrecv(gfile,
"cnwat",
"sfc", 1, dummy, 0, iret=rc)
3884 if (rc /= 0)
call error_handler(
"READING CANOPY MOISTURE CONTENT.", rc)
3886 print*,
'cnwat ',maxval(dummy2d),minval(dummy2d)
3889 print*,
"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." 3891 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3894 if (localpet == 0)
then 3896 call nemsio_readrecv(gfile,
"sfcr",
"sfc", 1, dummy, 0, iret=rc)
3899 print*,
'sfcr ',maxval(dummy2d),minval(dummy2d)
3902 print*,
"- CALL FieldScatter FOR INPUT GRID Z0." 3903 call esmf_fieldscatter(
z0_input_grid, dummy2d, rootpet=0, rc=rc)
3904 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3909 if (localpet == 0)
then 3910 print*,
"- READ LIQUID SOIL MOISTURE." 3911 call nemsio_readrecv(gfile,
"slc",
"soil layer", 1, dummy, 0, iret=rc)
3912 if (rc /= 0)
call error_handler(
"READING LAYER 1 LIQUID SOIL MOIST.", rc)
3914 call nemsio_readrecv(gfile,
"slc",
"soil layer", 2, dummy, 0, iret=rc)
3915 if (rc /= 0)
call error_handler(
"READING LAYER 2 LIQUID SOIL MOIST.", rc)
3917 call nemsio_readrecv(gfile,
"slc",
"soil layer", 3, dummy, 0, iret=rc)
3918 if (rc /= 0)
call error_handler(
"READING LAYER 3 LIQUID SOIL MOIST.", rc)
3920 call nemsio_readrecv(gfile,
"slc",
"soil layer", 4, dummy, 0, iret=rc)
3921 if (rc /= 0)
call error_handler(
"READING LAYER 4 LIQUID SOIL MOIST.", rc)
3923 print*,
'slc ',maxval(dummy3d),minval(dummy3d)
3926 print*,
"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." 3928 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3931 if (localpet == 0)
then 3932 print*,
"- READ TOTAL SOIL MOISTURE." 3933 call nemsio_readrecv(gfile,
"smc",
"soil layer", 1, dummy, 0, iret=rc)
3934 if (rc /= 0)
call error_handler(
"READING LAYER 1 TOTAL SOIL MOIST.", rc)
3936 call nemsio_readrecv(gfile,
"smc",
"soil layer", 2, dummy, 0, iret=rc)
3937 if (rc /= 0)
call error_handler(
"READING LAYER 2 TOTAL SOIL MOIST.", rc)
3939 call nemsio_readrecv(gfile,
"smc",
"soil layer", 3, dummy, 0, iret=rc)
3940 if (rc /= 0)
call error_handler(
"READING LAYER 3 TOTAL SOIL MOIST.", rc)
3942 call nemsio_readrecv(gfile,
"smc",
"soil layer", 4, dummy, 0, iret=rc)
3943 if (rc /= 0)
call error_handler(
"READING LAYER 4 TOTAL SOIL MOIST.", rc)
3945 print*,
'smc ',maxval(dummy3d),minval(dummy3d)
3948 print*,
"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." 3950 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3953 if (localpet == 0)
then 3954 print*,
"- READ SOIL TEMPERATURE." 3955 call nemsio_readrecv(gfile,
"stc",
"soil layer", 1, dummy, 0, iret=rc)
3956 if (rc /= 0)
call error_handler(
"READING LAYER 1 SOIL TEMP.", rc)
3958 call nemsio_readrecv(gfile,
"stc",
"soil layer", 2, dummy, 0, iret=rc)
3959 if (rc /= 0)
call error_handler(
"READING LAYER 2 SOIL TEMP.", rc)
3961 call nemsio_readrecv(gfile,
"stc",
"soil layer", 3, dummy, 0, iret=rc)
3962 if (rc /= 0)
call error_handler(
"READING LAYER 3 SOIL TEMP.", rc)
3964 call nemsio_readrecv(gfile,
"stc",
"soil layer", 4, dummy, 0, iret=rc)
3965 if (rc /= 0)
call error_handler(
"READING LAYER 4 SOIL TEMP.", rc)
3967 print*,
'stc ',maxval(dummy3d),minval(dummy3d)
3970 print*,
"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." 3972 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3975 deallocate(dummy3d, dummy)
3977 if (localpet == 0)
call nemsio_close(gfile)
3989 integer,
intent(in) :: localpet
3991 character(len=250) :: the_file
3995 real(nemsio_realkind),
allocatable :: dummy(:)
3996 real(esmf_kind_r8),
allocatable :: dummy2d(:,:)
3997 real(esmf_kind_r8),
allocatable :: dummy3d(:,:,:)
3999 type(nemsio_gfile) :: gfile
4003 if (localpet == 0)
then 4007 print*,
"- OPEN FILE ", trim(the_file)
4008 call nemsio_open(gfile, the_file,
"read", iret=rc)
4011 allocate(dummy3d(0,0,0))
4012 allocate(dummy2d(0,0))
4016 if (localpet == 0)
then 4017 print*,
"- READ TERRAIN." 4018 call nemsio_readrecv(gfile,
"orog",
"sfc", 1, dummy, 0, iret=rc)
4021 print*,
'orog ',maxval(dummy2d),minval(dummy2d)
4024 print*,
"- CALL FieldScatter FOR INPUT TERRAIN." 4026 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4029 if (localpet == 0)
then 4030 print*,
"- READ LANDSEA MASK." 4031 call nemsio_readrecv(gfile,
"land",
"sfc", 1, dummy, 0, iret=rc)
4032 if (rc /= 0)
call error_handler(
"READING LANDSEA MASK.", rc)
4034 print*,
'landmask ',maxval(dummy2d),minval(dummy2d)
4037 print*,
"- CALL FieldScatter FOR INPUT LANDSEA MASK." 4039 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4042 if (localpet == 0)
then 4043 print*,
"- READ SEAICE FRACTION." 4044 call nemsio_readrecv(gfile,
"icec",
"sfc", 1, dummy, 0, iret=rc)
4045 if (rc /= 0)
call error_handler(
"READING SEAICE FRACTION.", rc)
4047 print*,
'icec ',maxval(dummy2d),minval(dummy2d)
4050 print*,
"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." 4052 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4055 if (localpet == 0)
then 4056 print*,
"- READ SEAICE DEPTH." 4057 call nemsio_readrecv(gfile,
"icetk",
"sfc", 1, dummy, 0, iret=rc)
4058 if (rc /= 0)
call error_handler(
"READING SEAICE DEPTH.", rc)
4060 print*,
'icetk ',maxval(dummy2d),minval(dummy2d)
4063 print*,
"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." 4065 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4068 if (localpet == 0)
then 4069 print*,
"- READ SEAICE SKIN TEMPERATURE." 4070 call nemsio_readrecv(gfile,
"ti",
"sfc", 1, dummy, 0, iret=rc)
4071 if (rc /= 0)
call error_handler(
"READING SEAICE SKIN TEMP.", rc)
4073 print*,
'ti ',maxval(dummy2d),minval(dummy2d)
4076 print*,
"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." 4078 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4081 if (localpet == 0)
then 4082 print*,
"- READ SNOW LIQUID EQUIVALENT." 4083 call nemsio_readrecv(gfile,
"weasd",
"sfc", 1, dummy, 0, iret=rc)
4084 if (rc /= 0)
call error_handler(
"READING SNOW LIQUID EQUIVALENT.", rc)
4086 print*,
'weasd ',maxval(dummy2d),minval(dummy2d)
4089 print*,
"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." 4091 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4094 if (localpet == 0)
then 4095 print*,
"- READ SNOW DEPTH." 4096 call nemsio_readrecv(gfile,
"snod",
"sfc", 1, dummy, 0, iret=rc)
4099 print*,
'snod ',maxval(dummy2d),minval(dummy2d)
4102 print*,
"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." 4104 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4107 if (localpet == 0)
then 4108 print*,
"- READ VEG TYPE." 4109 call nemsio_readrecv(gfile,
"vtype",
"sfc", 1, dummy, 0, iret=rc)
4112 print*,
'vtype ',maxval(dummy2d),minval(dummy2d)
4115 print*,
"- CALL FieldScatter FOR INPUT GRID VEG TYPE." 4117 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4120 if (localpet == 0)
then 4121 print*,
"- READ SOIL TYPE." 4122 call nemsio_readrecv(gfile,
"sotyp",
"sfc", 1, dummy, 0, iret=rc)
4125 print*,
'sotype ',maxval(dummy2d),minval(dummy2d)
4128 print*,
"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." 4130 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4133 if (localpet == 0)
then 4134 print*,
"- READ T2M." 4135 call nemsio_readrecv(gfile,
"tmp",
"2 m above gnd", 1, dummy, 0, iret=rc)
4138 print*,
't2m ',maxval(dummy2d),minval(dummy2d)
4141 print*,
"- CALL FieldScatter FOR INPUT GRID T2M." 4142 call esmf_fieldscatter(
t2m_input_grid, dummy2d, rootpet=0, rc=rc)
4143 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4146 if (localpet == 0)
then 4147 print*,
"- READ Q2M." 4148 call nemsio_readrecv(gfile,
"spfh",
"2 m above gnd", 1, dummy, 0, iret=rc)
4151 print*,
'q2m ',maxval(dummy2d),minval(dummy2d)
4154 print*,
"- CALL FieldScatter FOR INPUT GRID Q2M." 4155 call esmf_fieldscatter(
q2m_input_grid, dummy2d, rootpet=0, rc=rc)
4156 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4159 if (localpet == 0)
then 4160 print*,
"- READ TPRCP." 4161 call nemsio_readrecv(gfile,
"tprcp",
"sfc", 1, dummy, 0, iret=rc)
4164 print*,
'tprcp ',maxval(dummy2d),minval(dummy2d)
4167 print*,
"- CALL FieldScatter FOR INPUT GRID TPRCP." 4169 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4172 if (localpet == 0)
then 4173 print*,
"- READ FFMM." 4174 call nemsio_readrecv(gfile,
"ffmm",
"sfc", 1, dummy, 0, iret=rc)
4177 print*,
'ffmm ',maxval(dummy2d),minval(dummy2d)
4180 print*,
"- CALL FieldScatter FOR INPUT GRID FFMM" 4182 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4185 if (localpet == 0)
then 4186 print*,
"- READ USTAR." 4187 call nemsio_readrecv(gfile,
"fricv",
"sfc", 1, dummy, 0, iret=rc)
4190 print*,
'fricv ',maxval(dummy2d),minval(dummy2d)
4193 print*,
"- CALL FieldScatter FOR INPUT GRID USTAR" 4195 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4198 if (localpet == 0) dummy2d = 0.0
4199 print*,
"- CALL FieldScatter FOR INPUT GRID SRFLAG" 4201 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4204 if (localpet == 0)
then 4205 print*,
"- READ SKIN TEMPERATURE." 4206 call nemsio_readrecv(gfile,
"tmp",
"sfc", 1, dummy, 0, iret=rc)
4207 if (rc /= 0)
call error_handler(
"READING SKIN TEMPERATURE.", rc)
4209 print*,
'tmp ',maxval(dummy2d),minval(dummy2d)
4212 print*,
"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" 4214 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4217 if (localpet == 0)
then 4218 print*,
"- READ F10M." 4219 call nemsio_readrecv(gfile,
"f10m",
"10 m above gnd", 1, dummy, 0, iret=rc)
4222 print*,
'f10m ',maxval(dummy2d),minval(dummy2d)
4225 print*,
"- CALL FieldScatter FOR INPUT GRID F10M." 4227 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4230 if (localpet == 0)
then 4231 print*,
"- READ CANOPY MOISTURE CONTENT." 4232 call nemsio_readrecv(gfile,
"cnwat",
"sfc", 1, dummy, 0, iret=rc)
4233 if (rc /= 0)
call error_handler(
"READING CANOPY MOISTURE CONTENT.", rc)
4235 print*,
'cnwat ',maxval(dummy2d),minval(dummy2d)
4238 print*,
"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." 4240 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4243 if (localpet == 0)
then 4245 call nemsio_readrecv(gfile,
"sfcr",
"sfc", 1, dummy, 0, iret=rc)
4248 print*,
'sfcr ',maxval(dummy2d),minval(dummy2d)
4251 print*,
"- CALL FieldScatter FOR INPUT GRID Z0." 4252 call esmf_fieldscatter(
z0_input_grid, dummy2d, rootpet=0, rc=rc)
4253 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4258 if (localpet == 0)
then 4259 print*,
"- READ LIQUID SOIL MOISTURE." 4260 call nemsio_readrecv(gfile,
"soill",
"0-10 cm down", 1, dummy, 0, iret=rc)
4261 if (rc /= 0)
call error_handler(
"READING LAYER 1 LIQUID SOIL MOIST.", rc)
4263 call nemsio_readrecv(gfile,
"soill",
"10-40 cm down", 1, dummy, 0, iret=rc)
4264 if (rc /= 0)
call error_handler(
"READING LAYER 2 LIQUID SOIL MOIST.", rc)
4266 call nemsio_readrecv(gfile,
"soill",
"40-100 cm down", 1, dummy, 0, iret=rc)
4267 if (rc /= 0)
call error_handler(
"READING LAYER 3 LIQUID SOIL MOIST.", rc)
4269 call nemsio_readrecv(gfile,
"soill",
"100-200 cm down", 1, dummy, 0, iret=rc)
4270 if (rc /= 0)
call error_handler(
"READING LAYER 4 LIQUID SOIL MOIST.", rc)
4272 print*,
'soill ',maxval(dummy3d),minval(dummy3d)
4275 print*,
"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." 4277 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4280 if (localpet == 0)
then 4281 print*,
"- READ TOTAL SOIL MOISTURE." 4282 call nemsio_readrecv(gfile,
"soilw",
"0-10 cm down", 1, dummy, 0, iret=rc)
4283 if (rc /= 0)
call error_handler(
"READING LAYER 1 TOTAL SOIL MOIST.", rc)
4285 call nemsio_readrecv(gfile,
"soilw",
"10-40 cm down", 1, dummy, 0, iret=rc)
4286 if (rc /= 0)
call error_handler(
"READING LAYER 2 TOTAL SOIL MOIST.", rc)
4288 call nemsio_readrecv(gfile,
"soilw",
"40-100 cm down", 1, dummy, 0, iret=rc)
4289 if (rc /= 0)
call error_handler(
"READING LAYER 3 TOTAL SOIL MOIST.", rc)
4291 call nemsio_readrecv(gfile,
"soilw",
"100-200 cm down", 1, dummy, 0, iret=rc)
4292 if (rc /= 0)
call error_handler(
"READING LAYER 4 TOTAL SOIL MOIST.", rc)
4294 print*,
'soilm ',maxval(dummy3d),minval(dummy3d)
4297 print*,
"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." 4299 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4302 if (localpet == 0)
then 4303 print*,
"- READ SOIL TEMPERATURE." 4304 call nemsio_readrecv(gfile,
"tmp",
"0-10 cm down", 1, dummy, 0, iret=rc)
4305 if (rc /= 0)
call error_handler(
"READING LAYER 1 SOIL TEMP.", rc)
4307 call nemsio_readrecv(gfile,
"tmp",
"10-40 cm down", 1, dummy, 0, iret=rc)
4308 if (rc /= 0)
call error_handler(
"READING LAYER 2 SOIL TEMP.", rc)
4310 call nemsio_readrecv(gfile,
"tmp",
"40-100 cm down", 1, dummy, 0, iret=rc)
4311 if (rc /= 0)
call error_handler(
"READING LAYER 3 SOIL TEMP.", rc)
4313 call nemsio_readrecv(gfile,
"tmp",
"100-200 cm down", 1, dummy, 0, iret=rc)
4314 if (rc /= 0)
call error_handler(
"READING LAYER 4 SOIL TEMP.", rc)
4316 print*,
'soilt ',maxval(dummy3d),minval(dummy3d)
4319 print*,
"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." 4321 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4324 deallocate(dummy3d, dummy)
4326 if (localpet == 0)
call nemsio_close(gfile)
4338 integer,
intent(in) :: localpet
4340 character(len=500) :: tilefile
4342 integer :: error, rc
4343 integer :: id_dim, idim_input, jdim_input
4344 integer :: ncid, tile, id_var
4346 real(esmf_kind_r8),
allocatable :: data_one_tile(:,:)
4347 real(esmf_kind_r8),
allocatable :: data_one_tile_3d(:,:,:)
4355 print*,
"- READ GRID DIMENSIONS FROM: ", trim(tilefile)
4356 error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
4357 call netcdf_err(error,
'opening: '//trim(tilefile) )
4359 error=nf90_inq_dimid(ncid,
'xaxis_1', id_dim)
4360 call netcdf_err(error,
'reading xaxis_1 id' )
4361 error=nf90_inquire_dimension(ncid,id_dim,len=idim_input)
4362 call netcdf_err(error,
'reading xaxis_1 value' )
4364 error=nf90_inq_dimid(ncid,
'yaxis_1', id_dim)
4365 call netcdf_err(error,
'reading yaxis_1 id' )
4366 error=nf90_inquire_dimension(ncid,id_dim,len=jdim_input)
4367 call netcdf_err(error,
'reading yaxis_1 value' )
4370 call error_handler(
"DIMENSION MISMATCH BETWEEN SFC AND OROG FILES.", 1)
4373 error = nf90_close(ncid)
4375 if (localpet == 0)
then 4376 allocate(data_one_tile(idim_input,jdim_input))
4377 allocate(data_one_tile_3d(idim_input,jdim_input,
lsoil_input))
4379 allocate(data_one_tile(0,0))
4380 allocate(data_one_tile_3d(0,0,0))
4385 if (localpet == 0)
then 4387 print*,
'- OPEN OROGRAPHY FILE: ', trim(tilefile)
4388 error=nf90_open(tilefile,nf90_nowrite,ncid)
4389 call netcdf_err(error,
'OPENING OROGRAPHY FILE' )
4390 error=nf90_inq_varid(ncid,
'orog_raw', id_var)
4391 call netcdf_err(error,
'READING OROG RECORD ID' )
4392 error=nf90_get_var(ncid, id_var, data_one_tile)
4393 call netcdf_err(error,
'READING OROG RECORD' )
4394 print*,
'terrain check ',tile, maxval(data_one_tile)
4395 error=nf90_close(ncid)
4398 print*,
"- CALL FieldScatter FOR INPUT TERRAIN." 4399 call esmf_fieldscatter(
terrain_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4400 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4409 if (localpet == 0)
then 4410 call read_fv3_grid_data_netcdf(
'slc', tile, idim_input, jdim_input, &
4414 print*,
"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." 4416 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4419 if (localpet == 0)
then 4420 call read_fv3_grid_data_netcdf(
'smc', tile, idim_input, jdim_input, &
4424 print*,
"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." 4426 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4429 if (localpet == 0)
then 4430 call read_fv3_grid_data_netcdf(
'stc', tile, idim_input, jdim_input, &
4434 print*,
"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." 4436 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4441 if (localpet == 0)
then 4442 call read_fv3_grid_data_netcdf(
'slmsk', tile, idim_input, jdim_input, &
4446 print*,
"- CALL FieldScatter FOR INPUT LANDSEA MASK." 4448 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4453 if (localpet == 0)
then 4454 call read_fv3_grid_data_netcdf(
'fice', tile, idim_input, jdim_input, &
4458 print*,
"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." 4460 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4465 if (localpet == 0)
then 4466 call read_fv3_grid_data_netcdf(
'hice', tile, idim_input, jdim_input, &
4470 print*,
"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." 4472 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4477 if (localpet == 0)
then 4478 call read_fv3_grid_data_netcdf(
'tisfc', tile, idim_input, jdim_input, &
4482 print*,
"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." 4484 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4489 if (localpet == 0)
then 4490 call read_fv3_grid_data_netcdf(
'sheleg', tile, idim_input, jdim_input, &
4494 print*,
"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." 4496 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4501 if (localpet == 0)
then 4502 call read_fv3_grid_data_netcdf(
'snwdph', tile, idim_input, jdim_input, &
4504 data_one_tile = data_one_tile
4507 print*,
"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." 4509 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4514 if (localpet == 0)
then 4515 call read_fv3_grid_data_netcdf(
'vtype', tile, idim_input, jdim_input, &
4519 print*,
"- CALL FieldScatter FOR INPUT GRID VEG TYPE." 4521 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4526 if (localpet == 0)
then 4527 call read_fv3_grid_data_netcdf(
'stype', tile, idim_input, jdim_input, &
4531 print*,
"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." 4533 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4538 if (localpet == 0)
then 4539 call read_fv3_grid_data_netcdf(
't2m', tile, idim_input, jdim_input, &
4543 print*,
"- CALL FieldScatter FOR INPUT GRID T2M." 4544 call esmf_fieldscatter(
t2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4545 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4550 if (localpet == 0)
then 4551 call read_fv3_grid_data_netcdf(
'q2m', tile, idim_input, jdim_input, &
4555 print*,
"- CALL FieldScatter FOR INPUT GRID Q2M." 4556 call esmf_fieldscatter(
q2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4557 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4560 if (localpet == 0)
then 4561 call read_fv3_grid_data_netcdf(
'tprcp', tile, idim_input, jdim_input, &
4565 print*,
"- CALL FieldScatter FOR INPUT GRID TPRCP." 4566 call esmf_fieldscatter(
tprcp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4567 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4570 if (localpet == 0)
then 4571 call read_fv3_grid_data_netcdf(
'f10m', tile, idim_input, jdim_input, &
4575 print*,
"- CALL FieldScatter FOR INPUT GRID F10M" 4576 call esmf_fieldscatter(
f10m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4577 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4580 if (localpet == 0)
then 4581 call read_fv3_grid_data_netcdf(
'ffmm', tile, idim_input, jdim_input, &
4585 print*,
"- CALL FieldScatter FOR INPUT GRID FFMM" 4586 call esmf_fieldscatter(
ffmm_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4587 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4590 if (localpet == 0)
then 4591 call read_fv3_grid_data_netcdf(
'uustar', tile, idim_input, jdim_input, &
4595 print*,
"- CALL FieldScatter FOR INPUT GRID USTAR" 4596 call esmf_fieldscatter(
ustar_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4597 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4600 if (localpet == 0)
then 4601 call read_fv3_grid_data_netcdf(
'srflag', tile, idim_input, jdim_input, &
4605 print*,
"- CALL FieldScatter FOR INPUT GRID SRFLAG" 4606 call esmf_fieldscatter(
srflag_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4607 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4610 if (localpet == 0)
then 4611 call read_fv3_grid_data_netcdf(
'tsea', tile, idim_input, jdim_input, &
4615 print*,
"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" 4617 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4620 if (localpet == 0)
then 4621 call read_fv3_grid_data_netcdf(
'canopy', tile, idim_input, jdim_input, &
4625 print*,
"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." 4627 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4630 if (localpet == 0)
then 4631 call read_fv3_grid_data_netcdf(
'zorl', tile, idim_input, jdim_input, &
4635 print*,
"- CALL FieldScatter FOR INPUT GRID Z0." 4636 call esmf_fieldscatter(
z0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4637 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4642 deallocate(data_one_tile, data_one_tile_3d)
4655 integer,
intent(in) :: localpet
4657 character(len=500) :: tilefile
4659 integer :: error, id_var
4660 integer :: id_dim, idim_input, jdim_input
4661 integer :: ncid, rc, tile
4663 real(esmf_kind_r8),
allocatable :: data_one_tile(:,:)
4664 real(esmf_kind_r8),
allocatable :: data_one_tile_3d(:,:,:)
4672 print*,
"- READ GRID DIMENSIONS FROM: ", trim(tilefile)
4673 error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
4674 call netcdf_err(error,
'opening: '//trim(tilefile) )
4676 error=nf90_inq_dimid(ncid,
'grid_xt', id_dim)
4677 call netcdf_err(error,
'reading grid_xt id' )
4678 error=nf90_inquire_dimension(ncid,id_dim,len=idim_input)
4679 call netcdf_err(error,
'reading grid_xt value' )
4681 error=nf90_inq_dimid(ncid,
'grid_yt', id_dim)
4682 call netcdf_err(error,
'reading grid_yt id' )
4683 error=nf90_inquire_dimension(ncid,id_dim,len=jdim_input)
4684 call netcdf_err(error,
'reading grid_yt value' )
4687 call error_handler(
"DIMENSION MISMATCH BETWEEN SFC AND OROG FILES.", 3)
4690 error = nf90_close(ncid)
4692 if (localpet == 0)
then 4693 allocate(data_one_tile(idim_input,jdim_input))
4694 allocate(data_one_tile_3d(idim_input,jdim_input,
lsoil_input))
4696 allocate(data_one_tile(0,0))
4697 allocate(data_one_tile_3d(0,0,0))
4702 if (trim(
input_type) ==
"gaussian_netcdf")
then 4703 if (localpet == 0)
then 4704 call read_fv3_grid_data_netcdf(
'orog', tile, idim_input, jdim_input, &
4710 if (localpet == 0)
then 4712 print*,
'- OPEN OROGRAPHY FILE: ', trim(tilefile)
4713 error=nf90_open(tilefile,nf90_nowrite,ncid)
4714 call netcdf_err(error,
'OPENING OROGRAPHY FILE.' )
4715 error=nf90_inq_varid(ncid,
'orog_raw', id_var)
4716 call netcdf_err(error,
'READING OROGRAPHY RECORD ID.' )
4717 error=nf90_get_var(ncid, id_var, data_one_tile)
4718 call netcdf_err(error,
'READING OROGRAPHY RECORD.' )
4719 print*,
'terrain check history ',tile, maxval(data_one_tile)
4720 error=nf90_close(ncid)
4725 print*,
"- CALL FieldScatter FOR INPUT TERRAIN." 4726 call esmf_fieldscatter(
terrain_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4727 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4736 if (localpet == 0)
then 4737 call read_fv3_grid_data_netcdf(
'soill1', tile, idim_input, jdim_input, &
4739 data_one_tile_3d(:,:,1) = data_one_tile
4740 call read_fv3_grid_data_netcdf(
'soill2', tile, idim_input, jdim_input, &
4742 data_one_tile_3d(:,:,2) = data_one_tile
4743 call read_fv3_grid_data_netcdf(
'soill3', tile, idim_input, jdim_input, &
4745 data_one_tile_3d(:,:,3) = data_one_tile
4746 call read_fv3_grid_data_netcdf(
'soill4', tile, idim_input, jdim_input, &
4748 data_one_tile_3d(:,:,4) = data_one_tile
4751 print*,
"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." 4753 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4758 if (localpet == 0)
then 4759 call read_fv3_grid_data_netcdf(
'soilw1', tile, idim_input, jdim_input, &
4761 data_one_tile_3d(:,:,1) = data_one_tile
4762 call read_fv3_grid_data_netcdf(
'soilw2', tile, idim_input, jdim_input, &
4764 data_one_tile_3d(:,:,2) = data_one_tile
4765 call read_fv3_grid_data_netcdf(
'soilw3', tile, idim_input, jdim_input, &
4767 data_one_tile_3d(:,:,3) = data_one_tile
4768 call read_fv3_grid_data_netcdf(
'soilw4', tile, idim_input, jdim_input, &
4770 data_one_tile_3d(:,:,4) = data_one_tile
4773 print*,
"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." 4775 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4780 if (localpet == 0)
then 4781 call read_fv3_grid_data_netcdf(
'soilt1', tile, idim_input, jdim_input, &
4783 data_one_tile_3d(:,:,1) = data_one_tile
4784 call read_fv3_grid_data_netcdf(
'soilt2', tile, idim_input, jdim_input, &
4786 data_one_tile_3d(:,:,2) = data_one_tile
4787 call read_fv3_grid_data_netcdf(
'soilt3', tile, idim_input, jdim_input, &
4789 data_one_tile_3d(:,:,3) = data_one_tile
4790 call read_fv3_grid_data_netcdf(
'soilt4', tile, idim_input, jdim_input, &
4792 data_one_tile_3d(:,:,4) = data_one_tile
4795 print*,
"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." 4797 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4802 if (localpet == 0)
then 4803 call read_fv3_grid_data_netcdf(
'land', tile, idim_input, jdim_input, &
4807 print*,
"- CALL FieldScatter FOR INPUT LANDSEA MASK." 4809 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4814 if (localpet == 0)
then 4815 call read_fv3_grid_data_netcdf(
'icec', tile, idim_input, jdim_input, &
4819 print*,
"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." 4821 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4826 if (localpet == 0)
then 4827 call read_fv3_grid_data_netcdf(
'icetk', tile, idim_input, jdim_input, &
4831 print*,
"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." 4833 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4838 if (localpet == 0)
then 4839 call read_fv3_grid_data_netcdf(
'tisfc', tile, idim_input, jdim_input, &
4843 print*,
"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." 4845 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4850 if (localpet == 0)
then 4851 call read_fv3_grid_data_netcdf(
'weasd', tile, idim_input, jdim_input, &
4855 print*,
"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." 4857 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4862 if (localpet == 0)
then 4863 call read_fv3_grid_data_netcdf(
'snod', tile, idim_input, jdim_input, &
4865 data_one_tile = data_one_tile * 1000.0
4868 print*,
"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." 4870 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4875 if (localpet == 0)
then 4876 call read_fv3_grid_data_netcdf(
'vtype', tile, idim_input, jdim_input, &
4880 print*,
"- CALL FieldScatter FOR INPUT GRID VEG TYPE." 4882 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4887 if (localpet == 0)
then 4888 call read_fv3_grid_data_netcdf(
'sotyp', tile, idim_input, jdim_input, &
4892 print*,
"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." 4894 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4899 if (localpet == 0)
then 4900 call read_fv3_grid_data_netcdf(
'tmp2m', tile, idim_input, jdim_input, &
4904 print*,
"- CALL FieldScatter FOR INPUT GRID T2M." 4905 call esmf_fieldscatter(
t2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4906 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4911 if (localpet == 0)
then 4912 call read_fv3_grid_data_netcdf(
'spfh2m', tile, idim_input, jdim_input, &
4916 print*,
"- CALL FieldScatter FOR INPUT GRID Q2M." 4917 call esmf_fieldscatter(
q2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4918 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4921 if (localpet == 0)
then 4922 call read_fv3_grid_data_netcdf(
'tprcp', tile, idim_input, jdim_input, &
4926 print*,
"- CALL FieldScatter FOR INPUT GRID TPRCP." 4927 call esmf_fieldscatter(
tprcp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4928 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4931 if (localpet == 0)
then 4932 call read_fv3_grid_data_netcdf(
'f10m', tile, idim_input, jdim_input, &
4936 print*,
"- CALL FieldScatter FOR INPUT GRID F10M" 4937 call esmf_fieldscatter(
f10m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4938 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4941 if (localpet == 0)
then 4942 call read_fv3_grid_data_netcdf(
'ffmm', tile, idim_input, jdim_input, &
4946 print*,
"- CALL FieldScatter FOR INPUT GRID FFMM" 4947 call esmf_fieldscatter(
ffmm_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4948 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4951 if (localpet == 0)
then 4952 call read_fv3_grid_data_netcdf(
'fricv', tile, idim_input, jdim_input, &
4956 print*,
"- CALL FieldScatter FOR INPUT GRID USTAR" 4957 call esmf_fieldscatter(
ustar_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4958 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4961 if (localpet == 0)
then 4967 print*,
"- CALL FieldScatter FOR INPUT GRID SRFLAG" 4968 call esmf_fieldscatter(
srflag_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4969 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4972 if (localpet == 0)
then 4973 call read_fv3_grid_data_netcdf(
'tmpsfc', tile, idim_input, jdim_input, &
4977 print*,
"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" 4979 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4982 if (localpet == 0)
then 4983 call read_fv3_grid_data_netcdf(
'cnwat', tile, idim_input, jdim_input, &
4987 print*,
"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." 4989 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4992 if (localpet == 0)
then 4993 call read_fv3_grid_data_netcdf(
'sfcr', tile, idim_input, jdim_input, &
4997 print*,
"- CALL FieldScatter FOR INPUT GRID Z0." 4998 call esmf_fieldscatter(
z0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4999 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
5004 deallocate(data_one_tile, data_one_tile_3d)
5022 integer,
intent(in) :: localpet
5024 character(len=250) :: the_file
5025 character(len=250) :: geo_file
5026 character(len=20) :: vname, vname_file, slev
5027 character(len=50) :: method
5028 character(len=20) :: to_upper
5030 integer :: rc, varnum, iret, i, j,k
5031 integer :: ncid2d, varid, varsize
5032 integer :: lugb, lugi
5033 integer :: jdisc, jgdtn, jpdtn, pdt_num
5034 integer :: jids(200), jgdt(200), jpdt(200)
5036 logical :: rap_latlon, unpack
5038 real(esmf_kind_r4) :: value
5039 real(esmf_kind_r4),
allocatable :: dummy2d(:,:)
5040 real(esmf_kind_r8),
allocatable :: icec_save(:,:)
5041 real(esmf_kind_r4),
allocatable :: dummy1d(:)
5042 real(esmf_kind_r8),
allocatable :: dummy2d_8(:,:),dummy2d_82(:,:),tsk_save(:,:)
5043 real(esmf_kind_r8),
allocatable :: dummy3d(:,:,:), dummy3d_stype(:,:,:)
5044 integer(esmf_kind_i4),
allocatable :: slmsk_save(:,:)
5045 integer(esmf_kind_i8),
allocatable :: dummy2d_i(:,:)
5047 type(gribfield) :: gfld
5049 rap_latlon = trim(to_upper(external_model))==
"RAP" .and. trim(
input_grid_type) ==
"rotated_latlon" 5051 the_file = trim(data_dir_input_grid) //
"/" // trim(grib2_file_input_grid)
5052 geo_file = trim(geogrid_file_input_grid)
5054 print*,
"- READ SFC DATA FROM GRIB2 FILE: ", trim(the_file)
5058 if (localpet == 0)
then 5061 call baopenr(lugb,the_file,rc)
5062 if (rc /= 0)
call error_handler(
"ERROR OPENING GRIB2 FILE.", rc)
5074 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5075 unpack, k, gfld, rc)
5078 if (gfld%idsect(1) == 7 .and. gfld%idsect(2) == 2)
then 5079 print*,
'- THIS IS NCEP GEFS DATA.' 5085 if (rc /= 0)
call error_handler(
"ERROR READING GRIB2 FILE.", rc)
5093 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5094 unpack, k, gfld, rc)
5098 if (gfld%discipline == 2)
then 5099 if (gfld%ipdtnum == pdt_num)
then 5100 if (gfld%ipdtmpl(1) == 0 .and. gfld%ipdtmpl(2) == 2)
then 5102 if (gfld%ipdtmpl(10) == 106 .and. gfld%ipdtmpl(13) == 106)
then 5114 print*,
"- FILE HAS ",
lsoil_input,
" SOIL LEVELS." 5119 call mpi_barrier(mpi_comm_world, rc)
5120 call mpi_bcast(
lsoil_input,1,mpi_integer,0,mpi_comm_world,rc)
5130 print*,
"- CALL FieldCreate FOR INPUT SOIL TEMPERATURE." 5132 typekind=esmf_typekind_r8, &
5133 staggerloc=esmf_staggerloc_center, &
5134 ungriddedlbound=(/1/), &
5136 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
5139 print*,
"- CALL FieldCreate FOR INPUT TOTAL SOIL MOISTURE." 5141 typekind=esmf_typekind_r8, &
5142 staggerloc=esmf_staggerloc_center, &
5143 ungriddedlbound=(/1/), &
5145 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
5148 print*,
"- CALL FieldCreate FOR INPUT LIQUID SOIL MOISTURE." 5150 typekind=esmf_typekind_r8, &
5151 staggerloc=esmf_staggerloc_center, &
5152 ungriddedlbound=(/1/), &
5154 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
5159 if (localpet == 0)
then 5160 allocate(dummy2d(i_input,j_input))
5161 allocate(slmsk_save(i_input,j_input))
5162 allocate(tsk_save(i_input,j_input))
5163 allocate(icec_save(i_input,j_input))
5164 allocate(dummy2d_8(i_input,j_input))
5165 allocate(dummy2d_82(i_input,j_input))
5168 allocate(dummy3d(0,0,0))
5169 allocate(dummy2d_8(0,0))
5170 allocate(dummy2d_82(0,0))
5171 allocate(dummy2d(0,0))
5172 allocate(slmsk_save(0,0))
5180 if (localpet == 0)
then 5182 print*,
"- READ TERRAIN." 5192 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5193 unpack, k, gfld, rc)
5196 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5201 print*,
"- CALL FieldScatter FOR INPUT TERRAIN." 5203 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5206 if (localpet == 0)
then 5208 print*,
"- READ SEAICE FRACTION." 5218 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5219 unpack, k, gfld, rc)
5220 if (rc /= 0)
call error_handler(
"READING SEAICE FRACTION.", rc)
5222 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5225 icec_save = dummy2d_8
5229 print*,
"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." 5231 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5242 if (localpet == 0)
then 5244 print*,
"- READ LANDSEA MASK." 5253 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5254 unpack, k, gfld, rc)
5258 print*,
'landnn ', maxval(gfld%fld),minval(gfld%fld)
5269 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5270 unpack, k, gfld, rc)
5271 if (rc /= 0)
call error_handler(
"READING LANDSEA MASK.", rc)
5277 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5281 if(dummy2d_8(i,j) < 0.5_esmf_kind_r8) dummy2d_8(i,j)=0.0
5282 if(icec_save(i,j) > 0.15_esmf_kind_r8)
then 5283 dummy2d_8(i,j) = 2.0_esmf_kind_r8
5288 slmsk_save = nint(dummy2d_8)
5290 deallocate(icec_save)
5294 print*,
"- CALL FieldScatter FOR INPUT LANDSEA MASK." 5296 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5299 if (localpet == 0)
then 5301 print*,
"- READ SEAICE SKIN TEMPERATURE." 5311 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5312 unpack, k, gfld, rc)
5313 if (rc /= 0)
call error_handler(
"READING SEAICE SKIN TEMP.", rc)
5317 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5321 print*,
"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." 5323 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5332 if (localpet == 0)
then 5334 print*,
"- READ SNOW LIQUID EQUIVALENT." 5345 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5346 unpack, k, gfld, rc)
5347 if (rc /= 0)
call error_handler(
"READING SNOW LIQUID EQUIVALENT.", rc)
5351 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5355 if(slmsk_save(i,j) == 0) dummy2d_8(i,j) = 0.0
5361 print*,
"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." 5363 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5366 if (localpet == 0)
then 5368 print*,
"- READ SNOW DEPTH." 5379 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5380 unpack, k, gfld, rc)
5385 gfld%fld = gfld%fld * 1000.0
5387 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5392 if(slmsk_save(i,j) == 0) dummy2d_8(i,j) = 0.0
5398 print*,
"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." 5400 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5403 if (localpet == 0)
then 5405 print*,
"- READ T2M." 5417 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5418 unpack, k, gfld, rc)
5423 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5427 print*,
"- CALL FieldScatter FOR INPUT GRID T2M." 5428 call esmf_fieldscatter(
t2m_input_grid, dummy2d_8, rootpet=0,rc=rc)
5429 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5432 if (localpet == 0)
then 5434 print*,
"- READ Q2M." 5446 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5447 unpack, k, gfld, rc)
5452 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5456 print*,
"- CALL FieldScatter FOR INPUT GRID Q2M." 5457 call esmf_fieldscatter(
q2m_input_grid,dummy2d_8, rootpet=0,rc=rc)
5458 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5461 if (localpet == 0)
then 5463 print*,
"- READ SKIN TEMPERATURE." 5474 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5475 unpack, k, gfld, rc)
5477 if (rc /= 0 )
call error_handler(
"READING SKIN TEMPERATURE.", rc)
5480 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5482 tsk_save(:,:) = dummy2d_8
5486 if(slmsk_save(i,j) == 0 .and. dummy2d_8(i,j) < 271.2)
then 5488 dummy2d_8(i,j) = 271.2
5490 if(slmsk_save(i,j) == 0 .and. dummy2d_8(i,j) > 310.)
then 5492 dummy2d_8(i,j) = 310.0
5499 print*,
"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" 5501 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5506 if (localpet == 0) dummy2d_8 = 0.0
5508 print*,
"- CALL FieldScatter FOR INPUT GRID SRFLAG" 5510 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5513 if (localpet == 0)
then 5515 print*,
"- READ SOIL TYPE." 5526 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5527 unpack, k, gfld, rc)
5531 dummy2d = reshape(gfld%fld , (/i_input,j_input/))
5535 if (rc /= 0 .and. (trim(to_upper(external_model))==
"HRRR" .or. rap_latlon) .and. geo_file .ne.
"NULL")
then 5539 print*,
"OPEN GEOGRID FILE ", trim(geo_file)
5540 rc = nf90_open(geo_file,nf90_nowrite,ncid2d)
5543 print*,
"INQURE ABOUT DIM IDS" 5544 rc = nf90_inq_dimid(ncid2d,
"west_east",varid)
5545 call netcdf_err(rc,
"READING west_east DIMENSION FROM GEOGRID FILE")
5547 rc = nf90_inquire_dimension(ncid2d,varid,len=varsize)
5548 call netcdf_err(rc,
"READING west_east DIMENSION SIZE")
5549 if (varsize .ne. i_input)
call error_handler (
"GEOGRID FILE GRID SIZE DIFFERS FROM INPUT DATA.", -1)
5551 print*,
"INQUIRE ABOUT SOIL TYPE FROM GEOGRID FILE" 5552 rc = nf90_inq_varid(ncid2d,
"SCT_DOM",varid)
5553 call netcdf_err(rc,
"FINDING SCT_DOM IN GEOGRID FILE")
5555 print*,
"READ SOIL TYPE FROM GEOGRID FILE " 5556 rc = nf90_get_var(ncid2d,varid,dummy2d)
5557 call netcdf_err(rc,
"READING SCT_DOM FROM FILE")
5559 print*,
"INQUIRE ABOUT SOIL TYPE FRACTIONS FROM GEOGRID FILE" 5560 rc = nf90_inq_varid(ncid2d,
"SOILCTOP",varid)
5561 call netcdf_err(rc,
"FINDING SOILCTOP IN GEOGRID FILE")
5563 allocate(dummy3d_stype(i_input,j_input,16))
5564 print*,
"READ SOIL TYPE FRACTIONS FROM GEOGRID FILE " 5565 rc = nf90_get_var(ncid2d,varid,dummy3d_stype)
5566 call netcdf_err(rc,
"READING SCT_DOM FROM FILE")
5568 print*,
"CLOSE GEOGRID FILE " 5569 iret = nf90_close(ncid2d)
5574 allocate(dummy1d(16))
5577 if(dummy2d(i,j) == 14.0_esmf_kind_r4 .and. slmsk_save(i,j) == 1)
then 5578 dummy1d(:) = dummy3d_stype(i,j,:)
5579 dummy1d(14) = 0.0_esmf_kind_r4
5580 dummy2d(i,j) =
real(MAXLOC(dummy1d, 1),esmf_kind_r4)
5585 deallocate(dummy3d_stype)
5588 if ((rc /= 0 .and. trim(to_upper(external_model)) /=
"HRRR" .and. .not. rap_latlon) &
5589 .or. (rc /= 0 .and. (trim(to_upper(external_model)) ==
"HRRR" .or. rap_latlon)))
then 5591 call error_handler(
"COULD NOT FIND SOIL TYPE IN FILE. PLEASE SET SOTYP_FROM_CLIMO=.TRUE. . EXITING", rc)
5595 call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=
value, &
5599 print*,
"WARNING: "//trim(vname)//
" NOT AVAILABLE IN FILE. WILL NOT "//&
5600 "SCALE SOIL MOISTURE FOR DIFFERENCES IN SOIL TYPE. " 5601 dummy2d(:,:) = -99999.0_esmf_kind_r4
5613 if(dummy2d(i,j) == 14.0_esmf_kind_r4 .and. slmsk_save(i,j) == 1) dummy2d(i,j) = -99999.9
5617 allocate(dummy2d_i(i_input,j_input))
5618 dummy2d_8 =
real(dummy2d,esmf_kind_r8)
5620 where(slmsk_save == 1) dummy2d_i = 1
5622 call search(dummy2d_8,dummy2d_i,i_input,j_input,1,230)
5623 deallocate(dummy2d_i)
5625 dummy2d_8=
real(dummy2d,esmf_kind_r8)
5628 print*,
'sotype ',maxval(dummy2d_8),minval(dummy2d_8)
5632 print*,
"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." 5634 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5644 if (.not. vgfrc_from_climo)
then 5646 if (localpet == 0)
then 5648 print*,
"- READ VEG FRACTION." 5659 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5660 unpack, k, gfld, rc)
5663 call error_handler(
"COULD NOT FIND VEGETATION FRACTION IN FILE. & 5664 PLEASE SET VGFRC_FROM_CLIMO=.TRUE. EXITING", rc)
5666 if (maxval(gfld%fld) > 2.0) gfld%fld = gfld%fld / 100.0
5668 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5674 print*,
"- CALL FieldScatter FOR INPUT GRID VEG GREENNESS." 5676 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
5681 if (.not. minmax_vgfrc_from_climo)
then 5683 if (localpet == 0)
then 5685 print*,
"- READ MIN VEG FRACTION." 5697 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5698 unpack, k, gfld, rc)
5702 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5703 unpack, k, gfld, rc)
5706 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5707 unpack, k, gfld, rc)
5708 if (rc/=0)
call error_handler(
"COULD NOT FIND MIN VEGETATION FRACTION IN FILE. & 5709 PLEASE SET MINMAX_VGFRC_FROM_CLIMO=.TRUE. . EXITING",rc)
5713 if (maxval(gfld%fld) > 2.0) gfld%fld = gfld%fld / 100.0
5714 print*,
'vfrac min ', maxval(gfld%fld),minval(gfld%fld)
5715 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5719 print*,
"- CALL FieldScatter FOR INPUT GRID MIN VEG GREENNESS." 5721 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5724 if (localpet == 0)
then 5726 print*,
"- READ MAX VEG FRACTION." 5737 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5738 unpack, k, gfld, rc)
5741 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5742 unpack, k, gfld, rc)
5745 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5746 unpack, k, gfld, rc)
5747 if (rc <= 0)
call error_handler(
"COULD NOT FIND MAX VEGETATION FRACTION IN FILE. & 5748 PLEASE SET MINMAX_VGFRC_FROM_CLIMO=.TRUE. . EXITING",rc)
5752 if (maxval(gfld%fld) > 2.0) gfld%fld = gfld%fld / 100.0
5754 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5758 print*,
"- CALL FieldScatter FOR INPUT GRID MAX VEG GREENNESS." 5760 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5765 if (.not. lai_from_climo)
then 5767 if (localpet == 0)
then 5769 print*,
"- READ LAI." 5780 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5781 unpack, k, gfld, rc)
5783 if (rc /= 0)
call error_handler(
"COULD NOT FIND LAI IN FILE. & 5784 PLEASE SET LAI_FROM_CLIMO=.TRUE. . EXITING",rc)
5787 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5791 print*,
"- CALL FieldScatter FOR INPUT GRID LAI." 5792 call esmf_fieldscatter(
lai_input_grid,dummy2d_8,rootpet=0, rc=rc)
5793 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5798 if (localpet == 0)
then 5800 print*,
"- READ SEAICE DEPTH." 5803 call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=
value, &
5815 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5816 unpack, k, gfld, rc)
5821 print*,
"WARNING: "//trim(vname)//
" NOT AVAILABLE IN FILE. THIS FIELD WILL BE"//&
5822 " REPLACED WITH CLIMO. SET A FILL "// &
5823 "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." 5824 dummy2d_8(:,:) = 0.0
5828 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5833 print*,
"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." 5835 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5838 if (localpet == 0)
then 5840 print*,
"- READ TPRCP." 5843 call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=
value, &
5851 print*,
"WARNING: "//trim(vname)//
" NOT AVAILABLE IN FILE. THIS FIELD WILL NOT"//&
5852 " BE WRITTEN TO THE INPUT FILE. SET A FILL "// &
5853 "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." 5857 print*,
'tprcp ',maxval(dummy2d_8),minval(dummy2d_8)
5861 print*,
"- CALL FieldScatter FOR INPUT GRID TPRCP." 5863 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5866 if (localpet == 0)
then 5868 print*,
"- READ FFMM." 5871 call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=
value, &
5879 print*,
"WARNING: "//trim(vname)//
" NOT AVAILABLE IN FILE. THIS FIELD WILL NOT"//&
5880 " BE WRITTEN TO THE INPUT FILE. SET A FILL "// &
5881 "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." 5882 dummy2d_8(:,:) = 0.0
5885 print*,
'ffmm ',maxval(dummy2d_8),minval(dummy2d_8)
5889 print*,
"- CALL FieldScatter FOR INPUT GRID FFMM" 5891 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5894 if (localpet == 0)
then 5896 print*,
"- READ USTAR." 5899 call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=
value, &
5911 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5912 unpack, k, gfld, rc)
5915 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5916 unpack, k, gfld, rc)
5921 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5925 print*,
"WARNING: "//trim(vname)//
" NOT AVAILABLE IN FILE. THIS FIELD WILL "//&
5926 "REPLACED WITH CLIMO. SET A FILL "// &
5927 "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." 5928 dummy2d_8(:,:) = 0.0
5934 print*,
"- CALL FieldScatter FOR INPUT GRID USTAR" 5936 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5939 if (localpet == 0)
then 5941 print*,
"- READ F10M." 5943 slev=
":10 m above ground:" 5944 call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=
value, &
5951 print*,
"WARNING: "//trim(vname)//
" NOT AVAILABLE IN FILE. THIS FIELD WILL NOT"//&
5952 " BE WRITTEN TO THE INPUT FILE. SET A FILL "// &
5953 "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." 5954 dummy2d_8(:,:) = 0.0
5957 print*,
'f10m ',maxval(dummy2d_8),minval(dummy2d_8)
5961 print*,
"- CALL FieldScatter FOR INPUT GRID F10M." 5963 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5966 if (localpet == 0)
then 5968 print*,
"- READ CANOPY MOISTURE CONTENT." 5971 call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=
value, &
5983 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5984 unpack, k, gfld, rc)
5988 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5989 unpack, k, gfld, rc)
5993 print*,
'cnwat ', maxval(gfld%fld),minval(gfld%fld)
5994 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5999 print*,
"WARNING: "//trim(vname)//
" NOT AVAILABLE IN FILE. THIS FIELD WILL"//&
6000 " REPLACED WITH CLIMO. SET A FILL "// &
6001 "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." 6008 print*,
"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." 6010 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6013 if (localpet == 0)
then 6018 call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=
value, &
6030 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
6031 unpack, k, gfld, rc)
6036 print*,
"WARNING: "//trim(vname)//
" NOT AVAILABLE IN FILE. THIS FIELD WILL BE"//&
6037 " REPLACED WITH CLIMO. SET A FILL "// &
6038 "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." 6039 dummy2d_8(:,:) = 0.0
6042 gfld%fld = gfld%fld * 10.0
6044 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
6049 print*,
"- CALL FieldScatter FOR INPUT GRID Z0." 6050 call esmf_fieldscatter(
z0_input_grid,dummy2d_8, rootpet=0, rc=rc)
6051 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6054 if (localpet == 0)
then 6055 print*,
"- READ LIQUID SOIL MOISTURE." 6057 vname_file =
":SOILL:" 6062 print*,
"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." 6064 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6067 if (localpet == 0)
then 6068 print*,
"- READ TOTAL SOIL MOISTURE." 6070 vname_file =
"var2_2_1_" 6074 print*,
"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." 6076 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6085 print*,
"- CALL FieldGather for INPUT SOIL TYPE." 6087 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6090 if (localpet == 0)
then 6092 print*,
"- READ VEG TYPE." 6103 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
6104 unpack, k, gfld, rc)
6108 call error_handler(
"COULD NOT FIND VEGETATION TYPE IN FILE. PLEASE SET VGTYP_FROM_CLIMO=.TRUE. . EXITING", rc)
6112 dummy2d_8(i,j) = 0.0
6113 if(slmsk_save(i,j) == 1 .and. dummy3d(i,j,1) > 0.99) &
6115 dummy2d_8(i,j) =
real(veg_type_landice_input,esmf_kind_r8)
6120 dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
6123 if (trim(external_model) .ne.
"GFS")
then 6126 if (dummy2d_8(i,j) == 15.0_esmf_kind_r8 .and. slmsk_save(i,j) == 1)
then 6127 if (dummy3d(i,j,1) < 0.6)
then 6128 dummy2d_8(i,j) =
real(veg_type_landice_input,esmf_kind_r8)
6129 elseif (dummy3d(i,j,1) > 0.99)
then 6131 dummy2d_8(i,j) = 0.0_esmf_kind_r8
6132 dummy2d_82(i,j) = 0.0_esmf_kind_r8
6134 elseif (dummy2d_8(i,j) == 17.0_esmf_kind_r8 .and. slmsk_save(i,j)==0)
then 6135 dummy2d_8(i,j) = 0.0_esmf_kind_r8
6145 print*,
"- CALL FieldScatter FOR INPUT VEG TYPE." 6147 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6150 print*,
"- CALL FieldScatter FOR INPUT SOIL TYPE." 6152 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6155 deallocate(dummy2d_82)
6157 print*,
"- CALL FieldScatter FOR INPUT LANDSEA MASK." 6159 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6169 if (localpet == 0)
then 6170 print*,
"- READ SOIL TEMPERATURE." 6172 vname_file =
":TSOIL:" 6175 deallocate(tsk_save)
6178 deallocate(slmsk_save)
6180 print*,
"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." 6182 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6186 deallocate(dummy2d_8)
6188 if (localpet == 0)
call baclose(lugb, rc)
6201 integer,
intent(in) :: localpet
6203 character(len=10) :: field
6207 real(esmf_kind_r8),
allocatable :: data_one_tile(:,:)
6209 if (localpet == 0)
then 6212 allocate(data_one_tile(0,0))
6219 if (localpet == 0)
then 6225 call read_fv3_grid_data_netcdf(trim(field), tile,
i_input,
j_input, &
6229 print*,
"- CALL FieldScatter FOR INPUT C_D" 6230 call esmf_fieldscatter(
c_d_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6231 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6236 if (localpet == 0)
then 6242 call read_fv3_grid_data_netcdf(trim(field), tile,
i_input,
j_input, &
6246 print*,
"- CALL FieldScatter FOR INPUT C_0" 6247 call esmf_fieldscatter(
c_0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6248 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6253 if (localpet == 0)
then 6259 call read_fv3_grid_data_netcdf(trim(field), tile,
i_input,
j_input, &
6263 print*,
"- CALL FieldScatter FOR INPUT D_CONV." 6264 call esmf_fieldscatter(
d_conv_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6265 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6270 if (localpet == 0)
then 6276 call read_fv3_grid_data_netcdf(trim(field), tile,
i_input,
j_input, &
6280 print*,
"- CALL FieldScatter FOR INPUT DT_COOL." 6281 call esmf_fieldscatter(
dt_cool_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6282 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6287 if (localpet == 0)
then 6291 print*,
"- CALL FieldScatter FOR INPUT IFD." 6292 call esmf_fieldscatter(
ifd_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6293 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6298 if (localpet == 0)
then 6299 call read_fv3_grid_data_netcdf(
'qrain', tile,
i_input,
j_input, &
6303 print*,
"- CALL FieldScatter FOR INPUT QRAIN." 6304 call esmf_fieldscatter(
qrain_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6305 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6310 if (localpet == 0)
then 6315 print*,
"- CALL FieldScatter FOR INPUT TREF" 6316 call esmf_fieldscatter(
tref_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6317 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6322 if (localpet == 0)
then 6328 call read_fv3_grid_data_netcdf(trim(field), tile,
i_input,
j_input, &
6332 print*,
"- CALL FieldScatter FOR INPUT W_D" 6333 call esmf_fieldscatter(
w_d_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6334 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6339 if (localpet == 0)
then 6345 call read_fv3_grid_data_netcdf(trim(field), tile,
i_input,
j_input, &
6349 print*,
"- CALL FieldScatter FOR INPUT W_0" 6350 call esmf_fieldscatter(
w_0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6351 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6356 if (localpet == 0)
then 6361 print*,
"- CALL FieldScatter FOR INPUT XS" 6362 call esmf_fieldscatter(
xs_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6363 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6368 if (localpet == 0)
then 6373 print*,
"- CALL FieldScatter FOR INPUT XT" 6374 call esmf_fieldscatter(
xt_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6375 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6380 if (localpet == 0)
then 6385 print*,
"- CALL FieldScatter FOR INPUT XU" 6386 call esmf_fieldscatter(
xu_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6387 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6392 if (localpet == 0)
then 6397 print*,
"- CALL FieldScatter FOR INPUT XV" 6398 call esmf_fieldscatter(
xv_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6399 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6404 if (localpet == 0)
then 6409 print*,
"- CALL FieldScatter FOR INPUT XZ" 6410 call esmf_fieldscatter(
xz_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6411 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6416 if (localpet == 0)
then 6421 print*,
"- CALL FieldScatter FOR INPUT XTTS" 6422 call esmf_fieldscatter(
xtts_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6423 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6428 if (localpet == 0)
then 6433 print*,
"- CALL FieldScatter FOR INPUT XZTS" 6434 call esmf_fieldscatter(
xzts_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6435 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6440 if (localpet == 0)
then 6446 call read_fv3_grid_data_netcdf(trim(field), tile,
i_input,
j_input, &
6450 print*,
"- CALL FieldScatter FOR INPUT Z_C" 6451 call esmf_fieldscatter(
z_c_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6452 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6457 if (localpet == 0)
then 6461 print*,
"- CALL FieldScatter FOR INPUT ZM" 6462 call esmf_fieldscatter(
zm_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6463 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6468 deallocate(data_one_tile)
6485 integer,
intent(in) :: localpet
6487 character(len=300) :: the_file
6491 real(nemsio_realkind),
allocatable :: dummy(:)
6492 real(esmf_kind_r8),
allocatable :: dummy2d(:,:)
6494 type(nemsio_gfile) :: gfile
6496 if (trim(
input_type) ==
"gfs_gaussian_nemsio")
then 6503 print*,
"- READ NST DATA FROM: ", trim(the_file)
6505 if (localpet == 0)
then 6508 call nemsio_open(gfile, the_file,
"read", iret=rc)
6511 allocate(dummy2d(0,0))
6514 if (localpet == 0)
then 6515 print*,
"- READ TREF" 6516 call nemsio_readrecv(gfile,
"tref",
"sfc", 1, dummy, 0, iret=rc)
6519 print*,
'tref ',maxval(dummy2d),minval(dummy2d)
6522 print*,
"- CALL FieldScatter FOR INPUT TREF." 6524 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6527 if (localpet == 0)
then 6529 call nemsio_readrecv(gfile,
"cd",
"sfc", 1, dummy, 0, iret=rc)
6532 print*,
'cd ',maxval(dummy2d),minval(dummy2d)
6535 print*,
"- CALL FieldScatter FOR INPUT C_D." 6536 call esmf_fieldscatter(
c_d_input_grid, dummy2d, rootpet=0, rc=rc)
6537 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6540 if (localpet == 0)
then 6542 call nemsio_readrecv(gfile,
"c0",
"sfc", 1, dummy, 0, iret=rc)
6545 print*,
'c0 ',maxval(dummy2d),minval(dummy2d)
6548 print*,
"- CALL FieldScatter FOR INPUT C_0." 6549 call esmf_fieldscatter(
c_0_input_grid, dummy2d, rootpet=0, rc=rc)
6550 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6553 if (localpet == 0)
then 6554 print*,
"- READ DCONV" 6555 call nemsio_readrecv(gfile,
"dconv",
"sfc", 1, dummy, 0, iret=rc)
6558 print*,
'dconv ',maxval(dummy2d),minval(dummy2d)
6561 print*,
"- CALL FieldScatter FOR INPUT D_CONV." 6563 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6566 if (localpet == 0)
then 6567 print*,
"- READ DTCOOL" 6568 call nemsio_readrecv(gfile,
"dtcool",
"sfc", 1, dummy, 0, iret=rc)
6571 print*,
'dtcool ',maxval(dummy2d),minval(dummy2d)
6574 print*,
"- CALL FieldScatter FOR INPUT DT_COOL." 6576 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6579 if (localpet == 0)
then 6583 print*,
"- CALL FieldScatter FOR INPUT IFD." 6584 call esmf_fieldscatter(
ifd_input_grid, dummy2d, rootpet=0, rc=rc)
6585 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6588 if (localpet == 0)
then 6589 print*,
"- READ QRAIN" 6590 call nemsio_readrecv(gfile,
"qrain",
"sfc", 1, dummy, 0, iret=rc)
6593 print*,
'qrain ',maxval(dummy2d),minval(dummy2d)
6596 print*,
"- CALL FieldScatter FOR INPUT QRAIN." 6598 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6601 if (localpet == 0)
then 6603 call nemsio_readrecv(gfile,
"wd",
"sfc", 1, dummy, 0, iret=rc)
6606 print*,
'wd ',maxval(dummy2d),minval(dummy2d)
6609 print*,
"- CALL FieldScatter FOR INPUT WD." 6610 call esmf_fieldscatter(
w_d_input_grid, dummy2d, rootpet=0, rc=rc)
6611 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6614 if (localpet == 0)
then 6616 call nemsio_readrecv(gfile,
"w0",
"sfc", 1, dummy, 0, iret=rc)
6619 print*,
'w0 ',maxval(dummy2d),minval(dummy2d)
6622 print*,
"- CALL FieldScatter FOR INPUT W0." 6623 call esmf_fieldscatter(
w_0_input_grid, dummy2d, rootpet=0, rc=rc)
6624 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6627 if (localpet == 0)
then 6629 call nemsio_readrecv(gfile,
"xs",
"sfc", 1, dummy, 0, iret=rc)
6632 print*,
'xs ',maxval(dummy2d),minval(dummy2d)
6635 print*,
"- CALL FieldScatter FOR INPUT XS." 6636 call esmf_fieldscatter(
xs_input_grid, dummy2d, rootpet=0, rc=rc)
6637 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6640 if (localpet == 0)
then 6642 call nemsio_readrecv(gfile,
"xt",
"sfc", 1, dummy, 0, iret=rc)
6645 print*,
'xt ',maxval(dummy2d),minval(dummy2d)
6648 print*,
"- CALL FieldScatter FOR INPUT XT." 6649 call esmf_fieldscatter(
xt_input_grid, dummy2d, rootpet=0, rc=rc)
6650 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6653 if (localpet == 0)
then 6655 call nemsio_readrecv(gfile,
"xu",
"sfc", 1, dummy, 0, iret=rc)
6658 print*,
'xu ',maxval(dummy2d),minval(dummy2d)
6661 print*,
"- CALL FieldScatter FOR INPUT XU." 6662 call esmf_fieldscatter(
xu_input_grid, dummy2d, rootpet=0, rc=rc)
6663 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6666 if (localpet == 0)
then 6668 call nemsio_readrecv(gfile,
"xv",
"sfc", 1, dummy, 0, iret=rc)
6671 print*,
'xv ',maxval(dummy2d),minval(dummy2d)
6674 print*,
"- CALL FieldScatter FOR INPUT XV." 6675 call esmf_fieldscatter(
xv_input_grid, dummy2d, rootpet=0, rc=rc)
6676 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6679 if (localpet == 0)
then 6681 call nemsio_readrecv(gfile,
"xz",
"sfc", 1, dummy, 0, iret=rc)
6684 print*,
'xz ',maxval(dummy2d),minval(dummy2d)
6687 print*,
"- CALL FieldScatter FOR INPUT XZ." 6688 call esmf_fieldscatter(
xz_input_grid, dummy2d, rootpet=0, rc=rc)
6689 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6692 if (localpet == 0)
then 6693 print*,
"- READ XTTS" 6694 call nemsio_readrecv(gfile,
"xtts",
"sfc", 1, dummy, 0, iret=rc)
6697 print*,
'xtts ',maxval(dummy2d),minval(dummy2d)
6700 print*,
"- CALL FieldScatter FOR INPUT XTTS." 6702 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6705 if (localpet == 0)
then 6706 print*,
"- READ XZTS" 6707 call nemsio_readrecv(gfile,
"xzts",
"sfc", 1, dummy, 0, iret=rc)
6710 print*,
'xzts ',maxval(dummy2d),minval(dummy2d)
6713 print*,
"- CALL FieldScatter FOR INPUT XZTS." 6715 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6718 if (localpet == 0)
then 6720 call nemsio_readrecv(gfile,
"zc",
"sfc", 1, dummy, 0, iret=rc)
6723 print*,
'zc ',maxval(dummy2d),minval(dummy2d)
6726 print*,
"- CALL FieldScatter FOR INPUT Z_C." 6727 call esmf_fieldscatter(
z_c_input_grid, dummy2d, rootpet=0, rc=rc)
6728 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6731 if (localpet == 0)
then 6735 print*,
"- CALL FieldScatter FOR INPUT ZM." 6736 call esmf_fieldscatter(
zm_input_grid, dummy2d, rootpet=0, rc=rc)
6737 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6740 deallocate(dummy, dummy2d)
6742 if (localpet == 0)
call nemsio_close(gfile)
6756 SUBROUTINE read_fv3_grid_data_netcdf(FIELD,TILE_NUM,IMO,JMO,LMO, &
6757 SFCDATA, SFCDATA_3D)
6761 CHARACTER(LEN=*),
INTENT(IN) :: FIELD
6763 INTEGER,
INTENT(IN) :: IMO, JMO, LMO, TILE_NUM
6765 REAL(ESMF_KIND_R8),
INTENT(OUT),
OPTIONAL :: SFCDATA(IMO,JMO)
6766 REAL(ESMF_KIND_R8),
INTENT(OUT),
OPTIONAL :: SFCDATA_3D(IMO,JMO,LMO)
6768 CHARACTER(LEN=256) :: TILEFILE
6770 INTEGER :: ERROR, NCID, ID_VAR
6774 print*,
'WILL READ ',trim(field),
' FROM: ', trim(tilefile)
6776 error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
6777 CALL netcdf_err(error,
'OPENING: '//trim(tilefile) )
6779 error=nf90_inq_varid(ncid, field, id_var)
6782 IF (
PRESENT(sfcdata_3d))
THEN 6783 error=nf90_get_var(ncid, id_var, sfcdata_3d)
6786 error=nf90_get_var(ncid, id_var, sfcdata)
6790 error = nf90_close(ncid)
6792 END SUBROUTINE read_fv3_grid_data_netcdf
6805 subroutine read_winds(u,v,localpet,octet_23,rlevs,lugb,pdt_num)
6812 integer,
intent(in) :: localpet, lugb
6813 integer,
intent(in) :: pdt_num, octet_23
6815 real(esmf_kind_r8),
intent(inout),
allocatable :: u(:,:,:),v(:,:,:)
6816 real(esmf_kind_r8),
intent(in),
dimension(lev_input) :: rlevs
6818 real(esmf_kind_r4),
dimension(i_input,j_input) :: alpha
6819 real(esmf_kind_r8),
dimension(i_input,j_input) :: lon, lat
6820 real(esmf_kind_r4),
allocatable :: u_tmp(:,:),v_tmp(:,:)
6821 real(esmf_kind_r8),
allocatable :: dum2d(:,:)
6822 real(esmf_kind_r4),
dimension(i_input,j_input) :: ws,wd
6823 real(esmf_kind_r4) :: value_u, value_v,lov,latin1,latin2
6824 real(esmf_kind_r8) :: d2r
6826 integer :: varnum_u, varnum_v, vlev, &
6828 integer :: j, k, lugi, jgdtn, jpdtn
6829 integer :: jdisc, jids(200), jgdt(200), jpdt(200)
6831 character(len=20) :: vname
6832 character(len=50) :: method_u, method_v
6836 type(gribfield) :: gfld
6838 d2r=acos(-1.0_esmf_kind_r8) / 180.0_esmf_kind_r8
6839 if (localpet==0)
then 6848 call get_var_cond(vname,this_miss_var_method=method_u, this_miss_var_value=value_u, &
6851 call get_var_cond(vname,this_miss_var_method=method_v, this_miss_var_value=value_v, &
6854 print*,
"- CALL FieldGather FOR INPUT GRID LONGITUDE" 6856 if(esmf_logfounderror(rctocheck=error,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6859 print*,
"- CALL FieldGather FOR INPUT GRID LATITUDE" 6861 if(esmf_logfounderror(rctocheck=error,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6864 if (localpet==0)
then 6876 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
6877 unpack, k, gfld, iret)
6879 if (iret /= 0)
call error_handler(
"ERROR READING GRIB2 FILE.", iret)
6881 if (gfld%igdtnum == 32769)
then 6883 latin1 = float(gfld%igdtmpl(15))/1.0e6
6884 lov = float(gfld%igdtmpl(16))/1.0e6
6886 print*,
"- CALL CALCALPHA_ROTLATLON with center lat,lon = ",latin1,lov
6889 elseif (gfld%igdtnum == 30)
then 6891 lov = float(gfld%igdtmpl(14))/1.0e6
6892 latin1 = float(gfld%igdtmpl(19))/1.0e6
6893 latin2 = float(gfld%igdtmpl(20))/1.0e6
6895 print*,
"- CALL GRIDROT for LC grid with lov,latin1/2 = ",lov,latin1,latin2
6896 call gridrot(lov,latin1,latin2,lon,alpha)
6914 jpdt(12) = nint(rlevs(vlev))
6916 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
6917 unpack, k, gfld, iret)
6923 "VALUE IN THE VARMAP TABLE IF THIS ERROR IS NOT DESIRABLE.",iret)
6934 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
6935 unpack, k, gfld, iret)
6941 "VALUE IN THE VARMAP TABLE IF THIS ERROR IS NOT DESIRABLE.",iret)
6950 if (gfld%igdtnum == 0)
then 6951 if (external_model ==
'UKMET')
then 6958 else if (gfld%igdtnum == 32769)
then 6959 ws = sqrt(u_tmp**2 + v_tmp**2)
6960 wd = atan2(-u_tmp,-v_tmp) / d2r
6961 wd = wd + alpha + 180.0
6963 u(:,:,vlev) = -ws*cos(wd*d2r)
6964 v(:,:,vlev) = -ws*sin(wd*d2r)
6966 u(:,:,vlev) =
real(u_tmp * cos(alpha) + v_tmp * sin(alpha),esmf_kind_r8)
6967 v(:,:,vlev) =
real(v_tmp * cos(alpha) - u_tmp * sin(alpha),esmf_kind_r8)
6970 print*,
'max, min U ', minval(u(:,:,vlev)), maxval(u(:,:,vlev))
6971 print*,
'max, min V ', minval(v(:,:,vlev)), maxval(v(:,:,vlev))
6984 integer :: clb(4), cub(4)
6985 integer :: i, j, k, rc
6987 real(esmf_kind_r8) :: latrad, lonrad
6988 real(esmf_kind_r8),
pointer :: windptr(:,:,:,:)
6989 real(esmf_kind_r8),
pointer :: uptr(:,:,:)
6990 real(esmf_kind_r8),
pointer :: vptr(:,:,:)
6991 real(esmf_kind_r8),
pointer :: latptr(:,:)
6992 real(esmf_kind_r8),
pointer :: lonptr(:,:)
6994 print*,
"- CALL FieldGet FOR 3-D WIND." 6996 computationallbound=clb, &
6997 computationalubound=cub, &
6998 farrayptr=windptr, rc=rc)
6999 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
7002 print*,
"- CALL FieldGet FOR U." 7004 farrayptr=uptr, rc=rc)
7005 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
7008 print*,
"- CALL FieldGet FOR V." 7010 farrayptr=vptr, rc=rc)
7011 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
7014 print*,
"- CALL FieldGet FOR LATITUDE." 7016 farrayptr=latptr, rc=rc)
7017 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
7020 print*,
"- CALL FieldGet FOR LONGITUDE." 7022 farrayptr=lonptr, rc=rc)
7023 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
7026 do i = clb(1), cub(1)
7027 do j = clb(2), cub(2)
7028 latrad = latptr(i,j) * acos(-1.) / 180.0
7029 lonrad = lonptr(i,j) * acos(-1.) / 180.0
7030 do k = clb(3), cub(3)
7031 windptr(i,j,k,1) = uptr(i,j,k) * cos(lonrad) - vptr(i,j,k) * sin(latrad) * sin(lonrad)
7032 windptr(i,j,k,2) = uptr(i,j,k) * sin(lonrad) + vptr(i,j,k) * sin(latrad) * cos(lonrad)
7033 windptr(i,j,k,3) = vptr(i,j,k) * cos(latrad)
7056 subroutine gridrot(lov,latin1,latin2,lon,rot)
7062 real(esmf_kind_r4),
intent(in) :: lov,latin1,latin2
7063 real(esmf_kind_r4),
intent(inout) :: rot(i_input,j_input)
7064 real(esmf_kind_r8),
intent(in) :: lon(i_input,j_input)
7066 real(esmf_kind_r4) :: trot(i_input,j_input), tlon(i_input,j_input)
7067 real(esmf_kind_r4) :: dtor = 3.14159265359/180.0_esmf_kind_r4
7068 real(esmf_kind_r4) :: an
7074 if ( (latin1 - latin2) .lt. 0.000001 )
then 7075 an = sin(latin1*dtor)
7077 an = log( cos(latin1*dtor) / cos(latin2*dtor) ) / &
7078 log( tan(dtor*(90.0-latin1)/2.) / tan(dtor*(90.0-latin2)/2.))
7081 tlon = mod(lon - lov + 180. + 3600., 360.) - 180.
7102 real(esmf_kind_r8),
intent(in) :: latgrid(i_input,j_input), &
7103 longrid(i_input,j_input)
7104 real(esmf_kind_r4),
intent(in) :: cenlat, cenlon
7105 real(esmf_kind_r4),
intent(out) :: alpha(i_input,j_input)
7108 real(esmf_kind_r8) :: D2R,lon0_r,lat0_r,sphi0,cphi0
7109 real(esmf_kind_r8),
DIMENSION(i_input,j_input) :: tlat,tlon,tph,sinalpha
7111 d2r = acos(-1.0_esmf_kind_r8) / 180.0_esmf_kind_r8
7112 if (cenlon .lt. 0)
then 7113 lon0_r = (cenlon + 360.0)*d2r
7122 tlat = latgrid * d2r
7123 tlon = longrid * d2r
7126 tlon = -tlon + lon0_r
7127 tph = asin(cphi0*sin(tlat) - sphi0*cos(tlat)*cos(tlon))
7128 sinalpha = sphi0 * sin(tlon) / cos(tph)
7129 alpha = -asin(sinalpha)/d2r
7146 subroutine handle_grib_error(vname,lev,method,value,varnum, iret,var,var8,var3d)
7148 use,
intrinsic :: ieee_arithmetic
7152 real(esmf_kind_r4),
intent(in) :: value
7153 real(esmf_kind_r4),
intent(inout),
optional :: var(:,:)
7154 real(esmf_kind_r8),
intent(inout),
optional :: var8(:,:)
7155 real(esmf_kind_r8),
intent(inout),
optional :: var3d(:,:,:)
7157 character(len=20),
intent(in) :: vname, lev, method
7159 integer,
intent(in) :: varnum
7160 integer,
intent(inout) :: iret
7163 if (varnum == 9999)
then 7164 print*,
"WARNING: ", trim(vname),
" NOT FOUND AT LEVEL ", lev,
" IN EXTERNAL FILE ", &
7165 "AND NO ENTRY EXISTS IN VARMAP TABLE. VARIABLE WILL NOT BE USED." 7171 if (trim(method) ==
"skip" )
then 7172 print*,
"WARNING: SKIPPING ", trim(vname),
" IN FILE" 7175 elseif (trim(method) ==
"set_to_fill")
then 7176 print*,
"WARNING: ,", trim(vname),
" NOT AVAILABLE AT LEVEL ", trim(lev), &
7177 ". SETTING EQUAL TO FILL VALUE OF ",
value 7178 if(
present(var)) var(:,:) =
value 7179 if(
present(var8)) var8(:,:) =
value 7180 if(
present(var3d)) var3d(:,:,:) =
value 7181 elseif (trim(method) ==
"set_to_NaN")
then 7182 print*,
"WARNING: ,", trim(vname),
" NOT AVAILABLE AT LEVEL ", trim(lev), &
7183 ". SETTING EQUAL TO NaNs" 7184 if(
present(var)) var(:,:) = ieee_value(var,ieee_quiet_nan)
7185 if(
present(var8)) var8(:,:) = ieee_value(var8,ieee_quiet_nan)
7186 if(
present(var3d)) var3d(:,:,:) = ieee_value(var3d,ieee_quiet_nan)
7187 elseif (trim(method) ==
"stop")
then 7188 call error_handler(
"READING "//trim(vname)//
" at level "//lev//
". TO MAKE THIS NON- & 7189 FATAL, CHANGE STOP TO SKIP FOR THIS VARIABLE IN YOUR VARMAP & 7191 elseif (trim(method) ==
"intrp")
then 7192 print*,
"WARNING: ,"//trim(vname)//
" NOT AVAILABLE AT LEVEL "//trim(lev)// &
7193 ". WILL INTERPOLATE INTERSPERSED MISSING LEVELS AND/OR FILL MISSING"//&
7196 call error_handler(
"ERROR USING MISSING_VAR_METHOD. PLEASE SET VALUES IN" // &
7197 " VARMAP TABLE TO ONE OF: set_to_fill, set_to_NaN,"// &
7198 " , intrp, skip, or stop.", 1)
7211 subroutine read_grib_soil(vname, vname_file, lugb, pdt_num, dummy3d)
7217 character(len=20),
intent(in) :: vname,vname_file
7219 integer,
intent(in) :: lugb, pdt_num
7221 real(esmf_kind_r8),
intent(inout) :: dummy3d(:,:,:)
7223 character(len=50) :: slevs(lsoil_input)
7224 character(len=50) :: method
7226 integer :: varnum, i, j, k, rc, rc2
7227 integer :: jdisc, jgdtn, jpdtn, lugi
7228 integer :: jids(200), jgdt(200), jpdt(200)
7229 integer :: iscale1, iscale2
7233 real(esmf_kind_r4),
allocatable :: dummy2d(:,:)
7234 real(esmf_kind_r4) :: value
7236 type(gribfield) :: gfld
7240 if(lsoil_input == 4)
then 7241 slevs = (/
character(24)::
':0-0.1 m below ground:',
':0.1-0.4 m below ground:', &
7242 ':0.4-1 m below ground:',
':1-2 m below ground:'/)
7243 elseif(lsoil_input == 9)
then 7244 slevs = (/
character(26)::
':0-0 m below ground',
':0.01-0.01 m below ground:',
':0.04-0.04 m below ground:', &
7245 ':0.1-0.1 m below ground:',
':0.3-0.3 m below ground:',
':0.6-0.6 m below ground:', &
7246 ':1-1 m below ground:',
':1.6-1.6 m below ground:',
':3-3 m below ground:'/)
7249 call error_handler(
"reading soil levels. File must have 4 or 9 soil levels.", rc)
7252 call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=
value, &
7264 if (trim(vname) ==
'soilt') jpdt(2) = 2
7265 if (trim(vname) ==
'soilw') jpdt(2) = 192
7266 if (trim(vname) ==
'soill')
then 7274 do i = 1,lsoil_input
7276 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
7277 unpack, k, gfld, rc2)
7281 if (rc==1 .and. trim(vname) /=
"soill")
then 7283 call error_handler(
"READING IN "//trim(vname)//
". SET A FILL "// &
7284 "VALUE IN THE VARMAP TABLE IF THIS ERROR IS NOT DESIRABLE.",rc)
7286 dummy3d(:,:,:) = 0.0_esmf_kind_r8
7292 iscale1 = 10 ** gfld%ipdtmpl(11)
7293 iscale2 = 10 ** gfld%ipdtmpl(14)
7301 dummy3d(:,:,i) =
real(dummy2d,esmf_kind_r8)
7318 print*,
'- DESTROY ATMOSPHERIC INPUT DATA.' 7343 print*,
'- DESTROY NST INPUT DATA.' 7376 print*,
"- CALL FieldDestroy FOR INPUT GRID FIELDS." 7421 recursive subroutine quicksort(a, first, last)
7427 x = a( (first+last) / 2 )
7438 t = a(i); a(i) = a(j); a(j) = t
7442 if (first < i-1)
call quicksort(a, first, i-1)
7443 if (j+1 < last)
call quicksort(a, j+1, last)
7471 if (landmask(i,j) == 0_esmf_kind_i4 )
then 7472 soilt(i,j,k) = skint(i,j)
7473 else if (landmask(i,j) == 1_esmf_kind_i4 .and. soilt(i,j,k) > 350.0_esmf_kind_r8)
then 7474 soilt(i,j,k) = skint(i,j)
7475 else if (landmask(i,j) == 2_esmf_kind_i4 )
then 7494 real(esmf_kind_r8) :: max_cnwat = 0.5
7500 if (cnwat(i,j) .gt. max_cnwat) cnwat(i,j) = 0.0_esmf_kind_r8
7527 SUBROUTINE dint2p(PPIN,XXIN,NPIN,PPOUT,XXOUT,NPOUT &
7543 INTEGER npin,npout,linlog,ier
7544 real*8 ppin(npin),xxin(npin),ppout(npout),xmsg
7548 real*8 pin(npin),xin(npin),p(npin),x(npin)
7549 real*8 pout(npout),xout(npout)
7552 INTEGER j1,np,nl,nin,nlmax,nplvl,nlsave,np1,no1,n1,n2,loglin, &
7554 real*8 slope,pa,pb,pc
7556 loglin = abs(linlog)
7561 IF (npout.GT.0)
THEN 7570 IF (npin.LT.2 .OR. npout.LT.1) ier = ier + 1
7583 IF (ppin(1).LT.ppin(2))
THEN 7586 IF (ppout(1).LT.ppout(2))
THEN 7591 pin(np) = ppin(abs(np1-np))
7592 xin(np) = xxin(abs(np1-np))
7596 pout(np) = ppout(abs(no1-np))
7604 IF (xin(np).NE.xmsg .AND. pin(np).NE.xmsg)
THEN 7613 IF (nlmax.LT.2)
THEN 7615 print *,
'INT2P: ier=',ier
7634 DO nl = nlstrt,nlmax
7635 IF (pout(np).EQ.p(nl))
THEN 7644 IF (loglin.EQ.1)
THEN 7647 IF (pout(np).LT.p(nl) .AND. pout(np).GT.p(nl+1))
THEN 7648 slope = (x(nl)-x(nl+1))/ (p(nl)-p(nl+1))
7649 xout(np) = x(nl+1) + slope* (pout(np)-p(nl+1))
7656 IF (pout(np).LT.p(nl) .AND. pout(np).GT.p(nl+1))
THEN 7660 if (p(nl+1).gt.0.d0)
then 7666 slope = (x(nl)-x(nl+1))/ (pa-pc)
7667 xout(np) = x(nl+1) + slope* (pb-pc)
7676 IF (linlog.LT.0)
THEN 7679 IF (pout(np).GT.p(1))
THEN 7680 IF (loglin.EQ.1)
THEN 7681 slope = (x(2)-x(1))/ (p(2)-p(1))
7682 xout(np) = x(1) + slope* (pout(np)-p(1))
7687 slope = (x(2)-x(1))/ (pa-pc)
7688 xout(np) = x(1) + slope* (pb-pc)
7690 ELSE IF (pout(np).LT.p(nlmax))
THEN 7693 IF (loglin.EQ.1)
THEN 7694 slope = (x(n1)-x(n2))/ (p(n1)-p(n2))
7695 xout(np) = x(n1) + slope* (pout(np)-p(n1))
7700 slope = (x(n1)-x(n2))/ (pa-pc)
7702 xout(np) = x(n1) + slope* (pb-pa)
7715 ppout(np) = pout(n1)
7716 xxout(np) = xout(n1)
7720 ppout(np) = pout(np)
7721 xxout(np) = xout(np)
7727 END SUBROUTINE dint2p
Utilities for use when reading grib2 data.
This module contains code to read the setup namelist file, handle the varmap file for GRIB2 data...
character(len=500), dimension(6), public atm_tracer_files_input_grid
File names of input atmospheric restart tracer files.
integer, public num_tracers_input
Number of atmospheric tracers in input file.
character(len=500), public nst_files_input_grid
File name of input nst data.
integer, public ip1_input
i_input plus 1
integer, public j_input
j-dimension of input grid (or of each global tile)
logical, public lai_from_climo
If false, interpolate leaf area index from the input data to the target grid instead of using data fr...
character(len=20), dimension(max_tracers), public tracers
Name of each atmos tracer to be processed.
integer, public jp1_input
j_input plus 1
Sets up the ESMF grid objects for the input data grid and target FV3 grid.
character(len=20), dimension(max_tracers), public tracers_input
Name of each atmos tracer record in the input file.
type(esmf_field), public latitude_input_grid
latitude of grid center, input grid
Replace undefined values with a valid value.
subroutine, public get_var_cond(var_name, this_miss_var_method, this_miss_var_value, this_field_var_name, loc)
Search the variable mapping table to find conditions for handling missing variables.
logical, public sotyp_from_climo
If false, interpolate soil type from the input data to the target grid instead of using data from sta...
integer, public num_tiles_input_grid
Number of tiles, input grid.
logical, public minmax_vgfrc_from_climo
If false, interpolate min/max vegetation fraction from the input data to the target grid instead of u...
subroutine, public rh2spfh_gfs(rh_sphum, p, t)
Convert relative humidity to specific humidity (GFS formula) Calculation of saturation water vapor pr...
character(len=500), dimension(6), public orog_files_input_grid
Input grid orography files.
character(len=20), public external_model
The model that the input data is derived from.
subroutine, public search(field, mask, idim, jdim, tile, field_num, latitude, terrain_land, soilt_climo)
Replace undefined surface values.
character(len=500), public orog_dir_input_grid
Directory containing the input grid orography files.
logical, public convert_nst
Convert nst data when true.
character(len=500), dimension(6), public atm_files_input_grid
File names of input atmospheric data.
subroutine netcdf_err(err, string)
Error handler for netcdf.
character(len=500), public geogrid_file_input_grid
Name of "geogrid" file, which contains static surface fields on the input grid.
logical, public vgfrc_from_climo
If false, interpolate vegetation fraction from the input data to the target grid instead of using dat...
type(esmf_grid), public input_grid
input grid esmf grid object
character(len=500), public data_dir_input_grid
Directory containing input atm or sfc files.
subroutine error_handler(string, rc)
General error handler.
subroutine, public convert_omega(omega, p, t, q, clb, cub)
Convert omega to vertical velocity.
character(len=50), public input_grid_type
map projection of input grid
character(len=25), public input_type
Input data type:
character(len=500), dimension(7), public atm_core_files_input_grid
File names of input atmospheric restart core files.
type(esmf_field), public longitude_input_grid
longitude of grid center, input grid
character(len=500), public grib2_file_input_grid
REQUIRED.
logical, public vgtyp_from_climo
If false, interpolate vegetation type from the input data to the target grid instead of using data fr...
logical, dimension(:), allocatable, public read_from_input
When false, variable was not read from GRIB2 input file.
character(len=500), dimension(6), public sfc_files_input_grid
File names containing input surface data.
integer, public i_input
i-dimension of input grid (or of each global tile)
subroutine, public rh2spfh(rh_sphum, p, t)
Convert relative humidity to specific humidity.