[WAM-IPE] WAM-IPE r94277: commit Houjun and Phil IAU code, and Houjun F10.7 a...
Samuel.Trahan at noaa.gov
Samuel.Trahan at noaa.gov
Fri Jun 16 16:56:05 UTC 2017
Friendly WAM-IPE developers,
This is an automated email about a WAM-IPE commit.
Project: WAM-IPE
URL: https://svnemc.ncep.noaa.gov/projects/nems/branches/WAM-IPE/quasitrunk
Revision: 94277
Author: weiyu.yang at noaa.gov
Date: 2017-06-12T19:04:52.865262Z
Message:
commit Houjun and Phil IAU code, and Houjun F10.7 adjust to avoid the zero F10.7 value
See attached file for full differences.
First 4000 bytes of differences:
Index: checkout/src/atmos/phys/idea_phys.f
===================================================================
--- checkout/src/atmos/phys/idea_phys.f (revision 93833)
+++ checkout/src/atmos/phys/idea_phys.f (revision 94277)
@@ -53,7 +53,9 @@
use idea_composition, only : mmr_min, amo, amo2, amo3, amn2
use wam_ion, only : idea_ion
use wam_f107_kp_mod, only : f107_wy, kp_wy, kdt_3h
+
use wam_f107_kp_mod, only : f107_fix, f107d_fix, kp_fix
+
use wam_f107_kp_mod, only : fix_spweather_data
! use wam_f107_kp_mod, only : swpcf107_fix, swpcf107d_fix, swpckp_fix
!
@@ -127,7 +129,7 @@
!
integer, parameter :: ntrac_i=2 ! number of 2 WAM chem. tracers (O-O2)
!
- real :: f107_curdt, f107d_curdt, kp_curdt
+ real :: f107_curdt, f107d_curdt, kp_curdt
integer :: Mjdat(ndwam) ! IDAT_WAM + FHOUR
real :: Hcur ! current hour+min+sec real
!
Index: checkout/src/atmos/phys/wam_f107_kp_mod.f
===================================================================
--- checkout/src/atmos/phys/wam_f107_kp_mod.f (revision 93833)
+++ checkout/src/atmos/phys/wam_f107_kp_mod.f (revision 94277)
@@ -25,6 +25,10 @@
! Subprogram: read_wam_f107_kp_txt read-in the inputted f10.7 and kp data.
! Prgmmr: Weiyu Yang Date: 2015-10-19
!
+! !revision history log:
+!
+! 13Apr2017 Houjun Wang, enable handling cases when f107=0 or too small
+
CHARACTER*20 :: issuedate, realdate(f107_kp_size)
CHARACTER*20 :: realdate_work
INTEGER :: i, j
@@ -74,13 +78,30 @@
! f107=70.0
! kp=2.0
+! HW 15May2016
+! In case of f107 == 0 or too small,
+! use the last-readin 'correct' value or f107_81d_avg
+ do i = 1, f107_kp_size
+ if (f107_wy(i) >= 70.0) then
+ f107_work = f107_wy(i)
+ endif
+ enddo
+
+ if (f107_work < 70.0) f107_work = f107_81d_avg
+
+ do i = 1, f107_kp_size
+ if (f107_wy(i) < 70.0) then
+ f107_wy(i) = f107_work
+ endif
+ enddo
+
1000 FORMAT(20x, a20)
1001 FORMAT(20x, f3.0)
-! PRINT*, 'issuedate=', issuedate
-! PRINT*, 'f107_81d_avg=', f107_81d_avg
-! DO i = 1, f107_kp_read_in_size
-! PRINT*, i, f107(i), kp(i), f107_flag(i), kp_flag(i)
-! END DO
+ PRINT*, 'issuedate=', issuedate
+ PRINT*, 'f107_81d_avg=', f107_81d_avg
+ DO i = 1, f107_kp_read_in_size
+ PRINT*, i, f107_wy(i), kp_wy(i), f107_flag(i), kp_flag(i)
+ END DO
END SUBROUTINE read_wam_f107_kp_txt
!==========================================================
@@ -96,9 +117,10 @@
swpcf107_fix = 100.
swpckp_fix = 1.
swpcf107d_fix = swpcf107_fix
+
f107_fix = 100.
kp_fix = 1.
- f107d_fix = f107_fix
+ f107d_fix = f107_fix
END SUBROUTINE fix_spweather_data
!
SUBROUTINE read_spweather_real_data
@@ -109,7 +131,7 @@
!=======================================================================
f107_fix = 100.
kp_fix = 1.
- f107d_fix = f107_fix
+ f107d_fix = f107_fix
END SUBROUTINE read_spweather_real_data
!
Index: checkout/src/atmos/io/module_GET_CONFIG_WRITE_GFS.F90
===================================================================
--- checkout/src/atmos/io/module_GET_CONFIG_WRITE_GFS.F90 (revision 93833)
+++ checkout/src/atmos/io/module_GET_CONFIG_WRITE_GFS.F90 (revision 94277)
@@ -223,6 +223,22 @@
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
+ MESSAGE_CHECK="GET_CONFIG_WRITE: Extract IAU from Config File"
+! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
+! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
+!
+ CALL ESMF_ConfigGetAttribute(config=CF & !<-- The configure file object
+
... see attachment for the rest ...
-------------- next part --------------
Index: checkout/src/atmos/phys/idea_phys.f
===================================================================
--- checkout/src/atmos/phys/idea_phys.f (revision 93833)
+++ checkout/src/atmos/phys/idea_phys.f (revision 94277)
@@ -53,7 +53,9 @@
use idea_composition, only : mmr_min, amo, amo2, amo3, amn2
use wam_ion, only : idea_ion
use wam_f107_kp_mod, only : f107_wy, kp_wy, kdt_3h
+
use wam_f107_kp_mod, only : f107_fix, f107d_fix, kp_fix
+
use wam_f107_kp_mod, only : fix_spweather_data
! use wam_f107_kp_mod, only : swpcf107_fix, swpcf107d_fix, swpckp_fix
!
@@ -127,7 +129,7 @@
!
integer, parameter :: ntrac_i=2 ! number of 2 WAM chem. tracers (O-O2)
!
- real :: f107_curdt, f107d_curdt, kp_curdt
+ real :: f107_curdt, f107d_curdt, kp_curdt
integer :: Mjdat(ndwam) ! IDAT_WAM + FHOUR
real :: Hcur ! current hour+min+sec real
!
Index: checkout/src/atmos/phys/wam_f107_kp_mod.f
===================================================================
--- checkout/src/atmos/phys/wam_f107_kp_mod.f (revision 93833)
+++ checkout/src/atmos/phys/wam_f107_kp_mod.f (revision 94277)
@@ -25,6 +25,10 @@
! Subprogram: read_wam_f107_kp_txt read-in the inputted f10.7 and kp data.
! Prgmmr: Weiyu Yang Date: 2015-10-19
!
+! !revision history log:
+!
+! 13Apr2017 Houjun Wang, enable handling cases when f107=0 or too small
+
CHARACTER*20 :: issuedate, realdate(f107_kp_size)
CHARACTER*20 :: realdate_work
INTEGER :: i, j
@@ -74,13 +78,30 @@
! f107=70.0
! kp=2.0
+! HW 15May2016
+! In case of f107 == 0 or too small,
+! use the last-readin 'correct' value or f107_81d_avg
+ do i = 1, f107_kp_size
+ if (f107_wy(i) >= 70.0) then
+ f107_work = f107_wy(i)
+ endif
+ enddo
+
+ if (f107_work < 70.0) f107_work = f107_81d_avg
+
+ do i = 1, f107_kp_size
+ if (f107_wy(i) < 70.0) then
+ f107_wy(i) = f107_work
+ endif
+ enddo
+
1000 FORMAT(20x, a20)
1001 FORMAT(20x, f3.0)
-! PRINT*, 'issuedate=', issuedate
-! PRINT*, 'f107_81d_avg=', f107_81d_avg
-! DO i = 1, f107_kp_read_in_size
-! PRINT*, i, f107(i), kp(i), f107_flag(i), kp_flag(i)
-! END DO
+ PRINT*, 'issuedate=', issuedate
+ PRINT*, 'f107_81d_avg=', f107_81d_avg
+ DO i = 1, f107_kp_read_in_size
+ PRINT*, i, f107_wy(i), kp_wy(i), f107_flag(i), kp_flag(i)
+ END DO
END SUBROUTINE read_wam_f107_kp_txt
!==========================================================
@@ -96,9 +117,10 @@
swpcf107_fix = 100.
swpckp_fix = 1.
swpcf107d_fix = swpcf107_fix
+
f107_fix = 100.
kp_fix = 1.
- f107d_fix = f107_fix
+ f107d_fix = f107_fix
END SUBROUTINE fix_spweather_data
!
SUBROUTINE read_spweather_real_data
@@ -109,7 +131,7 @@
!=======================================================================
f107_fix = 100.
kp_fix = 1.
- f107d_fix = f107_fix
+ f107d_fix = f107_fix
END SUBROUTINE read_spweather_real_data
!
Index: checkout/src/atmos/io/module_GET_CONFIG_WRITE_GFS.F90
===================================================================
--- checkout/src/atmos/io/module_GET_CONFIG_WRITE_GFS.F90 (revision 93833)
+++ checkout/src/atmos/io/module_GET_CONFIG_WRITE_GFS.F90 (revision 94277)
@@ -223,6 +223,22 @@
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
+ MESSAGE_CHECK="GET_CONFIG_WRITE: Extract IAU from Config File"
+! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
+! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
+!
+ CALL ESMF_ConfigGetAttribute(config=CF & !<-- The configure file object
+ ,value =int_state%IAU & !<-- Put extracted quantity here
+ ,label ='iau:' & !<-- The quantity's label in the configure file
+ ,rc =RC)
+!
+! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
+ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_CONF)
+! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
+!
+!-----------------------------------------------------------------------
+!
+! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
MESSAGE_CHECK="GET_CONFIG_WRITE: Extract WRITE_DOPOST from Config File"
! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
Index: checkout/src/atmos/io/module_WRITE_ROUTINES_GFS.F90
===================================================================
--- checkout/src/atmos/io/module_WRITE_ROUTINES_GFS.F90 (revision 93833)
+++ checkout/src/atmos/io/module_WRITE_ROUTINES_GFS.F90 (revision 94277)
@@ -1718,6 +1718,7 @@
,NF_HOURS &
,NF_MINUTES &
,NF_SECONDS &
+ ,NF_HOURS_IAU &
,DIM1,DIM2,NFRAME &
,LEAD_WRITE_TASK)
@@ -1730,7 +1731,7 @@
TYPE(NEMSIO_GFILE),INTENT(INOUT) :: NEMSIOFILE !<-- The nemsio file handler
!
INTEGER,INTENT(IN) :: IYEAR_FCST, IMONTH_FCST, IDAY_FCST, IHOUR_FCST &
- ,IMINUTE_FCST, NF_HOURS, NF_MINUTES &
+ ,IMINUTE_FCST, NF_HOURS, NF_MINUTES,NF_HOURS_IAU &
,LEAD_WRITE_TASK, NBDL
INTEGER,INTENT(OUT) :: DIM1,DIM2,NFRAME
@@ -2312,7 +2313,7 @@
!
CALL NEMSIO_OPEN(NEMSIOFILE,trim(FILENAME),'write',iret, &
modelname="GFS", gdatatype=wrt_int_state%io_form(NBDL), &
- idate=idate,nfhour=NF_HOURS, &
+ idate=idate,nfhour=NF_HOURS_IAU, &
nfminute=NF_MINUTES,nfsecondn=nint(NF_SECONDS*100), &
nfsecondd=100,dimx=DIM1,dimy=DIM2,dimz=LM,nframe=NFRAME, &
nmeta=NMETA,jcap=JCAP,idsl=IDSL,idvm=IDVM,idvc=IDVC,idrt=IDRT, &
Index: checkout/src/atmos/io/module_WRITE_INTERNAL_STATE_GFS.F90
===================================================================
--- checkout/src/atmos/io/module_WRITE_INTERNAL_STATE_GFS.F90 (revision 93833)
+++ checkout/src/atmos/io/module_WRITE_INTERNAL_STATE_GFS.F90 (revision 94277)
@@ -176,6 +176,7 @@
!-----------------------------------------
!
LOGICAL :: WRITE_DOPOST
+ LOGICAL :: IAU
CHARACTER(ESMF_MAXSTR) :: POST_GRIBVERSION
LOGICAL :: GOCART_AER2POST
integer :: nlunit ! post namelist unit number - Moorthi
Index: checkout/src/atmos/io/module_WRITE_GRID_COMP_GFS.F90
===================================================================
--- checkout/src/atmos/io/module_WRITE_GRID_COMP_GFS.F90 (revision 93833)
+++ checkout/src/atmos/io/module_WRITE_GRID_COMP_GFS.F90 (revision 94277)
@@ -543,6 +543,18 @@
,IMINUTE_FCST &
,ISECOND_FCST &
,ISECOND_NUM &
+ ,IYEAR_IAU &
+ ,IMONTH_IAU &
+ ,IDAY_IAU &
+ ,IHOUR_IAU &
+ ,IMINUTE_IAU &
+ ,ISECOND_IAU &
+ ,IYEAR_INI &
+ ,IMONTH_INI &
+ ,IDAY_INI &
+ ,IHOUR_INI &
+ ,IMINUTE_INI &
+ ,ISECOND_INI &
,ISECOND_DEN
!
INTEGER(KIND=ESMF_KIND_I8) :: NTIMESTEP_ESMF
@@ -549,6 +561,7 @@
INTEGER(KIND=kind_io4) :: NTIMESTEP
!
INTEGER :: NF_HOURS &
+ ,NF_HOURS_IAU &
,NF_MINUTES &
,NSECONDS &
,NSECONDS_NUM &
@@ -633,6 +646,8 @@
TYPE(WRITE_INTERNAL_STATE_GFS), POINTER :: WRT_INT_STATE
TYPE(ESMF_LOGICAL),DIMENSION(:),POINTER :: FIRST_IO_PE
TYPE(ESMF_Time) :: CURRTIME
+ TYPE(ESMF_Time) :: IAUINITIME
+ TYPE(ESMF_TimeInterval) :: IAUTIMEINTERVAL
!
TYPE(ESMF_TypeKind_Flag) :: DATATYPE
!
@@ -1524,6 +1539,61 @@
,sN =NSECONDS_NUM & !<-- Numerator of fractional elapsed seconds
,sD =NSECONDS_DEN & !<-- denominator of fractional elapsed seconds
,rc =RC)
+ NF_HOURS_IAU=NF_HOURS
+ IF (wrt_int_state%iau.AND.NF_HOURS.GE. 6) THEN
+! set forecast hours back by 6-hours and advance initiali date by 6
+! hours
+ NF_HOURS_IAU=NF_HOURS-6
+ call esmf_timeintervalset(iautimeinterval, h = 6,m = 0, rc = rc)
+ iauinitime = wrt_int_state%IO_BASETIME + iautimeinterval
+ call esmf_timeget(wrt_int_state%IO_BASETIME & !<-- IO_BASETIME
+ ,yy =IYEAR_INI & !<-- The current forecast year (integer)
+ ,mm =IMONTH_INI & !<-- The current forecast month (integer)
+ ,dd =IDAY_INI & !<-- The current forecast day (integer)
+ ,h =IHOUR_INI & !<-- The current forecast hour (integer)
+ ,m =IMINUTE_INI & !<-- The current forecast minute (integer)
+ ,s =ISECOND_INI & !<-- The current forecast second (integer)
+ ,sN =ISECOND_NUM & !<-- Numerator of current fractional second (integer)
+ ,sD =ISECOND_DEN & !<-- Denominator of current fractional second (integer)
+ ,rc =RC)
+ call esmf_timeget(iauinitime & !<-- New initial date for IAU segment
+ ,yy =IYEAR_IAU & !<-- The current forecast year (integer)
+ ,mm =IMONTH_IAU & !<-- The current forecast month (integer)
+ ,dd =IDAY_IAU & !<-- The current forecast day (integer)
+ ,h =IHOUR_IAU & !<-- The current forecast hour (integer)
+ ,m =IMINUTE_IAU & !<-- The current forecast minute (integer)
+ ,s =ISECOND_IAU & !<-- The current forecast second (integer)
+ ,sN =ISECOND_NUM & !<-- Numerator of current fractional second (integer)
+ ,sD =ISECOND_DEN & !<-- Denominator of current fractional second (integer)
+ ,rc =RC)
+ if (mype.eq.lead_write_task) then
+ print*,'ini time=',IYEAR_INI,IMONTH_INI,IDAY_INI,IHOUR_INI
+ print*,'iau time=',IYEAR_IAU,IMONTH_IAU,IDAY_IAU,IHOUR_IAU
+ print*,'fct time=',IYEAR_FCST,IMONTH_FCST,IDAY_FCST,IHOUR_FCST
+ ENDIF
+! fill array 'IDAT' with updated initial time
+ N2 = 0 !<-- Word counter for full string of integer scalar/1D data
+ DO N=1,wrt_int_state%KOUNT_I1D(NBDL) !<-- Loop through all scalar/1D real data
+ NPOSN_1 = (N-1)*NAME_MAXSTR + 1
+ NPOSN_2 = N*NAME_MAXSTR
+ NAME = wrt_int_state%NAMES_I1D_STRING(NBDL)(NPOSN_1:NPOSN_2) !<-- The variable's name
+ LENGTH = wrt_int_state%LENGTH_DATA_I1D(N,NBDL) !<-- The variable's length in words
+ IF(LENGTH == 1) THEN
+ N2 = N2 + 1
+ ELSE
+ DO N1=1,LENGTH
+ N2 = N2 + 1
+ IF (N1==1.AND.NAME=='IDAT') THEN
+ wrt_int_state%ALL_DATA_I1D(N2,NBDL)= IHOUR_IAU
+ wrt_int_state%ALL_DATA_I1D(N2+2,NBDL)= IDAY_IAU
+ wrt_int_state%ALL_DATA_I1D(N2+1,NBDL)= IMONTH_IAU
+ wrt_int_state%ALL_DATA_I1D(N2+3,NBDL)= IYEAR_IAU
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ ENDIF
+ IF (wrt_int_state%iau.AND.NF_HOURS.GT. 6) NF_HOURS_IAU=NF_HOURS-6
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
CALL ERR_MSG(RC,MESSAGE_CHECK,RC_RUN)
@@ -1530,7 +1600,7 @@
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
NF_SECONDS=NSECONDS+REAL(NSECONDS_NUM)/REAL(NSECONDS_DEN)
- wrt_int_state%NFHOUR=NF_HOURS
+ wrt_int_state%NFHOUR=NF_HOURS_IAU
!
ENDIF
!
@@ -1566,7 +1636,7 @@
CALL POST_RUN_GFS(wrt_int_state,MYPE,MPI_COMM_COMP, &
LEAD_WRITE_TASK,post_gridtype, &
- post_maptype,NSOIL,NBDL,NF_HOURS,NF_MINUTES)
+ post_maptype,NSOIL,NBDL,NF_HOURS_IAU,NF_MINUTES)
! write(0,*)'af post_run_gfs'
!
@@ -1621,6 +1691,7 @@
,NF_HOURS &
,NF_MINUTES &
,NF_SECONDS &
+ ,NF_HOURS_IAU &
,DIM1,DIM2,NBDR &
,LEAD_WRITE_TASK)
FIELDSIZE=(DIM1+2*NBDR)*(DIM2+2*NBDR)
More information about the WAM-IPE
mailing list