From 6c27fdb9a2d0bb623c21b51c0c08235a293e622f Mon Sep 17 00:00:00 2001 From: Dusan Jovic <48258889+DusanJovic-NOAA@users.noreply.github.com> Date: Fri, 17 Dec 2021 08:23:54 -0500 Subject: [PATCH] Code cleanup. Remove used code/variables. Fix minor inconsistencies. (#440) * Remove ESMF Alarm and TimeInterval variables from module_fv3_config. * Variables nfhmax, nfhmax_hf are unused outside InitializeAdvertise. Declared them as local variables. * There is no need to keep duplicates of all time related variables in atm_int_state when we can easily access them from atm_int_state%Atm. * Remove redundant call to fms_init * Add few missing ESMF_LogFoundError checks in module_fcst_grid_comp.F90 * Delete time_utils.F90. Unused. * print only actual errors to stderr, everything else to stdout * Move realizeConnectedCplFields to module_cplfields from module_cap_cpl * Declare Atmos as module variable, and remove atmos_internalstate_wrapper * Move code from clock_cplIntval to InitializeAdvertise * Removed INTERNAL_FILE_NML from atmos_model.F90 --- atmos_model.F90 | 96 ++------- cpl/module_cap_cpl.F90 | 337 +----------------------------- cpl/module_cplfields.F90 | 165 ++++++++++++++- fv3_cap.F90 | 60 +++--- module_fcst_grid_comp.F90 | 424 ++++++++++++++------------------------ module_fv3_config.F90 | 6 +- time_utils.F90 | 170 --------------- 7 files changed, 369 insertions(+), 889 deletions(-) delete mode 100644 time_utils.F90 diff --git a/atmos_model.F90 b/atmos_model.F90 index 3ac2555e9..29133471a 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -165,7 +165,6 @@ module atmos_model_mod ! DYCORE containers !------------------- type(DYCORE_data_type), allocatable :: DYCORE_Data(:) ! number of blocks -type(DYCORE_diag_type) :: DYCORE_Diag(25) !---------------- ! GFS containers @@ -380,7 +379,7 @@ subroutine update_atmos_radiation_physics (Atmos) if(GFS_control%print_diff_pgr) then call atmos_timestep_diagnostics(Atmos) endif - + ! Update flag for first time step of time integration GFS_control%first_time_step = .false. @@ -444,7 +443,7 @@ subroutine atmos_timestep_diagnostics(Atmos) enddo pcount = pcount+count enddo - + ! Sum pgr stats from psum/pcount and convert to hPa/hour global avg: sendbuf(1:2) = (/ psum, pcount /) call MPI_Allreduce(sendbuf,recvbuf,2,MPI_DOUBLE_PRECISION,MPI_SUM,GFS_Control%communicator,ierror) @@ -454,7 +453,7 @@ subroutine atmos_timestep_diagnostics(Atmos) sendbuf(1:2) = (/ maxabs, dble(GFS_Control%me) /) call MPI_Allreduce(sendbuf,recvbuf,1,MPI_2DOUBLE_PRECISION,MPI_MAXLOC,GFS_Control%communicator,ierror) call MPI_Bcast(pmaxloc,size(pmaxloc),MPI_DOUBLE_PRECISION,nint(recvbuf(2)),GFS_Control%communicator,ierror) - + if(GFS_Control%me == GFS_Control%master) then 2933 format('At forecast hour ',F9.3,' mean abs pgr change is ',F16.8,' hPa/hr') 2934 format(' max abs change ',F15.10,' bar at tile=',I0,' i=',I0,' j=',I0) @@ -491,23 +490,17 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) type (atmos_data_type), intent(inout) :: Atmos type (time_type), intent(in) :: Time_init, Time, Time_step !--- local variables --- - integer :: unit, ntdiag, ntfamily, i, j, k - integer :: mlon, mlat, nlon, nlat, nlev, sec, dt + integer :: unit, i + integer :: mlon, mlat, nlon, nlat, nlev, sec integer :: ierr, io, logunit - integer :: idx, tile_num + integer :: tile_num integer :: isc, iec, jsc, jec - integer :: isd, ied, jsd, jed - integer :: blk, ibs, ibe, jbs, jbe real(kind=GFS_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 :: p_hydro, hydro logical, save :: block_message = .true. type(GFS_init_type) :: Init_parm integer :: bdat(8), cdat(8) - integer :: ntracers, maxhf, maxh + integer :: ntracers character(len=32), allocatable, target :: tracer_names(:) integer, allocatable, target :: tracer_types(:) integer :: nthrds, nb @@ -547,7 +540,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !---------------------------------------------------------------------------------------------- ! initialize atmospheric model - must happen AFTER atmosphere_init so that nests work correctly - IF ( file_exists('input.nml')) THEN + if (file_exists('input.nml')) then read(input_nml_file, nml=atmos_model_nml, iostat=io) ierr = check_nml_error(io, 'atmos_model_nml') endif @@ -635,19 +628,10 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) Init_parm%restart = Atm(mygrid)%flagstruct%warm_start Init_parm%hydrostatic = Atm(mygrid)%flagstruct%hydrostatic -#ifdef INTERNAL_FILE_NML ! allocate required to work around GNU compiler bug 100886 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100886 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 GFS_initialize (GFS_control, GFS_data%Statein, GFS_data%Stateout, GFS_data%Sfcprop, & GFS_data%Coupling, GFS_data%Grid, GFS_data%Tbd, GFS_data%Cldprop, GFS_data%Radtend, & @@ -964,7 +948,7 @@ subroutine atmos_model_end (Atmos) use update_ca, only: write_ca_restart type (atmos_data_type), intent(inout) :: Atmos !---local variables - integer :: idx, seconds, ierr + integer :: ierr !----------------------------------------------------------------------- !---- termination routine for atmospheric model ---- @@ -993,6 +977,8 @@ subroutine atmos_model_end (Atmos) call CCPP_step (step="finalize", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP finalize step failed') + call dealloc_atmos_data_type (Atmos) + end subroutine atmos_model_end ! @@ -1541,53 +1527,6 @@ subroutine update_atmos_chemistry(state, rc) end select end subroutine update_atmos_chemistry -! - -!####################################################################### -! -! -! -! 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) @@ -1623,7 +1562,6 @@ subroutine assign_importdata(jdat, rc) integer :: sphum, liq_wat, ice_wat, o3mr character(len=128) :: impfield_name, fldname type(ESMF_TypeKind_Flag) :: datatype - real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: datar42d real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d real(kind=ESMF_KIND_R8), dimension(:,:,:), pointer:: datar83d real(kind=GFS_kind_phys), dimension(:,:), pointer :: datar8 @@ -1690,10 +1628,6 @@ subroutine assign_importdata(jdat, rc) if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplIMP,atmos gets ',trim(impfield_name),' datar8=', & datar8(isc,jsc), maxval(datar8), minval(datar8) found = .true. -! gfs physics runs with r8 -! else -! call ESMF_FieldGet(importFields(n),farrayPtr=datar42d,localDE=0, rc=rc) -! datar8 = datar42d endif else if( dimCount == 3) then @@ -2560,9 +2494,9 @@ subroutine setup_exportdata(rc) integer, optional, intent(out) :: rc !--- local variables - integer :: i, j, k, idx, ix + integer :: i, j, ix integer :: isc, iec, jsc, jec - integer :: ib, jb, nb, nsb, nk + integer :: nb, nk integer :: sphum, liq_wat, ice_wat, o3mr real(GFS_kind_phys) :: rtime, rtimek @@ -2586,7 +2520,6 @@ subroutine setup_exportdata(rc) jsc = Atm_block%jsc jec = Atm_block%jec nk = Atm_block%npz - nsb = Atm_block%blkno(isc,jsc) rtime = one / GFS_control%dtp rtimek = GFS_control%rho_h2o * rtime @@ -2895,7 +2828,6 @@ subroutine addLsmask2grid(fcstGrid, rc) integer isc, iec, jsc, jec integer i, j, nb, ix ! integer CLbnd(2), CUbnd(2), CCount(2), TLbnd(2), TUbnd(2), TCount(2) - type(ESMF_StaggerLoc) :: staggerloc integer, allocatable :: lsmask(:,:) integer(kind=ESMF_KIND_I4), pointer :: maskPtr(:,:) ! diff --git a/cpl/module_cap_cpl.F90 b/cpl/module_cap_cpl.F90 index 47f48ce4d..d69f6c989 100644 --- a/cpl/module_cap_cpl.F90 +++ b/cpl/module_cap_cpl.F90 @@ -6,253 +6,15 @@ module module_cap_cpl ! 12 Mar 2018: J. Wang Pull coupled subroutines from fv3_cap.F90 to this module ! use ESMF - use NUOPC - use module_cplfields, only : FieldInfo -! implicit none + private - public clock_cplIntval - ! public realizeConnectedInternCplField - public realizeConnectedCplFields public diagnose_cplFields ! contains !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - - subroutine clock_cplIntval(gcomp, CF) - - type(ESMF_GridComp) :: gcomp - type(ESMF_Config) :: CF -! - real(ESMF_KIND_R8) :: medAtmCouplingIntervalSec - type(ESMF_Clock) :: fv3Clock - type(ESMF_TimeInterval) :: fv3Step - integer :: rc -! - call ESMF_ConfigGetAttribute(config=CF, value=medAtmCouplingIntervalSec, & - label="atm_coupling_interval_sec:", default=-1.0_ESMF_KIND_R8, rc=RC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - - if (medAtmCouplingIntervalSec > 0._ESMF_KIND_R8) then ! The coupling time step is provided - call ESMF_TimeIntervalSet(fv3Step, s_r8=medAtmCouplingIntervalSec, rc=RC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - call ESMF_GridCompGet(gcomp, clock=fv3Clock, rc=RC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - call ESMF_ClockSet(fv3Clock, timestep=fv3Step, rc=RC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - - end subroutine clock_cplIntval - - !----------------------------------------------------------------------------- - - subroutine addFieldMetadata(field, key, values, rc) - - ! This subroutine implements a preliminary method to provide metadata to - ! a coupled model that is accessing the field via reference sharing - ! (NUOPC SharedStatusField=.true.). The method sets a (key, values) pair - ! in the field's array ESMF_Info object to retrieve an array of strings - ! encoding metadata. - ! - ! Such a capability should be implemented in the standard NUOPC connector - ! for more general applications, possibly providing access to the field's - ! ESMF_Info object. - - type(ESMF_Field) :: field - character(len=*), intent(in) :: key - character(len=*), intent(in) :: values(:) - integer, optional, intent(out) :: rc - - ! local variable - integer :: localrc - type(ESMF_Array) :: array - type(ESMF_Info) :: info - - ! begin - if (present(rc)) rc = ESMF_SUCCESS - - call ESMF_FieldGet(field, array=array, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call ESMF_InfoGetFromHost(array, info, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call ESMF_InfoSet(info, key, values, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - - end subroutine addFieldMetadata - - !----------------------------------------------------------------------------- - -#if 0 - subroutine realizeConnectedInternCplField(state, field, standardName, grid, rc) - - type(ESMF_State) :: state - type(ESMF_Field), optional :: field - character(len=*), optional :: standardName - type(ESMF_Grid), optional :: grid - integer, intent(out), optional :: rc - - ! local variables - character(len=80) :: fieldName - type(ESMF_ArraySpec) :: arrayspec - integer :: i, localrc - logical :: isConnected - real(ESMF_KIND_R8), pointer :: fptr(:,:) - - if (present(rc)) rc = ESMF_SUCCESS - - fieldName = standardName ! use standard name as field name - - !! Create fields using wam2dmesh if they are WAM fields - isConnected = NUOPC_IsConnected(state, fieldName=fieldName, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - - if (isConnected) then - - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, name=fieldName, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call NUOPC_Realize(state, field=field, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - - call ESMF_FieldGet(field, farrayPtr=fptr, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - - fptr=0._ESMF_KIND_R8 ! zero out the entire field - call NUOPC_SetAttribute(field, name="Updated", value="true", rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - - else - ! remove a not connected Field from State - call ESMF_StateRemove(state, (/fieldName/), rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - endif - - end subroutine realizeConnectedInternCplField -#endif - !----------------------------------------------------------------------------- - - subroutine realizeConnectedCplFields(state, grid, & - numLevels, numSoilLayers, numTracers, & - fields_info, state_tag, fieldList, fill_value, rc) - - use field_manager_mod, only: MODEL_ATMOS - use tracer_manager_mod, only: get_number_tracers, get_tracer_names - - type(ESMF_State), intent(inout) :: state - type(ESMF_Grid), intent(in) :: grid - integer, intent(in) :: numLevels - integer, intent(in) :: numSoilLayers - integer, intent(in) :: numTracers - type(FieldInfo), dimension(:), intent(in) :: fields_info - character(len=*), intent(in) :: state_tag !< Import or export. - type(ESMF_Field), dimension(:), intent(out) :: fieldList - real(ESMF_KIND_R8), optional , intent(in) :: fill_value - integer, intent(out) :: rc - - ! local variables - - integer :: item, pos, tracerCount - logical :: isConnected - type(ESMF_Field) :: field - real(ESMF_KIND_R8) :: l_fill_value - real(ESMF_KIND_R8), parameter :: d_fill_value = 0._ESMF_KIND_R8 - type(ESMF_StateIntent_Flag) :: stateintent - character(len=32), allocatable, dimension(:) :: tracerNames, tracerUnits - - ! begin - rc = ESMF_SUCCESS - - if (present(fill_value)) then - l_fill_value = fill_value - else - l_fill_value = d_fill_value - end if - - ! attach list of tracer names to exported tracer field as metadata - call ESMF_StateGet(state, stateintent=stateintent, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - if (stateintent == ESMF_STATEINTENT_EXPORT) then - call get_number_tracers(MODEL_ATMOS, num_tracers=tracerCount) - allocate(tracerNames(tracerCount), tracerUnits(tracerCount)) - do item = 1, tracerCount - call get_tracer_names(MODEL_ATMOS, item, tracerNames(item), units=tracerUnits(item)) - end do - end if - - do item = 1, size(fields_info) - isConnected = NUOPC_IsConnected(state, fieldName=trim(fields_info(item)%name), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (isConnected) then - call ESMF_StateGet(state, field=field, itemName=trim(fields_info(item)%name), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_FieldEmptySet(field, grid=grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - select case (fields_info(item)%type) - case ('l','layer') - call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/numLevels/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - case ('i','interface') - call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/numLevels+1/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - case ('t','tracer') - call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1, 1/), ungriddedUBound=(/numLevels, numTracers/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (allocated(tracerNames)) then - call addFieldMetadata(field, 'tracerNames', tracerNames, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if - if (allocated(tracerUnits)) then - call addFieldMetadata(field, 'tracerUnits', tracerUnits, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if - case ('s','surface') - call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - case ('g','soil') - call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/numSoilLayers/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - case default - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg="exportFieldType = '"//trim(fields_info(item)%type)//"' not recognized", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - end select - call NUOPC_Realize(state, field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! -- initialize field value - call ESMF_FieldFill(field, dataFillScheme="const", const1=l_fill_value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! -- save field - fieldList(item) = field - call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fields_info(item)%name) & - // ' is connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) - else - ! remove a not connected Field from State - call ESMF_StateRemove(state, (/trim(fields_info(item)%name)/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fields_info(item)%name) & - // ' is not connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) - end if - end do - - if (allocated(tracerNames)) deallocate(tracerNames) - if (allocated(tracerUnits)) deallocate(tracerUnits) - - end subroutine realizeConnectedCplFields - !----------------------------------------------------------------------------- subroutine diagnose_cplFields(gcomp, clock_fv3, fcstpe, & @@ -316,103 +78,6 @@ subroutine diagnose_cplFields(gcomp, clock_fv3, fcstpe, & end subroutine diagnose_cplFields - !----------------------------------------------------------------------------- - - subroutine ESMFPP_RegridWriteState(state, fileName, timeslice, rc) - - type(ESMF_State), intent(in) :: state - character(len=*), intent(in) :: fileName - integer, intent(in) :: timeslice - integer, intent(out) :: rc - - ! local - type(ESMF_Field) :: field - type(ESMF_Grid) :: outGrid - integer :: i, icount - character(64), allocatable :: itemNameList(:) - type(ESMF_StateItem_Flag), allocatable :: typeList(:) - - rc = ESMF_SUCCESS - - ! 1degx1deg - outGrid = ESMF_GridCreate1PeriDimUfrm(maxIndex=(/360,180/), & - minCornerCoord=(/0.0_ESMF_KIND_R8,-90.0_ESMF_KIND_R8/), & - maxCornerCoord=(/360.0_ESMF_KIND_R8,90.0_ESMF_KIND_R8/), & - staggerLocList=(/ESMF_STAGGERLOC_CORNER, ESMF_STAGGERLOC_CENTER/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_StateGet(state, itemCount=icount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - allocate(typeList(icount), itemNameList(icount)) - call ESMF_StateGet(state, itemTypeList=typeList, itemNameList=itemNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - do i = 1, icount - if(typeList(i) == ESMF_STATEITEM_FIELD) then - call ESMF_LogWrite("RegridWrite Field Name Initiated: "//trim(itemNameList(i)), ESMF_LOGMSG_INFO) - call ESMF_StateGet(state, itemName=itemNameList(i), field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMFPP_RegridWrite(field, outGrid, ESMF_REGRIDMETHOD_BILINEAR, & - fileName//trim(itemNameList(i))//'.nc', trim(itemNameList(i)), timeslice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite("RegridWrite Field Name done: "//trim(itemNameList(i)), ESMF_LOGMSG_INFO) - endif - enddo - - deallocate(typeList, itemNameList) - - call ESMF_GridDestroy(outGrid,noGarbage=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - end subroutine ESMFPP_RegridWriteState - - subroutine ESMFPP_RegridWrite(inField, outGrid, regridMethod, fileName, fieldName, timeslice, rc) - - ! input arguments - type(ESMF_Field), intent(in) :: inField - type(ESMF_Grid), intent(in) :: outGrid - type(ESMF_RegridMethod_Flag), intent(in) :: regridMethod - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: fieldName - integer, intent(in) :: timeslice - integer, intent(inout) :: rc - - ! local variables - integer :: srcTermProcessing - type(ESMF_Routehandle) :: rh - type(ESMF_Field) :: outField - - outField = ESMF_FieldCreate(outGrid, typekind=ESMF_TYPEKIND_R8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! Perform entire regridding arithmetic on the destination PET - srcTermProcessing = 0 - ! For other options for the regrid operation, please refer to: - ! http://www.earthsystemmodeling.org/esmf_releases/last_built/ESMF_refdoc/node5.html#SECTION050366000000000000000 - call ESMF_FieldRegridStore(inField, outField, regridMethod=regridMethod, & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - srcTermProcessing=srcTermProcessing, Routehandle=rh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! Use fixed ascending order for the sum terms based on their source - ! sequence index to ensure bit-for-bit reproducibility - call ESMF_FieldRegrid(inField, outField, Routehandle=rh, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_FieldWrite(outField, fileName, variableName=fieldName, timeslice=timeslice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_FieldRegridRelease(routehandle=rh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_FieldDestroy(outField,noGarbage=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - rc = ESMF_SUCCESS - - end subroutine ESMFPP_RegridWrite - !----------------------------------------------------------------------------- ! This subroutine requires ESMFv8 - for coupled FV3 diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 index 380c49c77..68d6f10d8 100644 --- a/cpl/module_cplfields.F90 +++ b/cpl/module_cplfields.F90 @@ -6,6 +6,7 @@ module module_cplfields !----------------------------------------------------------------------------- use ESMF + use NUOPC implicit none @@ -224,6 +225,7 @@ module module_cplfields ! Methods public queryImportFields, queryExportFields public cplFieldGet + public realizeConnectedCplFields !----------------------------------------------------------------------------- contains @@ -237,6 +239,8 @@ integer function queryExportFields(fieldname, abortflag) end function queryExportFields +!----------------------------------------------------------------------------- + integer function queryImportFields(fieldname, abortflag) character(len=*),intent(in) :: fieldname @@ -246,6 +250,7 @@ integer function queryImportFields(fieldname, abortflag) end function queryImportFields +!----------------------------------------------------------------------------- integer function queryFieldList(fieldsInfo, fieldname, abortflag) ! returns integer index of first found fieldname in fieldlist @@ -282,9 +287,9 @@ integer function queryFieldList(fieldsInfo, fieldname, abortflag) CALL ESMF_Finalize(endflag=ESMF_END_ABORT) endif end function queryFieldList -! -!------------------------------------------------------------------------------ -! + +!----------------------------------------------------------------------------- + subroutine cplStateGet(state, fieldList, fieldCount, rc) character(len=*), intent(in) :: state @@ -311,6 +316,7 @@ subroutine cplStateGet(state, fieldList, fieldCount, rc) end subroutine cplStateGet +!----------------------------------------------------------------------------- subroutine cplFieldGet(state, name, localDe, & farrayPtr2d, farrayPtr3d, farrayPtr4d, rc) @@ -379,6 +385,159 @@ subroutine cplFieldGet(state, name, localDe, & end do end subroutine cplFieldGet + + + subroutine realizeConnectedCplFields(state, grid, & + numLevels, numSoilLayers, numTracers, & + fields_info, state_tag, fieldList, fill_value, rc) + + use field_manager_mod, only: MODEL_ATMOS + use tracer_manager_mod, only: get_number_tracers, get_tracer_names + + type(ESMF_State), intent(inout) :: state + type(ESMF_Grid), intent(in) :: grid + integer, intent(in) :: numLevels + integer, intent(in) :: numSoilLayers + integer, intent(in) :: numTracers + type(FieldInfo), dimension(:), intent(in) :: fields_info + character(len=*), intent(in) :: state_tag !< Import or export. + type(ESMF_Field), dimension(:), intent(out) :: fieldList + real(ESMF_KIND_R8), optional , intent(in) :: fill_value + integer, intent(out) :: rc + + ! local variables + + integer :: item, pos, tracerCount + logical :: isConnected + type(ESMF_Field) :: field + real(ESMF_KIND_R8) :: l_fill_value + real(ESMF_KIND_R8), parameter :: d_fill_value = 0._ESMF_KIND_R8 + type(ESMF_StateIntent_Flag) :: stateintent + character(len=32), allocatable, dimension(:) :: tracerNames, tracerUnits + + ! begin + rc = ESMF_SUCCESS + + if (present(fill_value)) then + l_fill_value = fill_value + else + l_fill_value = d_fill_value + end if + + ! attach list of tracer names to exported tracer field as metadata + call ESMF_StateGet(state, stateintent=stateintent, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (stateintent == ESMF_STATEINTENT_EXPORT) then + call get_number_tracers(MODEL_ATMOS, num_tracers=tracerCount) + allocate(tracerNames(tracerCount), tracerUnits(tracerCount)) + do item = 1, tracerCount + call get_tracer_names(MODEL_ATMOS, item, tracerNames(item), units=tracerUnits(item)) + end do + end if + + do item = 1, size(fields_info) + isConnected = NUOPC_IsConnected(state, fieldName=trim(fields_info(item)%name), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (isConnected) then + call ESMF_StateGet(state, field=field, itemName=trim(fields_info(item)%name), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldEmptySet(field, grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + select case (fields_info(item)%type) + case ('l','layer') + call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), ungriddedUBound=(/numLevels/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + case ('i','interface') + call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), ungriddedUBound=(/numLevels+1/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + case ('t','tracer') + call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1, 1/), ungriddedUBound=(/numLevels, numTracers/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (allocated(tracerNames)) then + call addFieldMetadata(field, 'tracerNames', tracerNames, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if + if (allocated(tracerUnits)) then + call addFieldMetadata(field, 'tracerUnits', tracerUnits, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if + case ('s','surface') + call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + case ('g','soil') + call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), ungriddedUBound=(/numSoilLayers/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + case default + call ESMF_LogSetError(ESMF_RC_NOT_VALID, & + msg="exportFieldType = '"//trim(fields_info(item)%type)//"' not recognized", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + end select + call NUOPC_Realize(state, field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! -- initialize field value + call ESMF_FieldFill(field, dataFillScheme="const", const1=l_fill_value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! -- save field + fieldList(item) = field + call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fields_info(item)%name) & + // ' is connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) + else + ! remove a not connected Field from State + call ESMF_StateRemove(state, (/trim(fields_info(item)%name)/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fields_info(item)%name) & + // ' is not connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) + end if + end do + + if (allocated(tracerNames)) deallocate(tracerNames) + if (allocated(tracerUnits)) deallocate(tracerUnits) + + end subroutine realizeConnectedCplFields + +!----------------------------------------------------------------------------- + + subroutine addFieldMetadata(field, key, values, rc) + + ! This subroutine implements a preliminary method to provide metadata to + ! a coupled model that is accessing the field via reference sharing + ! (NUOPC SharedStatusField=.true.). The method sets a (key, values) pair + ! in the field's array ESMF_Info object to retrieve an array of strings + ! encoding metadata. + ! + ! Such a capability should be implemented in the standard NUOPC connector + ! for more general applications, possibly providing access to the field's + ! ESMF_Info object. + + type(ESMF_Field) :: field + character(len=*), intent(in) :: key + character(len=*), intent(in) :: values(:) + integer, optional, intent(out) :: rc + + ! local variable + integer :: localrc + type(ESMF_Array) :: array + type(ESMF_Info) :: info + + ! begin + if (present(rc)) rc = ESMF_SUCCESS + + call ESMF_FieldGet(field, array=array, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + call ESMF_InfoGetFromHost(array, info, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + call ESMF_InfoSet(info, key, values, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + end subroutine addFieldMetadata ! !------------------------------------------------------------------------------ ! diff --git a/fv3_cap.F90 b/fv3_cap.F90 index a256fbdf6..06e3edae9 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -27,8 +27,6 @@ module fv3gfs_cap_mod ! use module_fv3_config, only: quilting, output_fh, & nfhout, nfhout_hf, nsout, dt_atmos, & - nfhmax, nfhmax_hf,output_hfmax, & - output_interval,output_interval_hf, & calendar, calendar_type, & force_date_from_configure, & cplprint_flag,output_1st_tstep_rst, & @@ -51,8 +49,8 @@ module fv3gfs_cap_mod nImportFields, importFields, importFieldsInfo, & importFieldsValid, queryImportFields - use module_cap_cpl, only: realizeConnectedCplFields, & - clock_cplIntval, diagnose_cplFields + use module_cplfields, only: realizeConnectedCplFields + use module_cap_cpl, only: diagnose_cplFields use atmos_model_mod, only: setup_exportdata @@ -178,13 +176,17 @@ subroutine InitializeAdvertise(gcomp, rc) type(ESMF_Config) :: cf type(ESMF_RegridMethod_Flag) :: regridmethod type(ESMF_TimeInterval) :: earthStep - integer(ESMF_KIND_I4) :: nhf, nrg + real(ESMF_KIND_R8) :: medAtmCouplingIntervalSec + type(ESMF_Clock) :: fv3Clock + type(ESMF_TimeInterval) :: fv3Step integer,dimension(6) :: date, date_init - integer :: i, j, k, io_unit, urc, ierr, ist + integer :: i, j, k, io_unit, urc, ist integer :: noutput_fh, nfh, nfh2 integer :: petcount integer :: num_output_file + integer :: nfhmax_hf + real :: nfhmax real :: output_startfh, outputfh, outputfh2(2) logical :: opened, loutput_fh, lfreq character(ESMF_MAXSTR) :: name @@ -406,7 +408,23 @@ subroutine InitializeAdvertise(gcomp, rc) line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) ! Read in the FV3 coupling interval - call clock_cplIntval(gcomp, CF) + call ESMF_ConfigGetAttribute(config=CF, value=medAtmCouplingIntervalSec, & + label="atm_coupling_interval_sec:", default=-1.0_ESMF_KIND_R8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + if (medAtmCouplingIntervalSec > 0._ESMF_KIND_R8) then ! The coupling time step is provided + call ESMF_TimeIntervalSet(fv3Step, s_r8=medAtmCouplingIntervalSec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + call ESMF_GridCompGet(gcomp, clock=fv3Clock, rc=RC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + call ESMF_ClockSet(fv3Clock, timestep=fv3Step, rc=RC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + endif first_kdt = 1 if( output_1st_tstep_rst) then @@ -660,7 +678,7 @@ subroutine InitializeAdvertise(gcomp, rc) !--- use nsout for output frequency nsout*dt_atmos nfh = 0 if( nfhmax > output_startfh ) nfh = nint((nfhmax-output_startfh)/(nsout*dt_atmos/3600.))+1 - if(nfh >0) then + if(nfh >0) then allocate(output_fh(nfh)) if( output_startfh == 0) then output_fh(1) = dt_atmos/3600. @@ -746,7 +764,7 @@ subroutine InitializeAdvertise(gcomp, rc) endif do i=2,nfh output_fh(i) = (i-1)*outputfh2(1) + output_startfh - ! Except fh000, which is the first time output, if any other of the + ! Except fh000, which is the first time output, if any other of the ! output time is not integer hour, set lflname_fulltime to be true, so the ! history file names will contain the full time stamp (HHH-MM-SS). if(.not.lflname_fulltime) then @@ -764,7 +782,7 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if( output_startfh == 0) then ! If the output time in output_fh array contains first time stamp output, - ! check the rest of output time, otherwise, check all the output time. + ! check the rest of output time, otherwise, check all the output time. ! If any of them is not integer hour, the history file names will ! contain the full time stamp (HHH-MM-SS) ist = 1 @@ -790,7 +808,7 @@ subroutine InitializeAdvertise(gcomp, rc) endif endif endif ! end loutput_fh - endif + endif if(mype==0) print *,'output_fh=',output_fh(1:size(output_fh)),'lflname_fulltime=',lflname_fulltime ! ! --- advertise Fields in importState and exportState ------------------- @@ -824,10 +842,9 @@ subroutine InitializeRealize(gcomp, rc) integer, intent(out) :: rc ! local variables - character(len=*),parameter :: subname='(fv3gfs_cap:InitializeRealize)' - type(ESMF_State) :: importState, exportState - logical :: isPetLocal - integer :: n + character(len=*),parameter :: subname='(fv3gfs_cap:InitializeRealize)' + type(ESMF_State) :: importState, exportState + logical :: isPetLocal rc = ESMF_SUCCESS @@ -872,12 +889,11 @@ subroutine ModelAdvance(gcomp, rc) ! local variables type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime, startTime, stopTime - type(ESMF_TimeInterval) :: timeStep + ! type(ESMF_TimeInterval) :: timeStep - integer :: i, urc character(len=*),parameter :: subname='(fv3_cap:ModelAdvance)' character(240) :: msgString - character(240) :: startTime_str, currTime_str, stopTime_str, timeStep_str + ! character(240) :: startTime_str, currTime_str, stopTime_str, timeStep_str !----------------------------------------------------------------------------- @@ -962,11 +978,9 @@ subroutine ModelAdvance_phase1(gcomp, rc) integer, intent(out) :: rc ! local variables - type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock - type(ESMF_Time) :: currTime type(ESMF_TimeInterval) :: timeStep - type(ESMF_Time) :: startTime, stopTime + type(ESMF_Time) :: startTime, stopTime, currTime integer :: urc logical :: fcstpe @@ -1074,8 +1088,6 @@ subroutine ModelAdvance_phase2(gcomp, rc) integer, intent(out) :: rc ! local variables - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime type(ESMF_TimeInterval) :: timeStep type(ESMF_Time) :: startTime, stopTime @@ -1323,7 +1335,7 @@ subroutine ModelFinalize(gcomp, rc) ! local variables character(len=*),parameter :: subname='(fv3gfs_cap:ModelFinalize)' - integer :: i, unit, urc + integer :: i, urc type(ESMF_VM) :: vm real(kind=8) :: MPI_Wtime, timeffs ! diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index b9e6bdd9f..7d1544984 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -1,10 +1,5 @@ -#ifdef __PGI -#define ESMF_ERR_ABORT(rc) \ -if (rc /= ESMF_SUCCESS) write(0,*) 'rc=',rc,__FILE__,__LINE__; call ESMF_Finalize(endflag=ESMF_END_ABORT) -#else #define ESMF_ERR_ABORT(rc) \ if (rc /= ESMF_SUCCESS) write(0,*) 'rc=',rc,__FILE__,__LINE__; if(ESMF_LogFoundError(rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) -#endif !----------------------------------------------------------------------- ! @@ -55,7 +50,7 @@ module module_fcst_grid_comp use mpp_domains_mod, only: mpp_get_compute_domains, domain2D use sat_vapor_pres_mod, only: sat_vapor_pres_init - use diag_manager_mod, only: diag_manager_init, diag_manager_end, & + use diag_manager_mod, only: diag_manager_init, diag_manager_end, & diag_manager_set_time_end use data_override_mod, only: data_override_init @@ -65,13 +60,14 @@ module module_fcst_grid_comp use fms_io_mod, only: field_exist, read_data use atmosphere_mod, only: atmosphere_control_data -! - use module_fv3_io_def, only: num_pes_fcst, num_files, filename_base, nbdlphys, & - iau_offset - use module_fv3_config, only: dt_atmos, calendar, fcst_mpi_comm, fcst_ntasks, & - quilting, calendar_type, & - cplprint_flag, force_date_from_configure, & + + use module_fv3_io_def, only: num_pes_fcst, num_files, filename_base, & + nbdlphys, iau_offset + use module_fv3_config, only: dt_atmos, fcst_mpi_comm, fcst_ntasks, & + quilting, calendar, calendar_type, & + cplprint_flag, force_date_from_configure, & restart_endfcst + use get_stochy_pattern_mod, only: write_stoch_restart_atm ! !----------------------------------------------------------------------- @@ -84,23 +80,10 @@ module module_fcst_grid_comp ! !---- model defined-types ---- - type atmos_internalstate_type - type(atmos_data_type) :: Atm - type(time_type) :: Time_atmos, Time_init, Time_end, & - Time_step_atmos, Time_step_ocean, & - Time_restart, Time_step_restart, & - Time_atstart - integer :: num_atmos_calls, ret, intrm_rst - end type - - type atmos_internalstate_wrapper - type(atmos_internalstate_type), pointer :: ptr - end type + type(atmos_data_type), save :: Atmos - type(atmos_internalstate_type),pointer,save :: atm_int_state - type(atmos_internalstate_wrapper),save :: wrap - type(ESMF_VM),save :: VM - type(ESMF_Grid) :: fcstGrid + type(ESMF_Grid) :: fcstGrid + integer :: num_atmos_calls, intrm_rst !----- coupled model data ----- @@ -154,7 +137,7 @@ end subroutine SetServices subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! !----------------------------------------------------------------------- -!*** INITIALIZE THE WRITE GRIDDED COMPONENT. +!*** INITIALIZE THE FORECAST GRIDDED COMPONENT. !----------------------------------------------------------------------- ! type(esmf_GridComp) :: fcst_comp @@ -162,34 +145,33 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) type(esmf_Clock) :: clock integer,intent(out) :: rc ! -!*** LOCAL VARIABLES +!*** local variables ! + type(ESMF_VM) :: vm integer :: tl, i, j integer,dimension(2,6) :: decomptile !define delayout for the 6 cubed-sphere tiles integer,dimension(2) :: regdecomp !define delayout for the nest grid type(ESMF_FieldBundle) :: fieldbundle ! type(ESMF_Time) :: CurrTime, StartTime, StopTime - type(ESMF_TimeInterval) :: RunDuration, TimeElapsed + type(ESMF_TimeInterval) :: RunDuration type(ESMF_Config) :: cf integer :: Run_length integer,dimension(6) :: date, date_end ! character(len=9) :: month - integer :: initClock, unit, nfhour, total_inttime + integer :: initClock, unit, total_inttime integer :: mype - character(3) cfhour character(4) dateSY character(2) dateSM,dateSD,dateSH,dateSN,dateSS character(len=esmf_maxstr) name_FB, name_FB1 character(len=80) :: dateS - real, allocatable, dimension(:,:) :: glon_bnd, glat_bnd character(256) :: gridfile type(ESMF_FieldBundle),dimension(:), allocatable :: fieldbundlephys - real(8) :: mpi_wtime, timeis + real(kind=8) :: mpi_wtime, timeis type(ESMF_DELayout) :: delayout type(ESMF_DistGrid) :: distgrid @@ -197,7 +179,6 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) real(ESMF_KIND_R8),parameter :: dtor = 180.0_ESMF_KIND_R8 / 3.1415926535897931_ESMF_KIND_R8 integer :: jsc, jec, isc, iec, nlev type(domain2D) :: domain - type(time_type) :: iautime integer :: n, fcstNpes, tmpvar logical :: freq_restart, fexist integer, allocatable, dimension(:) :: isl, iel, jsl, jel @@ -212,6 +193,9 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) integer :: num_restart_interval, restart_starttime real,dimension(:),allocatable :: restart_interval + type(time_type) :: Time_init, Time, Time_step, Time_end, & + Time_restart, Time_step_restart + type(time_type) :: iautime ! !----------------------------------------------------------------------- !*********************************************************************** @@ -220,47 +204,36 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) timeis = mpi_wtime() rc = ESMF_SUCCESS ! -!----------------------------------------------------------------------- -!*** ALLOCATE THE WRITE COMPONENT'S INTERNAL STATE. -!----------------------------------------------------------------------- -! - allocate(atm_int_state,stat=rc) -! -!----------------------------------------------------------------------- -!*** ATTACH THE INTERNAL STATE TO THE WRITE COMPONENT. -!----------------------------------------------------------------------- -! - wrap%ptr => atm_int_state - call ESMF_GridCompSetInternalState(fcst_comp, wrap, rc) + call ESMF_VMGetCurrent(vm=vm,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! - call ESMF_VMGetCurrent(vm=VM,rc=RC) - call ESMF_VMGet(vm=VM, localPet=mype, mpiCommunicator=fcst_mpi_comm, & + + call ESMF_VMGet(vm=vm, localPet=mype, mpiCommunicator=fcst_mpi_comm, & petCount=fcst_ntasks, rc=rc) - if (mype == 0) write(0,*)'in fcst comp init, fcst_ntasks=',fcst_ntasks -! + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (mype == 0) write(*,*)'in fcst comp init, fcst_ntasks=',fcst_ntasks + CF = ESMF_ConfigCreate(rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_ConfigLoadFile(config=CF ,filename='model_configure' ,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! + num_restart_interval = ESMF_ConfigGetLen(config=CF, label ='restart_interval:',rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if(mype == 0) print *,'af nems config,num_restart_interval=',num_restart_interval + if (mype == 0) print *,'af nems config,num_restart_interval=',num_restart_interval if (num_restart_interval<=0) num_restart_interval = 1 allocate(restart_interval(num_restart_interval)) restart_interval = 0 call ESMF_ConfigGetAttribute(CF,valueList=restart_interval,label='restart_interval:', & - count=num_restart_interval, rc=rc) + count=num_restart_interval, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if(mype == 0) print *,'af nems config,restart_interval=',restart_interval - + if (mype == 0) print *,'af nems config,restart_interval=',restart_interval ! call fms_init(fcst_mpi_comm) call mpp_init() initClock = mpp_clock_id( 'Initialization' ) call mpp_clock_begin (initClock) !nesting problem - call fms_init call constants_init call sat_vapor_pres_init ! @@ -298,56 +271,51 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) date_init = 0 call ESMF_TimeGet (StartTime, & YY=date_init(1), MM=date_init(2), DD=date_init(3), & - H=date_init(4), M =date_init(5), S =date_init(6), RC=rc) + H=date_init(4), M =date_init(5), S =date_init(6), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if ( date_init(1) == 0 ) date_init = date - atm_int_state%Time_init = set_date (date_init(1), date_init(2), date_init(3), & - date_init(4), date_init(5), date_init(6)) - if(mype==0) write(*,'(A,6I5)') 'StartTime=',date_init + Time_init = set_date (date_init(1), date_init(2), date_init(3), & + date_init(4), date_init(5), date_init(6)) + if (mype == 0) write(*,'(A,6I5)') 'StartTime=',date_init date=0 call ESMF_TimeGet (CurrTime, & YY=date(1), MM=date(2), DD=date(3), & - H=date(4), M =date(5), S =date(6), RC=rc ) + H=date(4), M =date(5), S =date(6), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if(mype==0) write(*,'(A,6I5)') 'CurrTime =',date + if (mype == 0) write(*,'(A,6I5)') 'CurrTime =',date - atm_int_state%Time_atmos = set_date (date(1), date(2), date(3), & - date(4), date(5), date(6)) + Time = set_date (date(1), date(2), date(3), & + date(4), date(5), date(6)) date_end=0 call ESMF_TimeGet (StopTime, & YY=date_end(1), MM=date_end(2), DD=date_end(3), & - H=date_end(4), M =date_end(5), S =date_end(6), RC=rc ) + H=date_end(4), M =date_end(5), S =date_end(6), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if ( date_end(1) == 0 ) date_end = date - atm_int_state%Time_end = set_date (date_end(1), date_end(2), date_end(3), & - date_end(4), date_end(5), date_end(6)) - if(mype==0) write(*,'(A,6I5)') 'StopTime =',date_end -! - call diag_manager_set_time_end(atm_int_state%Time_end) + Time_end = set_date (date_end(1), date_end(2), date_end(3), & + date_end(4), date_end(5), date_end(6)) + if (mype == 0) write(*,'(A,6I5)') 'StopTime =',date_end ! - CALL ESMF_TimeIntervalGet(RunDuration, S=Run_length, RC=rc) + CALL ESMF_TimeIntervalGet(RunDuration, S=Run_length, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! call diag_manager_init (TIME_INIT=date) - call diag_manager_set_time_end(atm_int_state%Time_end) + call diag_manager_set_time_end(Time_end) ! - atm_int_state%Time_step_atmos = set_time (dt_atmos,0) - atm_int_state%num_atmos_calls = Run_length / dt_atmos - atm_int_state%Time_atstart = atm_int_state%Time_atmos - if (mype == 0) write(0,*)'num_atmos_calls=',atm_int_state%num_atmos_calls,'time_init=', & - date_init,'time_atmos=',date,'time_end=',date_end,'dt_atmos=',dt_atmos, & + Time_step = set_time (dt_atmos,0) + num_atmos_calls = Run_length / dt_atmos + if (mype == 0) write(*,*)'num_atmos_calls=',num_atmos_calls,'time_init=', & + date_init,'time=',date,'time_end=',date_end,'dt_atmos=',dt_atmos, & 'Run_length=',Run_length ! set up forecast time array that controls when to write out restart files frestart = 0 - call get_time(atm_int_state%Time_end - atm_int_state%Time_init,total_inttime) + call get_time(Time_end - Time_init, total_inttime) ! set iau offset time - atm_int_state%Atm%iau_offset = iau_offset + Atmos%iau_offset = iau_offset if(iau_offset > 0 ) then iautime = set_time(iau_offset * 3600, 0) endif @@ -359,19 +327,19 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) if(freq_restart) then if(restart_interval(1) >= 0) then tmpvar = restart_interval(1) * 3600 - atm_int_state%Time_step_restart = set_time (tmpvar, 0) + Time_step_restart = set_time (tmpvar, 0) if(iau_offset > 0 ) then - atm_int_state%Time_restart = atm_int_state%Time_init + iautime + atm_int_state%Time_step_restart + Time_restart = Time_init + iautime + Time_step_restart frestart(1) = tmpvar + iau_offset *3600 else - atm_int_state%Time_restart = atm_int_state%Time_init + atm_int_state%Time_step_restart + Time_restart = Time_init + Time_step_restart frestart(1) = tmpvar endif if(restart_interval(1) > 0) then i = 2 - do while ( atm_int_state%Time_restart < atm_int_state%Time_end ) + do while ( Time_restart < Time_end ) frestart(i) = frestart(i-1) + tmpvar - atm_int_state%Time_restart = atm_int_state%Time_restart + atm_int_state%Time_step_restart + Time_restart = Time_restart + Time_step_restart i = i + 1 enddo endif @@ -396,9 +364,9 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) if ( ANY(frestart(:) == total_inttime) ) restart_endfcst = .true. if (mype == 0) print *,'frestart=',frestart(1:10)/3600, 'restart_endfcst=',restart_endfcst, & 'total_inttime=',total_inttime -! if there is restart writing during integration - atm_int_state%intrm_rst = 0 - if (frestart(1)>0) atm_int_state%intrm_rst = 1 +! if there is restart writing during integration + intrm_rst = 0 + if (frestart(1)>0) intrm_rst = 1 ! !----- write time stamps (for start time and end time) ------ @@ -412,14 +380,11 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! !------ initialize component models ------ - call atmos_model_init (atm_int_state%Atm, atm_int_state%Time_init, & - atm_int_state%Time_atmos, atm_int_state%Time_step_atmos) + call atmos_model_init (Atmos, Time_init, Time, Time_step) ! inquire(FILE='data_table', EXIST=fexist) if (fexist) then - call data_override_init ( ) ! Atm_domain_in = Atm%domain, & - ! Ice_domain_in = Ice%domain, & - ! Land_domain_in = Land%domain ) + call data_override_init() endif !----------------------------------------------------------------------- !---- open and close dummy file in restart dir to check if dir exists -- @@ -444,15 +409,15 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) endif if (mpp_pe() == mpp_root_pe()) & - write(*, *) 'create fcst grid: mype,regional,nested=',mype,atm_int_state%Atm%regional,atm_int_state%Atm%nested + write(*, *) 'create fcst grid: mype,regional,nested=',mype,Atmos%regional,Atmos%nested ! regional-only without nests - if( atm_int_state%Atm%regional .and. .not. atm_int_state%Atm%nested ) then + if( Atmos%regional .and. .not. Atmos%nested ) then call atmosphere_control_data (isc, iec, jsc, jec, nlev) - domain = atm_int_state%Atm%domain - fcstNpes = atm_int_state%Atm%layout(1)*atm_int_state%Atm%layout(2) + domain = Atmos%domain + fcstNpes = Atmos%layout(1)*Atmos%layout(2) allocate(isl(fcstNpes), iel(fcstNpes), jsl(fcstNpes), jel(fcstNpes)) allocate(deBlockList(2,2,fcstNpes)) call mpp_get_compute_domains(domain,xbegin=isl,xend=iel,ybegin=jsl,yend=jel) @@ -462,13 +427,13 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) end do delayout = ESMF_DELayoutCreate(petMap=(/(i,i=0,fcstNpes-1)/), rc=rc); ESMF_ERR_ABORT(rc) distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), & - maxIndex=(/atm_int_state%Atm%mlon,atm_int_state%Atm%mlat/), & + maxIndex=(/Atmos%mlon,Atmos%mlat/), & delayout=delayout, & deBlockList=deBlockList, rc=rc); ESMF_ERR_ABORT(rc) - fcstGrid = ESMF_GridCreateNoPeriDim(regDecomp=(/atm_int_state%Atm%layout(1),atm_int_state%Atm%layout(2)/), & + fcstGrid = ESMF_GridCreateNoPeriDim(regDecomp=(/Atmos%layout(1),Atmos%layout(2)/), & minIndex=(/1,1/), & - maxIndex=(/atm_int_state%Atm%mlon,atm_int_state%Atm%mlat/), & + maxIndex=(/Atmos%mlon,Atmos%mlat/), & gridAlign=(/-1,-1/), & decompflag=(/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/), & name="fcst_grid", & @@ -484,8 +449,8 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) do j = jsc, jec do i = isc, iec - glonPtr(i-isc+1,j-jsc+1) = atm_int_state%Atm%lon(i-isc+1,j-jsc+1) * dtor - glatPtr(i-isc+1,j-jsc+1) = atm_int_state%Atm%lat(i-isc+1,j-jsc+1) * dtor + glonPtr(i-isc+1,j-jsc+1) = Atmos%lon(i-isc+1,j-jsc+1) * dtor + glatPtr(i-isc+1,j-jsc+1) = Atmos%lat(i-isc+1,j-jsc+1) * dtor enddo enddo @@ -496,22 +461,22 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) totalLBound=tlb, totalUBound=tub, & farrayPtr=glonPtr, rc=rc); ESMF_ERR_ABORT(rc) glonPtr(tlb(1):tub(1),tlb(2):tub(2)) = & - atm_int_state%Atm%lon_bnd(tlb(1):tub(1),tlb(2):tub(2)) * dtor + Atmos%lon_bnd(tlb(1):tub(1),tlb(2):tub(2)) * dtor call ESMF_GridGetCoord(fcstGrid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CORNER, & totalLBound=tlb, totalUBound=tub, & farrayPtr=glatPtr, rc=rc); ESMF_ERR_ABORT(rc) glatPtr(tlb(1):tub(1),tlb(2):tub(2)) = & - atm_int_state%Atm%lat_bnd(tlb(1):tub(1),tlb(2):tub(2)) * dtor + Atmos%lat_bnd(tlb(1):tub(1),tlb(2):tub(2)) * dtor call mpp_error(NOTE, 'after create fcst grid for regional-only') else ! not regional only - if (.not. atm_int_state%Atm%regional .and. .not. atm_int_state%Atm%nested ) then !! global only + if (.not. Atmos%regional .and. .not. Atmos%nested ) then !! global only do tl=1,6 - decomptile(1,tl) = atm_int_state%Atm%layout(1) - decomptile(2,tl) = atm_int_state%Atm%layout(2) + decomptile(1,tl) = Atmos%layout(1) + decomptile(2,tl) = Atmos%layout(2) decompflagPTile(:,tl) = (/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/) enddo fcstGrid = ESMF_GridCreateMosaic(filename="INPUT/"//trim(gridfile), & @@ -525,12 +490,12 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) else !! global-nesting or regional-nesting - if (mype==0) TileLayout = atm_int_state%Atm%layout + if (mype == 0) TileLayout = Atmos%layout call ESMF_VMBroadcast(vm, bcstData=TileLayout, count=2, & rootPet=0, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (mype==0) npes(1) = mpp_npes() + if (mype == 0) npes(1) = mpp_npes() call ESMF_VMBroadcast(vm, bcstData=npes, count=1, & rootPet=0, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -544,31 +509,31 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) nestRootPet = npes(1) gridfile="grid.nest02.tile2.nc" else - call mpp_error(FATAL, 'Inconsistent nestRootPet and Atm%layout') + call mpp_error(FATAL, 'Inconsistent nestRootPet and Atmos%layout') endif if (mype == nestRootPet) then - if (nestRootPet /= atm_int_state%Atm%pelist(1)) then - write(0,*)'error in fcst_initialize: nestRootPet /= atm_int_state%Atm%pelist(1)' + if (nestRootPet /= Atmos%pelist(1)) then + write(0,*)'error in fcst_initialize: nestRootPet /= Atmos%pelist(1)' write(0,*)'error in fcst_initialize: nestRootPet = ',nestRootPet - write(0,*)'error in fcst_initialize: atm_int_state%Atm%pelist(1) = ',atm_int_state%Atm%pelist(1) + write(0,*)'error in fcst_initialize: Atmos%pelist(1) = ',Atmos%pelist(1) ESMF_ERR_ABORT(100) endif endif ! nest rootPet shares peList with others - if (mype == nestRootPet) peListSize(1) = size(atm_int_state%Atm%pelist) + if (mype == nestRootPet) peListSize(1) = size(Atmos%pelist) call ESMF_VMBroadcast(vm, bcstData=peListSize, count=1, rootPet=nestRootPet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! nest rootPet shares layout with others - if (mype == nestRootPet) regDecomp = atm_int_state%Atm%layout + if (mype == nestRootPet) regDecomp = Atmos%layout call ESMF_VMBroadcast(vm, bcstData=regDecomp, count=2, rootPet=nestRootPet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! prepare petMap variable allocate(petMap(peListSize(1))) - if (mype == nestRootPet) petMap = atm_int_state%Atm%pelist + if (mype == nestRootPet) petMap = Atmos%pelist ! do the actual broadcast of the petMap call ESMF_VMBroadcast(vm, bcstData=petMap, count=peListSize(1), rootPet=nestRootPet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -592,7 +557,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) endif ! !! FIXME - if ( .not. atm_int_state%Atm%nested ) then !! global only + if ( .not. Atmos%nested ) then !! global only call addLsmask2grid(fcstGrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! print *,'call addLsmask2grid after fcstGrid, rc=',rc @@ -653,11 +618,10 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) dateS="hours since "//dateSY//'-'//dateSM//'-'//dateSD//' '//dateSH//':'// & dateSN//":"//dateSS - if (mype == 0) write(0,*)'dateS=',trim(dateS),'date_init=',date_init + if (mype == 0) write(*,*)'dateS=',trim(dateS),'date_init=',date_init call ESMF_AttributeSet(exportState, convention="NetCDF", purpose="FV3", & name="time:units", value=trim(dateS), rc=rc) -! name="time:units", value="hours since 2016-10-03 00:00:00", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_AttributeSet(exportState, convention="NetCDF", purpose="FV3", & @@ -687,10 +651,10 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! for dyn name_FB1 = trim(name_FB)//'_bilinear' fieldbundle = ESMF_FieldBundleCreate(name=trim(name_FB1),rc=rc) - if (mype == 0) write(0,*)'af create fcst fieldbundle, name=',trim(name_FB),'rc=',rc if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (mype == 0) write(*,*)'af create fcst fieldbundle, name=',trim(name_FB),'rc=',rc - call fv_dyn_bundle_setup(atm_int_state%Atm%axes, & + call fv_dyn_bundle_setup(Atmos%axes, & fieldbundle, fcstGrid, quilting, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -709,11 +673,11 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) name_FB1 = trim(name_FB)//'_bilinear' endif fieldbundlephys(j) = ESMF_FieldBundleCreate(name=trim(name_FB1),rc=rc) - if (mype == 0) write(0,*)'af create fcst fieldbundle, name=',trim(name_FB1),'rc=',rc if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (mype == 0) write(*,*)'af create fcst fieldbundle, name=',trim(name_FB1),'rc=',rc enddo ! - call fv_phys_bundle_setup(atm_int_state%Atm%diag, atm_int_state%Atm%axes, & + call fv_phys_bundle_setup(Atmos%diag, Atmos%axes, & fieldbundlephys, fcstGrid, quilting, nbdlphys) ! ! Add the field to the importState so parent can connect to it @@ -737,16 +701,8 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) call get_atmos_model_ungridded_dim(nlev=numLevels, & nsoillev=numSoilLayers, & ntracers=numTracers) -! -!----------------------------------------------------------------------- -! - IF(rc /= ESMF_SUCCESS) THEN - WRITE(0,*)"FAIL: Fcst_Initialize." -! ELSE -! WRITE(0,*)"PASS: Fcst_Initialize." - ENDIF -! - if (mype == 0) write(0,*)'in fcst,init total time: ', mpi_wtime() - timeis + + if (mype == 0) write(*,*)'fcst_initialize total time: ', mpi_wtime() - timeis ! !----------------------------------------------------------------------- ! @@ -767,30 +723,22 @@ subroutine fcst_run_phase_1(fcst_comp, importState, exportState,clock,rc) type(ESMF_Clock) :: clock integer,intent(out) :: rc ! -!----------------------------------------------------------------------- !*** local variables ! - integer :: i,j, mype, na, date(6) - character(20) :: compname - - type(ESMF_Time) :: currtime + integer :: mype, na integer(kind=ESMF_KIND_I8) :: ntimestep_esmf - character(len=64) :: timestamp -! -!----------------------------------------------------------------------- -! - real(kind=8) :: mpi_wtime, tbeg1 + real(kind=8) :: mpi_wtime, tbeg1 ! !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- ! tbeg1 = mpi_wtime() - rc = esmf_success + rc = ESMF_SUCCESS ! !----------------------------------------------------------------------- ! - call ESMF_GridCompGet(fcst_comp, name=compname, localpet=mype, rc=rc) + call ESMF_GridCompGet(fcst_comp, localpet=mype, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! call ESMF_ClockGet(clock, advanceCount=NTIMESTEP_ESMF, rc=rc) @@ -801,31 +749,21 @@ subroutine fcst_run_phase_1(fcst_comp, importState, exportState,clock,rc) !----------------------------------------------------------------------- ! *** call fcst integration subroutines - call get_date (atm_int_state%Time_atmos, date(1), date(2), date(3), & - date(4), date(5), date(6)) - atm_int_state%Time_atmos = atm_int_state%Time_atmos + atm_int_state%Time_step_atmos - - call update_atmos_model_dynamics (atm_int_state%Atm) + call update_atmos_model_dynamics (Atmos) - call update_atmos_radiation_physics (atm_int_state%Atm) + call update_atmos_radiation_physics (Atmos) - call atmos_model_exchange_phase_1 (atm_int_state%Atm, rc=rc) + call atmos_model_exchange_phase_1 (Atmos, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -!----------------------------------------------------------------------- -! -! IF(RC /= ESMF_SUCCESS) THEN -! if(mype==0) WRITE(0,*)"FAIL: fcst_RUN" -! ELSE - if(mype==0) WRITE(*,*)"PASS: fcstRUN phase 1, na = ",na, ' time is ', mpi_wtime()-tbeg1 -! ENDIF + if (mype == 0) write(*,*)"PASS: fcstRUN phase 1, na = ",na, ' time is ', mpi_wtime()-tbeg1 ! !----------------------------------------------------------------------- ! end subroutine fcst_run_phase_1 ! !----------------------------------------------------------------------- -!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& +!####################################################################### !----------------------------------------------------------------------- ! subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) @@ -839,78 +777,78 @@ subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) type(ESMF_Clock) :: clock integer,intent(out) :: rc ! -!----------------------------------------------------------------------- !*** local variables ! - integer :: i,j, mype, na, date(6), seconds - character(20) :: compname - - type(time_type) :: restart_inctime - type(ESMF_Time) :: currtime + integer :: mype, na, date(6), seconds integer(kind=ESMF_KIND_I8) :: ntimestep_esmf character(len=64) :: timestamp -! -!----------------------------------------------------------------------- -! - real(kind=8) :: mpi_wtime, tbeg1 + integer :: unit + real(kind=8) :: mpi_wtime, tbeg1 ! !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- ! tbeg1 = mpi_wtime() - rc = esmf_success + rc = ESMF_SUCCESS ! !----------------------------------------------------------------------- ! - call ESMF_GridCompGet(fcst_comp, name=compname, localpet=mype, rc=rc) + call ESMF_GridCompGet(fcst_comp, localpet=mype, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! + call ESMF_ClockGet(clock, advanceCount=NTIMESTEP_ESMF, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return na = NTIMESTEP_ESMF - if (mype == 0) write(0,*)'in fcst run phase 2, na=',na ! !----------------------------------------------------------------------- ! *** call fcst integration subroutines - call atmos_model_exchange_phase_2 (atm_int_state%Atm, rc=rc) + call atmos_model_exchange_phase_2 (Atmos, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call update_atmos_model_state (atm_int_state%Atm, rc=rc) + call update_atmos_model_state (Atmos, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -!--- intermediate restart - if (atm_int_state%intrm_rst>0) then - if (na /= atm_int_state%num_atmos_calls-1) then - call get_time(atm_int_state%Time_atmos - atm_int_state%Time_init, seconds) + !--- intermediate restart + if (intrm_rst>0) then + if (na /= num_atmos_calls-1) then + call get_time(Atmos%Time - Atmos%Time_init, seconds) if (ANY(frestart(:) == seconds)) then - if (mype == 0) write(0,*)'write out restart at na=',na,' seconds=',seconds, & - 'integration lenght=',na*dt_atmos/3600. - timestamp = date_to_string (atm_int_state%Time_atmos) - call atmos_model_restart(atm_int_state%Atm, timestamp) + if (mype == 0) write(*,*)'write out restart at na=',na,' seconds=',seconds, & + 'integration lenght=',na*dt_atmos/3600. + + timestamp = date_to_string (Atmos%Time) + call atmos_model_restart(Atmos, timestamp) call write_stoch_restart_atm('RESTART/'//trim(timestamp)//'.atm_stoch.res.nc') - call wrt_atmres_timestamp(atm_int_state,timestamp) + !----- write restart file ------ + if (mpp_pe() == mpp_root_pe())then + call get_date (Atmos%Time, date(1), date(2), date(3), & + date(4), date(5), date(6)) + call mpp_open( unit, 'RESTART/'//trim(timestamp)//'.coupler.res', nohdrs=.TRUE. ) + write( unit, '(i6,8x,a)' )calendar_type, & + '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' + + write( unit, '(6i6,8x,a)' )date_init, & + 'Model start time: year, month, day, hour, minute, second' + write( unit, '(6i6,8x,a)' )date, & + 'Current model time: year, month, day, hour, minute, second' + call mpp_close(unit) + endif endif endif endif -! -!----------------------------------------------------------------------- -! -! IF(RC /= ESMF_SUCCESS) THEN -! if(mype==0) WRITE(0,*)"FAIL: fcst_RUN" -! ELSE - if(mype==0) WRITE(*,*)"PASS: fcstRUN phase 2, na = ",na, ' time is ', mpi_wtime()-tbeg1 -! ENDIF + + if (mype == 0) write(*,*)"PASS: fcstRUN phase 2, na = ",na, ' time is ', mpi_wtime()-tbeg1 ! !----------------------------------------------------------------------- ! end subroutine fcst_run_phase_2 ! !----------------------------------------------------------------------- -!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& +!####################################################################### !----------------------------------------------------------------------- ! subroutine fcst_finalize(fcst_comp, importState, exportState,clock,rc) @@ -919,45 +857,33 @@ subroutine fcst_finalize(fcst_comp, importState, exportState,clock,rc) !*** finalize the forecast grid component. !----------------------------------------------------------------------- ! - type(ESMF_GridComp) :: fcst_comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer,intent(out) :: rc + type(ESMF_GridComp) :: fcst_comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer,intent(out) :: rc ! !*** local variables ! - integer :: unit - integer,dimension(6) :: date - - real(8) mpi_wtime, tfs, tfe + integer :: mype + integer :: unit + integer,dimension(6) :: date + real(kind=8) :: mpi_wtime, tbeg1 ! !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- ! - tfs = mpi_wtime() - rc = ESMF_SUCCESS -! -!----------------------------------------------------------------------- -!*** retrieve the fcst component's esmf internal state -!----------------------------------------------------------------------- -! - call ESMF_GridCompGetInternalState(fcst_comp, wrap, rc) - atm_int_state => wrap%ptr -! -!----------------------------------------------------------------------- -! - call atmos_model_end (atm_int_state%atm) -! -!*** check time versus expected ending time + tbeg1 = mpi_wtime() + rc = ESMF_SUCCESS + + call ESMF_GridCompGet(fcst_comp, localpet=mype, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (atm_int_state%Time_atmos /= atm_int_state%Time_end) & - call error_mesg ('program coupler', & - 'final time does not match expected ending time', WARNING) + call atmos_model_end (Atmos) !*** write restart file if( restart_endfcst ) then - call get_date (atm_int_state%Time_atmos, date(1), date(2), date(3), & + call get_date (Atmos%Time, date(1), date(2), date(3), & date(4), date(5), date(6)) call mpp_open( unit, 'RESTART/coupler.res', nohdrs=.TRUE. ) if (mpp_pe() == mpp_root_pe())then @@ -971,56 +897,18 @@ subroutine fcst_finalize(fcst_comp, importState, exportState,clock,rc) endif call mpp_close(unit) endif -! - call diag_manager_end(atm_int_state%Time_atmos ) + + call diag_manager_end (Atmos%Time) call fms_end + + if (mype == 0) write(*,*)'fcst_finalize total time: ', mpi_wtime() - tbeg1 ! !----------------------------------------------------------------------- -! - IF(RC /= ESMF_SUCCESS)THEN - WRITE(0,*)'FAIL: Write_Finalize.' -! ELSE -! WRITE(0,*)'PASS: Write_Finalize.' - ENDIF -! - tfe = mpi_wtime() -! print *,'fms end time: ', tfe-tfs -!----------------------------------------------------------------------- ! end subroutine fcst_finalize ! !####################################################################### -!-- change name from coupler_res to wrt_res_stamp to avoid confusion, -!-- here we only write out atmos restart time stamp -! - subroutine wrt_atmres_timestamp(atm_int_state,timestamp) - type(atmos_internalstate_type), intent(in) :: atm_int_state - character(len=32), intent(in) :: timestamp - - integer :: unit, date(6) - -!----- compute current date ------ - - call get_date (atm_int_state%Time_atmos, date(1), date(2), date(3), & - date(4), date(5), date(6)) - -!----- write restart file ------ - - if (mpp_pe() == mpp_root_pe())then - call mpp_open( unit, 'RESTART/'//trim(timestamp)//'.coupler.res', nohdrs=.TRUE. ) - write( unit, '(i6,8x,a)' )calendar_type, & - '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' - - write( unit, '(6i6,8x,a)' )date_init, & - 'Model start time: year, month, day, hour, minute, second' - write( unit, '(6i6,8x,a)' )date, & - 'Current model time: year, month, day, hour, minute, second' - call mpp_close(unit) - endif - end subroutine wrt_atmres_timestamp -! -!####################################################################### !-- write forecast grid to NetCDF file for diagnostics ! subroutine wrt_fcst_grid(grid, fileName, relaxedflag, regridArea, rc) @@ -1030,7 +918,6 @@ subroutine wrt_fcst_grid(grid, fileName, relaxedflag, regridArea, rc) logical, intent(in), optional :: regridArea integer, intent(out) :: rc ! -!----------------------------------------------------------------------- !*** local variables ! logical :: ioCapable @@ -1040,7 +927,6 @@ subroutine wrt_fcst_grid(grid, fileName, relaxedflag, regridArea, rc) type(ESMF_Array) :: array type(ESMF_ArrayBundle) :: arraybundle logical :: isPresent - integer :: stat logical :: hasCorners logical :: lRegridArea type(ESMF_Field) :: areaField diff --git a/module_fv3_config.F90 b/module_fv3_config.F90 index 53963b488..5a27967a0 100644 --- a/module_fv3_config.F90 +++ b/module_fv3_config.F90 @@ -14,12 +14,8 @@ module module_fv3_config implicit none ! integer :: nfhout, nfhout_hf, nsout, dt_atmos - integer :: nfhmax_hf, first_kdt + integer :: first_kdt integer :: fcst_mpi_comm, fcst_ntasks - real :: nfhmax - type(ESMF_Alarm) :: alarm_output_hf, alarm_output - type(ESMF_TimeInterval) :: output_hfmax - type(ESMF_TimeInterval) :: output_interval,output_interval_hf ! logical :: cplprint_flag logical :: quilting, output_1st_tstep_rst diff --git a/time_utils.F90 b/time_utils.F90 deleted file mode 100644 index 69aafcb60..000000000 --- a/time_utils.F90 +++ /dev/null @@ -1,170 +0,0 @@ -module time_utils_mod - - use fms_mod, only: uppercase - use mpp_mod, only: mpp_error, FATAL - use time_manager_mod, only: time_type, set_time, set_date, get_date - use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR - use time_manager_mod, only: fms_get_calendar_type => get_calendar_type - use ESMF - - implicit none - private - - !-------------------- interface blocks --------------------- - interface fms2esmf_cal - module procedure fms2esmf_cal_c - module procedure fms2esmf_cal_i - end interface fms2esmf_cal - interface esmf2fms_time - module procedure esmf2fms_time_t - module procedure esmf2fms_timestep - end interface esmf2fms_time - - public fms2esmf_cal - public esmf2fms_time - public fms2esmf_time - public string_to_date - - contains - - !-------------------- module code --------------------- - - function fms2esmf_cal_c(calendar) -! ! Return Value: - type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_c -! ! Arguments: - character(len=*), intent(in) :: calendar - - select case( uppercase(trim(calendar)) ) - case( 'GREGORIAN' ) - fms2esmf_cal_c = ESMF_CALKIND_GREGORIAN - case( 'JULIAN' ) - fms2esmf_cal_c = ESMF_CALKIND_JULIAN - case( 'NOLEAP' ) - fms2esmf_cal_c = ESMF_CALKIND_NOLEAP - case( 'THIRTY_DAY' ) - fms2esmf_cal_c = ESMF_CALKIND_360DAY - case( 'NO_CALENDAR' ) - fms2esmf_cal_c = ESMF_CALKIND_NOCALENDAR - case default - call mpp_error(FATAL, & - 'ocean_solo: ocean_solo_nml entry calendar must be one of GREGORIAN|JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) - end select - end function fms2esmf_cal_c - - function fms2esmf_cal_i(calendar) -! ! Return Value: - type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_i -! ! Arguments: - integer, intent(in) :: calendar - - select case(calendar) - case(THIRTY_DAY_MONTHS) - fms2esmf_cal_i = ESMF_CALKIND_360DAY - case(GREGORIAN) - fms2esmf_cal_i = ESMF_CALKIND_GREGORIAN - case(JULIAN) - fms2esmf_cal_i = ESMF_CALKIND_JULIAN - case(NOLEAP) - fms2esmf_cal_i = ESMF_CALKIND_NOLEAP - case(NO_CALENDAR) - fms2esmf_cal_i = ESMF_CALKIND_NOCALENDAR - end select - end function fms2esmf_cal_i - - function esmf2fms_time_t(time) - ! Return Value - type(Time_type) :: esmf2fms_time_t - ! Input Arguments - type(ESMF_Time), intent(in) :: time - ! Local Variables - integer :: yy, mm, dd, h, m, s - type(ESMF_CALKIND_FLAG) :: calkind - - integer :: rc - - call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, & - calkindflag=calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - esmf2fms_time_t = Set_date(yy, mm, dd, h, m, s) - - end function esmf2fms_time_t - - function esmf2fms_timestep(timestep) - ! Return Value - type(Time_type) :: esmf2fms_timestep - ! Input Arguments - type(ESMF_TimeInterval), intent(in):: timestep - ! Local Variables - integer :: s - type(ESMF_CALKIND_FLAG) :: calkind - - integer :: rc - - call ESMF_TimeIntervalGet(timestep, s=s, calkindflag=calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - esmf2fms_timestep = set_time(s, 0) - - end function esmf2fms_timestep - - function fms2esmf_time(time, calkind) - ! Return Value - type(ESMF_Time) :: fms2esmf_time - ! Input Arguments - type(Time_type), intent(in) :: time - type(ESMF_CALKIND_FLAG), intent(in), optional :: calkind - ! Local Variables - integer :: yy, mm, d, h, m, s - type(ESMF_CALKIND_FLAG) :: l_calkind - - integer :: rc - - integer :: yy1, mm1, d1, h1, m1, s1 - - if(present(calkind)) then - l_calkind = calkind - else - l_calkind = fms2esmf_cal(fms_get_calendar_type()) - endif - - call get_date(time, yy, mm, d, h, m, s) - print *,'in fms2esmf_time,time=',yy,mm,d,h,m,s,'calendar_type=', & - fms_get_calendar_type() - - call ESMF_TimeSet(fms2esmf_time, yy=yy, mm=mm, d=d, h=h, m=m, s=s, rc=rc) -! call ESMF_TimeSet(fms2esmf_time, yy=yy, mm=mm, d=d, h=h, m=m, s=s, & -! calkindflag=l_calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - -!test - call ESMF_TimeGet(fms2esmf_time,yy=yy1, mm=mm1, d=d1, h=h1, m=m1, s=s1,rc=rc) - print *,'in fms2esmf_time,test time=',yy1,mm1,d1,h1,m1,s1 - - end function fms2esmf_time - - function string_to_date(string, rc) - character(len=15), intent(in) :: string - integer, intent(out), optional :: rc - type(time_type) :: string_to_date - - integer :: yr,mon,day,hr,min,sec - - if(present(rc)) rc = ESMF_SUCCESS - - read(string, '(I4.4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') yr, mon, day, hr, min, sec - string_to_date = set_date(yr, mon, day, hr, min, sec) - - end function string_to_date - -end module time_utils_mod