diff --git a/.circleci/config.yml b/.circleci/config.yml index c6df06f..92df902 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -1,7 +1,7 @@ version: 2.1 # Anchors in case we need to override the defaults from the orb -#baselibs_version: &baselibs_version v8.9.0 +#baselibs_version: &baselibs_version v8.14.0 #bcs_version: &bcs_version v12.0.0 orbs: @@ -10,6 +10,7 @@ orbs: workflows: build-test: jobs: + # Build GEOSgcm - ci/build: name: build-GEOSgcm-on-<< matrix.compiler >> context: @@ -23,7 +24,7 @@ workflows: # V12 code uses a special branch for now. fixture_branch: feature/sdrabenh/gcm_v12 # We comment out this as it will "undo" the fixture_branch - #mepodevelop: false + #mepodevelop: true persist_workspace: true # Needs to be true to run fv3/gcm experiment, costs extra - ci/run_fv3: name: run-FV3-on-<< matrix.compiler >>-with-GEOSgcm diff --git a/.github/workflows/enforce-labels.yml b/.github/workflows/enforce-labels.yml index 6e1720e..86f4bb4 100644 --- a/.github/workflows/enforce-labels.yml +++ b/.github/workflows/enforce-labels.yml @@ -8,18 +8,20 @@ jobs: require-label: runs-on: ubuntu-latest steps: - - uses: mheap/github-action-required-labels@v2 + - uses: mheap/github-action-required-labels@v5 env: GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} with: mode: minimum count: 1 - labels: "0 diff,0 diff trivial,Non 0-diff,0 diff structural,0-diff trivial,Not 0-diff,0-diff,automatic,0-diff uncoupled" + labels: "0 diff,0 diff trivial,Non 0-diff,0 diff structural,0-diff trivial,Not 0-diff,0-diff,automatic,0-diff uncoupled,github_actions" add_comment: true + message: "This PR is being prevented from merging because you have not added one of our required labels: {{ provided }}. Please add one so that the PR can be merged." + blocking-label: runs-on: ubuntu-latest steps: - - uses: mheap/github-action-required-labels@v2 + - uses: mheap/github-action-required-labels@v5 env: GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} with: @@ -27,3 +29,4 @@ jobs: count: 0 labels: "Contingent - DNA,Needs Lead Approval,Contingent -- Do Not Approve" add_comment: true + message: "This PR is being prevented from merging because you have added one of our blocking labels: {{ provided }}. You'll need to remove it before this PR can be merged." diff --git a/.github/workflows/push-to-develop.yml b/.github/workflows/push-to-develop.yml index 00825d1..6df057b 100644 --- a/.github/workflows/push-to-develop.yml +++ b/.github/workflows/push-to-develop.yml @@ -15,7 +15,7 @@ jobs: with: fetch-depth: 0 - name: Run the action - uses: devops-infra/action-pull-request@v0.4 + uses: devops-infra/action-pull-request@v0.5.5 with: github_token: ${{ secrets.GITHUB_TOKEN }} source_branch: feature/sdrabenh/gcm_v12 diff --git a/AdvCore_GridCompMod.F90 b/AdvCore_GridCompMod.F90 index a60f954..bb3ee24 100755 --- a/AdvCore_GridCompMod.F90 +++ b/AdvCore_GridCompMod.F90 @@ -6,7 +6,7 @@ ! ! !MODULE: AdvCore_GridCompMod ! -! !DESCRIPTION: +! !DESCRIPTION: ! This a MAPL component that can be used in ! either with offline or online applications to advect an arbitrary set ! of constituents. @@ -21,7 +21,7 @@ ! which this component is taken may be found in: ! ! \begin{quote} -! Lin, S.-J. 2004, A vertically Lagrangian Finite-Volume Dynamical +! Lin, S.-J. 2004, A vertically Lagrangian Finite-Volume Dynamical ! Core for Global Models. {\em Mon. Wea. Rev.}, {\bf 132}, 2293-2307. ! \end{quote} ! @@ -46,7 +46,7 @@ ! state. Each Field in the Bundle is tested for ``Friendliness'' to ! advection; if friendly it is advected and its values updated. ! -! Currently no Export capability is implemented. +! Currently no Export capability is implemented. ! ! !INTERFACE: @@ -60,7 +60,7 @@ module AdvCore_GridCompMod use m_set_eta, only: set_eta use mpp_mod, only: mpp_pe, mpp_root_pe use fv_arrays_mod, only: fv_atmos_type, FVPRC, REAL4, REAL8 - use fms_mod, only: fms_init, set_domain, nullify_domain + use fms_mod, only: fms_init use fv_control_mod, only: fv_init1, fv_init2, fv_end use fv_tracer2d_mod, only: offline_tracer_advection use fv_mp_mod, only: is,ie, js,je, is_master, tile @@ -139,7 +139,7 @@ subroutine SetServices(GC, rc) ! Get my name and set-up traceback handle ! --------------------------------------- - + call ESMF_GridCompGet( GC, NAME=COMP_NAME, vm=vm, RC=STATUS ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // 'SetServices' @@ -195,7 +195,7 @@ subroutine SetServices(GC, rc) call MAPL_AddImportSpec ( gc, & SHORT_NAME = 'PLE1', & - LONG_NAME = 'pressure_at_layer_edges_after_advection', & + LONG_NAME = 'pressure_at_layer_edges_after_advection', & UNITS = 'Pa', & PRECISION = ESMF_KIND_R8, & DIMS = MAPL_DimsHorzVert, & @@ -218,7 +218,7 @@ subroutine SetServices(GC, rc) DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) - + ! 3D Tracers do ntracer=1,ntracers @@ -256,7 +256,7 @@ subroutine SetServices(GC, rc) call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_FINALIZE, Finalize, RC=status) VERIFY_(STATUS) - ! Check if AdvCore is running without FV3_DynCoreIsRunning, if yes then setup the MAPL Grid + ! Check if AdvCore is running without FV3_DynCoreIsRunning, if yes then setup the MAPL Grid ! ---------------------------------------------------------------------------- call MAPL_GetObjectFromGC (GC, MAPL, RC=STATUS ) VERIFY_(STATUS) @@ -341,7 +341,7 @@ subroutine SetServices(GC, rc) call fv_init2(FV_Atm, dt, grids_on_my_pe, p_split) end if - ! Ending with a Generic SetServices call is a MAPL requirement + ! Ending with a Generic SetServices call is a MAPL requirement !------------------------------------------------------------- call MAPL_GenericSetServices ( GC, rc=STATUS) VERIFY_(STATUS) @@ -360,7 +360,7 @@ end subroutine SetServices subroutine Initialize(GC, IMPORT, EXPORT, CLOCK, RC) ! ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component type(ESMF_State), intent(inout) :: IMPORT ! Import state type(ESMF_State), intent(inout) :: EXPORT ! Export state type(ESMF_Clock), intent(inout) :: CLOCK ! The clock @@ -371,8 +371,8 @@ subroutine Initialize(GC, IMPORT, EXPORT, CLOCK, RC) ! !DESCRIPTION: ! This initialization routine creates the import and export states, ! as well as the internal state, which is attached to the component. -! It also determines the distribution (and therefore the grid) -! and performs allocations of persistent data, +! It also determines the distribution (and therefore the grid) +! and performs allocations of persistent data, ! !EOP !============================================================================= @@ -389,7 +389,7 @@ subroutine Initialize(GC, IMPORT, EXPORT, CLOCK, RC) logical :: gridCreated type(ESMF_Grid) :: grid -! Begin... +! Begin... ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- @@ -452,7 +452,7 @@ end subroutine Initialize subroutine Run(GC, IMPORT, EXPORT, CLOCK, RC) ! ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component type(ESMF_State), intent(inout) :: IMPORT ! Import state type(ESMF_State), intent(inout) :: EXPORT ! Export state type(ESMF_Clock), intent(inout) :: CLOCK ! The clock @@ -461,7 +461,7 @@ subroutine Run(GC, IMPORT, EXPORT, CLOCK, RC) integer, optional, intent( out) :: RC ! Error code ! ! !DESCRIPTION: -! +! ! The Run method advanced the advection one long time step, as ! specified in the configuration. This may be broken down int a ! number of internal, small steps, also configurable. @@ -696,7 +696,7 @@ subroutine Run(GC, IMPORT, EXPORT, CLOCK, RC) end if if (allocated(biggerlist)) then - deallocate(biggerlist) + deallocate(biggerlist) end if firstRun=.false. @@ -772,7 +772,7 @@ subroutine Run(GC, IMPORT, EXPORT, CLOCK, RC) call global_integral(TMASS1, TRACERS, PLE1, IM,JM,LM, NQ) endif - ! Conserve Specific Mass of Constituents Keeping Mixing_Ratio Constant WRT_Dry_Air + ! Conserve Specific Mass of Constituents Keeping Mixing_Ratio Constant WRT_Dry_Air ! -------------------------------------------------------------------------------- if (rpt_mass) then do N=1,NQ @@ -878,7 +878,7 @@ end subroutine Run subroutine Finalize(GC, IMPORT, EXPORT, CLOCK, RC) ! ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component type(ESMF_State), intent(inout) :: IMPORT ! Import state type(ESMF_State), intent(inout) :: EXPORT ! Export state type(ESMF_Clock), intent(inout) :: CLOCK ! The clock diff --git a/CMakeLists.txt b/CMakeLists.txt index 6b6acbc..4751952 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -111,37 +111,27 @@ if (BUILD_GEOS_GTFV3_INTERFACE) SRCS ${srcs} SUBCOMPONENTS fvdycore DEPENDENCIES ${dependencies} + DEPENDENCIES FMS::fms DEPENDENCIES geos_gtfv3_interface_py) # Make the main library depend on the Python library else () esma_add_library (${this} SRCS ${srcs} SUBCOMPONENTS fvdycore - DEPENDENCIES ${dependencies}) + DEPENDENCIES ${dependencies} + DEPENDENCIES FMS::fms) endif () -if (FV_PRECISION STREQUAL R4) - target_link_libraries (${this} PUBLIC FMS::fms_r4) - target_compile_definitions (${this} PRIVATE SINGLE_FV OVERLOAD_R4) -elseif (FV_PRECISION STREQUAL R4R8) # FV is R4 but FMS is R8 - # fvdycore needs r4 .mod interfaces - get_target_property(inc_r4 FMS::fms_r4 INTERFACE_INCLUDE_DIRECTORIES) - target_include_directories(${this} PRIVATE $) - - # But fvdycore should not *compile* with fms_r8 includes - target_link_libraries(${this} PUBLIC $) - - target_compile_definitions (${this} PRIVATE SINGLE_FV OVERLOAD_R4) - - # This tells CMake that we need these targets built before we can build - add_dependencies(${this} FMS::fms_r4 FMS::fms_r8) -elseif (FV_PRECISION STREQUAL R8) - target_link_libraries (${this} PUBLIC FMS::fms_r8) +if (FV_PRECISION STREQUAL R8) string(REPLACE " " ";" tmp ${FREAL8}) foreach(flag ${tmp}) target_compile_options (${this} PRIVATE $<$:${flag}>) endforeach() endif () +if (FV_PRECISION MATCHES R4) + target_compile_definitions (${this} PRIVATE -DSINGLE_FV -DOVERLOAD_R4) +endif () + message(STATUS "Building FV as ${FV_PRECISION}") #set (CMAKE_Fortran_FLAGS_RELEASE "${GEOS_Fortran_FLAGS_VECT}") @@ -193,31 +183,17 @@ ecbuild_add_executable ( SOURCES interp_restarts_bin.F90 LIBS ${this} OpenMP::OpenMP_Fortran) -# If we are doing R4R8 we also need add_dependencies for both fms_r4 and fms_r8 -# for all our executables that link to ${this} because of the way we set up the -# main library above. -if (FV_PRECISION STREQUAL R4R8) - foreach(executable - StandAlone_FV3_Dycore.x - rs_scale.x - StandAlone_AdvCore.x - StandAlone_DynAdvCore.x - c2c.x - interp_restarts.x - interp_restarts_bin.x) - - # fvdycore needs r4 .mod interfaces - get_target_property(inc_r4 FMS::fms_r4 INTERFACE_INCLUDE_DIRECTORIES) - target_include_directories(${executable} PRIVATE $) - - # But fvdycore should not *compile* with FMS::fms_r8 includes - target_link_libraries(${executable} $) - - # This tells CMake that we need these targets built before we can build - add_dependencies(${executable} FMS::fms_r4 FMS::fms_r8) - endforeach() -endif () - +# Note this macro requires ESMA_cmake v4.19.0 or later +include(check_fms1_io_support) +check_fms1_io_support(FMS1_IO_SUPPORTED) +if(FMS1_IO_SUPPORTED) + message(STATUS "Using deprecated FMS1 I/O for ${this}") + target_compile_definitions (${this} PRIVATE FMS1_IO) + target_compile_definitions (interp_restarts.x PRIVATE FMS1_IO) + target_compile_definitions (interp_restarts_bin.x PRIVATE FMS1_IO) +else() + message(STATUS "Using FMS2 I/O for ${this}") +endif() if (BUILD_GEOS_GTFV3_INTERFACE) ecbuild_add_executable ( diff --git a/CreateTopography.F90 b/CreateTopography.F90 index c30c00b..b447ded 100755 --- a/CreateTopography.F90 +++ b/CreateTopography.F90 @@ -1,10 +1,19 @@ PROGRAM CreateTopography use ESMF - use constants_mod, only: pi, grav +#if defined (SINGLE_FV) + use constantsr4_mod, only: pi, grav +#else + use constants_mod, only: pi, grav +#endif ! Shared Utilities - use fms_mod, only: fms_init, fms_end, file_exist + use fms_mod, only: fms_init, fms_end +#if defined(FMS1_IO) + use fms_mod, only: file_exists => file_exist +#else + use fms2_io_mod, only: file_exists +#endif use mpp_mod, only: mpp_error, FATAL, NOTE use fv_arrays_mod, only: fv_atmos_type, FVPRC, REAL4, REAL8 use fv_control_mod, only: npx,npy,npz, ntiles @@ -39,7 +48,7 @@ PROGRAM CreateTopography real(REAL8) :: dlon, dlat integer :: nlon, nlat integer :: c2c_interp_npts - + real(REAL8), allocatable :: lat1(:) real(REAL8), allocatable :: lon1(:) real(REAL8), allocatable :: r8latlon1(:,:) @@ -115,7 +124,7 @@ PROGRAM CreateTopography deallocate( phis_m ) endif -! Get GWD/TRB Variance +! Get GWD/TRB Variance ! if (npx-1 <= 180) then allocate( r8tmp(Atm(1)%isd:Atm(1)%ied,Atm(1)%jsd:Atm(1)%jed) ) allocate ( gwd_global(im,im,6) ) @@ -133,13 +142,13 @@ PROGRAM CreateTopography enddo ! Read GWD write(fname1, "('topo_GWD_var_',i3.3,'x',i2.2,'_DC.data')") nlon,nlat - if (.not. file_exist(fname1)) then + if (.not. file_exists(fname1)) then write(fname1, "('topo_GWD_var_',i3.3,'x',i3.3,'_DC.data')") nlon,nlat - if (.not. file_exist(fname1)) then + if (.not. file_exists(fname1)) then write(fname1, "('topo_GWD_var_',i4.4,'x',i3.3,'_DC.data')") nlon,nlat - if (.not. file_exist(fname1)) then + if (.not. file_exists(fname1)) then write(fname1, "('topo_GWD_var_',i4.4,'x',i4.4,'_DC.data')") nlon,nlat - if (.not. file_exist(fname1)) call mpp_error(FATAL,fname1) + if (.not. file_exists(fname1)) call mpp_error(FATAL,fname1) endif endif endif @@ -178,13 +187,13 @@ PROGRAM CreateTopography allocate ( rtrb(im,jm) ) ! Read TRB write(fname1, "('topo_TRB_var_',i3.3,'x',i2.2,'_DC.data')") nlon,nlat - if (.not. file_exist(fname1)) then + if (.not. file_exists(fname1)) then write(fname1, "('topo_TRB_var_',i3.3,'x',i3.3,'_DC.data')") nlon,nlat - if (.not. file_exist(fname1)) then + if (.not. file_exists(fname1)) then write(fname1, "('topo_TRB_var_',i4.4,'x',i3.3,'_DC.data')") nlon,nlat - if (.not. file_exist(fname1)) then + if (.not. file_exists(fname1)) then write(fname1, "('topo_TRB_var_',i4.4,'x',i4.4,'_DC.data')") nlon,nlat - if (.not. file_exist(fname1)) call mpp_error(FATAL,fname1) + if (.not. file_exists(fname1)) call mpp_error(FATAL,fname1) endif endif endif @@ -390,7 +399,7 @@ subroutine cube2cube_gwd_trb(npx_in,npx_out) ! Do DYN_ave interp allocate( var_out(npx_out,npx_out,ntiles) ) write(fname1, "('topo_DYN_ave_',i4.4,'x',i5.5,'.data')") (npx_in),ntiles*(npx_in) - if (.not. file_exist(fname1)) call mpp_error(FATAL,fname1) + if (.not. file_exists(fname1)) call mpp_error(FATAL,fname1) open(IUNIT,file=fname1,form='unformatted',status='old') read(IUNIT) vari close(IUNIT) @@ -418,7 +427,7 @@ subroutine cube2cube_gwd_trb(npx_in,npx_out) ! Do GWD interp if (npx_out-1 <= 360) then write(fname1, "('topo_GWD_var_',i4.4,'x',i5.5,'.data')") (npx_in),ntiles*(npx_in) - if (.not. file_exist(fname1)) call mpp_error(FATAL,fname1) + if (.not. file_exists(fname1)) call mpp_error(FATAL,fname1) open(IUNIT,file=fname1,form='unformatted',status='old') read(IUNIT) vari close(IUNIT) @@ -449,7 +458,7 @@ subroutine cube2cube_gwd_trb(npx_in,npx_out) ! Do TRB interp if (npx_out-1 <= 360) then write(fname1, "('topo_TRB_var_',i4.4,'x',i5.5,'.data')") (npx_in),ntiles*(npx_in) - if (.not. file_exist(fname1)) call mpp_error(FATAL,fname1) + if (.not. file_exists(fname1)) call mpp_error(FATAL,fname1) open(IUNIT,file=fname1,form='unformatted',status='old') read(IUNIT) vari close(IUNIT) @@ -467,10 +476,10 @@ subroutine cube2cube_gwd_trb(npx_in,npx_out) else var_out(:,:,:) = 0.0 endif - write(fname2, "('topo_TRB_var_',i4.4,'x',i5.5,'.data')") (npx_out),ntiles*(npx_out) + write(fname2, "('topo_TRB_var_',i4.4,'x',i5.5,'.data')") (npx_out),ntiles*(npx_out) open(OUNIT,file=fname2,form='unformatted',status='unknown') do l=1,ntiles - j1 = (npx_out)*(l-1) + 1 + j1 = (npx_out)*(l-1) + 1 j2 = (npx_out)*(l-1) + npx_out varo(:,j1:j2)=var_out(:,:,l) enddo diff --git a/DynCore_GridCompMod.F90 b/DynCore_GridCompMod.F90 index c7886ef..ce5e433 100644 --- a/DynCore_GridCompMod.F90 +++ b/DynCore_GridCompMod.F90 @@ -905,7 +905,7 @@ Subroutine SetServices ( gc, rc ) DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, RC=STATUS ) VERIFY_(STATUS) - + call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'ZL0', & LONG_NAME = 'mid_layer_heights_above_surface', & @@ -1933,14 +1933,14 @@ Subroutine SetServices ( gc, rc ) VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) - call MAPL_AddExportSpec ( gc, & - SHORT_NAME = 'U100', & + call MAPL_AddExportSpec ( gc, & + SHORT_NAME = 'U100', & LONG_NAME = 'eastward_wind_at_100_hPa', & UNITS = 'm s-1', & - DIMS = MAPL_DimsHorzOnly, & - FIELD_TYPE = MAPL_VectorField, & - VLOCATION = MAPL_VLocationNone, RC=STATUS ) - VERIFY_(STATUS) + DIMS = MAPL_DimsHorzOnly, & + FIELD_TYPE = MAPL_VectorField, & + VLOCATION = MAPL_VLocationNone, RC=STATUS ) + VERIFY_(STATUS) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'UTOP', & @@ -2079,8 +2079,8 @@ Subroutine SetServices ( gc, rc ) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'T100', & LONG_NAME = 'air_temperature_at_100_hPa', & - UNITS = 'K', & - DIMS = MAPL_DimsHorzOnly, & + UNITS = 'K', & + DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) @@ -2118,13 +2118,13 @@ Subroutine SetServices ( gc, rc ) VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) - call MAPL_AddExportSpec ( gc, & - SHORT_NAME = 'Q300', & - LONG_NAME = 'specific_humidity_at_300_hPa', & + call MAPL_AddExportSpec ( gc, & + SHORT_NAME = 'Q300', & + LONG_NAME = 'specific_humidity_at_300_hPa', & UNITS = 'kg kg-1', & DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationNone, RC=STATUS ) + VERIFY_(STATUS) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'Q250', & @@ -2134,13 +2134,13 @@ Subroutine SetServices ( gc, rc ) VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) - call MAPL_AddExportSpec ( gc, & - SHORT_NAME = 'Q200', & - LONG_NAME = 'specific_humidity_at_200_hPa', & + call MAPL_AddExportSpec ( gc, & + SHORT_NAME = 'Q200', & + LONG_NAME = 'specific_humidity_at_200_hPa', & UNITS = 'kg kg-1', & DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationNone, RC=STATUS ) + VERIFY_(STATUS) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'Q100', & @@ -2221,22 +2221,22 @@ Subroutine SetServices ( gc, rc ) VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) - call MAPL_AddExportSpec ( gc, & + call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'H200', & - LONG_NAME = 'height_at_200_hPa', & - UNITS = 'm', & - DIMS = MAPL_DimsHorzOnly, & + LONG_NAME = 'height_at_200_hPa', & + UNITS = 'm', & + DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & - RC=STATUS ) + RC=STATUS ) VERIFY_(STATUS) - call MAPL_AddExportSpec ( gc, & + call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'H100', & - LONG_NAME = 'height_at_100_hPa', & - UNITS = 'm', & - DIMS = MAPL_DimsHorzOnly, & + LONG_NAME = 'height_at_100_hPa', & + UNITS = 'm', & + DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & - RC=STATUS ) + RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( gc, & @@ -2612,7 +2612,7 @@ Subroutine SetServices ( gc, rc ) VERIFY_(STATUS) call MAPL_GetResource ( MAPL, DEBUG_ADV, 'DEBUG_ADV:', default=.FALSE., rc=status ) - VERIFY_(STATUS) + VERIFY_(STATUS) call MAPL_GetResource ( MAPL, DEBUG_TQ_ERRORS, 'DEBUG_TQ_ERRORS:', default=.FALSE., rc=status ) VERIFY_(STATUS) @@ -3023,7 +3023,7 @@ subroutine Run(gc, import, export, clock, rc) real(r8), allocatable ::delpold(:,:,:) ! temporary array real(r8), allocatable :: ox(:,:,:) ! temporary array real(r8), allocatable :: zl(:,:,:) ! temporary array - real(r8), allocatable :: zle(:,:,:) ! temporary array + real(r8), allocatable :: zle(:,:,:) ! temporary array real(r8), allocatable :: logpe(:,:,:) ! temporary array real(r8), allocatable :: delp(:,:,:) ! temporary array real(r8), allocatable :: dudt(:,:,:) ! temporary array @@ -5202,7 +5202,7 @@ subroutine Run(gc, import, export, clock, rc) endif - call MAPL_GetPointer(export,temp2d,'WSPD_10M',rc=status) + call MAPL_GetPointer(export,temp2d,'WSPD_10M',rc=status) VERIFY_(STATUS) if(associated(temp2d)) then call VertInterp(temp2d,sqrt(ur**2 + vr**2),-zle,-10.0, rc=status) @@ -5238,7 +5238,7 @@ subroutine Run(gc, import, export, clock, rc) endif enddo enddo - enddo + enddo end if end if @@ -5370,7 +5370,7 @@ subroutine Run(gc, import, export, clock, rc) if (.not. HYDROSTATIC) then call FILLOUT3 (export, 'DELZ' , vars%dz(ifirstxy:ilastxy,jfirstxy:jlastxy,:) , rc=status) - VERIFY_(STATUS) + VERIFY_(STATUS) call FILLOUT3 (export, 'W' , vars%w(ifirstxy:ilastxy,jfirstxy:jlastxy,:) , rc=status) VERIFY_(STATUS) @@ -6701,7 +6701,7 @@ subroutine RunAddIncs(gc, import, export, clock, rc) ! call Write_Profile(grid, tempxy, 'T') !#endif - if (DEBUG_DYN) then + if (DEBUG_DYN) then call MAPL_MaxMin('DYN: Q_AF_INC ', qv) call MAPL_MaxMin('DYN: T_AF_INC ', tempxy, pmax=TMAX, pmin=TMIN) call MAPL_MaxMin('DYN: U_AF_INC ', ua) @@ -6847,7 +6847,7 @@ subroutine RunAddIncs(gc, import, export, clock, rc) call VertInterp(temp2d,ur,-zle,-50., rc=status) VERIFY_(STATUS) end if - + call MAPL_GetPointer(export,temp2d,'V50M', rc=status) VERIFY_(STATUS) if(associated(temp2d)) then @@ -6855,10 +6855,10 @@ subroutine RunAddIncs(gc, import, export, clock, rc) VERIFY_(STATUS) end if - call MAPL_GetPointer(export,temp2d,'U100', rc=status) - VERIFY_(STATUS) - if(associated(temp2d)) then - call VertInterp(temp2d,ur,logpe,log(10000.) , rc=status) + call MAPL_GetPointer(export,temp2d,'U100', rc=status) + VERIFY_(STATUS) + if(associated(temp2d)) then + call VertInterp(temp2d,ur,logpe,log(10000.) , rc=status) VERIFY_(STATUS) end if @@ -6876,10 +6876,10 @@ subroutine RunAddIncs(gc, import, export, clock, rc) VERIFY_(STATUS) end if - call MAPL_GetPointer(export,temp2d,'U300', rc=status) - VERIFY_(STATUS) - if(associated(temp2d)) then - call VertInterp(temp2d,ur,logpe,log(30000.) , rc=status) + call MAPL_GetPointer(export,temp2d,'U300', rc=status) + VERIFY_(STATUS) + if(associated(temp2d)) then + call VertInterp(temp2d,ur,logpe,log(30000.) , rc=status) VERIFY_(STATUS) end if @@ -7003,14 +7003,14 @@ subroutine RunAddIncs(gc, import, export, clock, rc) end if call MAPL_GetPointer(export,temp2d,'Q100', rc=status) - VERIFY_(STATUS) + VERIFY_(STATUS) if(associated(temp2d)) then call VertInterp(temp2d,qv,logpe,log(10000.) , positive_definite=.true., rc=status) VERIFY_(STATUS) end if - call MAPL_GetPointer(export,temp2d,'Q200', rc=status) - VERIFY_(STATUS) + call MAPL_GetPointer(export,temp2d,'Q200', rc=status) + VERIFY_(STATUS) if(associated(temp2d)) then call VertInterp(temp2d,qv,logpe,log(20000.) , positive_definite=.true., rc=status) VERIFY_(STATUS) @@ -7023,10 +7023,10 @@ subroutine RunAddIncs(gc, import, export, clock, rc) VERIFY_(STATUS) end if - call MAPL_GetPointer(export,temp2d,'Q300', rc=status) - VERIFY_(STATUS) + call MAPL_GetPointer(export,temp2d,'Q300', rc=status) + VERIFY_(STATUS) if(associated(temp2d)) then - call VertInterp(temp2d,qv,logpe,log(30000.) , positive_definite=.true., rc=status) + call VertInterp(temp2d,qv,logpe,log(30000.) , positive_definite=.true., rc=status) VERIFY_(STATUS) end if @@ -7037,10 +7037,10 @@ subroutine RunAddIncs(gc, import, export, clock, rc) VERIFY_(STATUS) end if - call MAPL_GetPointer(export,temp2d,'Q700', rc=status) - VERIFY_(STATUS) + call MAPL_GetPointer(export,temp2d,'Q700', rc=status) + VERIFY_(STATUS) if(associated(temp2d)) then - call VertInterp(temp2d,qv,logpe,log(70000.) , positive_definite=.true., rc=status) + call VertInterp(temp2d,qv,logpe,log(70000.) , positive_definite=.true., rc=status) VERIFY_(STATUS) end if @@ -7211,7 +7211,6 @@ end subroutine RunAddIncs !----------------------------------------------------------------------- subroutine ADD_INCS ( MAPL,STATE,IMPORT,DT,IS_WEIGHTED,RC ) - use fms_mod, only: set_domain, nullify_domain use fv_diagnostics_mod, only: prt_maxmin use time_manager_mod, only: time_type use fv_update_phys_mod, only: fv_update_phys @@ -9176,7 +9175,7 @@ Subroutine Write_Profile_R4(grid, arr, name, delp) endif deallocate(arr_global, glbArr) - + End Subroutine Write_Profile_R4 function R8_TO_R4(dbl_var) diff --git a/FV_StateMod.F90 b/FV_StateMod.F90 index c14a57c..085c858 100644 --- a/FV_StateMod.F90 +++ b/FV_StateMod.F90 @@ -17,7 +17,10 @@ module FV_StateMod use fv_mp_mod, only: start_group_halo_update, complete_group_halo_update use fv_mp_mod, only: group_halo_update_type - use fms_mod, only: fms_init, set_domain, nullify_domain + use fms_mod, only: fms_init +#if defined(FMS1_IO) + use fms_mod, only: set_domain, nullify_domain +#endif use mpp_domains_mod, only: mpp_update_domains, CGRID_NE, DGRID_NE, mpp_get_boundary use mpp_parameter_mod, only: AGRID_PARAM=>AGRID, CORNER use fv_timing_mod, only: timing_on, timing_off, timing_init, timing_prt @@ -601,42 +604,42 @@ subroutine FV_Setup(GC,LAYOUT_FILE, RC) FV_Atm(1)%flagstruct%RF_fast = .false. endif if (FV_Atm(1)%flagstruct%npx*CEILING(FV_Atm(1)%flagstruct%stretch_fac) >= 1120) then - FV_Atm(1)%flagstruct%hydrostatic = .false. + FV_Atm(1)%flagstruct%hydrostatic = .false. FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 60.0 ) if (FV_Atm(1)%flagstruct%stretch_fac > 1) FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 90.0 ) FV_Atm(1)%flagstruct%tau = 2.5 FV_Atm(1)%flagstruct%RF_fast = .false. endif if (FV_Atm(1)%flagstruct%npx*CEILING(FV_Atm(1)%flagstruct%stretch_fac) >= 1440) then - FV_Atm(1)%flagstruct%hydrostatic = .false. + FV_Atm(1)%flagstruct%hydrostatic = .false. FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 37.5 ) if (FV_Atm(1)%flagstruct%stretch_fac > 1) FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 60.0 ) FV_Atm(1)%flagstruct%tau = 2.0 FV_Atm(1)%flagstruct%RF_fast = .true. endif if (FV_Atm(1)%flagstruct%npx*CEILING(FV_Atm(1)%flagstruct%stretch_fac) >= 2880) then - FV_Atm(1)%flagstruct%hydrostatic = .false. + FV_Atm(1)%flagstruct%hydrostatic = .false. FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 18.75 ) if (FV_Atm(1)%flagstruct%stretch_fac > 1) FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 30.0 ) FV_Atm(1)%flagstruct%tau = 1.5 FV_Atm(1)%flagstruct%RF_fast = .true. endif if (FV_Atm(1)%flagstruct%npx*CEILING(FV_Atm(1)%flagstruct%stretch_fac) >= 4320) then - FV_Atm(1)%flagstruct%hydrostatic = .false. + FV_Atm(1)%flagstruct%hydrostatic = .false. FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 15.0 ) if (FV_Atm(1)%flagstruct%stretch_fac > 1) FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 15.0 ) FV_Atm(1)%flagstruct%tau = 1.0 FV_Atm(1)%flagstruct%RF_fast = .true. endif if (FV_Atm(1)%flagstruct%npx*CEILING(FV_Atm(1)%flagstruct%stretch_fac) >= 5760) then - FV_Atm(1)%flagstruct%hydrostatic = .false. + FV_Atm(1)%flagstruct%hydrostatic = .false. FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 9.375 ) if (FV_Atm(1)%flagstruct%stretch_fac > 1) FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 7.5 ) FV_Atm(1)%flagstruct%tau = 1.0 FV_Atm(1)%flagstruct%RF_fast = .true. endif if (FV_Atm(1)%flagstruct%npx*CEILING(FV_Atm(1)%flagstruct%stretch_fac) >= 10800) then - FV_Atm(1)%flagstruct%hydrostatic = .false. + FV_Atm(1)%flagstruct%hydrostatic = .false. FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 4.6875 ) if (FV_Atm(1)%flagstruct%stretch_fac > 1) FV_Atm(1)%flagstruct%k_split = CEILING(DT/ 3.25 ) FV_Atm(1)%flagstruct%tau = 1.0 @@ -651,7 +654,7 @@ subroutine FV_Setup(GC,LAYOUT_FILE, RC) FV_Atm(1)%flagstruct%d4_bg_bot = 0.12 ! High-order Divg Damping coef FV_Atm(1)%flagstruct%d2_bg = 0.0 ! 2nd order Divg Damping coef FV_Atm(1)%flagstruct%d_ext = 0.0 ! External damping - ! Local Richardson-number turbulent mixing + ! Local Richardson-number turbulent mixing FV_Atm(1)%flagstruct%fv_sg_adj = DT*4 ! Sponge layer FV_Atm(1)%flagstruct%n_sponge = 9 @@ -665,7 +668,7 @@ subroutine FV_Setup(GC,LAYOUT_FILE, RC) FV_Atm(1)%flagstruct%a_imp = 1.0 ! dz_min is a NH delta-z limiter increasing may improve stability FV_Atm(1)%flagstruct%dz_min = 2.0 - ! p_fac is a NH pressure fraction limiter near model top (0:0.25) + ! p_fac is a NH pressure fraction limiter near model top (0:0.25) FV_Atm(1)%flagstruct%p_fac = 0.05 ! General defaults FV_Atm(1)%flagstruct%make_nh = .false. @@ -1921,7 +1924,9 @@ subroutine FV_Run (STATE, EXPORT, CLOCK, GC, PLE0, RC) call MAPL_TimerOn(MAPL,"--NH_ADIABATIC_INIT") if ((.not. FV_Atm(1)%flagstruct%hydrostatic) .and. (FV_Atm(1)%flagstruct%na_init>0)) then allocate( DEBUG_ARRAY(isc:iec,jsc:jec,NPZ) ) +#if defined (FMS1_IO) call nullify_domain ( ) +#endif DEBUG_ARRAY(:,:,1:npz) = FV_Atm(1)%w(isc:iec,jsc:jec,:) call prt_maxmin('Before adiabatic_init W: ', DEBUG_ARRAY, isc, iec, jsc, jec, 0, npz, fac1 ) call adiabatic_init(myDT,DEBUG_ARRAY,fac1) @@ -1934,7 +1939,9 @@ subroutine FV_Run (STATE, EXPORT, CLOCK, GC, PLE0, RC) call MAPL_TimerOn(MAPL,"--FV_DYNAMICS") if (.not. FV_OFF) then +#if defined (FMS1_IO) call set_domain(FV_Atm(1)%domain) ! needed for diagnostic output done in fv_dynamics +#endif allocate ( u_dt(isc:iec,jsc:jec,npz) ) allocate ( v_dt(isc:iec,jsc:jec,npz) ) allocate ( t_dt(isc:iec,jsc:jec,npz) ) @@ -2035,7 +2042,9 @@ subroutine FV_Run (STATE, EXPORT, CLOCK, GC, PLE0, RC) deallocate ( t_dt ) deallocate ( w_dt ) +#if defined (FMS1_IO) call nullify_domain() +#endif endif call MAPL_TimerOff(MAPL,"--FV_DYNAMICS") @@ -2714,9 +2723,9 @@ subroutine fv_getPKZ_NH(pkz,temp,qv,pe,delz) !------------------------------------------------------------------------- ! Re-compute the full (nonhydrostatic) pressure due to temperature changes !------------------------------------------------------------------------- -!$omp parallel do default (none) & +!$omp parallel do default (none) & !$omp shared (npz, jsc, jec, isc, iec, pkz, kappa, rdg, delp, temp, zvir, qv, delz) & -!$omp private (k, j, i) +!$omp private (k, j, i) do k=1,npz do j=jsc,jec do i=isc,iec @@ -2749,9 +2758,9 @@ subroutine fv_getPKZ(pkz,pe) peln = log(pe) pk = exp( kappa*peln ) -!$omp parallel do default (none) & +!$omp parallel do default (none) & !$omp shared (npz, jsc, jec, isc, iec, pkz, pk, kappa, peln) & -!$omp private (k, j, i) +!$omp private (k, j, i) do k=1,npz do j=jsc,jec do i=isc,iec @@ -4028,7 +4037,11 @@ subroutine fv_getDivergence(uc, vc, divg) end subroutine fv_getDivergence subroutine fv_getUpdraftHelicity(uh25, uh03, srh01, srh03, srh25) +#if defined (SINGLE_FV) + use constantsr4_mod, only: fms_grav=>grav +#else use constants_mod, only: fms_grav=>grav +#endif ! made this REAL4 real(REAL4), intent(OUT) :: uh25(:,:) real(REAL4), intent(OUT) :: uh03(:,:) @@ -5021,7 +5034,7 @@ subroutine adiabatic_init(myDT,DEBUG_ARRAY,fac1) allocate ( t0(isc:iec,jsc:jec, npz) ) allocate (dp0(isc:iec,jsc:jec, npz) ) -!$omp parallel do default (none) & +!$omp parallel do default (none) & !$omp shared (npz, jsc, jec, isc, iec, n, sphum, u0, v0, t0, dp0, FV_Atm, zvir) & !$omp private (k, j, i) do k=1,npz @@ -5085,7 +5098,7 @@ subroutine adiabatic_init(myDT,DEBUG_ARRAY,fac1) time_total) !Nudging back to IC !$omp parallel do default (none) & -!$omp shared (npz, jsc, jec, isc, iec, n, sphum, FV_Atm, u0, v0, t0, dp0, xt, zvir) & +!$omp shared (npz, jsc, jec, isc, iec, n, sphum, FV_Atm, u0, v0, t0, dp0, xt, zvir) & !$omp private (i, j, k) do k=1,npz do j=jsc,jec+1 diff --git a/GetWeights.F90 b/GetWeights.F90 index c21f990..899e356 100644 --- a/GetWeights.F90 +++ b/GetWeights.F90 @@ -1,14 +1,17 @@ - + ! $Id$ - + !!!#define REAL8 8 - + subroutine GetWeights_init (in_ntiles,in_ncnst,in_npx,in_npy,in_npz,& in_nx,in_ny,in_hydro,in_mknh,comm) - use fms_mod, only: fms_init, set_domain + use fms_mod, only: fms_init +#if defined (FMS1_IO) + use fms_mod, only: set_domain +#endif use fv_control_mod, only: fv_init1, fv_init2 use fv_arrays_mod, only: REAL4, REAL8, FVPRC - use FV_StateMod, only : FV_Atm + use FV_StateMod, only : FV_Atm implicit none integer,intent(in) :: in_ntiles,in_ncnst integer,intent(in) :: in_npx,in_npy,in_npz @@ -22,7 +25,7 @@ subroutine GetWeights_init (in_ntiles,in_ncnst,in_npx,in_npy,in_npz,& !#endif integer :: p_split logical, allocatable :: grids_on_my_pe(:) - + p_split = 1 call fms_init(comm) @@ -42,12 +45,14 @@ subroutine GetWeights_init (in_ntiles,in_ncnst,in_npx,in_npy,in_npz,& call fv_init2(FV_atm, dt_who_cares, grids_on_my_pe, p_split) +#if defined (FMS1_IO) call set_domain(FV_Atm(1)%domain) +#endif end subroutine GetWeights_init subroutine GetWeights(npx, npy, nlat, nlon, index, weight, id1, id2, jdc, l2c, & - ee1, ee2, ff1, ff2, gg1, gg2, e1, e2, f1, f2, g1, g2, sublons, sublats, AmNodeRoot, WriteNetcdf) + ee1, ee2, ff1, ff2, gg1, gg2, e1, e2, f1, f2, g1, g2, sublons, sublats, AmNodeRoot, WriteNetcdf) #include "MAPL_Generic.h" use MAPL @@ -58,7 +63,7 @@ subroutine GetWeights(npx, npy, nlat, nlon, index, weight, id1, id2, jdc, l2c, & use fv_arrays_mod, only : REAL4, REAL8, FVPRC use CUB2LATLON_mod, only : init_latlon_grid, get_c2l_weight use GHOST_CUBSPH_mod, only : B_grid, A_grid, ghost_cubsph_update - use FV_StateMod, only : FV_Atm + use FV_StateMod, only : FV_Atm use fv_mp_mod, only : is,js,ie,je, is_master include "netcdf.inc" @@ -72,10 +77,10 @@ subroutine GetWeights(npx, npy, nlat, nlon, index, weight, id1, id2, jdc, l2c, & integer, intent( out) :: jdc(npx,npy) real(REAL8), intent( out) :: l2c(4,npx,npy) real(REAL8), intent( out) :: ee1(npx,npy,3) - real(REAL8), intent( out) :: ee2(npx,npy,3) - real(REAL8), intent( out) :: ff1(npx,npy,3) - real(REAL8), intent( out) :: ff2(npx,npy,3) - real(REAL8), intent( out) :: gg1(npx,npy,3) + real(REAL8), intent( out) :: ee2(npx,npy,3) + real(REAL8), intent( out) :: ff1(npx,npy,3) + real(REAL8), intent( out) :: ff2(npx,npy,3) + real(REAL8), intent( out) :: gg1(npx,npy,3) real(REAL8), intent( out) :: gg2(npx,npy,3) real(REAL8), pointer :: e1(:,:,:) real(REAL8), pointer :: e2(:,:,:) @@ -135,14 +140,14 @@ subroutine GetWeights(npx, npy, nlat, nlon, index, weight, id1, id2, jdc, l2c, & call gnomonic_grids(A_grid, npx, grid_global(:,:,1,1), grid_global(:,:,2,1)) -! mirror_grid assumes that the tile=1 is centered +! mirror_grid assumes that the tile=1 is centered ! on equator and greenwich meridian Lon[-pi,pi] !------------------------------------------------ call mirror_grid(grid_global, 0, npts, npts, ndims, ntiles) ! Shift the corner away from Japan. -! This will result in the corner +! This will result in the corner ! close to the east coast of China. !----------------------------------- @@ -243,7 +248,7 @@ subroutine GetWeights(npx, npy, nlat, nlon, index, weight, id1, id2, jdc, l2c, & endif ! calculate weights for bilinear interpolation -! from cubed sphere to latlon grid +! from cubed sphere to latlon grid !--------------------------------------------- if (present(sublons) .and. present(sublats)) then call get_c2l_weight(sph_corner, npts, npts, ntiles, & @@ -258,7 +263,7 @@ subroutine GetWeights(npx, npy, nlat, nlon, index, weight, id1, id2, jdc, l2c, & deallocate ( sph_corner ) ! calculate weights for bilinear interpolation -! from cubed sphere to latlon grid +! from cubed sphere to latlon grid !--------------------------------------------- call remap_coef( agrid, xlon, ylat, id1, id2, jdc, l2c ) @@ -266,7 +271,7 @@ subroutine GetWeights(npx, npy, nlat, nlon, index, weight, id1, id2, jdc, l2c, & deallocate ( xlon, ylat ) deallocate ( agrid ) -! write out NETCDF weights file +! write out NETCDF weights file !--------------------------------------------- if (present(WriteNetcdf)) then if (WriteNetcdf) then @@ -321,7 +326,7 @@ subroutine GetWeights(npx, npy, nlat, nlon, index, weight, id1, id2, jdc, l2c, & if (is_master()) print *, 'Reading weights for ', TRIM(c2l_fname) -! read NETCDF weights file +! read NETCDF weights file !--------------------------------------------- STATUS = NF_OPEN (trim(c2l_fname), NF_NOWRITE, c2l_unit) diff --git a/fv_regrid_c2c.F90 b/fv_regrid_c2c.F90 index 2f3fd16..e0c836e 100644 --- a/fv_regrid_c2c.F90 +++ b/fv_regrid_c2c.F90 @@ -5,7 +5,11 @@ module fv_regrid_c2c #define DEALLOCGLOB_(A) if(associated(A)) then;A=0;if(MAPL_ShmInitialized) then; call MAPL_DeAllocNodeArray(A,rc=status);else; deallocate(A);endif;NULLIFY(A);endif #endif - use fms_mod, only: file_exist, read_data, field_exist +#if defined (FMS1_IO) + use fms_mod, only: file_exists => file_exist +#else + use fms2_io_mod, only: file_exists +#endif use mpp_mod, only: mpp_error, FATAL use mpp_domains_mod, only: domain2d, mpp_update_domains, mpp_get_boundary, DGRID_NE use tracer_manager_mod, only: get_tracer_names, get_number_tracers, get_tracer_index @@ -239,7 +243,7 @@ subroutine get_geos_cubed_ic( Atm_i, Atm, grid_i, grid, Arrdes_i, extra_rst ) Atm(1)%q = 0. ! Read input FV core restart file fname = "fvcore_internal_restart_in" - if( file_exist(fname) ) then + if( file_exists(fname) ) then allocate(cfg(1)) call formatter%open(fname,pFIO_READ,rc=status) @@ -425,7 +429,7 @@ subroutine get_geos_cubed_ic( Atm_i, Atm, grid_i, grid, Arrdes_i, extra_rst ) ! Read input topography write(fname1, "('topo_DYN_ave_',a,'x',a,'.data')") trim(imc), trim(jmc) - if (.not. file_exist(fname1)) then + if (.not. file_exists(fname1)) then call mpp_error(FATAL,'get_geos_cubed_ic: cannot find topo_DYN_ave file') endif allocate ( gz0(is_i:ie_i,js_i:je_i) ) @@ -456,7 +460,7 @@ subroutine get_geos_cubed_ic( Atm_i, Atm, grid_i, grid, Arrdes_i, extra_rst ) ! Horiz Interp for moist tracers ! is there a moist restart file to interpolate? ! Read in tracers: only sphum at this point - if( file_exist("moist_internal_restart_in") ) then + if( file_exists("moist_internal_restart_in") ) then if (is_master()) print*, '' if (is_master()) print*, 'Regridding moist_internal_restart_in' diff --git a/fv_regrid_c2c_bin.F90 b/fv_regrid_c2c_bin.F90 index fe19e2a..301309d 100644 --- a/fv_regrid_c2c_bin.F90 +++ b/fv_regrid_c2c_bin.F90 @@ -5,8 +5,11 @@ module fv_regrid_c2c_bin #endif use fv_arrays_mod, only: REAL4, REAL8, FVPRC - use fms_mod, only: file_exist, read_data, field_exist - use fms_io_mod, only: get_tile_string, field_size +#if defined (FMS1_IO) + use fms_mod, only: file_exists => file_exist +#else + use fms2_io_mod, only: file_exists +#endif use mpp_mod, only: mpp_error, FATAL, NOTE, mpp_broadcast,mpp_npes use mpp_parameter_mod, only: AGRID_PARAM=>AGRID use mpp_domains_mod, only: mpp_get_tile_id, domain2d, mpp_update_domains, mpp_get_boundary, DGRID_NE @@ -103,9 +106,9 @@ subroutine get_geos_ic_bin( Atm, extra_rst, rstcube, gridOut) end if enddo else - do j=1,size(extra_rst(i)%vars) + do j=1,size(extra_rst(i)%vars) allocate(extra_rst(i)%vars(j)%ptr3d(isd:ied,jsd:jed,extra_rst(i)%vars(j)%nLev),source=0.0_FVPRC ) - enddo + enddo end if enddo @@ -196,7 +199,7 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut ) ! Read input FV core restart file fname = "fvcore_internal_restart_in" - if( file_exist(fname) ) then + if( file_exists(fname) ) then open(IUNIT,file=fname ,access='sequential',form='unformatted',status='old') read (IUNIT, IOSTAT=status) header @@ -210,7 +213,7 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut ) if(is_master()) write(*,*) 'Using GEOS restart:', fname - if ( file_exist(fname) ) then + if ( file_exists(fname) ) then if(is_master()) write(*,*) 'External IC dimensions:', im , jm , km if(is_master()) write(*,*) 'Interpolating to :', npx-1, (npy-1)*6, npz else @@ -261,7 +264,7 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut ) ! Read U allocate ( u0(isd_i:ied_i,jsd_i:jed_i+1,km) ) - u0(:,:,:) = 0.0 + u0(:,:,:) = 0.0 !offset = sequential access: 4 + INT(6) + 8 + INT(5) + 8 + DBL(NPZ+1) + 8 + DBL(NPZ+1) + 8 offset = 4 + 24 + 8 + 20 + 8 + (km+1)*8 + 8 + (km+1)*8 + 8 if (is_master()) print*, offset @@ -282,7 +285,7 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut ) sbufferx=sbuffer, nbufferx=nbuffer, & gridtype=DGRID_NE ) do k=1,km - do i=is_i,ie_i + do i=is_i,ie_i u0(i,je_i+1,k) = nbuffer(i,k) enddo do j=js_i,je_i @@ -342,7 +345,7 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut ) jmc = adjustl(jmc) write(fname1, "('topo_DYN_ave_',a,'x',a,'.data')") trim(imc), trim(jmc) - if (.not. file_exist(fname1)) then + if (.not. file_exists(fname1)) then call mpp_error(FATAL,'get_geos_cubed_ic: cannot find topo_DYN_ave file') endif call print_memuse_stats('get_geos_cubed_ic: '//TRIM(fname1)//' being read') @@ -358,7 +361,7 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut ) Atm(1)%phis = Atm(1)%phis*grav call print_memuse_stats('get_geos_cubed_ic: phis') -! Horiz Interp for surface pressure +! Horiz Interp for surface pressure call prt_maxmin('PS_geos', ps0, is_i, ie_i, js_i, je_i, ng_i, 1, 1.0_FVPRC) call regridder%regrid(ps0(is_i:ie_i,js_i:je_i),psc(is:ie,js:je),rc=status) deallocate ( ps0 ) @@ -376,7 +379,7 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut ) ! Horiz Interp for moist tracers ! is there a moist restart file to interpolate? ! Read in tracers: only sphum at this point - if( file_exist("moist_internal_restart_in") ) then + if( file_exists("moist_internal_restart_in") ) then if (is_master()) print*, 'Trying to interpolate moist_internal_restart_in' offset=4 @@ -401,13 +404,13 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut ) do j=1,size(extra_rst(i)%vars) if (extra_rst(i)%have_descriptor) then if (extra_rst(i)%vars(j)%nLev/=1) then - if (extra_rst(i)%vars(j)%nLev == npz) then + if (extra_rst(i)%vars(j)%nLev == npz) then tracer_bundles(i)%vars(j)%nLev=km allocate(tracer_bundles(i)%vars(j)%ptr3d(is:ie,js:je,km) ) else if (extra_rst(i)%vars(j)%nLev == npz+1) then tracer_bundles(i)%vars(j)%nLev=km+1 allocate(tracer_bundles(i)%vars(j)%ptr3d(is:ie,js:je,km+1) ) - end if + end if else allocate(tracer_bundles(i)%vars(j)%ptr2d(is:ie,js:je) ) end if @@ -443,7 +446,7 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut ) deallocate(qlev) enddo - + ! Horiz Interp for T deallocate ( q0 ) call mpp_update_domains(t0, domain_i) @@ -486,12 +489,12 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut ) call prt_maxmin('PT_model', Atm(1)%pt, is, ie, js, je, ng, npz, 1.0_FVPRC) ! Range check the MOIST tracers ! Iterate over tracer names - + iter = moist_tracers%begin() do while (iter /= moist_tracers%end()) iptr => iter%value() cptr => iter%key() - if (.not.match(cptr)) then + if (.not.match(cptr)) then do k=1,npz do j=js,je do i=is,ie @@ -552,7 +555,7 @@ subroutine get_geos_latlon_ic( Atm, extra_rst) real(FVPRC):: s2c(is:ie,js:je,4) integer, dimension(is:ie,js:je):: id1, id2, jdc real(FVPRC) psc(is:ie,js:je) - real(FVPRC) gzc(is:ie,js:je) + real(FVPRC) gzc(is:ie,js:je) real(FVPRC), allocatable:: tp(:,:,:), qp(:,:,:,:) real(FVPRC), allocatable:: ua(:,:,:), va(:,:,:) @@ -582,7 +585,7 @@ subroutine get_geos_latlon_ic( Atm, extra_rst) ! Read in lat-lon FV core restart file fname = "fvcore_internal_restart_in" - if( file_exist(fname) ) then + if( file_exists(fname) ) then call MAPL_NCIOGetFileType(fname,filetype) @@ -624,7 +627,7 @@ subroutine get_geos_latlon_ic( Atm, extra_rst) enddo allocate ( lat(jm) ) do j=1,jm - lat(j) = -0.5*pi + real(j-1)*pi/real(jm-1) ! SP to NP + lat(j) = -0.5*pi + real(j-1)*pi/real(jm-1) ! SP to NP enddo call remap_coef( im, jm, lon, lat, id1, id2, jdc, s2c , Atm(1)%gridstruct%agrid, Atm(1)%bd) @@ -724,7 +727,7 @@ subroutine get_geos_latlon_ic( Atm, extra_rst) enddo call print_memuse_stats('get_geos_latlon_ic: read t') ! Read PE - do k=1,km+1 + do k=1,km+1 if (isNC4) then call MAPL_VarRead(formatter,"PE",r8latlon,lev=k) else @@ -764,8 +767,8 @@ subroutine get_geos_latlon_ic( Atm, extra_rst) jmc = adjustl(jmc) write(fname1, "('topo_DYN_ave_',a,'x',a,'_DC.data')") trim(imc), trim(jmc) - if (.not. file_exist(fname1)) then - CALL mpp_error(FATAL,'get_geos_latlon_ic: cannot find topo_DYN_ave file') + if (.not. file_exists(fname1)) then + CALL mpp_error(FATAL,'get_geos_latlon_ic: cannot find topo_DYN_ave file') endif call print_memuse_stats('get_geos_latlon_ic: '//TRIM(fname1)//' being read') allocate ( r4latlon(im,jm) ) @@ -786,7 +789,7 @@ subroutine get_geos_latlon_ic( Atm, extra_rst) jmc = adjustl(jmc) write(fname1, "('topo_DYN_ave_',a,'x',a,'.data')") trim(imc), trim(jmc) - if (.not. file_exist(fname1)) then + if (.not. file_exists(fname1)) then call mpp_error(FATAL,'get_geos_latlon_ic: cannot find topo_DYN_ave file') endif allocate( phis_r4(Atm(1)%npx-1,6*(Atm(1)%npy-1)) ) @@ -798,7 +801,7 @@ subroutine get_geos_latlon_ic( Atm, extra_rst) deallocate( phis_r4 ) call print_memuse_stats('get_geos_latlon_ic: phis') -! Horiz Interp for surface pressure +! Horiz Interp for surface pressure if(is_master()) call pmaxmin( 'PS_geos', ps0, im, jm, 0.01_FVPRC) do j=js,je do i=is,ie @@ -832,7 +835,7 @@ subroutine get_geos_latlon_ic( Atm, extra_rst) ! Horiz Interp for moist tracers ! is there a moist restart file to interpolate? ! Read in tracers: only sphum at this point - if( file_exist("moist_internal_restart_in")) then + if( file_exists("moist_internal_restart_in")) then if (is_master()) print*, 'Trying to interpolate moist_internal_restart_in' allocate ( r4latlon(im,jm) ) @@ -890,13 +893,13 @@ subroutine get_geos_latlon_ic( Atm, extra_rst) do j=1,size(extra_rst(i)%vars) if (extra_rst(i)%have_descriptor) then if (extra_rst(i)%vars(j)%nLev/=1) then - if (extra_rst(i)%vars(j)%nLev == npz) then + if (extra_rst(i)%vars(j)%nLev == npz) then tracer_bundles(i)%vars(j)%nLev=km allocate(tracer_bundles(i)%vars(j)%ptr3d(is:ie,js:je,km) ) else if (extra_rst(i)%vars(j)%nLev == npz+1) then tracer_bundles(i)%vars(j)%nLev=km+1 allocate(tracer_bundles(i)%vars(j)%ptr3d(is:ie,js:je,km+1) ) - end if + end if else allocate(tracer_bundles(i)%vars(j)%ptr2d(is:ie,js:je) ) end if @@ -971,7 +974,7 @@ subroutine get_geos_latlon_ic( Atm, extra_rst) deallocate ( q0 ) ! Horiz Interp for T - if(is_master()) call pmaxmin( 'T_geos', t0, im*jm, km, 1.0_FVPRC) + if(is_master()) call pmaxmin( 'T_geos', t0, im*jm, km, 1.0_FVPRC) allocate ( tp(is:ie,js:je,km) ) do k=1,km do j=js,je @@ -989,12 +992,12 @@ subroutine get_geos_latlon_ic( Atm, extra_rst) ! Horz/Vert remap for MOIST, GOCART, and PCHEM scalars (Assuming Total Number is divisible by KM) ! ----------------------------------------------------------------------------------------------- - nqmap = nmoist + ngocart + npchem + nqmap = nmoist + ngocart + npchem !! call remap_scalar(im, jm, km, npz, nqmap, nqmap, ak0, bk0, psc, gzc, tp, qp, Atm(1), tracer_bundles, extra_rst) deallocate ( tp ) - deallocate ( qp ) + deallocate ( qp ) call print_memuse_stats('get_geos_latlon_ic: remap_scalar') ! Horz/Vert remap for U/V @@ -1103,7 +1106,7 @@ subroutine remap_coef( im, jm, lon, lat, id1, id2, jdc, s2c, agrid, bd ) endif enddo endif -111 continue +111 continue if ( agrid(i,j,2) file_exist +#else + use fms2_io_mod, only: file_exists +#endif use fv_control_mod, only: fv_init1, fv_init2, fv_end use fv_arrays_mod, only: fv_atmos_type, FVPRC use fv_mp_mod, only: is_master @@ -220,7 +225,7 @@ program interp_restarts ! ------------------------------------------------------------- ! Need to get input grid and ak/bk - if( file_exist("fvcore_internal_restart_in") ) then + if( file_exists("fvcore_internal_restart_in") ) then call InFmt%open("fvcore_internal_restart_in",pFIO_READ,rc=status) allocate(InCfg(1)) InCfg(1) = InFmt%read() @@ -260,7 +265,7 @@ program interp_restarts call print_memuse_stats('interp_restarts: Atm_i: init') nmoist = 0 - if( file_exist("moist_internal_restart_in") ) then + if( file_exists("moist_internal_restart_in") ) then call InFmt%open("moist_internal_restart_in",pFIO_READ,rc=status) allocate(InCfg(1)) InCfg(1) = InFmt%read() @@ -332,7 +337,7 @@ program interp_restarts do i=1,n_files - if (file_exist(trim(extra_files(i)))) then + if (file_exists(trim(extra_files(i)))) then rst_files(i)%file_name=trim(extra_files(i)) call InFmt%open(trim(extra_files(i)),pFIO_READ,rc=status) @@ -470,7 +475,7 @@ program interp_restarts call print_memuse_stats('interp_restarts: going to write restarts') ! write fvcore_internal_rst - if( file_exist("fvcore_internal_restart_in") ) then + if( file_exists("fvcore_internal_restart_in") ) then write(fname1, "('fvcore_internal_rst_c',i4.4,'_',i3.3,'L')") npx-1,npz if (is_master()) print*, 'Writing : ', TRIM(fname1) @@ -583,7 +588,7 @@ program interp_restarts allocate(r4_local(is:ie,js:je,npz+1)) allocate(r4_local2D(is:ie,js:je)) - if( file_exist("moist_internal_restart_in") ) then + if( file_exists("moist_internal_restart_in") ) then write(fname1, "('moist_internal_rst_c',i4.4,'_',i3.3,'L')") npx-1,npz if (is_master()) print*, 'Writing : ', TRIM(fname1) imc = npx-1 diff --git a/interp_restarts_bin.F90 b/interp_restarts_bin.F90 index c3b88c0..278ee80 100755 --- a/interp_restarts_bin.F90 +++ b/interp_restarts_bin.F90 @@ -8,7 +8,12 @@ program interp_restarts !--------------------------------------------------------------------! use ESMF use mpp_mod, only: mpp_error, FATAL, NOTE, mpp_root_pe, mpp_broadcast - use fms_mod, only: print_memory_usage, fms_init, fms_end, file_exist + use fms_mod, only: print_memory_usage, fms_init, fms_end +#if defined (FMS1_IO) + use fms_mod, only: file_exists => file_exist +#else + use fms2_io_mod, only: file_exists +#endif use fv_control_mod, only: fv_init1, fv_init2, fv_end use fv_arrays_mod, only: fv_atmos_type, REAL4, REAL8, FVPRC use fv_mp_mod, only: is_master, ng, mp_gather, tile @@ -16,7 +21,12 @@ program interp_restarts use fv_regridding_utils use fv_grid_utils_mod, only: ptop_min use init_hydro_mod, only: p_var - use constants_mod, only: pi, omega, grav, kappa, rdgas, rvgas, cp_air +#if defined (SINGLE_FV) + use constantsr4_mod, & +#else + use constants_mod, & +#endif + only: pi, omega, grav, kappa, rdgas, rvgas, cp_air use fv_diagnostics_mod,only: prt_maxmin ! use fv_eta_mod, only: set_eta use m_set_eta, only: set_eta @@ -185,7 +195,7 @@ program interp_restarts FV_Atm(1)%flagstruct%stretch_fac=schmidt_parameters(3) end if - if (n_files > 0) allocate(rst_files(n_files)) + if (n_files > 0) allocate(rst_files(n_files)) ! Initialize SHMEM in MAPL call pfl_initialize() @@ -214,12 +224,12 @@ program interp_restarts call mpp_broadcast(nmoist, mpp_root_pe()) call mpp_broadcast(isBinMoist, mpp_root_pe()) - if (is_master()) print*, 'HYDROSTATIC : ', FV_Atm(1)%flagstruct%hydrostatic + if (is_master()) print*, 'HYDROSTATIC : ', FV_Atm(1)%flagstruct%hydrostatic if (is_master()) print*, 'Make_NH : ', FV_Atm(1)%flagstruct%Make_NH if (is_master()) print*, 'Tracers : ', FV_Atm(1)%ncnst ! Need to get ak/bk - if( file_exist("fvcore_internal_restart_in") ) then + if( file_exists("fvcore_internal_restart_in") ) then open(IUNIT,file='fvcore_internal_restart_in' ,access='sequential',form='unformatted',status='old') ! Headers read (IUNIT, IOSTAT=status) header @@ -232,7 +242,7 @@ program interp_restarts call mpp_error(FATAL, 'ABORT: fvcore_internal_restart_in does not exist') endif - if( file_exist("moist_internal_restart_in") ) then + if( file_exists("moist_internal_restart_in") ) then call rs_count( "moist_internal_restart_in",nmoist ) if (mod(nmoist,km)/=0) then call mpp_error(FATAL, 'ABORT: '//'binary moist restart must have only 3D variabels') @@ -282,7 +292,7 @@ program interp_restarts do i=1,n_files - if (file_exist(trim(extra_files(i)))) then + if (file_exists(trim(extra_files(i)))) then call rs_count(trim(extra_files(i)),nlevs) if (mod(nlevs,km) /= 0) then rst_files(i)%have_descriptor=.false. @@ -323,9 +333,9 @@ program interp_restarts csfactory = CubedSphereGridFactory(im_world=npx-1,lm=npz,nx=npes_x,ny=npes_y,stretch_factor=schmidt_parameters(3), & target_lon=schmidt_parameters(1),target_lat=schmidt_parameters(2)) else - csfactory = CubedSphereGridFactory(im_world=npx-1,lm=npz,nx=npes_x,ny=npes_y) + csfactory = CubedSphereGridFactory(im_world=npx-1,lm=npz,nx=npes_x,ny=npes_y) end if - grid = grid_manager%make_grid(csfactory,rc=status) + grid = grid_manager%make_grid(csfactory,rc=status) FV_Atm(1)%flagstruct%Make_NH = .false. ! Do this after rescaling if (jm == 6*im) then @@ -367,7 +377,7 @@ program interp_restarts call print_memuse_stats('interp_restarts: going to write restarts') ! write fvcore_internal_rst - if( file_exist("fvcore_internal_restart_in") ) then + if( file_exists("fvcore_internal_restart_in") ) then write(fname1, "('fvcore_internal_rst_c',i4.4,'_',i3.3,'L')") npx-1,npz if (is_master()) print*, 'Writing : ', TRIM(fname1) @@ -385,7 +395,7 @@ program interp_restarts end if ! Headers - read (IUNIT, IOSTAT=status) header + read (IUNIT, IOSTAT=status) header if(n_writers > 1) then call Write_Parallel(HEADER, OUNIT, ARRDES=ARRDES, RC=status) VERIFY_(STATUS) @@ -395,7 +405,7 @@ program interp_restarts if (is_master()) print*, header read (IUNIT, IOSTAT=status) header(1:5) - if (is_master()) print*, header(1:5) + if (is_master()) print*, header(1:5) header(1) = (npx-1) header(2) = (npy-1)*6 header(3) = npz @@ -407,7 +417,7 @@ program interp_restarts if (amwriter) write(OUNIT) header(1:5) endif - if (is_master()) print*, header(1:5) + if (is_master()) print*, header(1:5) close(IUNIT) ! AK and BK @@ -528,7 +538,7 @@ program interp_restarts allocate(r4_local(is:ie,js:je,npz+1)) allocate(r4_local2D(is:ie,js:je)) - if( file_exist("moist_internal_restart_in") ) then + if( file_exists("moist_internal_restart_in") ) then write(fname1, "('moist_internal_rst_c',i4.4,'_',i3.3,'L')") npx-1,npz if (is_master()) print*, 'Writing : ', TRIM(fname1) call ArrDescrSet(arrdes,offset=0_MPI_OFFSET_KIND) @@ -565,12 +575,12 @@ program interp_restarts end if end if deallocate(r4_local) - + ! extra restarts ! do ifile=1,size(rst_files) - if (is_master()) write(*,*)'Writing results of ',trim(rst_files(ifile)%file_name) + if (is_master()) write(*,*)'Writing results of ',trim(rst_files(ifile)%file_name) fname1=extra_output(ifile) if (is_master()) print*, 'Writing : ', TRIM(fname1) call ArrDescrSet(arrdes,offset=0_MPI_OFFSET_KIND) diff --git a/rs_scale.F90 b/rs_scale.F90 index c5471cc..06a0359 100644 --- a/rs_scale.F90 +++ b/rs_scale.F90 @@ -108,7 +108,7 @@ program main open(unit=10, file=trim(dynrst), form='unformatted') open(unit=20, file=trim(mstrst), form='unformatted') - + ! ********************************************************************** ! **** Read dycore internal Restart **** ! ********************************************************************** @@ -295,7 +295,7 @@ program main do while ( dabs( pdrydif_ave ).gt.eps .and. iter.le.20 ) ! -------------------------------------- - + do n=1,5 qsum = 0.0_8 do L=1,lm @@ -506,7 +506,7 @@ program main ! check if we have ncpl and ncpi if (nVarsMoist == 9) then allocate( dum4(im,jm) ) - + do L=1,lm call MAPL_VarRead(InMoist,"NCPL",dum4,lev=l) call MAPL_VarWrite(OutMoist,"NCPL",dum4,lev=l) @@ -576,7 +576,12 @@ program main subroutine Get_Areas ( area,im,jm ) use ESMF - use constants_mod, only: cnst_radius=>radius +#if defined (SINGLE_FV) + use constantsr4_mod, & +#else + use constants_mod, & +#endif + only: cnst_radius=>radius use fv_grid_utils_mod, only: get_area use fv_arrays_mod, only: R_GRID implicit none @@ -638,7 +643,7 @@ end subroutine AppCSEdgeCreateF else ! Cube Area ! --------- - allocate(grid_lons(im+1,im+1,6)) + allocate(grid_lons(im+1,im+1,6)) allocate(grid_lats(im+1,im+1,6)) call AppCSEdgeCreateF(im,grid_lons,grid_lats) do k=1,6