[WAM-IPE] WAM-IPE r93160: Commit the WAM restart files in the gsm quasitrunk
Samuel.Trahan at noaa.gov
Samuel.Trahan at noaa.gov
Tue May 23 20:58:11 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/gsm/branches/WAM-IPE/quasitrunk
Revision: 93160
Author: weiyu.yang at noaa.gov
Date: 2017-05-23T20:44:47.070007Z
Message:
Commit the WAM restart files in the gsm quasitrunk
See attached file for full differences.
First 4000 bytes of differences:
Index: checkout/phys/fix_fields_idea_rst.f
===================================================================
--- checkout/phys/fix_fields_idea_rst.f (nonexistent)
+++ checkout/phys/fix_fields_idea_rst.f (revision 93160)
@@ -0,0 +1,117 @@
+
+ SUBROUTINE fix_fields_idea_rst(
+ & LONSPERLAR,GLOBAL_LATS_R,XLON,XLAT,sfc_fld,
+ & nst_fld,HPRIME,JINDX1,JINDX2,DDY,OZPLIN,CREAD,
+ & cread_grd,cread_nst,nblck,phy_f3d,phy_f2d)
+!!
+!! Code Revision
+!! jan 26 2010 Jun Wang, added phy_f3d,phy_f2d read in from restart file
+!! Nov 2010 S. Moorthi - nst model related changes
+!! Mar 2013 Jun Wang restart for idea
+!! Aug 2015 Xu Li change nst_fcst and nst_spinup to be nstf_name
+!! introduce the depth mean SST,
+!! remove nst_reset_nonwater
+!! add nemsio for nst file
+
+!!
+ use machine , only : kind_rad, kind_phys
+ use funcphys
+ use module_progtm
+ use resol_def
+ use namelist_physics_def
+ use layout1
+ use gg_def
+ use ozne_def
+ use module_nst_water_prop, only: get_dtzm_2d
+ use gfs_physics_sfc_flx_mod
+ use gfs_physics_nst_var_mod
+ use idea_composition, only: pr_idea,gg,amgms,prsilvl
+ IMPLICIT NONE
+!!
+ TYPE(Sfc_Var_Data) :: sfc_fld
+ TYPE(Nst_Var_Data) :: nst_fld
+ CHARACTER (len=*) :: CREAD
+ CHARACTER (len=*) :: CREAD_grd
+ CHARACTER (len=*) :: cread_nst
+ INTEGER JINDX1(LATS_NODE_R),JINDX2(LATS_NODE_R)
+ REAL (KIND=KIND_RAD) DDY(LATS_NODE_R)
+ REAL (KIND=KIND_RAD) HPRIME(NMTVR,LONR,LATS_NODE_R)
+
+ INTEGER IOZONDP
+ REAL (kind=kind_rad) OZPLIN(LATSOZP,LEVOZP,pl_coeff,timeoz)
+ &, XLON(LONR,LATS_NODE_R)
+ &, XLAT(LONR,LATS_NODE_R)
+ &, dtzm(lonr,lats_node_r)
+
+ integer, dimension(latr) :: global_lats_r, lonsperlar
+!
+ integer nblck
+ real (kind=kind_rad) phy_f3d(NGPTC,LEVS,ntot3d,NBLCK,LATS_NODE_R)
+ &, phy_f2d(lonr,lats_node_r,ntot2d)
+ REAL (KIND=KIND_RAD) plyr(levs)
+!
+ real (kind=kind_phys) gaul(lats_node_r), pi
+ real (kind=kind_phys) :: zsea1,zsea2
+
+ real, PARAMETER:: RLAPSE=0.65E-2
+ real dt_warm
+ integer needoro, i, j, lat, k
+ INTEGER NREAD, NREAD_NST
+!!
+ call gfuncphys
+ if (lsm == 0) then ! For OSU LSM
+ CALL GRDDF
+ CALL GRDKT
+ endif
+!!
+ IOZONDP = 0
+ if (ntoz > 0) IOZONDP = 1
+ NREAD = 14
+! CREAD = 'fort.14'
+ sfc_fld%ORO = 0.
+ NEEDORO = 0
+
+ if(.not.allocated(pr_idea)) then
+ allocate(pr_idea(levs))
+ allocate(gg(levs))
+ allocate(prsilvl(levs+1))
+ endif
+!
+ if (me .eq. 0) print *,' call read_sfc_r CREAD=',cread
+ CALL read_sfc_r(cread,sfc_fld,phy_f2d,phy_f3d,
+ & NGPTC,NBLCK,GLOBAL_LATS_R,LONSPERLAR,
+ & NEEDORO,lsidea,pr_idea,gg,prsilvl,amgms)
+
+ if ( nstf_name(1) > 0 ) then
+ nst_fld%slmsk = sfc_fld%slmsk
+ NREAD_NST = 15
+ if (me == 0) print *,' call read_nst_r CREAD=',cread_nst
+ CALL read_nst_r(nst_fld,NREAD_NST,CREAD_NST,
+ & GLOBAL_LATS_R,LONSPERLAR)
+ endif
+ NEEDORO=1
+ CALL read_mtn_hprim_oz(sfc_fld%SLMSK,HPRIME,NEEDORO,sfc_fld%ORO,
+ & sfc_fld%oro_uf,IOZONDP,OZPLIN,
+ & GLOBAL_LATS_R,LONSPERLAR)
+!
+! Set up some interpolation coefficients for ozone forcing
+!
+ if (ntoz > 0) then
+ pi = acos(-1.0)
+ do j=1, lats_node_r
+ lat = global_lats_r(ipt_lats_node_r-1+J)
+ if (lat <= latr2) then
+ gaul(j) = 90.0 - colrad_r(lat)*180.0/PI
+ else
+ gaul(j) =
... see attachment for the rest ...
-------------- next part --------------
Index: checkout/phys/fix_fields_idea_rst.f
===================================================================
--- checkout/phys/fix_fields_idea_rst.f (nonexistent)
+++ checkout/phys/fix_fields_idea_rst.f (revision 93160)
@@ -0,0 +1,117 @@
+
+ SUBROUTINE fix_fields_idea_rst(
+ & LONSPERLAR,GLOBAL_LATS_R,XLON,XLAT,sfc_fld,
+ & nst_fld,HPRIME,JINDX1,JINDX2,DDY,OZPLIN,CREAD,
+ & cread_grd,cread_nst,nblck,phy_f3d,phy_f2d)
+!!
+!! Code Revision
+!! jan 26 2010 Jun Wang, added phy_f3d,phy_f2d read in from restart file
+!! Nov 2010 S. Moorthi - nst model related changes
+!! Mar 2013 Jun Wang restart for idea
+!! Aug 2015 Xu Li change nst_fcst and nst_spinup to be nstf_name
+!! introduce the depth mean SST,
+!! remove nst_reset_nonwater
+!! add nemsio for nst file
+
+!!
+ use machine , only : kind_rad, kind_phys
+ use funcphys
+ use module_progtm
+ use resol_def
+ use namelist_physics_def
+ use layout1
+ use gg_def
+ use ozne_def
+ use module_nst_water_prop, only: get_dtzm_2d
+ use gfs_physics_sfc_flx_mod
+ use gfs_physics_nst_var_mod
+ use idea_composition, only: pr_idea,gg,amgms,prsilvl
+ IMPLICIT NONE
+!!
+ TYPE(Sfc_Var_Data) :: sfc_fld
+ TYPE(Nst_Var_Data) :: nst_fld
+ CHARACTER (len=*) :: CREAD
+ CHARACTER (len=*) :: CREAD_grd
+ CHARACTER (len=*) :: cread_nst
+ INTEGER JINDX1(LATS_NODE_R),JINDX2(LATS_NODE_R)
+ REAL (KIND=KIND_RAD) DDY(LATS_NODE_R)
+ REAL (KIND=KIND_RAD) HPRIME(NMTVR,LONR,LATS_NODE_R)
+
+ INTEGER IOZONDP
+ REAL (kind=kind_rad) OZPLIN(LATSOZP,LEVOZP,pl_coeff,timeoz)
+ &, XLON(LONR,LATS_NODE_R)
+ &, XLAT(LONR,LATS_NODE_R)
+ &, dtzm(lonr,lats_node_r)
+
+ integer, dimension(latr) :: global_lats_r, lonsperlar
+!
+ integer nblck
+ real (kind=kind_rad) phy_f3d(NGPTC,LEVS,ntot3d,NBLCK,LATS_NODE_R)
+ &, phy_f2d(lonr,lats_node_r,ntot2d)
+ REAL (KIND=KIND_RAD) plyr(levs)
+!
+ real (kind=kind_phys) gaul(lats_node_r), pi
+ real (kind=kind_phys) :: zsea1,zsea2
+
+ real, PARAMETER:: RLAPSE=0.65E-2
+ real dt_warm
+ integer needoro, i, j, lat, k
+ INTEGER NREAD, NREAD_NST
+!!
+ call gfuncphys
+ if (lsm == 0) then ! For OSU LSM
+ CALL GRDDF
+ CALL GRDKT
+ endif
+!!
+ IOZONDP = 0
+ if (ntoz > 0) IOZONDP = 1
+ NREAD = 14
+! CREAD = 'fort.14'
+ sfc_fld%ORO = 0.
+ NEEDORO = 0
+
+ if(.not.allocated(pr_idea)) then
+ allocate(pr_idea(levs))
+ allocate(gg(levs))
+ allocate(prsilvl(levs+1))
+ endif
+!
+ if (me .eq. 0) print *,' call read_sfc_r CREAD=',cread
+ CALL read_sfc_r(cread,sfc_fld,phy_f2d,phy_f3d,
+ & NGPTC,NBLCK,GLOBAL_LATS_R,LONSPERLAR,
+ & NEEDORO,lsidea,pr_idea,gg,prsilvl,amgms)
+
+ if ( nstf_name(1) > 0 ) then
+ nst_fld%slmsk = sfc_fld%slmsk
+ NREAD_NST = 15
+ if (me == 0) print *,' call read_nst_r CREAD=',cread_nst
+ CALL read_nst_r(nst_fld,NREAD_NST,CREAD_NST,
+ & GLOBAL_LATS_R,LONSPERLAR)
+ endif
+ NEEDORO=1
+ CALL read_mtn_hprim_oz(sfc_fld%SLMSK,HPRIME,NEEDORO,sfc_fld%ORO,
+ & sfc_fld%oro_uf,IOZONDP,OZPLIN,
+ & GLOBAL_LATS_R,LONSPERLAR)
+!
+! Set up some interpolation coefficients for ozone forcing
+!
+ if (ntoz > 0) then
+ pi = acos(-1.0)
+ do j=1, lats_node_r
+ lat = global_lats_r(ipt_lats_node_r-1+J)
+ if (lat <= latr2) then
+ gaul(j) = 90.0 - colrad_r(lat)*180.0/PI
+ else
+ gaul(j) = -(90.0 - colrad_r(lat)*180.0/PI)
+ endif
+!cselaif(me.eq.0) print*,'gau(j,1) gau(j,2)',gaul(j,1),gaul(j,2)
+ enddo
+ CALL SETINDXOZ(LATS_NODE_R,LATS_NODE_R,GAUL,
+ & JINDX1,JINDX2,DDY)
+ endif
+!
+ CALL LONLAT_PARA(GLOBAL_LATS_R,XLON,XLAT,LONSPERLAR)
+!!
+ RETURN
+ END
Index: checkout/phys/makefile
===================================================================
--- checkout/phys/makefile (revision 90320)
+++ checkout/phys/makefile (revision 93160)
@@ -73,6 +73,7 @@
gbphys_adv_hyb_gc.o \
gbphys_adv_hyb_gc_h.o \
fix_fields.o \
+ fix_fields_idea_rst.o \
read_fix.o \
GFS_simple_scatter.o \
wrtout_physics.o \
Index: checkout/phys/gfs_physics_initialize_mod.f
===================================================================
--- checkout/phys/gfs_physics_initialize_mod.f (revision 90320)
+++ checkout/phys/gfs_physics_initialize_mod.f (revision 93160)
@@ -733,15 +733,25 @@
! write(0,*)' gis_phy%lonsperlar2b=',gis_phy%lonsperlar
! write(0,*)' before fix_fields'
- call fix_fields(gis_phy%LONSPERLAR, gis_phy%GLOBAL_LATS_R, &
- gis_phy%XLON, gis_phy%XLAT, gis_phy%sfc_fld, &
- gis_phy%nst_fld, gis_phy%HPRIME, gis_phy%JINDX1, &
- gis_phy%JINDX2, gis_phy%DDY, gis_phy%OZPLIN, &
- gis_phy%nam_gfs_phy%sfc_ini, &
- gis_phy%nam_gfs_phy%grd_ini, &
- gis_phy%nam_gfs_phy%nst_ini, &
- nblck, gis_phy%phy_f3d, gis_phy%phy_f2d )
-
+ IF(lsidea .AND. gis_phy%restart_run) THEN
+ call fix_fields_idea_rst(gis_phy%LONSPERLAR, gis_phy%GLOBAL_LATS_R, &
+ gis_phy%XLON, gis_phy%XLAT, gis_phy%sfc_fld, &
+ gis_phy%nst_fld, gis_phy%HPRIME, gis_phy%JINDX1, &
+ gis_phy%JINDX2, gis_phy%DDY, gis_phy%OZPLIN, &
+ gis_phy%nam_gfs_phy%sfc_ini, &
+ gis_phy%nam_gfs_phy%grd_ini, &
+ gis_phy%nam_gfs_phy%nst_ini, &
+ nblck, gis_phy%phy_f3d, gis_phy%phy_f2d )
+ ELSE
+ call fix_fields(gis_phy%LONSPERLAR, gis_phy%GLOBAL_LATS_R, &
+ gis_phy%XLON, gis_phy%XLAT, gis_phy%sfc_fld, &
+ gis_phy%nst_fld, gis_phy%HPRIME, gis_phy%JINDX1, &
+ gis_phy%JINDX2, gis_phy%DDY, gis_phy%OZPLIN, &
+ gis_phy%nam_gfs_phy%sfc_ini, &
+ gis_phy%nam_gfs_phy%grd_ini, &
+ gis_phy%nam_gfs_phy%nst_ini, &
+ nblck, gis_phy%phy_f3d, gis_phy%phy_f2d )
+ END IF
! print *,' GISXLAT=',gis_phy%XLAT(1,:)
! write(0,*)' after fix_fields'
!!
Index: checkout/phys/gfs_physics_run_mod.f
===================================================================
--- checkout/phys/gfs_physics_run_mod.f (revision 90320)
+++ checkout/phys/gfs_physics_run_mod.f (revision 93160)
@@ -116,24 +116,6 @@
(kdt_dif <= ndfi/2 .or. kdt_dif > ndfi) .or. gis_phy%kdt == 1
endif
-! if (me == 0) &
-! write(0,*)' in phy nsout_hf=',nsout_hf,' fhmax_hf=',fhmax_hf
-! write(0,*)' in phy ' ,&
-! 'gis_phy%lsout=',gis_phy%lsout,' kdt=',gis_phy%kdt
-!
-! print *,' end of common_to_physics_vars,kdt=',gis_phy%kdt, &
-! 'nsout=',nsout,'lsout=',gis_phy%LSOUT,'zhour=',gis_phy%ZHOUR, &
-! 'ldfi=',ldfi,'ndfi=',ndfi,gis_phy%kdt<=ndfi/2,gis_phy%kdt>ndfi, &
-! gis_phy%kdt<=ndfi/2.or.gis_phy%kdt>ndfi
-! if(gis_phy%kdt==12.and.gis_phy%kdt<=13.or.gis_phy%kdt>=24.and.gis_phy%kdt<=25) then
-! print *,'be phys one,kdt=',gis_phy%kdt,'ps=',maxval(gis_phy%grid_fld%ps), &
-! minval(gis_phy%grid_fld%ps),'t=',maxval(gis_phy%grid_fld%t), &
-! minval(gis_phy%grid_fld%t),'spfh=',maxval(gis_phy%grid_fld%tracers(1)%flds), &
-! minval(gis_phy%grid_fld%tracers(1)%flds),'tsea=',maxval(gis_phy%sfc_fld%tsea),&
-! minval(gis_phy%sfc_fld%tsea),maxloc(gis_phy%sfc_fld%tsea),maxloc(gis_phy%grid_fld%ps)
-! print *,' ps1lp(',gis_phy%kdt,')= ',gis_phy%grid_fld%ps(154,58)
-! endif
-
if( ndfi > 0 .and. kdt_dif == ndfi/2+1 .and. .not. ldfi ) then
call dfi_fixwr(2, gis_phy%sfc_fld, gis_phy%nst_fld)
endif
Index: checkout/phys/read_fix.f
===================================================================
--- checkout/phys/read_fix.f (revision 90320)
+++ checkout/phys/read_fix.f (revision 93160)
@@ -594,10 +594,10 @@
99 FORMAT(1H ,'in read_sfc_nemsio, nread=',i3,2x,'HOUR=',f8.2,3x,
& 'IDATE=',4(1X,I4),4x,'lonsfc,latsfc,lsoil,ivssfc,iret=',5i8)
- if(iret.ne.0) goto 5000
- if(lonb4.ne.lonr) goto 5000
- if(latb4.ne.latr) goto 5000
- if(nsoil4.ne.lsoil) goto 5000
+ if(iret.ne.0) goto 6000
+! if(lonb4.ne.lonr) goto 6000
+! if(latb4.ne.latr) goto 6000
+ if(nsoil4.ne.lsoil) goto 6000
ENDIF
@@ -913,7 +913,7 @@
call nemsio_finalize()
!
RETURN
- 5000 PRINT *, ' error in input in routine read_sfc'
+ 6000 PRINT *, ' error in input in routine read_sfc_nemsio'
STOP
END
!
@@ -1149,10 +1149,10 @@
99 FORMAT(1H ,'in read_nst_nemsio, nread=',i3,2x,'HOUR=',f8.2,3x,
& 'IDATE=',4(1X,I4),4x,'lonsfc,latsfc,lsea,ivsnst,iret=',5i8)
- if(iret.ne.0) goto 5000
- if(lonb4.ne.lonr) goto 5000
- if(latb4.ne.latr) goto 5000
- if(nsea4.ne.lsea) goto 5000
+ if(iret.ne.0) goto 7000
+ if(lonb4.ne.lonr) goto 7000
+ if(latb4.ne.latr) goto 7000
+ if(nsea4.ne.lsea) goto 7000
ENDIF
@@ -1288,7 +1288,7 @@
call nemsio_finalize()
!
RETURN
- 5000 PRINT *, ' error in input in routine read_nst_nemsio'
+ 7000 PRINT *, ' error in input in routine read_nst_nemsio'
END ! read_nst_nemsio
SUBROUTINE set_nst(tsea, nst_fld)
Index: checkout/dyn/input_fields_rst.f
===================================================================
--- checkout/dyn/input_fields_rst.f (revision 90320)
+++ checkout/dyn/input_fields_rst.f (revision 93160)
@@ -10,6 +10,7 @@
! pwat nad ptot
! 20100908 J. WANG remove gfsio module
! 20110220 H. Juang remove some un-necessary name in treads_nemsio
+! 20170510 W. YANG modified for the WAM restart.
!
use gfs_dyn_resol_def
use gfs_dyn_layout1
@@ -63,6 +64,9 @@
integer lan, lat, lons_lat, jlonf,nnl,nn,kk,lon
integer indev1,indev2,indev,indod1,indod2,indod
REAL(KIND=KIND_EVOD) ga2
+ real(kind=kind_mpi_r),allocatable :: trieo_ls_nodes(:,:,:,:)
+ real(kind=kind_mpi_r),allocatable :: trieo_ls_node(:,:,:)
+ integer ioproc,lenrec,ii
!
include 'function2'
!
@@ -176,31 +180,6 @@
9878 FORMAT(1H ,'FHOUR AFTER TREAD',F6.2)
!
!--------------------------------------------------------------
-! fill up n+1 grid_gr in case of internal2export used.
-!
- trie_ls(:,:,p_zq)=trie_ls(:,:,p_q )
- trie_ls(:,:,p_y :p_y +levs-1)=trie_ls(:,:,p_te:p_te+levs-1)
- trie_ls(:,:,p_x :p_x +levs-1)=trie_ls(:,:,p_di:p_di+levs-1)
- trie_ls(:,:,p_w :p_w +levs-1)=trie_ls(:,:,p_ze:p_ze+levs-1)
- trio_ls(:,:,p_zq)=trio_ls(:,:,p_q )
- trio_ls(:,:,p_y :p_y +levs-1)=trio_ls(:,:,p_te:p_te+levs-1)
- trio_ls(:,:,p_x :p_x +levs-1)=trio_ls(:,:,p_di:p_di+levs-1)
- trio_ls(:,:,p_w :p_w +levs-1)=trio_ls(:,:,p_ze:p_ze+levs-1)
- if ( .not. ndslfv ) then
- trie_ls(:,:,p_rt :p_rt +levh-1)=trie_ls(:,:,p_rq:p_rq+levh-1)
- trio_ls(:,:,p_rt :p_rt +levh-1)=trio_ls(:,:,p_rq:p_rq+levh-1)
- endif
-!
-!--------------------------------------------------------------
-! fill up n+1 grid_gr in case of internal2export used.
-!
- grid_gr(:,:,g_zq)=grid_gr(:,:,g_q )
- grid_gr(:,:,g_t :g_t +levs-1)=grid_gr(:,:,g_tt:g_tt+levs-1)
- grid_gr(:,:,g_u :g_u +levs-1)=grid_gr(:,:,g_uu:g_uu+levs-1)
- grid_gr(:,:,g_v :g_v +levs-1)=grid_gr(:,:,g_vv:g_vv+levs-1)
- grid_gr(:,:,g_rt:g_rt+levh-1)=grid_gr(:,:,g_rq:g_rq+levh-1)
-!
-!--------------------------------------------------------------
! laplacian terrain for divergence
!
ga2=grav/(rerth*rerth)
@@ -236,6 +215,73 @@
X trio_ls(indod,2,p_gz)*snnp1od(indod)*ga2
end do
end do
+!
+!
+!------------------------------------------------------------------
+!
+ ioproc=0
+ trie_ls=0.0
+ trio_ls=0.0
+ allocate ( trieo_ls_node ( len_trie_ls_max+len_trio_ls_max,
+ & 2, lotls ),
+ & stat=ierr )
+ trieo_ls_node = 0.0
+ if ( me .eq. ioproc ) then
+ allocate ( trieo_ls_nodes ( len_trie_ls_max+len_trio_ls_max,
+ & 2, lotls, nodes ),
+ & stat=ierr )
+ trieo_ls_nodes = 0.0
+ READ(1051) trieo_ls_nodes
+ else
+ allocate (trieo_ls_nodes(1, 1, 1, 1), stat = ierr)
+ endif
+ lenrec = (len_trie_ls_max+len_trio_ls_max) * 2 * lotls
+
+ call mpi_scatter(trieo_ls_nodes, lenrec, MPI_R_MPI_R,
+ & trieo_ls_node, lenrec, MPI_R_MPI_R,
+ & ioproc, MPI_COMM_ALL, ierr)
+ DO k = 1, lotls
+ DO j = 1, 2
+ DO i = 1, len_trie_ls
+ trie_ls(i, j, k) = trieo_ls_node(i, j, k)
+ END DO
+ DO i = 1, len_trio_ls
+ ii = i + len_trie_ls_max
+ trio_ls(i, j, k) = trieo_ls_node(ii, j, k)
+ END DO
+ END DO
+ END DO
+
+ call mpi_barrier(MPI_COMM_ALL,ierr)
+ DEALLOCATE(trieo_ls_nodes)
+ DEALLOCATE(trieo_ls_node)
+
+!
+!--------------------------------------------------------------
+! fill up n+1 grid_gr in case of internal2export used.
+!
+ trie_ls(:,:,p_zq)=trie_ls(:,:,p_q )
+ trie_ls(:,:,p_y :p_y +levs-1)=trie_ls(:,:,p_te:p_te+levs-1)
+ trie_ls(:,:,p_x :p_x +levs-1)=trie_ls(:,:,p_di:p_di+levs-1)
+ trie_ls(:,:,p_w :p_w +levs-1)=trie_ls(:,:,p_ze:p_ze+levs-1)
+ trio_ls(:,:,p_zq)=trio_ls(:,:,p_q )
+ trio_ls(:,:,p_y :p_y +levs-1)=trio_ls(:,:,p_te:p_te+levs-1)
+ trio_ls(:,:,p_x :p_x +levs-1)=trio_ls(:,:,p_di:p_di+levs-1)
+ trio_ls(:,:,p_w :p_w +levs-1)=trio_ls(:,:,p_ze:p_ze+levs-1)
+ if ( .not. ndslfv ) then
+ trie_ls(:,:,p_rt :p_rt +levh-1)=trie_ls(:,:,p_rq:p_rq+levh-1)
+ trio_ls(:,:,p_rt :p_rt +levh-1)=trio_ls(:,:,p_rq:p_rq+levh-1)
+ endif
+!
+!--------------------------------------------------------------
+! fill up n+1 grid_gr in case of internal2export used.
+!
+ grid_gr(:,:,g_zq)=grid_gr(:,:,g_q )
+ grid_gr(:,:,g_t :g_t +levs-1)=grid_gr(:,:,g_tt:g_tt+levs-1)
+ grid_gr(:,:,g_u :g_u +levs-1)=grid_gr(:,:,g_uu:g_uu+levs-1)
+ grid_gr(:,:,g_v :g_v +levs-1)=grid_gr(:,:,g_vv:g_vv+levs-1)
+ grid_gr(:,:,g_rt:g_rt+levh-1)=grid_gr(:,:,g_rq:g_rq+levh-1)
+
!
!--------------------------------------------------------
!!
Index: checkout/dyn/wrtout_dynamics.f
===================================================================
--- checkout/dyn/wrtout_dynamics.f (revision 90320)
+++ checkout/dyn/wrtout_dynamics.f (revision 93160)
@@ -23,6 +23,7 @@
! Oct 2012 Jun Wang, add sigio output option
! Aug 2013 Henry Juang, add sigio output with ndsl
! Sep 2014 S Moorthi - some cleanup and optimization
+! May 2017 Weiyu Yang - Modified for the WAM restart.
!
use gfs_dyn_machine
use gfs_dyn_resol_def
@@ -470,7 +471,7 @@
use gfs_dyn_resol_def
use gfs_dyn_layout1
use gfs_dyn_mpi_def
- use namelist_dynamics_def, only : ndslfv
+ use namelist_dynamics_def, only : ndslfv, lsidea
use do_dynamics_mod
!
implicit none
@@ -495,6 +496,7 @@
real(kind=kind_evod) epso (len_trio_ls)
real(kind=kind_evod) plnew_a(len_trie_ls,latg2)
real(kind=kind_evod) plnow_a(len_trio_ls,latg2)
+
! for ndsl
real(kind=kind_evod),allocatable:: trie_ls_rqt(:,:,:)
&, trio_ls_rqt(:,:,:)
@@ -527,64 +529,69 @@
if (me == ioproc) print *,'in restart,lonsperlat=',lonsperlat
! n-1 time step spectral file
!
- step = -1
- filename = 'SIGR1'
+ step = -1
+ filename = 'SIGR1'
- if( .not. ndslfv ) then
- CALL TWRITES_rst(filename,ioproc,FHOUR,idate,
- & SI,LS_NODES,MAX_LS_NODES,step,
- & trie_ls,trio_ls,trie_ls,trio_ls)
+ if( .not. ndslfv ) then
+ CALL TWRITES_rst(filename,ioproc,FHOUR,idate,
+ & SI,LS_NODES,MAX_LS_NODES,step,
+ & trie_ls,trio_ls,trie_ls,trio_ls)
- else
+ else
- call do_dynamics_gridm2rqt(grid_gr,rqt_gr_a_2,
- & global_lats_a,lonsperlat)
- call grid_to_spect_rqt(rqt_gr_a_1,rqt_gr_a_2,
- & trie_ls_rqt,trio_ls_rqt,levh,
- & ls_node,ls_nodes,max_ls_nodes,
- & lats_nodes_a,global_lats_a,lonsperlat,
- & epse,epso,plnew_a,plnow_a)
- CALL TWRITES_rst(filename,ioproc,FHOUR,idate,
- & SI,LS_NODES,MAX_LS_NODES,step,
- & trie_ls,trio_ls,trie_ls_rqt,trio_ls_rqt)
+ call do_dynamics_gridm2rqt(grid_gr,rqt_gr_a_2,
+ & global_lats_a,lonsperlat)
+ call grid_to_spect_rqt(rqt_gr_a_1,rqt_gr_a_2,
+ & trie_ls_rqt,trio_ls_rqt,levh,
+ & ls_node,ls_nodes,max_ls_nodes,
+ & lats_nodes_a,global_lats_a,lonsperlat,
+ & epse,epso,plnew_a,plnow_a)
+ CALL TWRITES_rst(filename,ioproc,FHOUR,idate,
+ & SI,LS_NODES,MAX_LS_NODES,step,
+ & trie_ls,trio_ls,trie_ls_rqt,trio_ls_rqt)
- endif
+ endif
- if (me == ioproc) print *,'1 end of twritero_rst,',
- & trim(filename)
+ if (me == ioproc) print *,'1 end of twritero_rst,',
+ & trim(filename)
!
! n time step spectral file
!
- step = 0
- filename = 'SIGR2'
+ step = 0
+ filename = 'SIGR2'
- if( .not. ndslfv ) then
+ if( .not. ndslfv ) then
+ CALL TWRITES_rst(filename,ioproc,FHOUR,idate,
+ & SI,LS_NODES,MAX_LS_NODES,step,
+ & trie_ls,trio_ls,trie_ls,trio_ls)
- CALL TWRITES_rst(filename,ioproc,FHOUR,idate,
- & SI,LS_NODES,MAX_LS_NODES,step,
- & trie_ls,trio_ls,trie_ls,trio_ls)
+ else
- else
+ call do_dynamics_gridc2rqt(grid_gr,rqt_gr_a_2,
+ & global_lats_a,lonsperlat)
+ call grid_to_spect_rqt(rqt_gr_a_1,rqt_gr_a_2,
+ & trie_ls_rqt,trio_ls_rqt,levh,
+ & ls_node,ls_nodes,max_ls_nodes,
+ & lats_nodes_a,global_lats_a,lonsperlat,
+ & epse,epso,plnew_a,plnow_a)
+ CALL TWRITES_rst(filename,ioproc,FHOUR,idate,
+ & SI,LS_NODES,MAX_LS_NODES,step,
+ & trie_ls,trio_ls,trie_ls_rqt,trio_ls_rqt)
- call do_dynamics_gridc2rqt(grid_gr,rqt_gr_a_2,
- & global_lats_a,lonsperlat)
- call grid_to_spect_rqt(rqt_gr_a_1,rqt_gr_a_2,
- & trie_ls_rqt,trio_ls_rqt,levh,
- & ls_node,ls_nodes,max_ls_nodes,
- & lats_nodes_a,global_lats_a,lonsperlat,
- & epse,epso,plnew_a,plnow_a)
- CALL TWRITES_rst(filename,ioproc,FHOUR,idate,
- & SI,LS_NODES,MAX_LS_NODES,step,
- & trie_ls,trio_ls,trie_ls_rqt,trio_ls_rqt)
+ endif
- endif
+ if (me == ioproc) print *,'2 end of twritero_rst for ',
+ & trim(filename)
+ IF(lsidea) THEN
- if (me == ioproc) print *,'2 end of twritero_rst for ',
- & trim(filename)
+ CALL TWRITES_rst_idea('fort.1051',ioproc,FHOUR,idate,
+ & SI,LS_NODES,MAX_LS_NODES,trie_ls,trio_ls)
+ END IF
! n-1 time step grid file
!
filename = 'GRDR1'
+
CALL TWRITEG_rst(filename,ioproc,FHOUR,idate,
X SI,pdryini,global_lats_a,lonsperlat,lats_nodes_a,
& grid_gr(1,1,g_qm),
@@ -596,6 +603,7 @@
!
! n time step grid file
!
+
filename = 'GRDR2'
CALL TWRITEG_rst(filename,ioproc,FHOUR,idate,
X SI,pdryini,global_lats_a,lonsperlat,lats_nodes_a,
@@ -607,7 +615,6 @@
if (me == ioproc) print *,'2 end twriteg_rst,',trim(filename)
call mpi_barrier(mpi_comm_all,iret)
!
-
return
end
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -748,7 +755,3 @@
return
end
-
-
-
-
Index: checkout/dyn/get_w_z.f
===================================================================
--- checkout/dyn/get_w_z.f (revision 90320)
+++ checkout/dyn/get_w_z.f (revision 93160)
@@ -458,7 +458,13 @@
! For 3 minutes time step, output field every 240 hours.
!-------------------------------------------------------
! IF(MOD(kdt, 4800) == 0) CALL grid_collect_ipe(wwg,zzg,uug,vvg,
-! & ttg,rqg,n2g,global_lats_a,lonsperlat,
-! & lats_nodes_a, kdt)
+! For 3 minutes time step, output field every 120 hours.
+!-------------------------------------------------------
+ IF(MOD(kdt, 2400) == 0) THEN
+ PRINT*,'Output the WAM-IPE coupling fields at kdt=', kdt
+ CALL grid_collect_ipe(wwg,zzg,uug,vvg,
+ & ttg,rqg,n2g,global_lats_a,lonsperlat,
+ & lats_nodes_a, kdt)
+ END IF
END subroutine get_w_z
Index: checkout/dyn/twrites_rst_idea.f
===================================================================
--- checkout/dyn/twrites_rst_idea.f (nonexistent)
+++ checkout/dyn/twrites_rst_idea.f (revision 93160)
@@ -0,0 +1,104 @@
+ subroutine twrites_rst_idea(fname,IOPROC,fhour,idate,
+ & si,ls_nodes,max_ls_nodes,trie_ls,trio_ls)
+!-------------------------------------------------------------------
+!*** program log
+!*** Dec, 2009 Jun Wang: write spectral variables for restart
+!*** Dec, 2010 Jun Wang: change to nemsio library
+!*** Feb, 2011 Henry Juang: use generic argument for spectral fit to mass_dp and ndsl
+! Jun 26 2014 S. Moorthi - added mpigathe8
+! May 11 2017 W. Yang - For WAM restart run.
+!-------------------------------------------------------------------
+!
+ use gfs_dyn_resol_def
+ use gfs_dyn_layout1
+ use gfs_dyn_coordinate_def
+ use namelist_dynamics_def
+ use gfs_dyn_mpi_def
+ use nemsio_module
+!
+ implicit none
+!
+ character(*),intent(in) :: fname
+ integer,intent(in) :: ioproc
+ real(kind=kind_evod),intent(in) :: fhour
+ integer,intent(in) :: idate(4)
+!
+ integer,intent(in) :: ls_nodes(ls_dim,nodes)
+ integer,intent(in) :: max_ls_nodes(nodes)
+!
+ real(kind=kind_evod),intent(in) :: trie_ls(len_trie_ls,2,lotls)
+ real(kind=kind_evod),intent(in) :: trio_ls(len_trio_ls,2,lotls)
+ real(kind=kind_evod) si(levp1)
+!
+!local variables:
+!
+ integer ierr,j,k,lenrec
+!
+ integer i, jj, step
+!
+ real(kind=kind_mpi_r),allocatable :: trieo_ls_node (:,:,:)
+ real(kind=kind_mpi_r),allocatable :: trieo_ls_nodes(:,:,:,:)
+!
+!
+!---------------------------------------------------------------------
+!
+ call mpi_comm_size(MPI_COMM_ALL,i,ierr)
+!
+!-- allocate
+ allocate ( trieo_ls_node ( len_trie_ls_max+len_trio_ls_max,
+ x 2, lotls ) )
+ trieo_ls_node = 0.0
+!
+ do k=1,lotls
+ do j=1,len_trie_ls
+ trieo_ls_node(j,1,k) = trie_ls(j,1,k)
+ trieo_ls_node(j,2,k) = trie_ls(j,2,k)
+ enddo
+ do j=1,len_trio_ls
+ jj = j+len_trie_ls_max
+ trieo_ls_node(jj,1,k) = trio_ls(j,1,k)
+ trieo_ls_node(jj,2,k) = trio_ls(j,2,k)
+ enddo
+ enddo
+!
+!-- collect data to ioproc
+!-----------
+ if ( me .eq. ioproc ) then
+ write(0,*)'ALLOC PARMS TWRITE ',len_trie_ls_max+len_trio_ls_max,
+ & 2, lotls, nodes,1
+!
+ allocate ( trieo_ls_nodes ( len_trie_ls_max+len_trio_ls_max,
+ & 2, lotls, nodes ),
+ & stat=ierr )
+ else
+ allocate (trieo_ls_nodes(1, 1, 1, 1), stat = ierr)
+ endif
+ if (ierr .ne. 0) then
+ write (0,*) ' GWX trieo_ls_nodes allocate failed'
+ call mpi_abort(mpi_comm_all,ierr,i)
+ endif
+!
+ call mpi_barrier(MPI_COMM_ALL,ierr)
+ if(nodes >1 )then
+ lenrec = (len_trie_ls_max+len_trio_ls_max) * 2 * lotls
+!
+ call mpi_gather(trieo_ls_node , lenrec, MPI_R_MPI_R,
+ & trieo_ls_nodes, lenrec, MPI_R_MPI_R,
+ & ioproc, MPI_COMM_ALL, ierr)
+ call mpi_barrier(MPI_COMM_ALL,ierr)
+ else
+ trieo_ls_nodes(:,:,:,1)=trieo_ls_node(:,:,:)
+ endif
+ deallocate ( trieo_ls_node )
+!
+!-- write out data
+ IF (me.eq.ioproc) THEN
+ OPEN(1050, FILE=fname,FORM='unformatted')
+ WRITE(1050) trieo_ls_nodes
+ endif !me.eq.ioproc
+ deallocate ( trieo_ls_nodes )
+!!
+ call mpi_barrier(MPI_COMM_ALL,ierr)
+
+ return
+ end
Index: checkout/dyn/makefile
===================================================================
--- checkout/dyn/makefile (revision 90320)
+++ checkout/dyn/makefile (revision 93160)
@@ -229,6 +229,7 @@
treadg_nemsio.o \
treads_nemsio.o \
twrites_rst.o \
+ twrites_rst_idea.o \
twrites_hst.o \
twriteg_rst.o \
grid_to_spect_inp.o \
Index: checkout/dyn/gfs_dynamics_initialize_mod.f
===================================================================
--- checkout/dyn/gfs_dynamics_initialize_mod.f (revision 90320)
+++ checkout/dyn/gfs_dynamics_initialize_mod.f (revision 93160)
@@ -499,6 +499,10 @@
allocate ( gis_dyn%ls_node (ls_dim*3) )
allocate ( gis_dyn%ls_nodes(ls_dim,nodes) )
allocate ( gis_dyn%max_ls_nodes(nodes) )
+ gis_dyn%ls_node = 0
+ gis_dyn%ls_nodes = 0
+ gis_dyn%max_ls_nodes = 0
+
!
allocate ( gis_dyn%lats_nodes_a_fix(nodes)) ! added for mGrid
!
More information about the WAM-IPE
mailing list