Add GEFS programs

src/CMakeLists.txt

@@ -17,3 +17,8 @@ add_subdirectory(overgridid.fd)
 add_subdirectory(webtitle.fd)
 
 add_subdirectory(ocnicepost.fd)
+
+add_subdirectory(ensadd.fd)
+add_subdirectory(ensppf.fd)
+add_subdirectory(ensstat.fd)
+add_subdirectory(wave_stat.fd)

src/ensadd.fd/CMakeLists.txt

@@ -0,0 +1,12 @@
+list(APPEND fortran_src
+  ENSADD.f90
+  printinfr.f90
+)
+
+set(exe_name ensadd.x)
+add_executable(${exe_name} ${fortran_src})
+target_link_libraries(${exe_name} PRIVATE bacio::bacio_4
+                                          w3emc::w3emc_4
+                                          g2::g2_d)
+
+install(TARGETS ${exe_name} RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR})

src/ensadd.fd/ENSADD.f90

@@ -0,0 +1,187 @@
+!$$$  MAIN PROGRAM DOCUMENTATION BLOCK
+!
+! MAIN PROGRAM: ENSADD_G2 
+!   PRGMMR: ZHU              ORG: NP23        DATE: 1999-08-31
+!
+! ABSTRACT: THIS PROGRAM WILL EXTEND PDS MESSAGE WHICH WILL  
+!           INCLUDE ENS(5) MESSAGE
+!
+! PROGRAM HISTORY LOG:
+!   96-10-??   MARK IREDELL     - Originator
+!   97-03-17   YUEJIAN ZHU      - Added DOCBLOACK
+!   99-07-26   YUEJIAN ZHU      - Modified to IBM-SP
+!   14-10-06   BO Cui           - Modified to Decode/Incode GRIB2 Data
+!
+! USAGE:
+!
+!   INPUT FILES:
+!     UNIT  11  GRIB FILE 
+!     UNIT   5  READ *, IENST,IENSI (For ensemble message)
+!
+!   OUTPUT FILES:
+!     UNIT  51  GRIB FILE 
+!
+!   SUBPROGRAMS CALLED:
+!     GETGB2 -- W3LIB ROUTINE
+!     PUTGB2 -- W3LIB ROUTINE
+!
+! ATTRIBUTES:
+!   LANGUAGE: FORTRAN
+!
+!$$$
+
+program      ensadd_g2
+
+use grib_mod
+use params
+
+implicit none
+
+type(gribfield) :: gfldo
+
+integer :: currlen=0
+logical :: unpack=.true.
+logical :: expand=.false.
+
+integer,dimension(200) :: kids,kpdt,kgdt
+integer kskp,kdisc,kpdtn,kgdtn,i
+
+integer,dimension(200) :: jids,jpdt,jgdt,iids,ipdt,igdt
+integer jskp,jdisc,jpdtn,jgdtn,idisc,ipdtn,igdtn
+
+integer temp(200)
+
+integer ienst,iensi,lpgb,lpgi,lpge,icount,iretb,ireti,irete,iret,jret,ipdtnum_out                                        
+character*255 cpgb,cpge
+namelist     /namin/ ienst,iensi,cpgb,cpge      
+
+CALL W3TAGB('ENSADD',1999,0243,0068,'NP23')
+
+read (5,namin)
+lpgb=len_trim(cpgb)
+lpge=len_trim(cpge)
+
+print *, cpgb(1:lpgb),' ',cpge(1:lpge)
+print *, ' '  
+
+call baopenr(11,cpgb(1:lpgb),iretb)
+call baopen (51,cpge(1:lpge),irete)
+
+! loop over variables
+
+kids=-9999;kpdt=-9999; kgdt=-9999
+kdisc=-1;  kpdtn=-1;   kgdtn=-1
+
+icount=0
+kskp=0
+do
+
+  print *, '----- Read Ensemble Forecast ------'
+  print *, ' '  
+
+  call getgb2(11,0,kskp,kdisc,kids,kpdtn,kpdt,kgdtn,kgdt,unpack,kskp,gfldo,iret)
+
+  if(iret.ne.0) then
+    if(iret.eq.99 ) exit
+    print *,' getgb2 error = ',iret
+    cycle
+    !call errexit(17)
+  endif
+
+  icount=icount+1
+
+  if(iret.eq.0) then
+    call printinfr(gfldo,icount)
+  else
+    print*, 'there is no fcst for ens member'
+  endif
+
+  ! gfldo%idsect(2): Identification of originating
+  ! gfldo%idsect(2)=2: NCEP Ensemble Products
+  ! Original GFS has gfldo%idsect(2)=0, change it to be 2
+
+  gfldo%idsect(2)=2
+  gfldo%idsect(13)=3
+
+  ! when product difinition template 4.0 change to 4.1
+  ! when product difinition template 4.8 change to 4.11
+  ! ipdtlen aslo change, need do modification for output
+
+! print*, '1 gfldo%ipdtmpl=',gfldo%ipdtmpl   
+
+  if(gfldo%ipdtnum.eq.0) then
+
+    temp=-9999
+
+    temp(1:gfldo%ipdtlen)=gfldo%ipdtmpl(1:gfldo%ipdtlen)
+    if(gfldo%ipdtmpl(3).eq.2) then
+     temp(3)=4
+    endif 
+
+    deallocate (gfldo%ipdtmpl)
+
+    gfldo%ipdtnum=1
+    if(gfldo%ipdtnum.eq.1) gfldo%ipdtlen=18
+    if(gfldo%ipdtnum.eq.1) allocate (gfldo%ipdtmpl(gfldo%ipdtlen))
+
+    gfldo%ipdtmpl(1:15)=temp(1:15)
+    gfldo%ipdtmpl(16)=ienst
+    gfldo%ipdtmpl(17)=iensi
+    gfldo%ipdtmpl(18)=10    
+
+  endif
+
+  if(gfldo%ipdtnum.eq.8) then
+
+    temp=-9999
+
+    temp(1:gfldo%ipdtlen)=gfldo%ipdtmpl(1:gfldo%ipdtlen)
+    if(gfldo%ipdtmpl(3).eq.2) then
+     temp(3)=4
+    endif 
+
+    deallocate (gfldo%ipdtmpl)
+
+    gfldo%ipdtnum=11
+    if(gfldo%ipdtnum.eq.11) gfldo%ipdtlen=32
+    if(gfldo%ipdtnum.eq.11) allocate (gfldo%ipdtmpl(gfldo%ipdtlen))
+
+    gfldo%ipdtmpl(1:15)=temp(1:15)
+    gfldo%ipdtmpl(16)=ienst
+    gfldo%ipdtmpl(17)=iensi
+    gfldo%ipdtmpl(18)=10    
+    gfldo%ipdtmpl(19:32)=temp(16:29)
+
+  endif
+
+! print*, '2 gfldo%ipdtmpl=',gfldo%ipdtmpl   
+
+! print*, 'gfldo%ipdtnum=',gfldo%ipdtnum   
+! print*, 'gfldo%ipdtlen=',gfldo%ipdtlen   
+
+  print *, '----- Write Ensemble Forecast ------'
+  print *, ' '  
+
+  call printinfr(gfldo,icount)
+  call putgb2(51,gfldo,jret)
+
+  ! end of probability forecast calculation
+
+  200 continue
+
+  call gf_free(gfldo)
+
+enddo
+
+! end of ivar loop
+
+! close files
+
+call baclose(11,iretb)
+call baclose(51,irete)
+
+CALL W3TAGE('ENSADD')
+
+stop
+end
+

