diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt index 2bd027110..1bf6a8f74 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt @@ -52,18 +52,7 @@ endif () esma_add_library (${this} SRCS ${srcs} - DEPENDENCIES GEOS_Shared GMAO_mpeu MAPL fms_r4 Chem_Shared Chem_Base ESMF::ESMF TYPE SHARED) - -# We need to add_dependencies for fms_r4 because CMake doesn't know we -# need it for include purposes. In R4R8, we only ever link against -# fms_r8, so it doesn't know to build the target fms_r4 -# NOTE NOTE NOTE: This should *not* be included in GEOSgcm v12 -# because FMS is pre-built library in that case. -add_dependencies (${this} fms_r4) -get_target_property (extra_incs fms_r4 INCLUDE_DIRECTORIES) -target_include_directories(${this} PRIVATE - $ - ) + DEPENDENCIES GEOS_Shared GMAO_mpeu MAPL Chem_Shared Chem_Base ESMF::ESMF TYPE SHARED) file (GLOB_RECURSE rc_files CONFIGURE_DEPENDS RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} *.rc *.yaml) foreach ( file ${rc_files} ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_GFDL_1M_InterfaceMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_GFDL_1M_InterfaceMod.F90 index 69cfa8378..3c40fc35e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_GFDL_1M_InterfaceMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_GFDL_1M_InterfaceMod.F90 @@ -225,10 +225,7 @@ subroutine GFDL_1M_Initialize (MAPL, CF, IMPORT, EXPORT, RC) real, pointer, dimension(:,:,:) :: Q, QLLS, QLCN, QILS, QICN, QRAIN, QSNOW, QGRAUPEL - type(ESMF_VM) :: VM - integer :: comm - - call MAPL_GetResource( MAPL, LHYDROSTATIC, Label='HYDROSTATIC:', default=.TRUE., RC=STATUS) + call MAPL_GetResource( MAPL, LHYDROSTATIC, Label="HYDROSTATIC:", default=.TRUE., RC=STATUS) VERIFY_(STATUS) call MAPL_GetResource( MAPL, LPHYS_HYDROSTATIC, Label='PHYS_HYDROSTATIC:', default=.TRUE., RC=STATUS) VERIFY_(STATUS) @@ -256,10 +253,7 @@ subroutine GFDL_1M_Initialize (MAPL, CF, IMPORT, EXPORT, RC) call MAPL_GetPointer(INTERNAL, QILS, 'QILS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, QICN, 'QICN' , RC=STATUS); VERIFY_(STATUS) - call ESMF_VMGetCurrent(VM, _RC) - call ESMF_VMGet(VM, mpiCommunicator=comm, _RC) - - call gfdl_cloud_microphys_init(comm) + call gfdl_cloud_microphys_init() call WRITE_PARALLEL ("INITIALIZED GFDL_1M microphysics in non-generic GC INIT") call MAPL_GetResource(MAPL, USE_PYMOIST_GFDL1M, 'USE_PYMOIST_GFDL1M:', default=.FALSE., RC=STATUS); VERIFY_(STATUS) @@ -587,7 +581,7 @@ subroutine GFDL_1M_Run (GC, IMPORT, EXPORT, CLOCK, RC) QRAIN = QRAIN + PTR3D*DT_MOIST endif call MAPL_GetPointer(EXPORT, PTR3D, 'SHLW_SNO3', ALLOC=.TRUE., RC=STATUS); VERIFY_(STATUS) - if (associated(PTR3D)) then + if (associated(PTR3D)) then QSNOW = QSNOW + PTR3D*DT_MOIST endif ! evap/subl/pdf diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/gfdl_cloud_microphys.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/gfdl_cloud_microphys.F90 index 54702daad..d8d55eb42 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/gfdl_cloud_microphys.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/gfdl_cloud_microphys.F90 @@ -36,7 +36,7 @@ module gfdl2_cloud_microphys_mod - use mpp_mod, only: mpp_pe, mpp_root_pe + ! use mpp_mod, only: mpp_pe, mpp_root_pe ! use mpp_mod, only: stdlog, mpp_pe, mpp_root_pe, mpp_clock_id, & ! mpp_clock_begin, mpp_clock_end, clock_routine, & ! input_nml_file @@ -46,10 +46,11 @@ module gfdl2_cloud_microphys_mod ! use fms_mod, only: write_version_number, open_namelist_file, & ! check_nml_error, file_exist, close_file - use fms_mod, only: write_version_number, open_namelist_file, & - check_nml_error, close_file, file_exist, & - fms_init + !use fms_mod, only: write_version_number, open_namelist_file, & + ! check_nml_error, close_file, file_exist, & + ! fms_init use GEOSmoist_Process_Library, only: sigma, ice_fraction + use MAPL, only: MAPL_AM_I_ROOT implicit none @@ -405,8 +406,6 @@ subroutine gfdl_cloud_microphys_driver (qv, ql, qr, qi, qs, qg, qa, qn, & je = jje - jjs + 1 ke = kke - kks + 1 - ! call mpp_clock_begin (gfdl_mp_clock) - ! ----------------------------------------------------------------------- ! define heat capacity of dry air and water vapor based on hydrostatical property ! ----------------------------------------------------------------------- @@ -498,34 +497,6 @@ subroutine gfdl_cloud_microphys_driver (qv, ql, qr, qi, qs, qg, qa, qn, & enddo endif - ! ----------------------------------------------------------------------- - ! diagnostic output - ! ----------------------------------------------------------------------- - - ! if (id_vtr > 0) then - ! used = send_data (id_vtr, vt_r, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_vts > 0) then - ! used = send_data (id_vts, vt_s, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_vtg > 0) then - ! used = send_data (id_vtg, vt_g, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_vti > 0) then - ! used = send_data (id_vti, vt_i, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_droplets > 0) then - ! used = send_data (id_droplets, qn2, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_var > 0) then - ! used = send_data (id_var, w_var, time, is_in = iis, js_in = jjs) - ! endif - ! convert to mm / day convt = 86400. * rdt * rgrav @@ -539,74 +510,6 @@ subroutine gfdl_cloud_microphys_driver (qv, ql, qr, qi, qs, qg, qa, qn, & enddo enddo - ! if (id_cond > 0) then - ! do j = js, je - ! do i = is, ie - ! cond (i, j) = cond (i, j) * rgrav - ! enddo - ! enddo - ! used = send_data (id_cond, cond, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_snow > 0) then - ! used = send_data (id_snow, snow, time, iis, jjs) - ! used = send_data (id_snow, snow, time, is_in = iis, js_in = jjs) - ! if (mp_print .and. seconds == 0) then - ! tot_prec = g_sum (snow, is, ie, js, je, area, 1) - ! if (root_proc) write (*, *) 'mean snow = ', tot_prec - ! endif - ! endif - ! - ! if (id_graupel > 0) then - ! used = send_data (id_graupel, graupel, time, iis, jjs) - ! used = send_data (id_graupel, graupel, time, is_in = iis, js_in = jjs) - ! if (mp_print .and. seconds == 0) then - ! tot_prec = g_sum (graupel, is, ie, js, je, area, 1) - ! if (root_proc) write (*, *) 'mean graupel = ', tot_prec - ! endif - ! endif - ! - ! if (id_ice > 0) then - ! used = send_data (id_ice, ice, time, iis, jjs) - ! used = send_data (id_ice, ice, time, is_in = iis, js_in = jjs) - ! if (mp_print .and. seconds == 0) then - ! tot_prec = g_sum (ice, is, ie, js, je, area, 1) - ! if (root_proc) write (*, *) 'mean ice_mp = ', tot_prec - ! endif - ! endif - ! - ! if (id_rain > 0) then - ! used = send_data (id_rain, rain, time, iis, jjs) - ! used = send_data (id_rain, rain, time, is_in = iis, js_in = jjs) - ! if (mp_print .and. seconds == 0) then - ! tot_prec = g_sum (rain, is, ie, js, je, area, 1) - ! if (root_proc) write (*, *) 'mean rain = ', tot_prec - ! endif - ! endif - ! - ! if (id_rh > 0) then !not used? - ! used = send_data (id_rh, rh0, time, iis, jjs) - ! used = send_data (id_rh, rh0, time, is_in = iis, js_in = jjs) - ! endif - ! - ! - ! if (id_prec > 0) then - ! used = send_data (id_prec, prec_mp, time, iis, jjs) - ! used = send_data (id_prec, prec_mp, time, is_in = iis, js_in = jjs) - ! endif - - ! if (mp_print) then - ! prec1 (:, :) = prec1 (:, :) + prec_mp (:, :) - ! if (seconds == 0) then - ! prec1 (:, :) = prec1 (:, :) * dt_in / 86400. - ! tot_prec = g_sum (prec1, is, ie, js, je, area, 1) - ! if (root_proc) write (*, *) 'daily prec_mp = ', tot_prec - ! prec1 (:, :) = 0. - ! endif - ! endif - - ! call mpp_clock_end (gfdl_mp_clock) - end subroutine gfdl_cloud_microphys_driver ! ----------------------------------------------------------------------- @@ -3363,27 +3266,14 @@ end subroutine setupm !! cloud microphysics. ! ======================================================================= -subroutine gfdl_cloud_microphys_init (comm) +subroutine gfdl_cloud_microphys_init () implicit none - integer, intent(in) :: comm integer :: nlunit character (len = 64) :: fn_nml = 'input.nml' integer :: ios, ierr logical :: exists - ! integer, intent (in) :: id, jd, kd - ! integer, intent (in) :: axes (4) - ! type (time_type), intent (in) :: time - - ! integer :: unit, io, ierr, k, logunit - ! logical :: flag - ! real :: tmp, q1, q2 - - call fms_init(comm) - - ! root_proc = (mpp_pe () .eq.mpp_root_pe ()) - #ifdef INTERNAL_FILE_NML read (input_nml_file, nml = gfdl_cloud_microphysics_nml) #else @@ -3392,88 +3282,35 @@ subroutine gfdl_cloud_microphys_init (comm) write (6, *) 'gfdl - mp :: namelist file: ', trim (fn_nml), ' does not exist' stop else - nlunit=open_namelist_file() - rewind (nlunit) + !nlunit=open_namelist_file() + !rewind (nlunit) + open(NEWUNIT=nlunit,file=trim(fn_nml), form='formatted',access='sequential',iostat=ios) + if(ios /= 0) stop 'open namelist file gfdl_cloud_microphys_init failed, bailing out...' + rewind (nlunit, iostat=ios) + if(ios /= 0) stop 'rewind namelist file gfdl_cloud_microphys_init failed, bailing out...' ! Read Main namelist read (nlunit,gfdl_cloud_microphysics_nml,iostat=ios) - ierr = check_nml_error(ios,'gfdl_cloud_microphysics_nml') - call close_file(nlunit) + if(ios /= 0) stop 'read namelist gfdl_cloud_microphys_init failed, bailing out...' + !ierr = check_nml_error(ios,'gfdl_cloud_microphysics_nml') + !call close_file(nlunit) + close(nlunit, iostat=ios) + if(ios /= 0) stop 'close namelist file gfdl_cloud_microphys_init failed, bailing out...' endif #endif - if (mpp_pe() .EQ. mpp_root_pe()) then + if (MAPL_AM_I_ROOT()) then write (*, *) " ================================================================== " write (*, *) "gfdl_cloud_microphys_mod" write (*, nml = gfdl_cloud_microphysics_nml) write (*, *) " ================================================================== " endif - ! write version number and namelist to log file - !if (me == root_proc) then - ! write (logunit, *) " ================================================================== " - ! write (logunit, *) "gfdl_cloud_microphys_mod" - ! write (logunit, nml = gfdl_cloud_microphysics_nml) - !endif - if (do_setup) then call setup_con call setupm do_setup = .false. endif - ! if (root_proc) write (logunit, nml = gfdl_cloud_microphys_nml) - ! - ! id_vtr = register_diag_field (mod_name, 'vt_r', axes (1:3), time, & - ! 'rain fall speed', 'm / s', missing_value = missing_value) - ! id_vts = register_diag_field (mod_name, 'vt_s', axes (1:3), time, & - ! 'snow fall speed', 'm / s', missing_value = missing_value) - ! id_vtg = register_diag_field (mod_name, 'vt_g', axes (1:3), time, & - ! 'graupel fall speed', 'm / s', missing_value = missing_value) - ! id_vti = register_diag_field (mod_name, 'vt_i', axes (1:3), time, & - ! 'ice fall speed', 'm / s', missing_value = missing_value) - - ! id_droplets = register_diag_field (mod_name, 'droplets', axes (1:3), time, & - ! 'droplet number concentration', '# / m3', missing_value = missing_value) - ! id_rh = register_diag_field (mod_name, 'rh_lin', axes (1:2), time, & - ! 'relative humidity', 'n / a', missing_value = missing_value) - - ! id_rain = register_diag_field (mod_name, 'rain_lin', axes (1:2), time, & - ! 'rain_lin', 'mm / day', missing_value = missing_value) - ! id_snow = register_diag_field (mod_name, 'snow_lin', axes (1:2), time, & - ! 'snow_lin', 'mm / day', missing_value = missing_value) - ! id_graupel = register_diag_field (mod_name, 'graupel_lin', axes (1:2), time, & - ! 'graupel_lin', 'mm / day', missing_value = missing_value) - ! id_ice = register_diag_field (mod_name, 'ice_lin', axes (1:2), time, & - ! 'ice_lin', 'mm / day', missing_value = missing_value) - ! id_prec = register_diag_field (mod_name, 'prec_lin', axes (1:2), time, & - ! 'prec_lin', 'mm / day', missing_value = missing_value) - - ! if (root_proc) write (*, *) 'prec_lin diagnostics initialized.', id_prec - - ! id_cond = register_diag_field (mod_name, 'cond_lin', axes (1:2), time, & - ! 'total condensate', 'kg / m ** 2', missing_value = missing_value) - ! id_var = register_diag_field (mod_name, 'var_lin', axes (1:2), time, & - ! 'subgrid variance', 'n / a', missing_value = missing_value) - - ! call qsmith_init - - ! testing the water vapor tables - - ! if (mp_debug .and. root_proc) then - ! write (*, *) 'testing water vapor tables in gfdl_cloud_microphys' - ! tmp = tice - 90. - ! do k = 1, 25 - ! q1 = wqsat_moist (tmp, 0., 1.e5) - ! q2 = qs1d_m (tmp, 0., 1.e5) - ! write (*, *) nint (tmp - tice), q1, q2, 'dq = ', q1 - q2 - ! tmp = tmp + 5. - ! enddo - ! endif - - ! if (root_proc) write (*, *) 'gfdl_cloud_micrphys diagnostics initialized.' - - ! gfdl_mp_clock = mpp_clock_id ('gfdl_cloud_microphys', grain = clock_routine) - module_is_initialized = .true. end subroutine gfdl_cloud_microphys_init @@ -3510,8 +3347,6 @@ subroutine setup_con implicit none - ! root_proc = (mpp_pe () .eq.mpp_root_pe ()) - rgrav = 1. / grav if (.not. qsmith_tables_initialized) call qsmith_init @@ -3605,15 +3440,6 @@ subroutine qsmith_init if (.not. tables_are_initialized) then - ! root_proc = (mpp_pe () .eq. mpp_root_pe ()) - ! if (root_proc) print *, ' gfdl mp: initializing qs tables' - - ! debug code - ! print *, mpp_pe (), allocated (table), allocated (table2), & - ! allocated (table3), allocated (tablew), allocated (des), & - ! allocated (des2), allocated (des3), allocated (desw) - ! end debug code - ! generate es table (dt = 0.1 deg. c) allocate (table (length)) @@ -4454,52 +4280,6 @@ subroutine neg_adj (ktop, kbot, pt, dp, qv, ql, qr, qi, qs, qg) end subroutine neg_adj -! ======================================================================= -! compute global sum -!>@brief quick local sum algorithm -! ======================================================================= - -!real function g_sum (p, ifirst, ilast, jfirst, jlast, area, mode) -! -! use mpp_mod, only: mpp_sum -! -! implicit none -! -! integer, intent (in) :: ifirst, ilast, jfirst, jlast -! integer, intent (in) :: mode ! if == 1 divided by area -! -! real, intent (in), dimension (ifirst:ilast, jfirst:jlast) :: p, area -! -! integer :: i, j -! -! real :: gsum -! -! if (global_area < 0.) then -! global_area = 0. -! do j = jfirst, jlast -! do i = ifirst, ilast -! global_area = global_area + area (i, j) -! enddo -! enddo -! call mpp_sum (global_area) -! endif -! -! gsum = 0. -! do j = jfirst, jlast -! do i = ifirst, ilast -! gsum = gsum + p (i, j) * area (i, j) -! enddo -! enddo -! call mpp_sum (gsum) -! -! if (mode == 1) then -! g_sum = gsum / global_area -! else -! g_sum = gsum -! endif -! -!end function g_sum - ! ========================================================================== !>@brief The subroutine 'interpolate_z' interpolates to a prescribed height. ! ==========================================================================