diff --git a/atmos_drivers/coupled/atmos_model.F90 b/atmos_drivers/coupled/atmos_model.F90 deleted file mode 100644 index 527711d2..00000000 --- a/atmos_drivers/coupled/atmos_model.F90 +++ /dev/null @@ -1,835 +0,0 @@ - -!*********************************************************************** -!* GNU Lesser General Public License -!* -!* This file is part of the GFDL Atmos Drivers project. -!* -!* This is free software: you can redistribute it and/or modify it under -!* the terms of the GNU Lesser General Public License as published by -!* the Free Software Foundation, either version 3 of the License, or (at -!* your option) any later version. -!* -!* It is distributed in the hope that it will be useful, but WITHOUT -!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -!* for more details. -!* -!* You should have received a copy of the GNU Lesser General Public -!* License along with FMS. If not, see . -!*********************************************************************** - -module atmos_model_mod -!----------------------------------------------------------------------- -! -! Driver for the atmospheric model, contains routines to advance the -! atmospheric model state by one time step. -! - -! -! This version of atmos_model_mod has been designed around the implicit -! version diffusion scheme of the GCM. It requires two routines to advance -! the atmospheric model one time step into the future. These two routines -! correspond to the down and up sweeps of the standard tridiagonal solver. -! Most atmospheric processes (dynamics,radiation,etc.) are performed -! in the down routine. The up routine finishes the vertical diffusion -! and computes moisture related terms (convection,large-scale condensation, -! and precipitation). - -! The boundary variables needed by other component models for coupling -! are contained in a derived data type. A variable of this derived type -! is returned when initializing the atmospheric model. It is used by other -! routines in this module and by coupling routines. The contents of -! this derived type should only be modified by the atmospheric model. - -! - -use mpp_mod, only: mpp_pe, mpp_root_pe, mpp_clock_id, mpp_clock_begin -use mpp_mod, only: mpp_clock_end, CLOCK_COMPONENT, MPP_CLOCK_SYNC -use mpp_mod, only: mpp_min, mpp_max, mpp_error, mpp_chksum -use mpp_domains_mod, only: domain2d -use mpp_mod, only: mpp_get_current_pelist_name -#ifdef INTERNAL_FILE_NML -use mpp_mod, only: input_nml_file -#else -use fms_mod, only: open_namelist_file -#endif -use fms_mod, only: file_exist, error_mesg -use fms_mod, only: close_file, write_version_number, stdlog, stdout -use fms_mod, only: clock_flag_default -use fms_mod, only: check_nml_error -use diag_manager_mod, only: diag_send_complete_instant -use time_manager_mod, only: time_type, get_time, get_date, & - operator(+), operator(-) -use field_manager_mod, only: MODEL_ATMOS -use tracer_manager_mod, only: get_number_tracers, get_tracer_names -use xgrid_mod, only: grid_box_type -use atmosphere_mod, only: atmosphere_init -use atmosphere_mod, only: atmosphere_restart -use atmosphere_mod, only: atmosphere_end -use atmosphere_mod, only: atmosphere_state_update -use atmosphere_mod, only: atmos_phys_driver_statein -use atmosphere_mod, only: atmosphere_control_data -use atmosphere_mod, only: atmosphere_resolution, atmosphere_domain -use atmosphere_mod, only: atmosphere_grid_bdry, atmosphere_grid_ctr -use atmosphere_mod, only: atmosphere_dynamics, atmosphere_diag_axes -use atmosphere_mod, only: atmosphere_etalvls, atmosphere_hgt -!rab use atmosphere_mod, only: atmosphere_tracer_postinit -use atmosphere_mod, only: atmosphere_diss_est, atmosphere_nggps_diag -use atmosphere_mod, only: atmosphere_scalar_field_halo -use atmosphere_mod, only: set_atmosphere_pelist -use atmosphere_mod, only: atmosphere_coarse_graining_parameters -use atmosphere_mod, only: atmosphere_coarse_diag_axes -use atmosphere_mod, only: atmosphere_coarsening_strategy -use atmosphere_mod, only: Atm, mygrid -use block_control_mod, only: block_control_type, define_blocks_packed -use IPD_typedefs, only: IPD_init_type, IPD_control_type, & - IPD_data_type, IPD_diag_type, & - IPD_restart_type, kind_phys -use IPD_driver, only: IPD_initialize, IPD_setup_step, & - IPD_radiation_step, & - IPD_physics_step1, & - IPD_physics_step2, IPD_physics_end -#ifdef STOCHY -use stochastic_physics, only: init_stochastic_physics, & - run_stochastic_physics -use stochastic_physics_sfc, only: run_stochastic_physics_sfc -#endif -use FV3GFS_io_mod, only: FV3GFS_restart_read, FV3GFS_restart_write, & - FV3GFS_IPD_checksum, & - gfdl_diag_register, gfdl_diag_output, & - FV3GFS_restart_write_coarse, FV3GFS_diag_register_coarse, & - sfc_data_override -use FV3GFS_io_mod, only: register_diag_manager_controlled_diagnostics, register_coarse_diag_manager_controlled_diagnostics -use FV3GFS_io_mod, only: send_diag_manager_controlled_diagnostic_data -use fv_iau_mod, only: iau_external_data_type,getiauforcing,iau_initialize -use module_ocean, only: ocean_init -!----------------------------------------------------------------------- - -implicit none -private - -public update_atmos_radiation_physics -public update_atmos_model_state -public update_atmos_model_dynamics -public atmos_model_init, atmos_model_end, atmos_data_type -public atmos_model_restart -!----------------------------------------------------------------------- - -! - type atmos_data_type - type (domain2d) :: domain ! domain decomposition - type (domain2d) :: domain_for_read ! domain decomposition for reads - integer :: axes(4) ! axis indices (returned by diag_manager) for the atmospheric grid - ! (they correspond to the x, y, pfull, phalf axes) - real, pointer, dimension(:,:) :: lon_bnd => null() ! local longitude axis grid box corners in radians. - real, pointer, dimension(:,:) :: lat_bnd => null() ! local latitude axis grid box corners in radians. - real(kind=kind_phys), pointer, dimension(:,:) :: lon => null() ! local longitude axis grid box centers in radians. - real(kind=kind_phys), pointer, dimension(:,:) :: lat => null() ! local latitude axis grid box centers in radians. - type (time_type) :: Time ! current time - type (time_type) :: Time_step ! atmospheric time step. - type (time_type) :: Time_init ! reference time. - integer :: iau_offset ! iau running window length - integer, pointer :: pelist(:) =>null() ! pelist where atmosphere is running. - logical :: pe ! current pe. - type(grid_box_type) :: grid ! hold grid information needed for 2nd order conservative flux exchange - ! to calculate gradient on cubic sphere grid. - integer :: layout(2) ! computer task laytout - logical :: regional ! true if domain is regional - logical :: bounded_domain ! true if domain is bounded - real(kind=8), pointer, dimension(:) :: ak - real(kind=8), pointer, dimension(:) :: bk - real(kind=8), pointer, dimension(:,:,:) :: layer_hgt - real(kind=8), pointer, dimension(:,:,:) :: level_hgt - real(kind=kind_phys), pointer, dimension(:,:) :: dx - real(kind=kind_phys), pointer, dimension(:,:) :: dy - real(kind=8), pointer, dimension(:,:) :: area - type(domain2d) :: coarse_domain ! domain decomposition of the coarse grid - logical :: write_coarse_restart_files ! whether to write coarse restart files - logical :: write_only_coarse_intermediate_restarts ! whether to write only coarse intermediate restart files - character(len=64) :: coarsening_strategy ! Strategy for coarse-graining diagnostics and restart files -end type atmos_data_type -! - -integer :: fv3Clock, getClock, overrideClock, updClock, setupClock, radClock, physClock - -!----------------------------------------------------------------------- -integer :: blocksize = 1 -logical :: chksum_debug = .false. -logical :: dycore_only = .false. -logical :: debug = .false. -logical :: sync = .false. -logical :: first_time_step = .false. -logical :: fprint = .true. -logical :: enforce_rst_cksum = .true. ! enforce or override data integrity restart checksums -real, dimension(4096) :: fdiag = 0. ! xic: TODO: this is hard coded, space can run out in some cases. Should make it allocatable. -logical :: fdiag_override = .false. ! lmh: if true overrides fdiag and fhzer: all quantities are zeroed out - ! after every calcluation, output interval and accumulation/avg/max/min - ! are controlled by diag_manager, fdiag controls output interval only -namelist /atmos_model_nml/ blocksize, chksum_debug, dycore_only, debug, sync, first_time_step, fdiag, fprint, & - fdiag_override, enforce_rst_cksum -type (time_type) :: diag_time, diag_time_fhzero -logical :: fdiag_fix = .false. - -!--- concurrent and decoupled radiation and physics variables -!---------------- -! IPD containers -!---------------- -type(IPD_control_type) :: IPD_Control -type(IPD_data_type), allocatable :: IPD_Data(:) ! number of blocks -type(IPD_diag_type) :: IPD_Diag(250) -type(IPD_restart_type) :: IPD_Restart - -!-------------- -! IAU container -!-------------- -type(iau_external_data_type) :: IAU_Data - -!----------------- -! Block container -!----------------- -type (block_control_type), target :: Atm_block - -!----------------------------------------------------------------------- - -character(len=128) :: version = '$Id$' -character(len=128) :: tagname = '$Name$' - -real(kind=kind_phys), parameter :: zero = 0.0_kind_phys - -contains - -!####################################################################### -! -! -! -! Called every time step as the atmospheric driver to compute the -! atmospheric tendencies for dynamics, radiation, vertical diffusion of -! momentum, tracers, and heat/moisture. For heat/moisture only the -! downward sweep of the tridiagonal elimination is performed, hence -! the name "_down". -! - -! - -! -! Derived-type variable that contains fields needed by the flux exchange module. -! These fields describe the atmospheric grid and are needed to -! compute/exchange fluxes with other component models. All fields in this -! variable type are allocated for the global grid (without halo regions). -! - -subroutine update_atmos_radiation_physics (Atmos) -!----------------------------------------------------------------------- - type (atmos_data_type), intent(in) :: Atmos -!--- local variables--- - integer :: nb, jdat(8) - integer :: nthrds - -#ifdef OPENMP - nthrds = omp_get_max_threads() -#else - nthrds = 1 -#endif - - if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "statein driver" -!--- get atmospheric state from the dynamic core - call set_atmosphere_pelist() - call mpp_clock_begin(getClock) - if (IPD_control%do_skeb) call atmosphere_diss_est (IPD_control%skeb_npass) ! do smoothing for SKEB - call atmos_phys_driver_statein (IPD_data, Atm_block) - call mpp_clock_end(getClock) - -!--- get varied surface data - call mpp_clock_begin(overrideClock) - call sfc_data_override (Atmos%Time, IPD_data, Atm_block, IPD_Control) - call mpp_clock_end(overrideClock) - -!--- if dycore only run, set up the dummy physics output state as the input state - if (dycore_only) then - do nb = 1,Atm_block%nblks - IPD_Data(nb)%Stateout%gu0 = IPD_Data(nb)%Statein%ugrs - IPD_Data(nb)%Stateout%gv0 = IPD_Data(nb)%Statein%vgrs - IPD_Data(nb)%Stateout%gt0 = IPD_Data(nb)%Statein%tgrs - IPD_Data(nb)%Stateout%gq0 = IPD_Data(nb)%Statein%qgrs - enddo - else - if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "setup step" - -!--- update IPD_Control%jdat(8) - jdat(:) = 0 - call get_date (Atmos%Time, jdat(1), jdat(2), jdat(3), & - jdat(5), jdat(6), jdat(7)) - IPD_Control%jdat(:) = jdat(:) -!--- execute the IPD atmospheric setup step - call mpp_clock_begin(setupClock) - call IPD_setup_step (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart) - -#ifdef STOCHY -!--- call stochastic physics pattern generation / cellular automata - if (IPD_Control%do_sppt .OR. IPD_Control%do_shum .OR. IPD_Control%do_skeb .OR. IPD_Control%do_sfcperts) then - call run_stochastic_physics(IPD_Control, IPD_Data(:)%Grid, IPD_Data(:)%Coupling, nthrds) - end if -#endif - - call mpp_clock_end(setupClock) - - if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "radiation driver" -!--- execute the IPD atmospheric radiation subcomponent (RRTM) - call mpp_clock_begin(radClock) -!$OMP parallel do default (none) & -!$OMP schedule (dynamic,1), & -!$OMP shared (Atm_block, IPD_Control, IPD_Data, IPD_Diag, IPD_Restart) & -!$OMP private (nb) - do nb = 1,Atm_block%nblks - call IPD_radiation_step (IPD_Control, IPD_Data(nb), IPD_Diag, IPD_Restart) - enddo - call mpp_clock_end(radClock) - - if (chksum_debug) then - if (mpp_pe() == mpp_root_pe()) print *,'RADIATION STEP ', IPD_Control%kdt, IPD_Control%fhour - call FV3GFS_IPD_checksum(IPD_Control, IPD_Data, Atm_block) - endif - - if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "physics driver" -!--- execute the IPD atmospheric physics step1 subcomponent (main physics driver) - call mpp_clock_begin(physClock) -!$OMP parallel do default (none) & -!$OMP schedule (dynamic,1), & -!$OMP shared (Atm_block, IPD_Control, IPD_Data, IPD_Diag, IPD_Restart) & -!$OMP private (nb) - do nb = 1,Atm_block%nblks - call IPD_physics_step1 (IPD_Control, IPD_Data(nb), IPD_Diag, IPD_Restart) - enddo - call mpp_clock_end(physClock) - - if (chksum_debug) then - if (mpp_pe() == mpp_root_pe()) print *,'PHYSICS STEP1 ', IPD_Control%kdt, IPD_Control%fhour - call FV3GFS_IPD_checksum(IPD_Control, IPD_Data, Atm_block) - endif - - if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "stochastic physics driver" -!--- execute the IPD atmospheric physics step2 subcomponent (stochastic physics driver) - call mpp_clock_begin(physClock) -!$OMP parallel do default (none) & -!$OMP schedule (dynamic,1), & -!$OMP shared (Atm_block, IPD_Control, IPD_Data, IPD_Diag, IPD_Restart) & -!$OMP private (nb) - do nb = 1,Atm_block%nblks - call IPD_physics_step2 (IPD_Control, IPD_Data(nb), IPD_Diag, IPD_Restart) - enddo - call mpp_clock_end(physClock) - - if (chksum_debug) then - if (mpp_pe() == mpp_root_pe()) print *,'PHYSICS STEP2 ', IPD_Control%kdt, IPD_Control%fhour - call FV3GFS_IPD_checksum(IPD_Control, IPD_Data, Atm_block) - endif - call getiauforcing(IPD_Control,IAU_data) - if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "end of radiation and physics step" - endif - -!----------------------------------------------------------------------- - end subroutine update_atmos_radiation_physics -! - - -!####################################################################### -! -! -! -! Routine to initialize the atmospheric model -! - -subroutine atmos_model_init (Atmos, Time_init, Time, Time_step, iau_offset) - -#ifdef OPENMP - use omp_lib -#endif - use mpp_mod, only: mpp_npes - - type (atmos_data_type), intent(inout) :: Atmos - type (time_type), intent(in) :: Time_init, Time, Time_step - integer, intent(in) :: iau_offset -!--- local variables --- - integer :: unit, ntdiag, ntfamily, i, j, k - integer :: mlon, mlat, nlon, nlat, nlev, sec, dt, sec_prev - integer :: ierr, io, logunit - integer :: idx, tile_num - integer :: isc, iec, jsc, jec - integer :: isd, ied, jsd, jed - integer :: blk, ibs, ibe, jbs, jbe - real(kind=kind_phys) :: dt_phys - real, allocatable :: q(:,:,:,:), p_half(:,:,:) - character(len=80) :: control - character(len=64) :: filename, filename2, pelist_name - character(len=132) :: text - logical :: p_hydro, hydro, fexist - logical, save :: block_message = .true. - type(IPD_init_type) :: Init_parm - integer :: bdat(8), cdat(8) - integer :: ntracers - integer :: kdt_prev - character(len=32), allocatable, target :: tracer_names(:) - integer :: coarse_diagnostic_axes(4) - integer :: nthrds - !----------------------------------------------------------------------- - -!---- set the atmospheric model time ------ - - Atmos % Time_init = Time_init - Atmos % Time = Time - Atmos % Time_step = Time_step - Atmos % iau_offset = iau_offset - call get_time (Atmos % Time_step, sec) - call get_time (Atmos%Time - Atmos%Time_init, sec_prev) - dt_phys = real(sec) ! integer seconds - kdt_prev = int(sec_prev / dt_phys) - - logunit = stdlog() - -!----------------------------------------------------------------------- -! initialize atmospheric model ----- - -!---------- initialize atmospheric dynamics ------- - call atmosphere_init (Atmos%Time_init, Atmos%Time, Atmos%Time_step,& - Atmos%grid, Atmos%area, IAU_Data) - - IF ( file_exist('input.nml')) THEN -#ifdef INTERNAL_FILE_NML - read(input_nml_file, nml=atmos_model_nml, iostat=io) - ierr = check_nml_error(io, 'atmos_model_nml') -#else - unit = open_namelist_file ( ) - ierr=1 - do while (ierr /= 0) - read (unit, nml=atmos_model_nml, iostat=io, end=10) - ierr = check_nml_error(io,'atmos_model_nml') - enddo - 10 call close_file (unit) -#endif - endif -!----------------------------------------------------------------------- - call atmosphere_resolution (nlon, nlat, global=.false.) - call atmosphere_resolution (mlon, mlat, global=.true.) - call alloc_atmos_data_type (nlon, nlat, Atmos) - call atmosphere_domain (Atmos%domain, Atmos%domain_for_read, Atmos%layout, Atmos%regional, & - Atmos%bounded_domain) - call atmosphere_diag_axes (Atmos%axes) - call atmosphere_etalvls (Atmos%ak, Atmos%bk, flip=.true.) - call atmosphere_grid_bdry (Atmos%lon_bnd, Atmos%lat_bnd, global=.false.) - call atmosphere_grid_ctr (Atmos%lon, Atmos%lat) - call atmosphere_hgt (Atmos%layer_hgt, 'layer', relative=.false., flip=.true.) - call atmosphere_hgt (Atmos%level_hgt, 'level', relative=.false., flip=.true.) - call atmosphere_coarse_graining_parameters(Atmos%coarse_domain, Atmos%write_coarse_restart_files, & - Atmos%write_only_coarse_intermediate_restarts) - call atmosphere_coarsening_strategy(Atmos%coarsening_strategy) - -!----------------------------------------------------------------------- -!--- before going any further check definitions for 'blocks' -!----------------------------------------------------------------------- - call atmosphere_control_data (isc, iec, jsc, jec, nlev, p_hydro, hydro, tile_num) - call define_blocks_packed ('atmos_model', Atm_block, isc, iec, jsc, jec, nlev, & - blocksize, block_message) - - allocate(IPD_Data(Atm_block%nblks)) - -#ifdef OPENMP - nthrds = omp_get_max_threads() -#else - nthrds = 1 -#endif - -!--- update IPD_Control%jdat(8) - bdat(:) = 0 - call get_date (Time_init, bdat(1), bdat(2), bdat(3), & - bdat(5), bdat(6), bdat(7)) - cdat(:) = 0 - call get_date (Time, cdat(1), cdat(2), cdat(3), & - cdat(5), cdat(6), cdat(7)) - call get_number_tracers(MODEL_ATMOS, num_tracers=ntracers) - allocate (tracer_names(ntracers)) - do i = 1, ntracers - call get_tracer_names(MODEL_ATMOS, i, tracer_names(i)) - enddo -!--- setup IPD Init_parm - Init_parm%me = mpp_pe() - Init_parm%master = mpp_root_pe() - Init_parm%tile_num = tile_num - Init_parm%isc = isc - Init_parm%jsc = jsc - Init_parm%nx = nlon - Init_parm%ny = nlat - Init_parm%levs = nlev - Init_parm%cnx = mlon - Init_parm%cny = mlat - Init_parm%gnx = Init_parm%cnx*4 - Init_parm%gny = Init_parm%cny*2 - Init_parm%nlunit = 9999 - Init_parm%logunit = logunit - Init_parm%bdat(:) = bdat(:) - Init_parm%cdat(:) = cdat(:) - Init_parm%dt_dycore = dt_phys - Init_parm%dt_phys = dt_phys - Init_parm%iau_offset = Atmos%iau_offset - Init_parm%blksz => Atm_block%blksz - Init_parm%ak => Atmos%ak - Init_parm%bk => Atmos%bk - Init_parm%xlon => Atmos%lon - Init_parm%xlat => Atmos%lat - Init_parm%area => Atmos%area - Init_parm%tracer_names => tracer_names - -#ifdef INTERNAL_FILE_NML - allocate(Init_parm%input_nml_file, mold=input_nml_file) - Init_parm%input_nml_file => input_nml_file - Init_parm%fn_nml='using internal file' -#else - pelist_name=mpp_get_current_pelist_name() - Init_parm%fn_nml='input_'//trim(pelist_name)//'.nml' - inquire(FILE=Init_parm%fn_nml, EXIST=fexist) - if (.not. fexist ) then - Init_parm%fn_nml='input.nml' - endif -#endif - - call IPD_initialize (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, Init_parm) - -#ifdef STOCHY - if (IPD_Control%do_sppt .OR. IPD_Control%do_shum .OR. IPD_Control%do_skeb .OR. IPD_Control%do_sfcperts) then - ! Initialize stochastic physics - call init_stochastic_physics(IPD_Control, Init_parm, mpp_npes(), nthrds) - if (mpp_pe() == mpp_root_pe()) print *,'do_skeb=',IPD_Control%do_skeb - end if - - if (IPD_Control%do_sfcperts) then - ! Get land surface perturbations here (move to GFS_time_vary - ! step if wanting to update each time-step) - call run_stochastic_physics_sfc(IPD_Control, IPD_Data(:)%Grid, IPD_Data(:)%Coupling) - end if -#endif - - Atm(mygrid)%flagstruct%do_diss_est = IPD_Control%do_skeb - -! initialize the IAU module - call iau_initialize (IPD_Control,IAU_data,Init_parm) - - IPD_Control%kdt_prev = kdt_prev - -!--- initialize slab ocean model or mixed layer ocean model -#ifdef INTERNAL_FILE_NML - if (IPD_Control%do_ocean) call ocean_init (IPD_Control, Init_parm%logunit, input_nml_file) -#else - if (IPD_Control%do_ocean) call ocean_init (IPD_Control, Init_parm%logunit) -#endif - - Init_parm%blksz => null() - Init_parm%ak => null() - Init_parm%bk => null() - Init_parm%xlon => null() - Init_parm%xlat => null() - Init_parm%area => null() - Init_parm%tracer_names => null() - deallocate (tracer_names) - - !--- update tracers in FV3 with any initialized during the physics/radiation init phase -!rab call atmosphere_tracer_postinit (IPD_Data, Atm_block) - - call atmosphere_nggps_diag (Time, init=.true.) - call gfdl_diag_register (Time, IPD_Data(:)%Sfcprop, IPD_Data(:)%IntDiag, IPD_Data%Cldprop, & - Atm_block, Atmos%axes, IPD_Control%nfxr, IPD_Control%ldiag3d, & - IPD_Control%nkld, IPD_Control%levs) - call register_diag_manager_controlled_diagnostics(Time, IPD_Data(:)%IntDiag, Atm_block%nblks, Atmos%axes) - if (Atm(mygrid)%coarse_graining%write_coarse_diagnostics) then - call atmosphere_coarse_diag_axes(coarse_diagnostic_axes) - call FV3GFS_diag_register_coarse(Time, coarse_diagnostic_axes) - call register_coarse_diag_manager_controlled_diagnostics(Time, coarse_diagnostic_axes) - endif - if (.not. dycore_only) & - call FV3GFS_restart_read (IPD_Data, IPD_Restart, Atm_block, IPD_Control, Atmos%domain_for_read, enforce_rst_cksum) - if (chksum_debug) then - if (mpp_pe() == mpp_root_pe()) print *,'RESTART READ ', IPD_Control%kdt, IPD_Control%fhour - call FV3GFS_IPD_checksum(IPD_Control, IPD_Data, Atm_block) - endif - - !--- set the initial diagnostic timestamp - diag_time = Time - if (Atmos%iau_offset > zero) then - call get_time (Atmos%Time - Atmos%Time_init, sec) - if (sec < Atmos%iau_offset*3600) then - diag_time = Atmos%Time_init - diag_time_fhzero = Atmos%Time - endif - endif - - !---- print version number to logfile ---- - - call write_version_number ( version, tagname ) - !--- write the namelist to a log file - if (mpp_pe() == mpp_root_pe()) then - unit = stdlog( ) - write (unit, nml=atmos_model_nml) - call close_file (unit) - endif - - !--- get fdiag -#ifdef GFS_PHYS -!--- check fdiag to see if it is an interval or a list - if (fdiag_override) then - if (mpp_pe() == mpp_root_pe()) write(6,*) "---OVERRIDING fdiag: USING SETTINGS IN diag_table for GFS PHYSICS DIAGS" - IPD_Control%fhzero = dt_phys / 3600. - if (mpp_pe() == mpp_root_pe()) write(6,*) "---fhzero IS SET TO dt_atmos: ALL DIAGNOSTICS ARE SINGLE-STEP" - else - if (nint(fdiag(2)) == 0) then - fdiag_fix = .true. - do i = 2, size(fdiag,1) - fdiag(i) = fdiag(1) * i - enddo - endif - if (mpp_pe() == mpp_root_pe()) write(6,*) "---fdiag",fdiag(1:40) - endif -#endif - - setupClock = mpp_clock_id( 'GFS Step Setup ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) - overrideClock = mpp_clock_id( 'GFS Override ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) - radClock = mpp_clock_id( 'GFS Radiation ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) - physClock = mpp_clock_id( 'GFS Physics ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) - getClock = mpp_clock_id( 'Dynamics get state ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) - updClock = mpp_clock_id( 'Dynamics update state ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) - if (sync) then - fv3Clock = mpp_clock_id( 'FV3 Dycore ', flags=clock_flag_default+MPP_CLOCK_SYNC, grain=CLOCK_COMPONENT ) - else - fv3Clock = mpp_clock_id( 'FV3 Dycore ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) - endif - -!----------------------------------------------------------------------- -end subroutine atmos_model_init -! - - -!####################################################################### -! -subroutine update_atmos_model_dynamics (Atmos) -! run the atmospheric dynamics to advect the properties - type (atmos_data_type), intent(in) :: Atmos - - call set_atmosphere_pelist() - call mpp_clock_begin(fv3Clock) - call atmosphere_dynamics (Atmos%Time) - call mpp_clock_end(fv3Clock) - -end subroutine update_atmos_model_dynamics -! - - -!####################################################################### -! -subroutine update_atmos_model_state (Atmos) -! to update the model state after all concurrency is completed - type (atmos_data_type), intent(inout) :: Atmos -!--- local variables - integer :: isec,seconds,isec_fhzero - real(kind=kind_phys) :: time_int, time_intfull - integer :: is, ie, js, je, kt - - call set_atmosphere_pelist() - call mpp_clock_begin(fv3Clock) - call mpp_clock_begin(updClock) - call atmosphere_state_update (Atmos%Time, IPD_Data, IAU_Data, Atm_block) - call mpp_clock_end(updClock) - call mpp_clock_end(fv3Clock) - - if (chksum_debug) then - if (mpp_pe() == mpp_root_pe()) print *,'UPDATE STATE ', IPD_Control%kdt, IPD_Control%fhour - call FV3GFS_IPD_checksum(IPD_Control, IPD_Data, Atm_block) - endif - -!------ advance time ------ - Atmos % Time = Atmos % Time + Atmos % Time_step - - call atmosphere_control_data(is, ie, js, je, kt) - call send_diag_manager_controlled_diagnostic_data(Atmos%Time, & - Atm_block, IPD_Data, IPD_Control%nx, IPD_Control%ny, IPD_Control%levs, & - Atm(mygrid)%coarse_graining%write_coarse_diagnostics, & - real(Atm(mygrid)%delp(is:ie,js:je,:), kind=kind_phys), & - Atmos%coarsening_strategy, real(Atm(mygrid)%ptop, kind=kind_phys)) - - call get_time (Atmos%Time - diag_time, isec) - call get_time (Atmos%Time - Atmos%Time_init, seconds) - - time_int = real(isec) - if (ANY(nint(fdiag(:)*3600.0) == seconds) .or. (fdiag_fix .and. mod(seconds, nint(fdiag(1)*3600.0)) .eq. 0) .or. (IPD_Control%kdt == 1 .and. first_time_step) ) then - if (mpp_pe() == mpp_root_pe()) write(6,*) "---isec,seconds",isec,seconds - if (mpp_pe() == mpp_root_pe()) write(6,*) ' gfs diags time since last bucket empty: ',time_int/3600.,'hrs' - call atmosphere_nggps_diag(Atmos%Time) - endif - if (ANY(nint(fdiag(:)*3600.0) == seconds) .or. (fdiag_fix .and. mod(seconds, nint(fdiag(1)*3600.0)) .eq. 0) .or. (IPD_Control%kdt == 1 .and. first_time_step)) then - if(Atmos%iau_offset > zero) then - if( time_int - Atmos%iau_offset*3600. > zero ) then - time_int = time_int - Atmos%iau_offset*3600. - else if(seconds == Atmos%iau_offset*3600) then - call get_time (Atmos%Time - diag_time_fhzero, isec_fhzero) - time_int = real(isec_fhzero) - if (mpp_pe() == mpp_root_pe()) write(6,*) "---iseczero",isec_fhzero - endif - endif - time_intfull = real(seconds) - if(Atmos%iau_offset > zero) then - if( time_intfull - Atmos%iau_offset*3600. > zero) then - time_intfull = time_intfull - Atmos%iau_offset*3600. - endif - endif - call gfdl_diag_output(Atmos%Time, Atm_block, IPD_Data, IPD_Control%nx, IPD_Control%ny, fprint, & - IPD_Control%levs, 1, 1, 1.d0, time_int, time_intfull, & - IPD_Control%fhswr, IPD_Control%fhlwr, & - mod(seconds, nint(fdiag(1)*3600.0)) .eq. 0, & - Atm(mygrid)%coarse_graining%write_coarse_diagnostics,& - real(Atm(mygrid)%delp(is:ie,js:je,:), kind=kind_phys), & - Atmos%coarsening_strategy, real(Atm(mygrid)%ptop, kind=kind_phys)) - call diag_send_complete_instant (Atmos%Time) - if (mod(isec,nint(3600*IPD_Control%fhzero)) == 0) diag_time = Atmos%Time - endif - - end subroutine update_atmos_model_state -! - - - -!####################################################################### -! -! -! -! termination routine for atmospheric model -! - -! -! Call once to terminate this module and any other modules used. -! This routine writes a restart file and deallocates storage -! used by the derived-type variable atmos_boundary_data_type. -! - -! - -! -! Derived-type variable that contains fields needed by the flux exchange module. -! - -subroutine atmos_model_end (Atmos) - type (atmos_data_type), intent(inout) :: Atmos -!---local variables - integer :: idx - - call IPD_physics_end (IPD_Control) - -!----------------------------------------------------------------------- -!---- termination routine for atmospheric model ---- - - call atmosphere_end (Atmos % Time, Atmos%grid) - if (.not. dycore_only) then - call FV3GFS_restart_write (IPD_Data, IPD_Restart, Atm_block, & - IPD_Control, Atmos%domain) - if (Atmos%write_coarse_restart_files) then - call FV3GFS_restart_write_coarse(IPD_Data, IPD_Restart, Atm_block, & - IPD_Control, Atmos%coarse_domain) - endif - endif - -end subroutine atmos_model_end - -! -!####################################################################### -! -! -! Write out restart files registered through register_restart_file -! -subroutine atmos_model_restart(Atmos, timestamp) - type (atmos_data_type), intent(inout) :: Atmos - character(len=*), intent(in) :: timestamp - - call atmosphere_restart(timestamp) - if (.not. dycore_only) then - if (.not. Atmos%write_only_coarse_intermediate_restarts) then - call FV3GFS_restart_write (IPD_Data, IPD_Restart, Atm_block, & - IPD_Control, Atmos%domain, timestamp) - endif - if (Atmos%write_coarse_restart_files) then - call FV3GFS_restart_write_coarse(IPD_Data, IPD_Restart, Atm_block, & - IPD_Control, Atmos%coarse_domain, timestamp) - endif - endif -end subroutine atmos_model_restart -! - -!####################################################################### -!####################################################################### -! -! -! -! Print checksums of the various fields in the atmos_data_type. -! - -! -! Routine to print checksums of the various fields in the atmos_data_type. -! - -! - -! -! Derived-type variable that contains fields in the atmos_data_type. -! -! -! -! Label to differentiate where this routine in being called from. -! -! -! -! An integer to indicate which timestep this routine is being called for. -! -! -subroutine atmos_data_type_chksum(id, timestep, atm) -type(atmos_data_type), intent(in) :: atm - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - integer :: n, outunit - -100 format("CHECKSUM::",A32," = ",Z20) -101 format("CHECKSUM::",A16,a,'%',a," = ",Z20) - - outunit = stdout() - write(outunit,*) 'BEGIN CHECKSUM(Atmos_data_type):: ', id, timestep - write(outunit,100) ' atm%lon_bnd ', mpp_chksum(atm%lon_bnd ) - write(outunit,100) ' atm%lat_bnd ', mpp_chksum(atm%lat_bnd ) - write(outunit,100) ' atm%lon ', mpp_chksum(atm%lon ) - write(outunit,100) ' atm%lat ', mpp_chksum(atm%lat ) - -end subroutine atmos_data_type_chksum - -! - - subroutine alloc_atmos_data_type (nlon, nlat, Atmos) - integer, intent(in) :: nlon, nlat - type(atmos_data_type), intent(inout) :: Atmos - allocate ( Atmos % lon_bnd (nlon+1,nlat+1), & - Atmos % lat_bnd (nlon+1,nlat+1), & - Atmos % lon (nlon,nlat), & - Atmos % lat (nlon,nlat) ) - - end subroutine alloc_atmos_data_type - - subroutine dealloc_atmos_data_type (Atmos) - type(atmos_data_type), intent(inout) :: Atmos - deallocate (Atmos%lon_bnd, & - Atmos%lat_bnd, & - Atmos%lon, & - Atmos%lat ) - end subroutine dealloc_atmos_data_type - -end module atmos_model_mod diff --git a/atmos_drivers/solo/atmos_model.F90 b/atmos_drivers/solo/atmos_model.F90 deleted file mode 100644 index bcf18d88..00000000 --- a/atmos_drivers/solo/atmos_model.F90 +++ /dev/null @@ -1,356 +0,0 @@ -!*********************************************************************** -!* GNU Lesser General Public License -!* -!* This file is part of the GFDL Atmos Drivers project. -!* -!* This is free software: you can redistribute it and/or modify it under -!* the terms of the GNU Lesser General Public License as published by -!* the Free Software Foundation, either version 3 of the License, or (at -!* your option) any later version. -!* -!* It is distributed in the hope that it will be useful, but WITHOUT -!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -!* for more details. -!* -!* You should have received a copy of the GNU Lesser General Public -!* License along with FMS. If not, see . -!*********************************************************************** - -program atmos_model - -!----------------------------------------------------------------------- -! -! Main program for running a stand-alone atmospheric dynamical core. -! -!----------------------------------------------------------------------- - -use atmosphere_mod, only: atmosphere_init, atmosphere_end, atmosphere, atmosphere_domain - -use time_manager_mod, only: time_type, set_time, get_time, & - operator(+), operator (<), operator (>), & - operator (/=), operator (/), operator (*) - -use fms_affinity_mod, only: fms_affinity_init, fms_affinity_set - -use fms_mod, only: check_nml_error, & - error_mesg, FATAL, WARNING, & - mpp_pe, mpp_root_pe, fms_init, fms_end, & - stdlog, stdout, write_version_number, & - mpp_clock_id, mpp_clock_begin, & - mpp_clock_end, CLOCK_COMPONENT -use fms2_io_mod, only: file_exists, ascii_read - -use mpp_mod, only: mpp_set_current_pelist, input_nml_file -use mpp_domains_mod, only: domain2d -use diag_manager_mod, only: diag_manager_init, diag_manager_end, get_base_date - -use field_manager_mod, only: MODEL_ATMOS -use tracer_manager_mod, only: register_tracers -use memutils_mod, only: print_memuse_stats -use constants_mod, only: SECONDS_PER_HOUR, SECONDS_PER_MINUTE -use sat_vapor_pres_mod, only: sat_vapor_pres_init - -implicit none - -!----------------------------------------------------------------------- - -character(len=128), parameter :: version = & -'$Id$' - -character(len=128), parameter :: tag = & -'$Name$' - -!----------------------------------------------------------------------- -! ----- model time ----- -! there is no calendar associated with model of this type -! therefore, year=0, month=0 are assumed - - type (time_type) :: Time, Time_init, Time_end, Time_step_atmos - integer :: num_atmos_calls, na - -! ----- model initial date ----- - - integer :: date_init(6) ! note: year=month=0 - -! ----- timing flags ----- - - integer :: id_init, id_loop, id_end - integer, parameter :: timing_level = 1 - -!----------------------------------------------------------------------- - character(len=80) :: text -!----------------------------------------------------------------------- - type(domain2d), save :: atmos_domain ! This variable must be treated as read-only -!----------------------------------------------------------------------- - - integer, dimension(4) :: current_time = (/ 0, 0, 0, 0 /) - integer :: days=0, hours=0, minutes=0, seconds=0 - integer :: dt_atmos = 0 - integer :: memuse_interval = 72 - integer :: atmos_nthreads = 1 - logical :: use_hyper_thread = .false. - - namelist /main_nml/ current_time, dt_atmos, & - days, hours, minutes, seconds, & - memuse_interval, atmos_nthreads, & - use_hyper_thread - -!####################################################################### - - call fms_init ( ) - call fms_affinity_init - call sat_vapor_pres_init - call atmos_model_init - -! ------ atmosphere integration loop ------- - - call mpp_clock_begin (id_loop) - - do na = 1, num_atmos_calls - - call atmosphere (Time) - - Time = Time + Time_step_atmos - - if(modulo(na,memuse_interval) == 0) then - write( text,'(a,i4)' )'Main loop at timestep=',na - call print_memuse_stats(text) - endif - - enddo - - call mpp_clock_end (id_loop) - -! ------ end of atmospheric time step loop ----- - - call atmos_model_end - call fms_end - -contains - -!####################################################################### - - subroutine atmos_model_init - -!----------------------------------------------------------------------- - integer :: unit, ierr, io, logunit - integer :: ntrace, ntprog, ntdiag, ntfamily - integer :: date(6) - type (time_type) :: Run_length -!$ integer :: omp_get_thread_num - integer :: get_cpu_affinity, base_cpu - character(len=:), dimension(:), allocatable :: restart_file !< Restart file saved as a string - integer :: time_stamp_unit !< Unif of the time_stamp file - integer :: ascii_unit !< Unit of a dummy ascii file -!----------------------------------------------------------------------- -!----- initialization timing identifiers ---- - - id_init = mpp_clock_id ('MAIN: initialization', grain=CLOCK_COMPONENT) - id_loop = mpp_clock_id ('MAIN: time loop' , grain=CLOCK_COMPONENT) - id_end = mpp_clock_id ('MAIN: termination' , grain=CLOCK_COMPONENT) - - logunit = stdlog() - - call mpp_clock_begin (id_init) - -!------------------------------------------- -! how many tracers have been registered? -! (will print number below) - call register_tracers ( MODEL_ATMOS, ntrace, ntprog, ntdiag, ntfamily ) - - -!----- read namelist ------- - - read (input_nml_file, nml=main_nml, iostat=io) - ierr = check_nml_error(io, 'main_nml') - -!----- write namelist to logfile ----- - - call write_version_number (version,tag) - if ( mpp_pe() == mpp_root_pe() ) write (logunit, nml=main_nml) - - if (dt_atmos == 0) then - call error_mesg ('program atmos_model', 'dt_atmos has not been specified', FATAL) - endif - -!----- read restart file ----- - - if (file_exists('INPUT/atmos_model.res')) then - call ascii_read('INPUT/atmos_model.res', restart_file) - read(restart_file(1), *) date - deallocate(restart_file) - else - ! use namelist time if restart file does not exist - date(1:2) = 0 - date(3:6) = current_time - endif - -!----- write current/initial date actually used to logfile file ----- - - if ( mpp_pe() == mpp_root_pe() ) then - write (logunit,16) date(3:6) - endif - - 16 format (' current time used = day',i5,' hour',i3,2(':',i2.2)) - -! print number of tracers to logfile - if (mpp_pe() == mpp_root_pe()) then - write (logunit, '(a,i3)') 'Number of tracers =', ntrace - write (logunit, '(a,i3)') 'Number of prognostic tracers =', ntprog - write (logunit, '(a,i3)') 'Number of diagnostic tracers =', ntdiag - endif - -!----------------------------------------------------------------------- -!------ initialize diagnostics manager ------ - - call diag_manager_init - -!----- always override initial/base date with diag_manager value ----- - -!----- get the base date in the diag_table from the diag_manager ---- -! this base date is typically the starting date for the -! experiment and is subtracted from the current date - - call get_base_date ( date_init(1), date_init(2), date_init(3), & - date_init(4), date_init(5), date_init(6) ) - - ! make sure base date does not have a year or month specified - if ( date_init(1)+date_init(2) /= 0 ) then - call error_mesg ('program atmos_model', 'invalid base base - & - &must have year = month = 0', FATAL) - endif - -!----- set initial and current time types ------ -!----- set run length and compute ending time ----- -#ifdef MARS_GCM -! Dont allow minutes in the Mars model - date_init(5)= 0.0 -#endif MARS_GCM - Time_init = set_time(date_init(4)*int(SECONDS_PER_HOUR)+date_init(5)*int(SECONDS_PER_MINUTE)+date_init(6),date_init(3)) - Time = set_time(date (4)*int(SECONDS_PER_HOUR)+date (5)*int(SECONDS_PER_MINUTE)+date (6),date (3)) - Run_length = set_time( hours*int(SECONDS_PER_HOUR)+ minutes*int(SECONDS_PER_MINUTE)+ seconds,days ) - Time_end = Time + Run_length - -!----------------------------------------------------------------------- -!----- write time stamps (for start time and end time) ------ - - if ( mpp_pe().EQ.mpp_root_pe() ) open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted') - - if ( mpp_pe() == mpp_root_pe() ) write (time_stamp_unit,20) date - -! compute ending time in days,hours,minutes,seconds - call get_time ( Time_end, date(6), date(3) ) ! gets sec,days - date(4) = date(6)/int(SECONDS_PER_HOUR); date(6) = date(6) - date(4)*int(SECONDS_PER_HOUR) -#ifdef MARS_GCM - date(5) = 0 ; date(6) = date(6) - date(5)*int(SECONDS_PER_MINUTE) -#else - date(5) = date(6)/int(SECONDS_PER_MINUTE) ; date(6) = date(6) - date(5)*int(SECONDS_PER_MINUTE) -#endif - if ( mpp_pe() == mpp_root_pe() ) write (time_stamp_unit,20) date - - if ( mpp_pe().EQ.mpp_root_pe() ) close(time_stamp_unit) - - 20 format (6i7,2x,'day') ! can handle day <= 999999 - -!----------------------------------------------------------------------- -!--- compute the time steps --- -! determine number of iterations through the time integration loop -! must be evenly divisible - - Time_step_atmos = set_time (dt_atmos,0) - num_atmos_calls = Run_length / Time_step_atmos - -!----------------------------------------------------------------------- -!----- initial (base) time must not be greater than current time ----- - - if ( Time_init > Time ) call error_mesg ('program atmos_model', & - 'initial time is greater than current time', FATAL) - -!----- make sure run length is a multiple of atmos time step ------ - - if ( num_atmos_calls * Time_step_atmos /= Run_length ) & - call error_mesg ('program atmos_model', & - 'run length must be multiple of atmosphere time step', FATAL) - -!----------------------------------------------------------------------- -!------ initialize atmospheric model ------ - - !--- setting affinity -!$ call fms_affinity_set('ATMOS', use_hyper_thread, atmos_nthreads) -!$ call omp_set_num_threads(atmos_nthreads) - if (mpp_pe() .eq. mpp_root_pe()) then - unit=stdout() - write(unit,*) ' starting ',atmos_nthreads,' OpenMP threads per MPI-task' - call flush(unit) - endif - - call atmosphere_init (Time_init, Time, Time_step_atmos) - call atmosphere_domain(atmos_domain) - -!----------------------------------------------------------------------- -! open and close dummy file in restart dir to check if dir exists - call mpp_set_current_pelist() - if ( mpp_pe().EQ.mpp_root_pe() ) then - open(newunit = ascii_unit, file='RESTART/file', status='replace', form='formatted') - close(ascii_unit,status="delete") - endif - -! ---- terminate timing ---- - call mpp_clock_end (id_init) - -!----------------------------------------------------------------------- - - call print_memuse_stats('atmos_model_init') - end subroutine atmos_model_init - -!####################################################################### - - subroutine atmos_model_end - - integer :: date(6) - integer :: restart_unit !< Unit for the coupler restart file -!----------------------------------------------------------------------- - call mpp_clock_begin (id_end) - - call atmosphere_end - -!----- compute current time in days,hours,minutes,seconds ----- - - date(1:2) = 0 - call get_time ( Time, date(6), date(3) ) - date(4) = date(6)/int(SECONDS_PER_HOUR); date(6) = date(6) - date(4)*int(SECONDS_PER_HOUR) -#ifdef MARS_GCM - date(5) = 0 ; date(6) = date(6) - date(5)*int(SECONDS_PER_MINUTE) -#else - date(5) = date(6)/int(SECONDS_PER_MINUTE); date(6) = date(6) - date(5)*int(SECONDS_PER_MINUTE) -#endif MARS_GCM - -!----- check time versus expected ending time ---- - - if (Time /= Time_end) call error_mesg ('program atmos_model', & - 'final time does not match expected ending time', WARNING) - -!----- write restart file ------ - - if ( mpp_pe() == mpp_root_pe() ) then - open(newunit = restart_unit, file='RESTART/atmos_model.res', status='replace', form='formatted') - write (restart_unit,'(6i6,8x,a)') date, & - 'Current model time: year, month, day, hour, minute, second' - close(restart_unit) - endif - -!----- final output of diagnostic fields ---- - call diag_manager_end (Time) - - call mpp_clock_end (id_end) -!----------------------------------------------------------------------- - - end subroutine atmos_model_end - -!####################################################################### -! routines to set/get date when no calendar is set (i.e., yr=0 and mo=0) -!####################################################################### - -end program atmos_model - diff --git a/simple_coupler/coupler_main.F90 b/simple_coupler/coupler_main.F90 deleted file mode 100644 index e886a5fb..00000000 --- a/simple_coupler/coupler_main.F90 +++ /dev/null @@ -1,515 +0,0 @@ -!*********************************************************************** -!* GNU Lesser General Public License -!* -!* This file is part of the GFDL Flexible Modeling System (FMS) Coupler. -!* -!* FMS Coupler is free software: you can redistribute it and/or modify -!* it under the terms of the GNU Lesser General Public License as -!* published by the Free Software Foundation, either version 3 of the -!* License, or (at your option) any later version. -!* -!* FMS Coupler is distributed in the hope that it will be useful, but -!* WITHOUT ANY WARRANTY; without even the implied warranty of -!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -!* General Public License for more details. -!* -!* You should have received a copy of the GNU Lesser General Public -!* License along with FMS Coupler. -!* If not, see . -!*********************************************************************** -program coupler_main - -!----------------------------------------------------------------------- -! -! program that couples component models for the atmosphere, -! ocean (amip), land, and sea-ice using the exchange module -! -!----------------------------------------------------------------------- - -use time_manager_mod, only: time_type, set_calendar_type, set_time, & - set_date, days_in_month, month_name, & - operator(+), operator (<), operator (>), & - operator (/=), operator (/), operator (==),& - operator (*), THIRTY_DAY_MONTHS, JULIAN, & - NOLEAP, NO_CALENDAR, date_to_string, & - get_date - -use atmos_model_mod, only: atmos_model_init, atmos_model_end, & - update_atmos_model_dynamics, & - update_atmos_radiation_physics, & - update_atmos_model_state, & - atmos_data_type, atmos_model_restart - -use constants_mod, only: constants_init -use mpp_mod, only: input_nml_file -use fms_affinity_mod, only: fms_affinity_init, fms_affinity_set - -use fms_mod, only: check_nml_error, & - error_mesg, fms_init, fms_end, & - write_version_number, uppercase -use fms2_io_mod, only: ascii_read, file_exists -use mpp_mod, only: mpp_init, mpp_pe, mpp_root_pe, mpp_npes, mpp_get_current_pelist, & - mpp_set_current_pelist, stdlog, mpp_error, NOTE, FATAL, WARNING -use mpp_mod, only: mpp_clock_id, mpp_clock_begin, mpp_clock_end, mpp_sync - -use mpp_domains_mod, only: mpp_get_global_domain, mpp_global_field, CORNER -use memutils_mod, only: print_memuse_stats -use sat_vapor_pres_mod,only: sat_vapor_pres_init - -use diag_manager_mod, only: diag_manager_init, diag_manager_end, & - get_base_date, diag_manager_set_time_end - -use data_override_mod, only: data_override_init - - -implicit none - -!----------------------------------------------------------------------- - -character(len=128) :: version = '$Id: coupler_main.F90,v 19.0.4.1.2.3 2014/09/09 23:51:59 Rusty.Benson Exp $' -character(len=128) :: tag = '$Name: ulm_201505 $' - -!----------------------------------------------------------------------- -!---- model defined-types ---- - - type (atmos_data_type) :: Atm - -!----------------------------------------------------------------------- -! ----- coupled model time ----- - - type (time_type) :: Time_atmos, Time_init, Time_end, & - Time_step_atmos, Time_step_ocean, & - Time_restart, Time_step_restart, & - Time_start_restart, Time_restart_aux, & - Time_step_restart_aux, Time_start_restart_aux, & - Time_duration_restart_aux, Time_restart_end_aux - - integer :: num_cpld_calls, num_atmos_calls, nc, na, ret - -! ----- coupled model initial date ----- - - integer :: date_init(6) - integer :: calendar_type = -99 - -! ----- timing flags ----- - - integer :: initClock, mainClock, termClock - integer, parameter :: timing_level = 1 - -! ----- namelist ----- - integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) - character(len=17) :: calendar = ' ' - logical :: force_date_from_namelist = .false. ! override restart values for date - integer :: months=0, days=0, hours=0, minutes=0, seconds=0 - integer :: iau_offset = 0 - integer :: dt_atmos = 0 - integer :: dt_ocean = 0 - integer :: restart_days = 0 - integer :: restart_secs = 0 - integer :: restart_start_days = 0 - integer :: restart_start_secs = 0 - integer :: restart_days_aux = 0 - integer :: restart_secs_aux = 0 - integer :: restart_start_days_aux = 0 - integer :: restart_start_secs_aux = 0 - integer :: restart_duration_days_aux = 0 - integer :: restart_duration_secs_aux = 0 - integer :: atmos_nthreads = 1 - logical :: memuse_verbose = .false. - logical :: use_hyper_thread = .false. - - namelist /coupler_nml/ current_date, calendar, force_date_from_namelist, & - months, days, hours, minutes, seconds, iau_offset, & - dt_atmos, dt_ocean, atmos_nthreads, memuse_verbose, & - use_hyper_thread, restart_secs, restart_days, & - restart_start_secs, restart_start_days, & - restart_secs_aux, restart_days_aux, & - restart_start_secs_aux, restart_start_days_aux, & - restart_duration_secs_aux, restart_duration_days_aux - -! ----- local variables ----- - character(len=32) :: timestamp - logical :: intrm_rst, intrm_rst_1step - -!####################################################################### - - call fms_init() - call mpp_init() - initClock = mpp_clock_id( 'Initialization' ) - call mpp_clock_begin (initClock) !nesting problem - - call fms_init - call constants_init - call fms_affinity_init - call sat_vapor_pres_init - - call coupler_init - call print_memuse_stats('after coupler init') - - call mpp_set_current_pelist() - call mpp_clock_end (initClock) !end initialization - mainClock = mpp_clock_id( 'Main loop' ) - termClock = mpp_clock_id( 'Termination' ) - call mpp_clock_begin(mainClock) !begin main loop - - do nc = 1, num_cpld_calls - - Time_atmos = Time_atmos + Time_step_atmos - - call update_atmos_model_dynamics (Atm) - - call update_atmos_radiation_physics (Atm) - - call update_atmos_model_state (Atm) - -!--- intermediate restart - if (intrm_rst) then - if (nc /= num_cpld_calls) then - if (intrm_rst_1step .and. nc == 1) then - timestamp = date_to_string (Time_atmos) - call atmos_model_restart(Atm, timestamp) - call coupler_res(timestamp) - endif - if (Time_atmos == Time_restart .or. Time_atmos == Time_restart_aux) then - if (Time_atmos == Time_restart) then - timestamp = date_to_string (Time_restart) - else - timestamp = date_to_string (Time_restart_aux) - endif - call atmos_model_restart(Atm, timestamp) - call coupler_res(timestamp) - if (Time_atmos == Time_restart) & - Time_restart = Time_restart + Time_step_restart - if ((restart_secs_aux > 0 .or. restart_days_aux > 0) .and. & - Time_atmos == Time_restart_aux .and. & - Time_restart_aux < Time_restart_end_aux) then - Time_restart_aux = Time_restart_aux + Time_step_restart_aux - endif - endif - endif - endif - - call print_memuse_stats('after full step') - - enddo - -!----------------------------------------------------------------------- - - call mpp_set_current_pelist() - call mpp_clock_end(mainClock) - call mpp_clock_begin(termClock) - - call coupler_end - call mpp_set_current_pelist() - call mpp_clock_end(termClock) - - call fms_end - -!----------------------------------------------------------------------- - - stop - -contains - -!####################################################################### - - subroutine coupler_init - -!----------------------------------------------------------------------- -! initialize all defined exchange grids and all boundary maps -!----------------------------------------------------------------------- - integer :: total_days, total_seconds, ierr, io - integer :: n, gnlon, gnlat - integer :: date(6), flags - type (time_type) :: Run_length - character(len=9) :: month - logical :: use_namelist - - logical, allocatable, dimension(:,:) :: mask - real, allocatable, dimension(:,:) :: glon_bnd, glat_bnd - character(len=:), dimension(:), allocatable :: restart_file !< Restart file saved as a string - integer :: time_stamp_unit !< Unit of the time_stamp file - integer :: ascii_unit !< Unit of a dummy ascii file - -!----------------------------------------------------------------------- -!----- initialization timing identifiers ---- - -!----- read namelist ------- -!----- for backwards compatibilty read from file coupler.nml ----- - - read(input_nml_file, nml=coupler_nml, iostat=io) - ierr = check_nml_error(io, 'coupler_nml') - -!----- write namelist to logfile ----- - call write_version_number (version, tag) - if (mpp_pe() == mpp_root_pe()) write(stdlog(),nml=coupler_nml) - -!----- allocate and set the pelist (to the global pelist) ----- - allocate( Atm%pelist (mpp_npes()) ) - call mpp_get_current_pelist(Atm%pelist) - -!----- read restart file ----- - - if (file_exists('INPUT/coupler.res')) then - call ascii_read('INPUT/coupler.res', restart_file) - read(restart_file(1), *) calendar_type - read(restart_file(2), *) date_init - read(restart_file(3), *) date - deallocate(restart_file) - else - force_date_from_namelist = .true. - endif - -!----- use namelist value (either no restart or override flag on) --- - - if ( force_date_from_namelist ) then - - if ( sum(current_date) <= 0 ) then - call error_mesg ('program coupler', & - 'no namelist value for current_date', FATAL) - else - date = current_date - endif - -!----- override calendar type with namelist value ----- - - select case( uppercase(trim(calendar)) ) - case( 'JULIAN' ) - calendar_type = JULIAN - case( 'NOLEAP' ) - calendar_type = NOLEAP - case( 'THIRTY_DAY' ) - calendar_type = THIRTY_DAY_MONTHS - case( 'NO_CALENDAR' ) - calendar_type = NO_CALENDAR - case default - call mpp_error ( FATAL, 'COUPLER_MAIN: coupler_nml entry calendar must '// & - 'be one of JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) - end select - - endif - - !--- setting affinity -!$ call fms_affinity_set('ATMOS', use_hyper_thread, atmos_nthreads) -!$ call omp_set_num_threads(atmos_nthreads) - - call set_calendar_type (calendar_type) - -!----- write current/initial date actually used to logfile file ----- - - if ( mpp_pe() == mpp_root_pe() ) then - write (stdlog(),16) date(1),trim(month_name(date(2))),date(3:6) - endif - - 16 format (' current date used = ',i4,1x,a,2i3,2(':',i2.2),' gmt') - -!----------------------------------------------------------------------- -!------ initialize diagnostics manager ------ - - call diag_manager_init (TIME_INIT=date) - -!----- always override initial/base date with diag_manager value ----- - - call get_base_date ( date_init(1), date_init(2), date_init(3), & - date_init(4), date_init(5), date_init(6) ) - -!----- use current date if no base date ------ - - if ( date_init(1) == 0 ) date_init = date - -!----- set initial and current time types ------ - - Time_init = set_date (date_init(1), date_init(2), date_init(3), & - date_init(4), date_init(5), date_init(6)) - - Time_atmos = set_date (date(1), date(2), date(3), & - date(4), date(5), date(6)) - -!----------------------------------------------------------------------- -!----- compute the ending time (compute days in each month first) ----- -! -! (NOTE: if run length in months then starting day must be <= 28) - - if ( months > 0 .and. date(3) > 28 ) & - call error_mesg ('program coupler', & - 'if run length in months then starting day must be <= 28', FATAL) - - Time_end = Time_atmos - total_days = 0 - do n = 1, months - total_days = total_days + days_in_month(Time_end) - Time_end = Time_atmos + set_time (0,total_days) - enddo - - total_days = total_days + days - total_seconds = hours*3600 + minutes*60 + seconds - Run_length = set_time (total_seconds,total_days) - Time_end = Time_atmos + Run_length - - !Need to pass Time_end into diag_manager for multiple thread case. - call diag_manager_set_time_end(Time_end) - - -!----------------------------------------------------------------------- -!----- write time stamps (for start time and end time) ------ - - if ( mpp_pe().EQ.mpp_root_pe() ) open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted') - - month = month_name(date(2)) - if ( mpp_pe() == mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3) - - call get_date (Time_end, date(1), date(2), date(3), & - date(4), date(5), date(6)) - month = month_name(date(2)) - if ( mpp_pe() == mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3) - - if ( mpp_pe().EQ.mpp_root_pe() ) close(time_stamp_unit) - - 20 format (6i4,2x,a3) - -!----------------------------------------------------------------------- -!----- compute the time steps ------ - -Time_step_atmos = set_time (dt_atmos,0) -Time_step_ocean = set_time (dt_ocean,0) -num_cpld_calls = Run_length / Time_step_ocean -num_atmos_calls = Time_step_ocean / Time_step_atmos -Time_step_restart = set_time (restart_secs, restart_days) -if (restart_start_secs > 0 .or. restart_start_days > 0) then - Time_start_restart = set_time (restart_start_secs, restart_start_days) - Time_restart = Time_atmos + Time_start_restart -else - Time_restart = Time_atmos + Time_step_restart -end if -Time_step_restart_aux = set_time (restart_secs_aux, restart_days_aux) -Time_duration_restart_aux = set_time (restart_duration_secs_aux, restart_duration_days_aux) -Time_start_restart_aux = set_time (restart_start_secs_aux, restart_start_days_aux) -Time_restart_aux = Time_atmos + Time_start_restart_aux -Time_restart_end_aux = Time_restart_aux + Time_duration_restart_aux -intrm_rst = .false. -intrm_rst_1step = .false. -if (restart_days > 0 .or. restart_secs > 0) intrm_rst = .true. -if (intrm_rst .and. restart_start_secs == 0 .and. & - restart_start_days == 0) intrm_rst_1step = .true. - -!----------------------------------------------------------------------- -!------------------- some error checks --------------------------------- - -!----- initial time cannot be greater than current time ------- - - if ( Time_init > Time_atmos ) call error_mesg ('program coupler', & - 'initial time is greater than current time', FATAL) - -!----- make sure run length is a multiple of ocean time step ------ - - if ( num_cpld_calls * Time_step_ocean /= Run_length ) & - call error_mesg ('program coupler', & - 'run length must be multiple of ocean time step', FATAL) - -! ---- make sure cpld time step is a multiple of atmos time step ---- - - if ( num_atmos_calls * Time_step_atmos /= Time_step_ocean ) & - call error_mesg ('program coupler', & - 'atmos time step is not a multiple of the ocean time step', FATAL) - -!------ initialize component models ------ - - call atmos_model_init (Atm, Time_init, Time_atmos, Time_step_atmos, & - iau_offset) - - call print_memuse_stats('after atmos model init') - - call mpp_get_global_domain(Atm%Domain, xsize=gnlon, ysize=gnlat) - allocate ( glon_bnd(gnlon+1,gnlat+1), glat_bnd(gnlon+1,gnlat+1) ) - call mpp_global_field(Atm%Domain, Atm%lon_bnd, glon_bnd, position=CORNER) - call mpp_global_field(Atm%Domain, Atm%lat_bnd, glat_bnd, position=CORNER) - - if (.NOT.Atm%bounded_domain) call data_override_init (Atm_domain_in = Atm%domain) - ! Atm_domain_in = Atm%domain, & - ! Ice_domain_in = Ice%domain, & - ! Land_domain_in = Land%domain ) - -!----------------------------------------------------------------------- -!---- open and close dummy file in restart dir to check if dir exists -- - - if (mpp_pe() == 0 ) then !one pe should do this check only in case of a nest - open(newunit = ascii_unit, file='RESTART/file', status='replace', form='formatted') - close(ascii_unit,status="delete") - endif - -!----------------------------------------------------------------------- - - end subroutine coupler_init - -!####################################################################### - subroutine coupler_res(timestamp) - character(len=32), intent(in) :: timestamp - - integer :: date(6) - integer :: restart_unit !< Unit for the coupler restart file - -!----- compute current date ------ - - call get_date (Time_atmos, date(1), date(2), date(3), & - date(4), date(5), date(6)) - -!----- write restart file ------ - call mpp_set_current_pelist() - if (mpp_pe() == mpp_root_pe())then - open(newunit = restart_unit, file='RESTART/'//trim(timestamp)//'.coupler.res', status='replace', form='formatted') - write(restart_unit, '(i6,8x,a)' )calendar_type, & - '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' - - write(restart_unit, '(6i6,8x,a)' )date_init, & - 'Model start time: year, month, day, hour, minute, second' - write(restart_unit, '(6i6,8x,a)' )date, & - 'Current model time: year, month, day, hour, minute, second' - close(restart_unit) - endif - end subroutine coupler_res - -!####################################################################### - - subroutine coupler_end - - integer :: date(6) - integer :: restart_unit !< Unit for the coupler restart file -!----------------------------------------------------------------------- - - call atmos_model_end (Atm) - -!----- compute current date ------ - - call get_date (Time_atmos, date(1), date(2), date(3), & - date(4), date(5), date(6)) - -!----- check time versus expected ending time ---- - - if (Time_atmos /= Time_end) call error_mesg ('program coupler', & - 'final time does not match expected ending time', WARNING) - -!----- write restart file ------ - call mpp_set_current_pelist() - if (mpp_pe() == mpp_root_pe())then - open(newunit = restart_unit, file='RESTART/coupler.res', status='replace', form='formatted') - write(restart_unit, '(i6,8x,a)' )calendar_type, & - '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' - - write(restart_unit, '(6i6,8x,a)' )date_init, & - 'Model start time: year, month, day, hour, minute, second' - write(restart_unit, '(6i6,8x,a)' )date, & - 'Current model time: year, month, day, hour, minute, second' - close(restart_unit) - endif - -!----- final output of diagnostic fields ---- - - call diag_manager_end (Time_atmos) - -!----------------------------------------------------------------------- - - end subroutine coupler_end - -!####################################################################### - -end program coupler_main