src/ensadd.fd/printinfr.f90

@@ -0,0 +1,82 @@
+subroutine printinfr(gfld,ivar)
+
+! SUBPROGRAM:    printinfr         
+!
+! PRGMMR: Bo Cui         DATE: 2013-06-11
+!
+! USAGE:   print grib2 data information
+!
+! INPUT:  gfld,ivar 
+
+use grib_mod
+use params
+
+implicit none
+
+type(gribfield) :: gfld
+
+integer,dimension(200) :: jids,jpdt,jgdt,ipdt,igdt
+integer :: currlen=0
+logical :: unpack=.true.
+
+integer kf,j,ivar,i
+real    fldmin,fldmax
+
+!kf=gfld%ngrdpts
+kf=gfld%ndpts   
+
+fldmin=gfld%fld(1)
+fldmax=gfld%fld(1)
+
+do j=2,kf               
+  if (gfld%fld(j).gt.fldmax) fldmax=gfld%fld(j)
+  if (gfld%fld(j).lt.fldmin) fldmin=gfld%fld(j)
+enddo
+
+! print out
+
+! gfld%ipdtnum 1/11: ens. fcst or control, high reslution
+! gfld%ipdtnum 2/12: ens. average fcst
+! gfld%ipdtnum 0/8:  cdas reanalysis 
+
+! gfld%ipdtnum 11: ens. fcst or control in a continuous or non-continuous time interval
+! gfld%ipdtnum 12: derived fcst based on ens. members in a continuous/non-continuous time interval
+! gfld%ipdtnum 8:  Rstatistically processed values in a continuous/non-continuous time interval
+
+if(gfld%ipdtnum.eq.11.or.gfld%ipdtnum.eq.12) then
+  write(6,100) 
+  write(6,102) ivar,gfld%ipdtnum,(gfld%ipdtmpl(i),i=1,3),gfld%ipdtmpl(10),gfld%ipdtmpl(12),   &
+                    (gfld%idsect(i),i=6,9),gfld%ipdtmpl(9),gfld%ipdtmpl(30),  &
+                    (gfld%ipdtmpl(i),i=16,17), &
+                     kf,fldmax,fldmin,gfld%fld(8601)
+  write(6,*) 
+
+elseif(gfld%ipdtnum.eq.8.or.gfld%ipdtnum.eq.0) then
+  write(6,300) 
+  write(6,302) ivar,gfld%ipdtnum,(gfld%ipdtmpl(i),i=1,3),gfld%ipdtmpl(10),gfld%ipdtmpl(12),   &
+                    (gfld%idsect(i),i=6,9),gfld%ipdtmpl(9), &
+                     kf,fldmax,fldmin,gfld%fld(8601)
+  write(6,*) 
+
+else
+  write(6,200) 
+  write(6,202) ivar,gfld%ipdtnum,(gfld%ipdtmpl(i),i=1,3),gfld%ipdtmpl(10),gfld%ipdtmpl(12),   &
+                    (gfld%idsect(i),i=6,9),gfld%ipdtmpl(9),(gfld%ipdtmpl(i),i=16,17), &
+                     kf,fldmax,fldmin,gfld%fld(8601)
+  write(6,*) 
+endif
+
+100 format(' REC PDTN PD1 PD2 PD3 PD10   PD12  YEAR MN DY HR FHR  TR ',  &
+           'E16 E17    LEN       MAX         MIN      EXAMPLE')
+102 format(i4,i5,4i4,i8,i6,3i3,2i4,2i4,i8,3f11.2)
+
+200 format(' REC PDTN PD1 PD2 PD3 PD10   PD12  YEAR MN DY HR FHR ',  &
+           'E16 E17    LEN       MAX         MIN      EXAMPLE')
+202 format(i4,i5,4i4,i8,i6,3i3,3i4,i8,3f11.2)
+
+300 format(' REC PDTN PD1 PD2 PD3 PD10   PD12  YEAR MN DY HR FHR ',  &
+           '           LEN       MAX         MIN      EXAMPLE')
+302 format(i4,i5,4i4,i8,i6,3i3,i4,8x,i8,3f11.2)
+
+return
+end

src/ensppf.fd/CMakeLists.txt

@@ -0,0 +1,13 @@
+list(APPEND fortran_src
+  ENSPPF.f90
+  printinfr.f90
+  init_parm.f90
+)
+
+set(exe_name ensppf.x)
+add_executable(${exe_name} ${fortran_src})
+target_link_libraries(${exe_name} PRIVATE bacio::bacio_4
+                                          w3emc::w3emc_4
+                                          g2::g2_d)
+
+install(TARGETS ${exe_name} RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR})