402 integer,
parameter,
public:: sfcio_lhead1=32
403 integer,
parameter,
public:: sfcio_intkind=4,sfcio_realkind=4,sfcio_dblekind=8
404 real(sfcio_realkind),
parameter,
public:: sfcio_realfill=-9999.
405 real(sfcio_dblekind),
parameter,
public:: sfcio_dblefill=sfcio_realfill
409 character(sfcio_lhead1):: clabsfc=
' '
410 real(sfcio_realkind):: fhour=0.
411 integer(sfcio_intkind):: idate(4)=(/0,0,0,0/),latb=0,lonb=0,lsoil=0,ivs=0
412 integer(sfcio_intkind):: irealf=1
413 integer(sfcio_intkind),
allocatable:: lpl(:)
414 real(sfcio_realkind),
allocatable:: zsoil(:)
417 real(sfcio_realkind),
pointer:: tsea(:,:)=>null()
418 real(sfcio_realkind),
pointer:: smc(:,:,:)=>null()
419 real(sfcio_realkind),
pointer:: sheleg(:,:)=>null()
420 real(sfcio_realkind),
pointer:: stc(:,:,:)=>null()
421 real(sfcio_realkind),
pointer:: tg3(:,:)=>null()
422 real(sfcio_realkind),
pointer:: zorl(:,:)=>null()
423 real(sfcio_realkind),
pointer:: cv(:,:)=>null()
424 real(sfcio_realkind),
pointer:: cvb(:,:)=>null()
425 real(sfcio_realkind),
pointer:: cvt(:,:)=>null()
426 real(sfcio_realkind),
pointer:: alvsf(:,:)=>null()
427 real(sfcio_realkind),
pointer:: alvwf(:,:)=>null()
428 real(sfcio_realkind),
pointer:: alnsf(:,:)=>null()
429 real(sfcio_realkind),
pointer:: alnwf(:,:)=>null()
430 real(sfcio_realkind),
pointer:: slmsk(:,:)=>null()
431 real(sfcio_realkind),
pointer:: vfrac(:,:)=>null()
432 real(sfcio_realkind),
pointer:: canopy(:,:)=>null()
433 real(sfcio_realkind),
pointer:: f10m(:,:)=>null()
434 real(sfcio_realkind),
pointer:: t2m(:,:)=>null()
435 real(sfcio_realkind),
pointer:: q2m(:,:)=>null()
436 real(sfcio_realkind),
pointer:: vtype(:,:)=>null()
437 real(sfcio_realkind),
pointer:: stype(:,:)=>null()
438 real(sfcio_realkind),
pointer:: facsf(:,:)=>null()
439 real(sfcio_realkind),
pointer:: facwf(:,:)=>null()
440 real(sfcio_realkind),
pointer:: uustar(:,:)=>null()
441 real(sfcio_realkind),
pointer:: ffmm(:,:)=>null()
442 real(sfcio_realkind),
pointer:: ffhh(:,:)=>null()
443 real(sfcio_realkind),
pointer:: hice(:,:)=>null()
444 real(sfcio_realkind),
pointer:: fice(:,:)=>null()
445 real(sfcio_realkind),
pointer:: tisfc(:,:)=>null()
446 real(sfcio_realkind),
pointer:: tprcp(:,:)=>null()
447 real(sfcio_realkind),
pointer:: srflag(:,:)=>null()
448 real(sfcio_realkind),
pointer:: snwdph(:,:)=>null()
449 real(sfcio_realkind),
pointer:: slc(:,:,:)=>null()
450 real(sfcio_realkind),
pointer:: shdmin(:,:)=>null()
451 real(sfcio_realkind),
pointer:: shdmax(:,:)=>null()
452 real(sfcio_realkind),
pointer:: slope(:,:)=>null()
453 real(sfcio_realkind),
pointer:: snoalb(:,:)=>null()
454 real(sfcio_realkind),
pointer:: orog(:,:)=>null()
457 real(sfcio_dblekind),
pointer:: tsea(:,:)=>null()
458 real(sfcio_dblekind),
pointer:: smc(:,:,:)=>null()
459 real(sfcio_dblekind),
pointer:: sheleg(:,:)=>null()
460 real(sfcio_dblekind),
pointer:: stc(:,:,:)=>null()
461 real(sfcio_dblekind),
pointer:: tg3(:,:)=>null()
462 real(sfcio_dblekind),
pointer:: zorl(:,:)=>null()
463 real(sfcio_dblekind),
pointer:: cv(:,:)=>null()
464 real(sfcio_dblekind),
pointer:: cvb(:,:)=>null()
465 real(sfcio_dblekind),
pointer:: cvt(:,:)=>null()
466 real(sfcio_dblekind),
pointer:: alvsf(:,:)=>null()
467 real(sfcio_dblekind),
pointer:: alvwf(:,:)=>null()
468 real(sfcio_dblekind),
pointer:: alnsf(:,:)=>null()
469 real(sfcio_dblekind),
pointer:: alnwf(:,:)=>null()
470 real(sfcio_dblekind),
pointer:: slmsk(:,:)=>null()
471 real(sfcio_dblekind),
pointer:: vfrac(:,:)=>null()
472 real(sfcio_dblekind),
pointer:: canopy(:,:)=>null()
473 real(sfcio_dblekind),
pointer:: f10m(:,:)=>null()
474 real(sfcio_dblekind),
pointer:: t2m(:,:)=>null()
475 real(sfcio_dblekind),
pointer:: q2m(:,:)=>null()
476 real(sfcio_dblekind),
pointer:: vtype(:,:)=>null()
477 real(sfcio_dblekind),
pointer:: stype(:,:)=>null()
478 real(sfcio_dblekind),
pointer:: facsf(:,:)=>null()
479 real(sfcio_dblekind),
pointer:: facwf(:,:)=>null()
480 real(sfcio_dblekind),
pointer:: uustar(:,:)=>null()
481 real(sfcio_dblekind),
pointer:: ffmm(:,:)=>null()
482 real(sfcio_dblekind),
pointer:: ffhh(:,:)=>null()
483 real(sfcio_dblekind),
pointer:: hice(:,:)=>null()
484 real(sfcio_dblekind),
pointer:: fice(:,:)=>null()
485 real(sfcio_dblekind),
pointer:: tisfc(:,:)=>null()
486 real(sfcio_dblekind),
pointer:: tprcp(:,:)=>null()
487 real(sfcio_dblekind),
pointer:: srflag(:,:)=>null()
488 real(sfcio_dblekind),
pointer:: snwdph(:,:)=>null()
489 real(sfcio_dblekind),
pointer:: slc(:,:,:)=>null()
490 real(sfcio_dblekind),
pointer:: shdmin(:,:)=>null()
491 real(sfcio_dblekind),
pointer:: shdmax(:,:)=>null()
492 real(sfcio_dblekind),
pointer:: slope(:,:)=>null()
493 real(sfcio_dblekind),
pointer:: snoalb(:,:)=>null()
494 real(sfcio_dblekind),
pointer:: orog(:,:)=>null()
498 public sfcio_sropen,sfcio_swopen,sfcio_sclose,sfcio_srhead,sfcio_swhead
499 public sfcio_alhead,sfcio_aldata,sfcio_axdata,sfcio_srdata,sfcio_swdata
500 public sfcio_aldbta,sfcio_axdbta,sfcio_srdbta,sfcio_swdbta
503 module procedure sfcio_srohdca,sfcio_srohdcb
505 interface sfcio_swohdc
506 module procedure sfcio_swohdca,sfcio_swohdcb
510 subroutine sfcio_sropen(lu,cfname,iret)
512 integer(sfcio_intkind),
intent(in):: lu
513 character*(*),
intent(in):: cfname
514 integer(sfcio_intkind),
intent(out):: iret
517 open(lu,file=cfname,form=
'unformatted',&
518 status=
'old',action=
'read',iostat=ios)
520 if(iret.ne.0) iret=-1
524 subroutine sfcio_swopen(lu,cfname,iret)
526 integer(sfcio_intkind),
intent(in):: lu
527 character*(*),
intent(in):: cfname
528 integer(sfcio_intkind),
intent(out):: iret
531 open(lu,file=cfname,form=
'unformatted',&
532 status=
'unknown',action=
'readwrite',iostat=ios)
534 if(iret.ne.0) iret=-1
538 subroutine sfcio_sclose(lu,iret)
540 integer(sfcio_intkind),
intent(in):: lu
541 integer(sfcio_intkind),
intent(out):: iret
546 if(iret.ne.0) iret=-1
550 subroutine sfcio_srhead(lu,head,iret)
552 integer(sfcio_intkind),
intent(in):: lu
553 type(sfcio_head),
intent(out):: head
554 integer(sfcio_intkind),
intent(out):: iret
556 character(4):: cgfs,csfc
557 integer(sfcio_intkind):: nhead,ndata,nresv(3)
561 read(lu,iostat=ios) head%clabsfc
563 if(head%clabsfc(1:8).eq.
'GFS SFC ' .or. head%clabsfc(1:8).eq.
' SFG CFS')
then
573 read(lu,iostat=ios) cgfs,csfc,head%ivs,nhead,ndata,nresv
575 if(head%ivs.eq.200509)
then
578 read(lu,iostat=ios) head%fhour,head%idate,head%lonb,head%latb,&
579 head%lsoil,head%irealf
581 call sfcio_alhead(head,ios)
583 read(lu,iostat=ios) head%lpl
585 read(lu,iostat=ios) head%zsoil
587 elseif(head%ivs.eq.200501)
then
590 read(lu,iostat=ios) head%fhour,head%idate,head%lonb,head%latb,head%lsoil
592 call sfcio_alhead(head,ios)
594 read(lu,iostat=ios) head%lpl
596 read(lu,iostat=ios) head%zsoil
602 read(lu,iostat=ios) head%fhour,head%idate,head%lonb,head%latb,head%ivs
604 if(head%ivs.eq.199802)
then
606 call sfcio_alhead(head,ios)
609 head%zsoil=(/-0.1,-2.0/)
610 elseif(head%ivs.eq.200004)
then
612 call sfcio_alhead(head,ios)
615 read(lu) head%clabsfc
616 read(lu,iostat=ios) head%fhour,head%idate,head%lonb,head%latb,head%ivs,&
619 head%zsoil=(/-0.1,-2.0/)
620 elseif(head%ivs.eq.200412)
then
622 call sfcio_alhead(head,ios)
625 read(lu) head%clabsfc
626 read(lu,iostat=ios) head%fhour,head%idate,head%lonb,head%latb,head%ivs,&
629 head%zsoil=(/-0.1,-0.4,-1.0,-2.0/)
639 subroutine sfcio_swhead(lu,head,iret)
641 integer(sfcio_intkind),
intent(in):: lu
642 type(sfcio_head),
intent(in):: head
643 integer(sfcio_intkind),
intent(out):: iret
648 if(head%ivs.eq.200509)
then
650 write(lu,iostat=ios)
'GFS SFC ',head%ivs,5,29+3*head%lsoil,0,0,0
652 write(lu,iostat=ios) 4*(/8,5+29+3*head%lsoil,25,head%latb/2,head%lsoil/),&
653 4*head%irealf*(/(head%lonb*head%latb,&
654 i=1,29+3*head%lsoil)/)
656 write(lu,iostat=ios) head%fhour,head%idate,head%lonb,head%latb,&
657 head%lsoil,head%irealf,(0,i=1,16)
659 write(lu,iostat=ios) head%lpl
661 write(lu,iostat=ios) head%zsoil
664 elseif(head%ivs.eq.200501)
then
666 write(lu,iostat=ios)
'GFS SFC ',head%ivs,5,29+3*head%lsoil,0,0,0
668 write(lu,iostat=ios) 4*(/8,5+29+3*head%lsoil,8,head%latb/2,head%lsoil/),&
669 4*(/(head%lonb*head%latb,i=1,29+3*head%lsoil)/)
671 write(lu,iostat=ios) head%fhour,head%idate,head%lonb,head%latb,head%lsoil
673 write(lu,iostat=ios) head%lpl
675 write(lu,iostat=ios) head%zsoil
678 elseif(head%ivs.eq.200004.and.head%lsoil.eq.2)
then
680 write(lu,iostat=ios) head%clabsfc
682 write(lu,iostat=ios) head%fhour,head%idate,head%lonb,head%latb,head%ivs,&
690 subroutine sfcio_alhead(head,iret,latb,lsoil)
692 type(sfcio_head),
intent(inout):: head
693 integer(sfcio_intkind),
intent(out):: iret
694 integer(sfcio_intkind),
optional,
intent(in):: latb,lsoil
697 if(
present(latb))
then
700 dim1l=(head%latb+1)/2
702 if(
present(lsoil))
then
707 if(
allocated(head%lpl))
deallocate(head%lpl)
708 if(
allocated(head%zsoil))
deallocate(head%zsoil)
709 allocate(head%lpl(dim1l),head%zsoil(dim1z),stat=iret)
712 head%zsoil=sfcio_realfill
714 if(iret.ne.0) iret=-3
718 subroutine sfcio_aldata(head,data,iret)
720 type(sfcio_head),
intent(in):: head
721 type(sfcio_data),
intent(inout):: data
722 integer(sfcio_intkind),
intent(out):: iret
723 integer dim1,dim2,dim3
725 call sfcio_axdata(
data,iret)
730 data%tsea(dim1,dim2),&
731 data%smc(dim1,dim2,dim3),&
732 data%sheleg(dim1,dim2),&
733 data%stc(dim1,dim2,dim3),&
734 data%tg3(dim1,dim2),&
735 data%zorl(dim1,dim2),&
737 data%cvb(dim1,dim2),&
738 data%cvt(dim1,dim2),&
739 data%alvsf(dim1,dim2),&
740 data%alvwf(dim1,dim2),&
741 data%alnsf(dim1,dim2),&
742 data%alnwf(dim1,dim2),&
743 data%slmsk(dim1,dim2),&
744 data%vfrac(dim1,dim2),&
745 data%canopy(dim1,dim2),&
746 data%f10m(dim1,dim2),&
747 data%t2m(dim1,dim2),&
748 data%q2m(dim1,dim2),&
749 data%vtype(dim1,dim2),&
750 data%stype(dim1,dim2),&
751 data%facsf(dim1,dim2),&
752 data%facwf(dim1,dim2),&
753 data%uustar(dim1,dim2),&
754 data%ffmm(dim1,dim2),&
755 data%ffhh(dim1,dim2),&
756 data%hice(dim1,dim2),&
757 data%fice(dim1,dim2),&
758 data%tisfc(dim1,dim2),&
759 data%tprcp(dim1,dim2),&
760 data%srflag(dim1,dim2),&
761 data%snwdph(dim1,dim2),&
762 data%slc(dim1,dim2,dim3),&
763 data%shdmin(dim1,dim2),&
764 data%shdmax(dim1,dim2),&
765 data%slope(dim1,dim2),&
766 data%snoalb(dim1,dim2),&
767 data%orog(dim1,dim2),&
769 if(iret.ne.0) iret=-3
773 subroutine sfcio_axdata(data,iret)
775 type(sfcio_data),
intent(inout):: data
776 integer(sfcio_intkind),
intent(out):: iret
857 if(iret.ne.0) iret=-3
861 subroutine sfcio_srdata(lu,head,data,iret)
863 integer(sfcio_intkind),
intent(in):: lu
864 type(sfcio_head),
intent(in):: head
865 type(sfcio_data),
intent(inout):: data
866 integer(sfcio_intkind),
intent(out):: iret
867 integer:: dim1,dim2,dim3,mdim1,mdim2,mdim3
870 type(sfcio_dbta) dbta
878 size(data%sheleg,1),&
888 size(data%canopy,1),&
896 size(data%uustar,1),&
903 size(data%srflag,1),&
904 size(data%snwdph,1),&
906 size(data%shdmin,1),&
907 size(data%shdmax,1),&
909 size(data%snoalb,1),&
914 size(data%sheleg,2),&
924 size(data%canopy,2),&
932 size(data%uustar,2),&
939 size(data%srflag,2),&
940 size(data%snwdph,2),&
942 size(data%shdmin,2),&
943 size(data%shdmax,2),&
945 size(data%snoalb,2),&
952 if(mdim1.lt.dim1.or.&
954 mdim3.lt.dim3)
return
957 data%t2m(:dim1,:dim2)=sfcio_realfill
958 data%q2m(:dim1,:dim2)=sfcio_realfill
959 data%tisfc(:dim1,:dim2)=sfcio_realfill
960 if(head%ivs.eq.200509)
then
961 if(head%irealf.ne.2)
then
962 read(lu,iostat=ios) data%slmsk(:dim1,:dim2)
964 read(lu,iostat=ios) data%orog(:dim1,:dim2)
966 read(lu,iostat=ios) data%tsea(:dim1,:dim2)
968 read(lu,iostat=ios) data%sheleg(:dim1,:dim2)
970 read(lu,iostat=ios) data%tg3(:dim1,:dim2)
972 read(lu,iostat=ios) data%zorl(:dim1,:dim2)
974 read(lu,iostat=ios) data%alvsf(:dim1,:dim2)
976 read(lu,iostat=ios) data%alvwf(:dim1,:dim2)
978 read(lu,iostat=ios) data%alnsf(:dim1,:dim2)
980 read(lu,iostat=ios) data%alnwf(:dim1,:dim2)
982 read(lu,iostat=ios) data%vfrac(:dim1,:dim2)
984 read(lu,iostat=ios) data%canopy(:dim1,:dim2)
986 read(lu,iostat=ios) data%f10m(:dim1,:dim2)
988 read(lu,iostat=ios) data%t2m(:dim1,:dim2)
990 read(lu,iostat=ios) data%q2m(:dim1,:dim2)
992 read(lu,iostat=ios) data%vtype(:dim1,:dim2)
994 read(lu,iostat=ios) data%stype(:dim1,:dim2)
996 read(lu,iostat=ios) data%facsf(:dim1,:dim2)
998 read(lu,iostat=ios) data%facwf(:dim1,:dim2)
1000 read(lu,iostat=ios) data%uustar(:dim1,:dim2)
1002 read(lu,iostat=ios) data%ffmm(:dim1,:dim2)
1004 read(lu,iostat=ios) data%ffhh(:dim1,:dim2)
1006 read(lu,iostat=ios) data%hice(:dim1,:dim2)
1008 read(lu,iostat=ios) data%fice(:dim1,:dim2)
1010 read(lu,iostat=ios) data%tisfc(:dim1,:dim2)
1012 read(lu,iostat=ios) data%tprcp(:dim1,:dim2)
1014 read(lu,iostat=ios) data%srflag(:dim1,:dim2)
1016 read(lu,iostat=ios) data%snwdph(:dim1,:dim2)
1018 read(lu,iostat=ios) data%shdmin(:dim1,:dim2)
1020 read(lu,iostat=ios) data%shdmax(:dim1,:dim2)
1022 read(lu,iostat=ios) data%slope(:dim1,:dim2)
1024 read(lu,iostat=ios) data%snoalb(:dim1,:dim2)
1027 read(lu,iostat=ios) data%stc(:dim1,:dim2,i)
1031 read(lu,iostat=ios) data%smc(:dim1,:dim2,i)
1035 read(lu,iostat=ios) data%slc(:dim1,:dim2,i)
1038 data%cv(:dim1,:dim2)=sfcio_realfill
1039 data%cvb(:dim1,:dim2)=sfcio_realfill
1040 data%cvt(:dim1,:dim2)=sfcio_realfill
1042 call sfcio_aldbta(head,dbta,iret)
1043 if(iret.ne.0)
return
1044 call sfcio_srdbta(lu,head,dbta,iret)
1045 if(iret.ne.0)
return
1046 data%tsea(:dim1,:dim2)=dbta%tsea(:dim1,:dim2)
1047 data%smc(:dim1,:dim2,:dim3)=dbta%smc(:dim1,:dim2,:dim3)
1048 data%sheleg(:dim1,:dim2)=dbta%sheleg(:dim1,:dim2)
1049 data%stc(:dim1,:dim2,:dim3)=dbta%stc(:dim1,:dim2,:dim3)
1050 data%tg3(:dim1,:dim2)=dbta%tg3(:dim1,:dim2)
1051 data%zorl(:dim1,:dim2)=dbta%zorl(:dim1,:dim2)
1052 data%cv(:dim1,:dim2)=dbta%cv(:dim1,:dim2)
1053 data%cvb(:dim1,:dim2)=dbta%cvb(:dim1,:dim2)
1054 data%cvt(:dim1,:dim2)=dbta%cvt(:dim1,:dim2)
1055 data%alvsf(:dim1,:dim2)=dbta%alvsf(:dim1,:dim2)
1056 data%alvwf(:dim1,:dim2)=dbta%alvwf(:dim1,:dim2)
1057 data%alnsf(:dim1,:dim2)=dbta%alnsf(:dim1,:dim2)
1058 data%alnwf(:dim1,:dim2)=dbta%alnwf(:dim1,:dim2)
1059 data%slmsk(:dim1,:dim2)=dbta%slmsk(:dim1,:dim2)
1060 data%vfrac(:dim1,:dim2)=dbta%vfrac(:dim1,:dim2)
1061 data%canopy(:dim1,:dim2)=dbta%canopy(:dim1,:dim2)
1062 data%f10m(:dim1,:dim2)=dbta%f10m(:dim1,:dim2)
1063 data%t2m(:dim1,:dim2)=dbta%t2m(:dim1,:dim2)
1064 data%q2m(:dim1,:dim2)=dbta%q2m(:dim1,:dim2)
1065 data%vtype(:dim1,:dim2)=dbta%vtype(:dim1,:dim2)
1066 data%stype(:dim1,:dim2)=dbta%stype(:dim1,:dim2)
1067 data%facsf(:dim1,:dim2)=dbta%facsf(:dim1,:dim2)
1068 data%facwf(:dim1,:dim2)=dbta%facwf(:dim1,:dim2)
1069 data%uustar(:dim1,:dim2)=dbta%uustar(:dim1,:dim2)
1070 data%ffmm(:dim1,:dim2)=dbta%ffmm(:dim1,:dim2)
1071 data%ffhh(:dim1,:dim2)=dbta%ffhh(:dim1,:dim2)
1072 data%hice(:dim1,:dim2)=dbta%hice(:dim1,:dim2)
1073 data%fice(:dim1,:dim2)=dbta%fice(:dim1,:dim2)
1074 data%tisfc(:dim1,:dim2)=dbta%tisfc(:dim1,:dim2)
1075 data%tprcp(:dim1,:dim2)=dbta%tprcp(:dim1,:dim2)
1076 data%srflag(:dim1,:dim2)=dbta%srflag(:dim1,:dim2)
1077 data%snwdph(:dim1,:dim2)=dbta%snwdph(:dim1,:dim2)
1078 data%slc(:dim1,:dim2,:dim3)=dbta%slc(:dim1,:dim2,:dim3)
1079 data%shdmin(:dim1,:dim2)=dbta%shdmin(:dim1,:dim2)
1080 data%shdmax(:dim1,:dim2)=dbta%shdmax(:dim1,:dim2)
1081 data%slope(:dim1,:dim2)=dbta%slope(:dim1,:dim2)
1082 data%snoalb(:dim1,:dim2)=dbta%snoalb(:dim1,:dim2)
1083 data%orog(:dim1,:dim2)=dbta%orog(:dim1,:dim2)
1084 call sfcio_axdbta(dbta,iret)
1087 elseif(head%ivs.eq.200501.and.head%irealf.ne.2)
then
1088 read(lu,iostat=ios) data%slmsk(:dim1,:dim2)
1090 read(lu,iostat=ios) data%orog(:dim1,:dim2)
1092 read(lu,iostat=ios) data%tsea(:dim1,:dim2)
1094 read(lu,iostat=ios) data%sheleg(:dim1,:dim2)
1096 read(lu,iostat=ios) data%tg3(:dim1,:dim2)
1098 read(lu,iostat=ios) data%zorl(:dim1,:dim2)
1100 read(lu,iostat=ios) data%alvsf(:dim1,:dim2)
1102 read(lu,iostat=ios) data%alvwf(:dim1,:dim2)
1104 read(lu,iostat=ios) data%alnsf(:dim1,:dim2)
1106 read(lu,iostat=ios) data%alnwf(:dim1,:dim2)
1108 read(lu,iostat=ios) data%vfrac(:dim1,:dim2)
1110 read(lu,iostat=ios) data%canopy(:dim1,:dim2)
1112 read(lu,iostat=ios) data%f10m(:dim1,:dim2)
1114 read(lu,iostat=ios) data%vtype(:dim1,:dim2)
1116 read(lu,iostat=ios) data%stype(:dim1,:dim2)
1118 read(lu,iostat=ios) data%facsf(:dim1,:dim2)
1120 read(lu,iostat=ios) data%facwf(:dim1,:dim2)
1122 read(lu,iostat=ios) data%uustar(:dim1,:dim2)
1124 read(lu,iostat=ios) data%ffmm(:dim1,:dim2)
1126 read(lu,iostat=ios) data%ffhh(:dim1,:dim2)
1128 read(lu,iostat=ios) data%hice(:dim1,:dim2)
1130 read(lu,iostat=ios) data%fice(:dim1,:dim2)
1132 read(lu,iostat=ios) data%tprcp(:dim1,:dim2)
1134 read(lu,iostat=ios) data%srflag(:dim1,:dim2)
1136 read(lu,iostat=ios) data%snwdph(:dim1,:dim2)
1138 read(lu,iostat=ios) data%shdmin(:dim1,:dim2)
1140 read(lu,iostat=ios) data%shdmax(:dim1,:dim2)
1142 read(lu,iostat=ios) data%slope(:dim1,:dim2)
1144 read(lu,iostat=ios) data%snoalb(:dim1,:dim2)
1147 read(lu,iostat=ios) data%stc(:dim1,:dim2,i)
1151 read(lu,iostat=ios) data%smc(:dim1,:dim2,i)
1155 read(lu,iostat=ios) data%slc(:dim1,:dim2,i)
1158 data%cv(:dim1,:dim2)=sfcio_realfill
1159 data%cvb(:dim1,:dim2)=sfcio_realfill
1160 data%cvt(:dim1,:dim2)=sfcio_realfill
1163 read(lu,iostat=ios) data%tsea(:dim1,:dim2)
1165 read(lu,iostat=ios) data%smc(:dim1,:dim2,:dim3)
1167 read(lu,iostat=ios) data%sheleg(:dim1,:dim2)
1169 read(lu,iostat=ios) data%stc(:dim1,:dim2,:dim3)
1171 read(lu,iostat=ios) data%tg3(:dim1,:dim2)
1173 read(lu,iostat=ios) data%zorl(:dim1,:dim2)
1175 read(lu,iostat=ios) data%cv(:dim1,:dim2)
1177 read(lu,iostat=ios) data%cvb(:dim1,:dim2)
1179 read(lu,iostat=ios) data%cvt(:dim1,:dim2)
1181 read(lu,iostat=ios) data%alvsf(:dim1,:dim2),&
1182 data%alvwf(:dim1,:dim2),&
1183 data%alnsf(:dim1,:dim2),&
1184 data%alnwf(:dim1,:dim2)
1186 read(lu,iostat=ios) data%slmsk(:dim1,:dim2)
1188 read(lu,iostat=ios) data%vfrac(:dim1,:dim2)
1190 read(lu,iostat=ios) data%canopy(:dim1,:dim2)
1192 read(lu,iostat=ios) data%f10m(:dim1,:dim2)
1194 read(lu,iostat=ios) data%vtype(:dim1,:dim2)
1196 read(lu,iostat=ios) data%stype(:dim1,:dim2)
1198 read(lu,iostat=ios) data%facsf(:dim1,:dim2),&
1199 data%facwf(:dim1,:dim2)
1201 if(head%ivs.ge.200004)
then
1202 read(lu,iostat=ios) data%uustar(:dim1,:dim2)
1204 read(lu,iostat=ios) data%ffmm(:dim1,:dim2)
1206 read(lu,iostat=ios) data%ffhh(:dim1,:dim2)
1209 data%uustar(:dim1,:dim2)=sfcio_realfill
1210 data%ffmm(:dim1,:dim2)=sfcio_realfill
1211 data%ffhh(:dim1,:dim2)=sfcio_realfill
1213 if(head%ivs.eq.200412)
then
1214 read(lu,iostat=ios) data%hice(:dim1,:dim2)
1216 read(lu,iostat=ios) data%fice(:dim1,:dim2)
1218 read(lu,iostat=ios) data%tprcp(:dim1,:dim2)
1220 read(lu,iostat=ios) data%srflag(:dim1,:dim2)
1222 read(lu,iostat=ios) data%snwdph(:dim1,:dim2)
1224 read(lu,iostat=ios) data%slc(:dim1,:dim2,:dim3)
1226 read(lu,iostat=ios) data%shdmin(:dim1,:dim2)
1228 read(lu,iostat=ios) data%shdmax(:dim1,:dim2)
1230 read(lu,iostat=ios) data%slope(:dim1,:dim2)
1232 read(lu,iostat=ios) data%snoalb(:dim1,:dim2)
1234 data%orog(:dim1,:dim2)=sfcio_realfill
1236 data%hice(:dim1,:dim2)=sfcio_realfill
1237 data%fice(:dim1,:dim2)=sfcio_realfill
1238 data%tprcp(:dim1,:dim2)=sfcio_realfill
1239 data%srflag(:dim1,:dim2)=sfcio_realfill
1240 data%snwdph(:dim1,:dim2)=sfcio_realfill
1241 data%slc(:dim1,:dim2,:dim3)=sfcio_realfill
1242 data%shdmin(:dim1,:dim2)=sfcio_realfill
1243 data%shdmax(:dim1,:dim2)=sfcio_realfill
1244 data%slope(:dim1,:dim2)=sfcio_realfill
1245 data%snoalb(:dim1,:dim2)=sfcio_realfill
1246 data%orog(:dim1,:dim2)=sfcio_realfill
1253 subroutine sfcio_swdata(lu,head,data,iret)
1255 integer(sfcio_intkind),
intent(in):: lu
1256 type(sfcio_head),
intent(in):: head
1257 type(sfcio_data),
intent(in):: data
1258 integer(sfcio_intkind),
intent(out):: iret
1259 integer:: dim1,dim2,dim3,mdim1,mdim2,mdim3
1262 type(sfcio_dbta) dbta
1270 size(data%sheleg,1),&
1274 size(data%alvsf,1),&
1275 size(data%alvwf,1),&
1276 size(data%alnsf,1),&
1277 size(data%alnwf,1),&
1278 size(data%slmsk,1),&
1279 size(data%vfrac,1),&
1280 size(data%canopy,1),&
1284 size(data%vtype,1),&
1285 size(data%stype,1),&
1286 size(data%facsf,1),&
1287 size(data%facwf,1),&
1288 size(data%uustar,1),&
1293 size(data%tisfc,1),&
1294 size(data%tprcp,1),&
1295 size(data%srflag,1),&
1296 size(data%snwdph,1),&
1298 size(data%shdmin,1),&
1299 size(data%shdmax,1),&
1300 size(data%slope,1),&
1301 size(data%snoalb,1),&
1306 size(data%sheleg,2),&
1310 size(data%alvsf,2),&
1311 size(data%alvwf,2),&
1312 size(data%alnsf,2),&
1313 size(data%alnwf,2),&
1314 size(data%slmsk,2),&
1315 size(data%vfrac,2),&
1316 size(data%canopy,2),&
1320 size(data%vtype,2),&
1321 size(data%stype,2),&
1322 size(data%facsf,2),&
1323 size(data%facwf,2),&
1324 size(data%uustar,2),&
1329 size(data%tisfc,2),&
1330 size(data%tprcp,2),&
1331 size(data%srflag,2),&
1332 size(data%snwdph,2),&
1334 size(data%shdmin,2),&
1335 size(data%shdmax,2),&
1336 size(data%slope,2),&
1337 size(data%snoalb,2),&
1344 if(mdim1.lt.dim1.or.&
1346 mdim3.lt.dim3)
return
1349 if(head%ivs.eq.200509)
then
1350 if(head%irealf.ne.2)
then
1351 write(lu,iostat=ios) data%slmsk(:dim1,:dim2)
1353 write(lu,iostat=ios) data%orog(:dim1,:dim2)
1355 write(lu,iostat=ios) data%tsea(:dim1,:dim2)
1357 write(lu,iostat=ios) data%sheleg(:dim1,:dim2)
1359 write(lu,iostat=ios) data%tg3(:dim1,:dim2)
1361 write(lu,iostat=ios) data%zorl(:dim1,:dim2)
1363 write(lu,iostat=ios) data%alvsf(:dim1,:dim2)
1365 write(lu,iostat=ios) data%alvwf(:dim1,:dim2)
1367 write(lu,iostat=ios) data%alnsf(:dim1,:dim2)
1369 write(lu,iostat=ios) data%alnwf(:dim1,:dim2)
1371 write(lu,iostat=ios) data%vfrac(:dim1,:dim2)
1373 write(lu,iostat=ios) data%canopy(:dim1,:dim2)
1375 write(lu,iostat=ios) data%f10m(:dim1,:dim2)
1377 write(lu,iostat=ios) data%t2m(:dim1,:dim2)
1379 write(lu,iostat=ios) data%q2m(:dim1,:dim2)
1381 write(lu,iostat=ios) data%vtype(:dim1,:dim2)
1383 write(lu,iostat=ios) data%stype(:dim1,:dim2)
1385 write(lu,iostat=ios) data%facsf(:dim1,:dim2)
1387 write(lu,iostat=ios) data%facwf(:dim1,:dim2)
1389 write(lu,iostat=ios) data%uustar(:dim1,:dim2)
1391 write(lu,iostat=ios) data%ffmm(:dim1,:dim2)
1393 write(lu,iostat=ios) data%ffhh(:dim1,:dim2)
1395 write(lu,iostat=ios) data%hice(:dim1,:dim2)
1397 write(lu,iostat=ios) data%fice(:dim1,:dim2)
1399 write(lu,iostat=ios) data%tisfc(:dim1,:dim2)
1401 write(lu,iostat=ios) data%tprcp(:dim1,:dim2)
1403 write(lu,iostat=ios) data%srflag(:dim1,:dim2)
1405 write(lu,iostat=ios) data%snwdph(:dim1,:dim2)
1407 write(lu,iostat=ios) data%shdmin(:dim1,:dim2)
1409 write(lu,iostat=ios) data%shdmax(:dim1,:dim2)
1411 write(lu,iostat=ios) data%slope(:dim1,:dim2)
1413 write(lu,iostat=ios) data%snoalb(:dim1,:dim2)
1416 write(lu,iostat=ios) data%stc(:dim1,:dim2,i)
1420 write(lu,iostat=ios) data%smc(:dim1,:dim2,i)
1424 write(lu,iostat=ios) data%slc(:dim1,:dim2,i)
1428 call sfcio_aldbta(head,dbta,iret)
1429 if(iret.ne.0)
return
1430 dbta%tsea(:dim1,:dim2)=data%tsea(:dim1,:dim2)
1431 dbta%smc(:dim1,:dim2,:dim3)=data%smc(:dim1,:dim2,:dim3)
1432 dbta%sheleg(:dim1,:dim2)=data%sheleg(:dim1,:dim2)
1433 dbta%stc(:dim1,:dim2,:dim3)=data%stc(:dim1,:dim2,:dim3)
1434 dbta%tg3(:dim1,:dim2)=data%tg3(:dim1,:dim2)
1435 dbta%zorl(:dim1,:dim2)=data%zorl(:dim1,:dim2)
1436 dbta%cv(:dim1,:dim2)=data%cv(:dim1,:dim2)
1437 dbta%cvb(:dim1,:dim2)=data%cvb(:dim1,:dim2)
1438 dbta%cvt(:dim1,:dim2)=data%cvt(:dim1,:dim2)
1439 dbta%alvsf(:dim1,:dim2)=data%alvsf(:dim1,:dim2)
1440 dbta%alvwf(:dim1,:dim2)=data%alvwf(:dim1,:dim2)
1441 dbta%alnsf(:dim1,:dim2)=data%alnsf(:dim1,:dim2)
1442 dbta%alnwf(:dim1,:dim2)=data%alnwf(:dim1,:dim2)
1443 dbta%slmsk(:dim1,:dim2)=data%slmsk(:dim1,:dim2)
1444 dbta%vfrac(:dim1,:dim2)=data%vfrac(:dim1,:dim2)
1445 dbta%canopy(:dim1,:dim2)=data%canopy(:dim1,:dim2)
1446 dbta%f10m(:dim1,:dim2)=data%f10m(:dim1,:dim2)
1447 dbta%t2m(:dim1,:dim2)=data%t2m(:dim1,:dim2)
1448 dbta%q2m(:dim1,:dim2)=data%q2m(:dim1,:dim2)
1449 dbta%vtype(:dim1,:dim2)=data%vtype(:dim1,:dim2)
1450 dbta%stype(:dim1,:dim2)=data%stype(:dim1,:dim2)
1451 dbta%facsf(:dim1,:dim2)=data%facsf(:dim1,:dim2)
1452 dbta%facwf(:dim1,:dim2)=data%facwf(:dim1,:dim2)
1453 dbta%uustar(:dim1,:dim2)=data%uustar(:dim1,:dim2)
1454 dbta%ffmm(:dim1,:dim2)=data%ffmm(:dim1,:dim2)
1455 dbta%ffhh(:dim1,:dim2)=data%ffhh(:dim1,:dim2)
1456 dbta%hice(:dim1,:dim2)=data%hice(:dim1,:dim2)
1457 dbta%fice(:dim1,:dim2)=data%fice(:dim1,:dim2)
1458 dbta%tisfc(:dim1,:dim2)=data%tisfc(:dim1,:dim2)
1459 dbta%tprcp(:dim1,:dim2)=data%tprcp(:dim1,:dim2)
1460 dbta%srflag(:dim1,:dim2)=data%srflag(:dim1,:dim2)
1461 dbta%snwdph(:dim1,:dim2)=data%snwdph(:dim1,:dim2)
1462 dbta%slc(:dim1,:dim2,:dim3)=data%slc(:dim1,:dim2,:dim3)
1463 dbta%shdmin(:dim1,:dim2)=data%shdmin(:dim1,:dim2)
1464 dbta%shdmax(:dim1,:dim2)=data%shdmax(:dim1,:dim2)
1465 dbta%slope(:dim1,:dim2)=data%slope(:dim1,:dim2)
1466 dbta%snoalb(:dim1,:dim2)=data%snoalb(:dim1,:dim2)
1467 dbta%orog(:dim1,:dim2)=data%orog(:dim1,:dim2)
1468 call sfcio_swdbta(lu,head,dbta,iret)
1469 if(iret.ne.0)
return
1470 call sfcio_axdbta(dbta,iret)
1473 elseif(head%ivs.eq.200501.and.head%irealf.ne.2)
then
1474 write(lu,iostat=ios) data%slmsk(:dim1,:dim2)
1476 write(lu,iostat=ios) data%orog(:dim1,:dim2)
1478 write(lu,iostat=ios) data%tsea(:dim1,:dim2)
1480 write(lu,iostat=ios) data%sheleg(:dim1,:dim2)
1482 write(lu,iostat=ios) data%tg3(:dim1,:dim2)
1484 write(lu,iostat=ios) data%zorl(:dim1,:dim2)
1486 write(lu,iostat=ios) data%alvsf(:dim1,:dim2)
1488 write(lu,iostat=ios) data%alvwf(:dim1,:dim2)
1490 write(lu,iostat=ios) data%alnsf(:dim1,:dim2)
1492 write(lu,iostat=ios) data%alnwf(:dim1,:dim2)
1494 write(lu,iostat=ios) data%vfrac(:dim1,:dim2)
1496 write(lu,iostat=ios) data%canopy(:dim1,:dim2)
1498 write(lu,iostat=ios) data%f10m(:dim1,:dim2)
1500 write(lu,iostat=ios) data%vtype(:dim1,:dim2)
1502 write(lu,iostat=ios) data%stype(:dim1,:dim2)
1504 write(lu,iostat=ios) data%facsf(:dim1,:dim2)
1506 write(lu,iostat=ios) data%facwf(:dim1,:dim2)
1508 write(lu,iostat=ios) data%uustar(:dim1,:dim2)
1510 write(lu,iostat=ios) data%ffmm(:dim1,:dim2)
1512 write(lu,iostat=ios) data%ffhh(:dim1,:dim2)
1514 write(lu,iostat=ios) data%hice(:dim1,:dim2)
1516 write(lu,iostat=ios) data%fice(:dim1,:dim2)
1518 write(lu,iostat=ios) data%tprcp(:dim1,:dim2)
1520 write(lu,iostat=ios) data%srflag(:dim1,:dim2)
1522 write(lu,iostat=ios) data%snwdph(:dim1,:dim2)
1524 write(lu,iostat=ios) data%shdmin(:dim1,:dim2)
1526 write(lu,iostat=ios) data%shdmax(:dim1,:dim2)
1528 write(lu,iostat=ios) data%slope(:dim1,:dim2)
1530 write(lu,iostat=ios) data%snoalb(:dim1,:dim2)
1533 write(lu,iostat=ios) data%stc(:dim1,:dim2,i)
1537 write(lu,iostat=ios) data%smc(:dim1,:dim2,i)
1541 write(lu,iostat=ios) data%slc(:dim1,:dim2,i)
1545 elseif(head%ivs.eq.200004.and.head%lsoil.eq.2)
then
1546 write(lu,iostat=ios) data%tsea(:dim1,:dim2)
1548 write(lu,iostat=ios) data%smc(:dim1,:dim2,:dim3)
1550 write(lu,iostat=ios) data%sheleg(:dim1,:dim2)
1552 write(lu,iostat=ios) data%stc(:dim1,:dim2,:dim3)
1554 write(lu,iostat=ios) data%tg3(:dim1,:dim2)
1556 write(lu,iostat=ios) data%zorl(:dim1,:dim2)
1558 write(lu,iostat=ios) data%cv(:dim1,:dim2)
1560 write(lu,iostat=ios) data%cvb(:dim1,:dim2)
1562 write(lu,iostat=ios) data%cvt(:dim1,:dim2)
1564 write(lu,iostat=ios) data%alvsf(:dim1,:dim2),&
1565 data%alvwf(:dim1,:dim2),&
1566 data%alnsf(:dim1,:dim2),&
1567 data%alnwf(:dim1,:dim2)
1569 write(lu,iostat=ios) data%slmsk(:dim1,:dim2)
1571 write(lu,iostat=ios) data%vfrac(:dim1,:dim2)
1573 write(lu,iostat=ios) data%canopy(:dim1,:dim2)
1575 write(lu,iostat=ios) data%f10m(:dim1,:dim2)
1577 write(lu,iostat=ios) data%vtype(:dim1,:dim2)
1579 write(lu,iostat=ios) data%stype(:dim1,:dim2)
1581 write(lu,iostat=ios) data%facsf(:dim1,:dim2),&
1582 data%facwf(:dim1,:dim2)
1584 write(lu,iostat=ios) data%uustar(:dim1,:dim2)
1586 write(lu,iostat=ios) data%ffmm(:dim1,:dim2)
1588 write(lu,iostat=ios) data%ffhh(:dim1,:dim2)
1595 subroutine sfcio_srohdca(lu,cfname,head,data,iret)
1597 integer(sfcio_intkind),
intent(in):: lu
1598 character*(*),
intent(in):: cfname
1599 type(sfcio_head),
intent(inout):: head
1600 type(sfcio_data),
intent(inout):: data
1601 integer(sfcio_intkind),
intent(out):: iret
1603 call sfcio_sropen(lu,cfname,iret)
1604 if(iret.ne.0)
return
1606 call sfcio_srhead(lu,head,iret)
1607 if(iret.ne.0)
return
1609 call sfcio_aldata(head,
data,iret)
1610 if(iret.ne.0)
return
1612 call sfcio_srdata(lu,head,
data,iret)
1613 if(iret.ne.0)
return
1615 call sfcio_sclose(lu,iret)
1616 if(iret.ne.0)
return
1620 subroutine sfcio_swohdca(lu,cfname,head,data,iret)
1622 integer(sfcio_intkind),
intent(in):: lu
1623 character*(*),
intent(in):: cfname
1624 type(sfcio_head),
intent(in):: head
1625 type(sfcio_data),
intent(in):: data
1626 integer(sfcio_intkind),
intent(out):: iret
1628 call sfcio_swopen(lu,cfname,iret)
1629 if(iret.ne.0)
return
1631 call sfcio_swhead(lu,head,iret)
1632 if(iret.ne.0)
return
1634 call sfcio_swdata(lu,head,
data,iret)
1635 if(iret.ne.0)
return
1637 call sfcio_sclose(lu,iret)
1638 if(iret.ne.0)
return
1642 subroutine sfcio_aldbta(head,dbta,iret)
1644 type(sfcio_head),
intent(in):: head
1645 type(sfcio_dbta),
intent(inout):: dbta
1646 integer(sfcio_intkind),
intent(out):: iret
1647 integer dim1,dim2,dim3
1649 call sfcio_axdbta(dbta,iret)
1654 dbta%tsea(dim1,dim2),&
1655 dbta%smc(dim1,dim2,dim3),&
1656 dbta%sheleg(dim1,dim2),&
1657 dbta%stc(dim1,dim2,dim3),&
1658 dbta%tg3(dim1,dim2),&
1659 dbta%zorl(dim1,dim2),&
1660 dbta%cv(dim1,dim2),&
1661 dbta%cvb(dim1,dim2),&
1662 dbta%cvt(dim1,dim2),&
1663 dbta%alvsf(dim1,dim2),&
1664 dbta%alvwf(dim1,dim2),&
1665 dbta%alnsf(dim1,dim2),&
1666 dbta%alnwf(dim1,dim2),&
1667 dbta%slmsk(dim1,dim2),&
1668 dbta%vfrac(dim1,dim2),&
1669 dbta%canopy(dim1,dim2),&
1670 dbta%f10m(dim1,dim2),&
1671 dbta%t2m(dim1,dim2),&
1672 dbta%q2m(dim1,dim2),&
1673 dbta%vtype(dim1,dim2),&
1674 dbta%stype(dim1,dim2),&
1675 dbta%facsf(dim1,dim2),&
1676 dbta%facwf(dim1,dim2),&
1677 dbta%uustar(dim1,dim2),&
1678 dbta%ffmm(dim1,dim2),&
1679 dbta%ffhh(dim1,dim2),&
1680 dbta%hice(dim1,dim2),&
1681 dbta%fice(dim1,dim2),&
1682 dbta%tisfc(dim1,dim2),&
1683 dbta%tprcp(dim1,dim2),&
1684 dbta%srflag(dim1,dim2),&
1685 dbta%snwdph(dim1,dim2),&
1686 dbta%slc(dim1,dim2,dim3),&
1687 dbta%shdmin(dim1,dim2),&
1688 dbta%shdmax(dim1,dim2),&
1689 dbta%slope(dim1,dim2),&
1690 dbta%snoalb(dim1,dim2),&
1691 dbta%orog(dim1,dim2),&
1693 if(iret.ne.0) iret=-3
1697 subroutine sfcio_axdbta(dbta,iret)
1699 type(sfcio_dbta),
intent(inout):: dbta
1700 integer(sfcio_intkind),
intent(out):: iret
1781 if(iret.ne.0) iret=-3
1785 subroutine sfcio_srdbta(lu,head,dbta,iret)
1787 integer(sfcio_intkind),
intent(in):: lu
1788 type(sfcio_head),
intent(in):: head
1789 type(sfcio_dbta),
intent(inout):: dbta
1790 integer(sfcio_intkind),
intent(out):: iret
1791 integer:: dim1,dim2,dim3,mdim1,mdim2,mdim3
1794 type(sfcio_data):: data
1802 size(dbta%sheleg,1),&
1806 size(dbta%alvsf,1),&
1807 size(dbta%alvwf,1),&
1808 size(dbta%alnsf,1),&
1809 size(dbta%alnwf,1),&
1810 size(dbta%slmsk,1),&
1811 size(dbta%vfrac,1),&
1812 size(dbta%canopy,1),&
1816 size(dbta%vtype,1),&
1817 size(dbta%stype,1),&
1818 size(dbta%facsf,1),&
1819 size(dbta%facwf,1),&
1820 size(dbta%uustar,1),&
1825 size(dbta%tisfc,1),&
1826 size(dbta%tprcp,1),&
1827 size(dbta%srflag,1),&
1828 size(dbta%snwdph,1),&
1830 size(dbta%shdmin,1),&
1831 size(dbta%shdmax,1),&
1832 size(dbta%slope,1),&
1833 size(dbta%snoalb,1),&
1838 size(dbta%sheleg,2),&
1842 size(dbta%alvsf,2),&
1843 size(dbta%alvwf,2),&
1844 size(dbta%alnsf,2),&
1845 size(dbta%alnwf,2),&
1846 size(dbta%slmsk,2),&
1847 size(dbta%vfrac,2),&
1848 size(dbta%canopy,2),&
1852 size(dbta%vtype,2),&
1853 size(dbta%stype,2),&
1854 size(dbta%facsf,2),&
1855 size(dbta%facwf,2),&
1856 size(dbta%uustar,2),&
1861 size(dbta%tisfc,2),&
1862 size(dbta%tprcp,2),&
1863 size(dbta%srflag,2),&
1864 size(dbta%snwdph,2),&
1866 size(dbta%shdmin,2),&
1867 size(dbta%shdmax,2),&
1868 size(dbta%slope,2),&
1869 size(dbta%snoalb,2),&
1876 if(mdim1.lt.dim1.or.&
1878 mdim3.lt.dim3)
return
1881 if(head%irealf.ne.2)
then
1882 call sfcio_aldata(head,
data,iret)
1883 if(iret.ne.0)
return
1884 call sfcio_srdata(lu,head,
data,iret)
1885 if(iret.ne.0)
return
1886 dbta%tsea(:dim1,:dim2)=data%tsea(:dim1,:dim2)
1887 dbta%smc(:dim1,:dim2,:dim3)=data%smc(:dim1,:dim2,:dim3)
1888 dbta%sheleg(:dim1,:dim2)=data%sheleg(:dim1,:dim2)
1889 dbta%stc(:dim1,:dim2,:dim3)=data%stc(:dim1,:dim2,:dim3)
1890 dbta%tg3(:dim1,:dim2)=data%tg3(:dim1,:dim2)
1891 dbta%zorl(:dim1,:dim2)=data%zorl(:dim1,:dim2)
1892 dbta%cv(:dim1,:dim2)=data%cv(:dim1,:dim2)
1893 dbta%cvb(:dim1,:dim2)=data%cvb(:dim1,:dim2)
1894 dbta%cvt(:dim1,:dim2)=data%cvt(:dim1,:dim2)
1895 dbta%alvsf(:dim1,:dim2)=data%alvsf(:dim1,:dim2)
1896 dbta%alvwf(:dim1,:dim2)=data%alvwf(:dim1,:dim2)
1897 dbta%alnsf(:dim1,:dim2)=data%alnsf(:dim1,:dim2)
1898 dbta%alnwf(:dim1,:dim2)=data%alnwf(:dim1,:dim2)
1899 dbta%slmsk(:dim1,:dim2)=data%slmsk(:dim1,:dim2)
1900 dbta%vfrac(:dim1,:dim2)=data%vfrac(:dim1,:dim2)
1901 dbta%canopy(:dim1,:dim2)=data%canopy(:dim1,:dim2)
1902 dbta%f10m(:dim1,:dim2)=data%f10m(:dim1,:dim2)
1903 dbta%t2m(:dim1,:dim2)=data%t2m(:dim1,:dim2)
1904 dbta%q2m(:dim1,:dim2)=data%q2m(:dim1,:dim2)
1905 dbta%vtype(:dim1,:dim2)=data%vtype(:dim1,:dim2)
1906 dbta%stype(:dim1,:dim2)=data%stype(:dim1,:dim2)
1907 dbta%facsf(:dim1,:dim2)=data%facsf(:dim1,:dim2)
1908 dbta%facwf(:dim1,:dim2)=data%facwf(:dim1,:dim2)
1909 dbta%uustar(:dim1,:dim2)=data%uustar(:dim1,:dim2)
1910 dbta%ffmm(:dim1,:dim2)=data%ffmm(:dim1,:dim2)
1911 dbta%ffhh(:dim1,:dim2)=data%ffhh(:dim1,:dim2)
1912 dbta%hice(:dim1,:dim2)=data%hice(:dim1,:dim2)
1913 dbta%fice(:dim1,:dim2)=data%fice(:dim1,:dim2)
1914 dbta%tisfc(:dim1,:dim2)=data%tisfc(:dim1,:dim2)
1915 dbta%tprcp(:dim1,:dim2)=data%tprcp(:dim1,:dim2)
1916 dbta%srflag(:dim1,:dim2)=data%srflag(:dim1,:dim2)
1917 dbta%snwdph(:dim1,:dim2)=data%snwdph(:dim1,:dim2)
1918 dbta%slc(:dim1,:dim2,:dim3)=data%slc(:dim1,:dim2,:dim3)
1919 dbta%shdmin(:dim1,:dim2)=data%shdmin(:dim1,:dim2)
1920 dbta%shdmax(:dim1,:dim2)=data%shdmax(:dim1,:dim2)
1921 dbta%slope(:dim1,:dim2)=data%slope(:dim1,:dim2)
1922 dbta%snoalb(:dim1,:dim2)=data%snoalb(:dim1,:dim2)
1923 dbta%orog(:dim1,:dim2)=data%orog(:dim1,:dim2)
1924 call sfcio_axdata(
data,iret)
1926 elseif(head%ivs == 200509)
then
1927 read(lu,iostat=ios) dbta%slmsk(:dim1,:dim2)
1929 read(lu,iostat=ios) dbta%orog(:dim1,:dim2)
1931 read(lu,iostat=ios) dbta%tsea(:dim1,:dim2)
1933 read(lu,iostat=ios) dbta%sheleg(:dim1,:dim2)
1935 read(lu,iostat=ios) dbta%tg3(:dim1,:dim2)
1937 read(lu,iostat=ios) dbta%zorl(:dim1,:dim2)
1939 read(lu,iostat=ios) dbta%alvsf(:dim1,:dim2)
1941 read(lu,iostat=ios) dbta%alvwf(:dim1,:dim2)
1943 read(lu,iostat=ios) dbta%alnsf(:dim1,:dim2)
1945 read(lu,iostat=ios) dbta%alnwf(:dim1,:dim2)
1947 read(lu,iostat=ios) dbta%vfrac(:dim1,:dim2)
1949 read(lu,iostat=ios) dbta%canopy(:dim1,:dim2)
1951 read(lu,iostat=ios) dbta%f10m(:dim1,:dim2)
1953 read(lu,iostat=ios) dbta%t2m(:dim1,:dim2)
1955 read(lu,iostat=ios) dbta%q2m(:dim1,:dim2)
1957 read(lu,iostat=ios) dbta%vtype(:dim1,:dim2)
1959 read(lu,iostat=ios) dbta%stype(:dim1,:dim2)
1961 read(lu,iostat=ios) dbta%facsf(:dim1,:dim2)
1963 read(lu,iostat=ios) dbta%facwf(:dim1,:dim2)
1965 read(lu,iostat=ios) dbta%uustar(:dim1,:dim2)
1967 read(lu,iostat=ios) dbta%ffmm(:dim1,:dim2)
1969 read(lu,iostat=ios) dbta%ffhh(:dim1,:dim2)
1971 read(lu,iostat=ios) dbta%hice(:dim1,:dim2)
1973 read(lu,iostat=ios) dbta%fice(:dim1,:dim2)
1975 read(lu,iostat=ios) dbta%tisfc(:dim1,:dim2)
1977 read(lu,iostat=ios) dbta%tprcp(:dim1,:dim2)
1979 read(lu,iostat=ios) dbta%srflag(:dim1,:dim2)
1981 read(lu,iostat=ios) dbta%snwdph(:dim1,:dim2)
1983 read(lu,iostat=ios) dbta%shdmin(:dim1,:dim2)
1985 read(lu,iostat=ios) dbta%shdmax(:dim1,:dim2)
1987 read(lu,iostat=ios) dbta%slope(:dim1,:dim2)
1989 read(lu,iostat=ios) dbta%snoalb(:dim1,:dim2)
1992 read(lu,iostat=ios) dbta%stc(:dim1,:dim2,i)
1996 read(lu,iostat=ios) dbta%smc(:dim1,:dim2,i)
2000 read(lu,iostat=ios) dbta%slc(:dim1,:dim2,i)
2003 dbta%cv(:dim1,:dim2)=sfcio_realfill
2004 dbta%cvb(:dim1,:dim2)=sfcio_realfill
2005 dbta%cvt(:dim1,:dim2)=sfcio_realfill
2011 subroutine sfcio_swdbta(lu,head,dbta,iret)
2013 integer(sfcio_intkind),
intent(in):: lu
2014 type(sfcio_head),
intent(in):: head
2015 type(sfcio_dbta),
intent(in):: dbta
2016 integer(sfcio_intkind),
intent(out):: iret
2017 integer:: dim1,dim2,dim3,mdim1,mdim2,mdim3
2020 type(sfcio_data):: data
2028 size(dbta%sheleg,1),&
2032 size(dbta%alvsf,1),&
2033 size(dbta%alvwf,1),&
2034 size(dbta%alnsf,1),&
2035 size(dbta%alnwf,1),&
2036 size(dbta%slmsk,1),&
2037 size(dbta%vfrac,1),&
2038 size(dbta%canopy,1),&
2042 size(dbta%vtype,1),&
2043 size(dbta%stype,1),&
2044 size(dbta%facsf,1),&
2045 size(dbta%facwf,1),&
2046 size(dbta%uustar,1),&
2051 size(dbta%tisfc,1),&
2052 size(dbta%tprcp,1),&
2053 size(dbta%srflag,1),&
2054 size(dbta%snwdph,1),&
2056 size(dbta%shdmin,1),&
2057 size(dbta%shdmax,1),&
2058 size(dbta%slope,1),&
2059 size(dbta%snoalb,1),&
2064 size(dbta%sheleg,2),&
2068 size(dbta%alvsf,2),&
2069 size(dbta%alvwf,2),&
2070 size(dbta%alnsf,2),&
2071 size(dbta%alnwf,2),&
2072 size(dbta%slmsk,2),&
2073 size(dbta%vfrac,2),&
2074 size(dbta%canopy,2),&
2078 size(dbta%vtype,2),&
2079 size(dbta%stype,2),&
2080 size(dbta%facsf,2),&
2081 size(dbta%facwf,2),&
2082 size(dbta%uustar,2),&
2087 size(dbta%tisfc,2),&
2088 size(dbta%tprcp,2),&
2089 size(dbta%srflag,2),&
2090 size(dbta%snwdph,2),&
2092 size(dbta%shdmin,2),&
2093 size(dbta%shdmax,2),&
2094 size(dbta%slope,2),&
2095 size(dbta%snoalb,2),&
2102 if(mdim1.lt.dim1.or.&
2104 mdim3.lt.dim3)
return
2107 if(head%irealf.ne.2)
then
2108 call sfcio_aldata(head,
data,iret)
2109 if(iret.ne.0)
return
2110 data%tsea(:dim1,:dim2)=dbta%tsea(:dim1,:dim2)
2111 data%smc(:dim1,:dim2,:dim3)=dbta%smc(:dim1,:dim2,:dim3)
2112 data%sheleg(:dim1,:dim2)=dbta%sheleg(:dim1,:dim2)
2113 data%stc(:dim1,:dim2,:dim3)=dbta%stc(:dim1,:dim2,:dim3)
2114 data%tg3(:dim1,:dim2)=dbta%tg3(:dim1,:dim2)
2115 data%zorl(:dim1,:dim2)=dbta%zorl(:dim1,:dim2)
2116 data%cv(:dim1,:dim2)=dbta%cv(:dim1,:dim2)
2117 data%cvb(:dim1,:dim2)=dbta%cvb(:dim1,:dim2)
2118 data%cvt(:dim1,:dim2)=dbta%cvt(:dim1,:dim2)
2119 data%alvsf(:dim1,:dim2)=dbta%alvsf(:dim1,:dim2)
2120 data%alvwf(:dim1,:dim2)=dbta%alvwf(:dim1,:dim2)
2121 data%alnsf(:dim1,:dim2)=dbta%alnsf(:dim1,:dim2)
2122 data%alnwf(:dim1,:dim2)=dbta%alnwf(:dim1,:dim2)
2123 data%slmsk(:dim1,:dim2)=dbta%slmsk(:dim1,:dim2)
2124 data%vfrac(:dim1,:dim2)=dbta%vfrac(:dim1,:dim2)
2125 data%canopy(:dim1,:dim2)=dbta%canopy(:dim1,:dim2)
2126 data%f10m(:dim1,:dim2)=dbta%f10m(:dim1,:dim2)
2127 data%t2m(:dim1,:dim2)=dbta%t2m(:dim1,:dim2)
2128 data%q2m(:dim1,:dim2)=dbta%q2m(:dim1,:dim2)
2129 data%vtype(:dim1,:dim2)=dbta%vtype(:dim1,:dim2)
2130 data%stype(:dim1,:dim2)=dbta%stype(:dim1,:dim2)
2131 data%facsf(:dim1,:dim2)=dbta%facsf(:dim1,:dim2)
2132 data%facwf(:dim1,:dim2)=dbta%facwf(:dim1,:dim2)
2133 data%uustar(:dim1,:dim2)=dbta%uustar(:dim1,:dim2)
2134 data%ffmm(:dim1,:dim2)=dbta%ffmm(:dim1,:dim2)
2135 data%ffhh(:dim1,:dim2)=dbta%ffhh(:dim1,:dim2)
2136 data%hice(:dim1,:dim2)=dbta%hice(:dim1,:dim2)
2137 data%fice(:dim1,:dim2)=dbta%fice(:dim1,:dim2)
2138 data%tisfc(:dim1,:dim2)=dbta%tisfc(:dim1,:dim2)
2139 data%tprcp(:dim1,:dim2)=dbta%tprcp(:dim1,:dim2)
2140 data%srflag(:dim1,:dim2)=dbta%srflag(:dim1,:dim2)
2141 data%snwdph(:dim1,:dim2)=dbta%snwdph(:dim1,:dim2)
2142 data%slc(:dim1,:dim2,:dim3)=dbta%slc(:dim1,:dim2,:dim3)
2143 data%shdmin(:dim1,:dim2)=dbta%shdmin(:dim1,:dim2)
2144 data%shdmax(:dim1,:dim2)=dbta%shdmax(:dim1,:dim2)
2145 data%slope(:dim1,:dim2)=dbta%slope(:dim1,:dim2)
2146 data%snoalb(:dim1,:dim2)=dbta%snoalb(:dim1,:dim2)
2147 data%orog(:dim1,:dim2)=dbta%orog(:dim1,:dim2)
2148 call sfcio_swdata(lu,head,
data,iret)
2149 if(iret.ne.0)
return
2150 call sfcio_axdata(
data,iret)
2152 elseif(head%ivs == 200509)
then
2153 write(lu,iostat=ios) dbta%slmsk(:dim1,:dim2)
2155 write(lu,iostat=ios) dbta%orog(:dim1,:dim2)
2157 write(lu,iostat=ios) dbta%tsea(:dim1,:dim2)
2159 write(lu,iostat=ios) dbta%sheleg(:dim1,:dim2)
2161 write(lu,iostat=ios) dbta%tg3(:dim1,:dim2)
2163 write(lu,iostat=ios) dbta%zorl(:dim1,:dim2)
2165 write(lu,iostat=ios) dbta%alvsf(:dim1,:dim2)
2167 write(lu,iostat=ios) dbta%alvwf(:dim1,:dim2)
2169 write(lu,iostat=ios) dbta%alnsf(:dim1,:dim2)
2171 write(lu,iostat=ios) dbta%alnwf(:dim1,:dim2)
2173 write(lu,iostat=ios) dbta%vfrac(:dim1,:dim2)
2175 write(lu,iostat=ios) dbta%canopy(:dim1,:dim2)
2177 write(lu,iostat=ios) dbta%f10m(:dim1,:dim2)
2179 write(lu,iostat=ios) dbta%t2m(:dim1,:dim2)
2181 write(lu,iostat=ios) dbta%q2m(:dim1,:dim2)
2183 write(lu,iostat=ios) dbta%vtype(:dim1,:dim2)
2185 write(lu,iostat=ios) dbta%stype(:dim1,:dim2)
2187 write(lu,iostat=ios) dbta%facsf(:dim1,:dim2)
2189 write(lu,iostat=ios) dbta%facwf(:dim1,:dim2)
2191 write(lu,iostat=ios) dbta%uustar(:dim1,:dim2)
2193 write(lu,iostat=ios) dbta%ffmm(:dim1,:dim2)
2195 write(lu,iostat=ios) dbta%ffhh(:dim1,:dim2)
2197 write(lu,iostat=ios) dbta%hice(:dim1,:dim2)
2199 write(lu,iostat=ios) dbta%fice(:dim1,:dim2)
2201 write(lu,iostat=ios) dbta%tisfc(:dim1,:dim2)
2203 write(lu,iostat=ios) dbta%tprcp(:dim1,:dim2)
2205 write(lu,iostat=ios) dbta%srflag(:dim1,:dim2)
2207 write(lu,iostat=ios) dbta%snwdph(:dim1,:dim2)
2209 write(lu,iostat=ios) dbta%shdmin(:dim1,:dim2)
2211 write(lu,iostat=ios) dbta%shdmax(:dim1,:dim2)
2213 write(lu,iostat=ios) dbta%slope(:dim1,:dim2)
2215 write(lu,iostat=ios) dbta%snoalb(:dim1,:dim2)
2218 write(lu,iostat=ios) dbta%stc(:dim1,:dim2,i)
2222 write(lu,iostat=ios) dbta%smc(:dim1,:dim2,i)
2226 write(lu,iostat=ios) dbta%slc(:dim1,:dim2,i)
2234 subroutine sfcio_srohdcb(lu,cfname,head,dbta,iret)
2236 integer(sfcio_intkind),
intent(in):: lu
2237 character*(*),
intent(in):: cfname
2238 type(sfcio_head),
intent(inout):: head
2239 type(sfcio_dbta),
intent(inout):: dbta
2240 integer(sfcio_intkind),
intent(out):: iret
2242 call sfcio_sropen(lu,cfname,iret)
2243 if(iret.ne.0)
return
2245 call sfcio_srhead(lu,head,iret)
2246 if(iret.ne.0)
return
2248 call sfcio_aldbta(head,dbta,iret)
2249 if(iret.ne.0)
return
2251 call sfcio_srdbta(lu,head,dbta,iret)
2252 if(iret.ne.0)
return
2254 call sfcio_sclose(lu,iret)
2255 if(iret.ne.0)
return
2259 subroutine sfcio_swohdcb(lu,cfname,head,dbta,iret)
2261 integer(sfcio_intkind),
intent(in):: lu
2262 character*(*),
intent(in):: cfname
2263 type(sfcio_head),
intent(in):: head
2264 type(sfcio_dbta),
intent(in):: dbta
2265 integer(sfcio_intkind),
intent(out):: iret
2267 call sfcio_swopen(lu,cfname,iret)
2268 if(iret.ne.0)
return
2270 call sfcio_swhead(lu,head,iret)
2271 if(iret.ne.0)
return
2273 call sfcio_swdbta(lu,head,dbta,iret)
2274 if(iret.ne.0)
return
2276 call sfcio_sclose(lu,iret)
2277 if(iret.ne.0)
return