diff --git a/atmos_model.F90 b/atmos_model.F90 index e6adc5ebc5..bd2c1c8871 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -99,8 +99,11 @@ module atmos_model_mod DIAG_SIZE use fv_iau_mod, only: iau_external_data_type,getiauforcing,iau_initialize use module_fv3_config, only: output_1st_tstep_rst, first_kdt, nsout, & - restart_endfcst -use module_block_data + restart_endfcst, output_fh, fcst_mpi_comm, & + fcst_ntasks +use module_block_data, only: block_atmos_copy, block_data_copy, & + block_data_copy_or_fill, & + block_data_combine_fractions !----------------------------------------------------------------------- @@ -156,10 +159,8 @@ module atmos_model_mod logical :: debug = .false. !logical :: debug = .true. logical :: sync = .false. -integer, parameter :: maxhr = 4096 -real, dimension(maxhr) :: fdiag = 0. -real :: fhmax=384.0, fhmaxhf=120.0, fhout=3.0, fhouthf=1.0,avg_max_length=3600. -namelist /atmos_model_nml/ blocksize, chksum_debug, dycore_only, debug, sync, fdiag, fhmax, fhmaxhf, fhout, fhouthf, ccpp_suite, avg_max_length +real :: avg_max_length=3600. +namelist /atmos_model_nml/ blocksize, chksum_debug, dycore_only, debug, sync, ccpp_suite, avg_max_length type (time_type) :: diag_time, diag_time_fhzero @@ -491,8 +492,6 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) #ifdef _OPENMP use omp_lib #endif - use fv_mp_mod, only: commglobal - use mpp_mod, only: mpp_npes use update_ca, only: read_ca_restart type (atmos_data_type), intent(inout) :: Atmos @@ -621,6 +620,8 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !--- setup Init_parm Init_parm%me = mpp_pe() Init_parm%master = mpp_root_pe() + Init_parm%fcst_mpi_comm = fcst_mpi_comm + Init_parm%fcst_ntasks = fcst_ntasks Init_parm%tile_num = tile_num Init_parm%isc = isc Init_parm%jsc = jsc @@ -664,7 +665,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) 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, & - GFS_data%Intdiag, GFS_interstitial, commglobal, mpp_npes(), Init_parm) + GFS_data%Intdiag, GFS_interstitial, Init_parm) !--- populate/associate the Diag container elements call GFS_externaldiag_populate (GFS_Diag, GFS_Control, GFS_Data%Statein, GFS_Data%Stateout, & @@ -755,29 +756,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) call close_file (unit) endif - !--- get fdiag -#ifdef GFS_PHYS -!--- check fdiag to see if it is an interval or a list - if (nint(fdiag(2)) == 0) then - if (fhmaxhf > 0) then - maxhf = fhmaxhf / fhouthf - maxh = maxhf + (fhmax-fhmaxhf) / fhout - fdiag(1) = fhouthf - do i=2,maxhf - fdiag(i) = fdiag(i-1) + fhouthf - enddo - do i=maxhf+1,maxh - fdiag(i) = fdiag(i-1) + fhout - enddo - else - maxh = fhmax / fhout - do i = 2, maxh - fdiag(i) = fdiag(i-1) + fhout - enddo - endif - endif - if (mpp_pe() == mpp_root_pe()) write(6,*) "---fdiag",fdiag(1:40) -#endif + !--- set up clock time setupClock = mpp_clock_id( 'GFS Step Setup ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) radClock = mpp_clock_id( 'GFS Radiation ', flags=clock_flag_default, grain=CLOCK_COMPONENT ) @@ -925,7 +904,7 @@ subroutine update_atmos_model_state (Atmos, rc) call get_time (Atmos%Time - diag_time, isec) call get_time (Atmos%Time - Atmos%Time_init, seconds) call atmosphere_nggps_diag(Atmos%Time,ltavg=.true.,avg_max_length=avg_max_length) - if (ANY(nint(fdiag(:)*3600.0) == seconds) .or. (GFS_control%kdt == first_kdt) .or. nsout > 0) then + if (ANY(nint(output_fh(:)*3600.0) == seconds) .or. (GFS_control%kdt == first_kdt) .or. nsout > 0) then if (mpp_pe() == mpp_root_pe()) write(6,*) "---isec,seconds",isec,seconds time_int = real(isec) if(Atmos%iau_offset > zero) then diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index a00b095f8d..110864fbf2 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -108,6 +108,8 @@ module GFS_typedefs type GFS_init_type integer :: me !< my MPI-rank integer :: master !< master MPI-rank + integer :: fcst_mpi_comm !< forecast tasks mpi communicator + integer :: fcst_ntasks !< total number of forecast tasks integer :: tile_num !< tile number for this MPI rank integer :: isc !< starting i-index for this MPI-domain integer :: jsc !< starting j-index for this MPI-domain diff --git a/ccpp/driver/GFS_init.F90 b/ccpp/driver/GFS_init.F90 index 6ea83e6e39..70f0f84940 100644 --- a/ccpp/driver/GFS_init.F90 +++ b/ccpp/driver/GFS_init.F90 @@ -27,8 +27,7 @@ module GFS_init !-------------- subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & Coupling, Grid, Tbd, Cldprop, Radtend, & - Diag, Interstitial, communicator, & - ntasks, Init_parm) + Diag, Interstitial, Init_parm) #ifdef _OPENMP use omp_lib @@ -46,8 +45,6 @@ subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & type(GFS_radtend_type), intent(inout) :: Radtend(:) type(GFS_diag_type), intent(inout) :: Diag(:) type(GFS_interstitial_type), intent(inout) :: Interstitial(:) - integer, intent(in) :: communicator - integer, intent(in) :: ntasks type(GFS_init_type), intent(in) :: Init_parm !--- local variables @@ -81,7 +78,8 @@ subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & Init_parm%input_nml_file, Init_parm%tile_num, & Init_parm%blksz, Init_parm%ak, Init_parm%bk, & Init_parm%restart, Init_parm%hydrostatic, & - communicator, ntasks, nthrds) + Init_parm%fcst_mpi_comm, & + Init_parm%fcst_ntasks, nthrds) do nb = 1,nblks ix = Init_parm%blksz(nb) diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 25b66b1899..1477f3bbce 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -25,11 +25,10 @@ module fv3gfs_cap_mod label_Finalize, & NUOPC_ModelGet ! - use module_fv3_config, only: quilting, & + use module_fv3_config, only: quilting, output_fh, & nfhout, nfhout_hf, nsout, dt_atmos, & nfhmax, nfhmax_hf,output_hfmax, & output_interval,output_interval_hf, & - alarm_output_hf, alarm_output, & calendar, calendar_type, & force_date_from_configure, & cplprint_flag,output_1st_tstep_rst, & @@ -40,8 +39,7 @@ module fv3gfs_cap_mod wrttasks_per_group, n_group, & lead_wrttask, last_wrttask, & output_grid, output_file, & - nsout_io, & - iau_offset + nsout_io, iau_offset ! use module_fcst_grid_comp, only: fcstSS => SetServices, & fcstGrid, numLevels, numSoilLayers, & @@ -176,8 +174,6 @@ subroutine InitializeAdvertise(gcomp, rc) logical :: isPresent, isSet type(ESMF_VM) :: vm, fcstVM type(ESMF_Time) :: currTime, startTime, stopTime - type(ESMF_Time) :: alarm_output_hf_ring, alarm_output_ring - type(ESMF_Time) :: alarm_output_hf_stop, alarm_output_stop type(ESMF_TimeInterval) :: RunDuration, timeStep, rsthour, IAU_offsetTI type(ESMF_Config) :: cf type(ESMF_RegridMethod_Flag) :: regridmethod @@ -186,9 +182,11 @@ subroutine InitializeAdvertise(gcomp, rc) integer,dimension(6) :: date, date_init integer :: i, j, k, io_unit, urc, ierr + integer :: noutput_fh, nfh, nfh2 integer :: petcount integer :: num_output_file - logical :: opened + real :: output_startfh, outputfh, outputfh2(2) + logical :: opened, loutput_fh, lfreq character(ESMF_MAXSTR) :: name integer,dimension(:), allocatable :: petList, fcstPetList, originPetList, targetPetList character(len=esmf_maxstr),allocatable :: fcstItemNameList(:) @@ -197,7 +195,6 @@ subroutine InitializeAdvertise(gcomp, rc) integer :: isrcTermProcessing character(len=*),parameter :: subname='(fv3_cap:InitializeAdvertise)' - integer :: nfmout, nfsout , nfmout_hf, nfsout_hf real(kind=8) :: MPI_Wtime, timewri, timeis, timerhs ! !------------------------------------------------------------------------ @@ -266,7 +263,10 @@ subroutine InitializeAdvertise(gcomp, rc) call ESMF_ConfigGetAttribute(config=CF,value=iau_offset,default=0,label ='iau_offset:',rc=rc) if (iau_offset < 0) iau_offset=0 - if(mype == 0) print *,'af nems config,quilting=',quilting,'calendar=', trim(calendar),' iau_offset=',iau_offset + noutput_fh = ESMF_ConfigGetLen(config=CF, label ='output_fh:',rc=rc) + + if(mype == 0) print *,'af nems config,quilting=',quilting,'calendar=', trim(calendar),' iau_offset=',iau_offset, & + 'noutput_fh=',noutput_fh ! nfhout = 0 ; nfhmax_hf = 0 ; nfhout_hf = 0 ; nsout = 0 if ( quilting ) then @@ -324,13 +324,14 @@ subroutine InitializeAdvertise(gcomp, rc) enddo endif ! -! variables for alarms - call ESMF_ConfigGetAttribute(config=CF, value=nfhout, label ='nfhout:', rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=nfhmax_hf,label ='nfhmax_hf:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=nfhout_hf,label ='nfhout_hf:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=nsout, label ='nsout:',rc=rc) +! variables for output + call ESMF_ConfigGetAttribute(config=CF, value=nfhout, label ='nfhout:', default=-1,rc=rc) + call ESMF_ConfigGetAttribute(config=CF, value=nfhmax_hf,label ='nfhmax_hf:',default=-1,rc=rc) + call ESMF_ConfigGetAttribute(config=CF, value=nfhout_hf,label ='nfhout_hf:',default=-1,rc=rc) + call ESMF_ConfigGetAttribute(config=CF, value=nsout, label ='nsout:', default=-1,rc=rc) nsout_io = nsout - if(mype==0) print *,'af nems config,nfhout,nsout=',nfhout,nfhmax_hf,nfhout_hf, nsout +! + if(mype==0) print *,'af nems config,nfhout,nsout=',nfhout,nfhmax_hf,nfhout_hf, nsout,noutput_fh endif ! quilting ! @@ -462,6 +463,9 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if(mype == 0) print *,'af fcstCom FBCount= ',FBcount ! +! set start time for output + output_startfh = 0. +! !----------------------------------------------------------------------- !*** create and initialize Write component(s). !----------------------------------------------------------------------- @@ -639,71 +643,70 @@ subroutine InitializeAdvertise(gcomp, rc) deallocate(targetPetList) ! !--------------------------------------------------------------------------------- -!--- SET UP ALARM +!--- set up output forecast time array ! -!--- for every time step output, overwrite nfhout - - if(nsout > 0) then - nfhout = int(nsout*dt_atmos/3600.) - nfmout = int((nsout*dt_atmos-nfhout*3600.)/60.) - nfsout = int(nsout*dt_atmos-nfhout*3600.-nfmout*60) - else - nfmout = 0 - nfsout = 0 +!--- get current forecast length + if(iau_offset > 0) then + output_startfh = iau_offset endif - call ESMF_TimeIntervalSet(output_interval, h=nfhout, m=nfmout, s=nfsout, rc=rc) - if(mype==0) print *,'af set up output_interval,rc=',rc,'nfhout=',nfhout,nfmout,nfsout - - if (nfhmax_hf > 0 .and. nsout <= 0) then - - nfmout_hf = 0; nfsout_hf = 0 - call ESMF_TimeIntervalSet(output_interval_hf, h=nfhout_hf, m=nfmout_hf, & - s=nfsout_hf, rc=rc) - call ESMF_TimeIntervalSet(output_hfmax, h=nfhmax_hf, m=0, s=0, rc=rc) - alarm_output_hf_stop = starttime + output_hfmax + output_interval_hf - if (currtime <= starttime+output_hfmax) then - nhf = (currtime-starttime)/output_interval_hf - alarm_output_hf_ring = startTime + (nhf+1_ESMF_KIND_I4)*output_interval_hf - if(iau_offset > 0) then - alarm_output_hf_ring = startTime + IAU_offsetTI - if( currtime > alarm_output_hf_ring ) then - alarm_output_hf_ring = startTime + (nhf+1_ESMF_KIND_I4)*output_interval_hf - endif + if(mype==0) print *,'in fv3 cap init, output_startfh=',output_startfh,'nsout=',nsout, & + 'iau_offset=',iau_offset,'nfhmax_hf=',nfhmax_hf,'nfhout_hf=',nfhout_hf, & + 'nfhout=',nfhout +! +!--- set up output_fh with output forecast hours +! if the run does not have iau, it will have output after first step integration as fh00 +! if the run has iau, it will start output at fh=00 at the cycle time (usually StartTime+IAU_offsetTI) + if(nsout > 0) then +!--- 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 + allocate(output_fh(nfh)) + if( output_startfh == 0) then + output_fh(1) = dt_atmos/3600. + else + output_fh(1) = output_startfh endif - alarm_output_hf = ESMF_AlarmCreate(clock_fv3,name='ALARM_OUTPUT_HF', & - ringTime =alarm_output_hf_ring, & - ringInterval =output_interval_hf, & !<-- Time interval between - stoptime =alarm_output_hf_stop, & !<-- Time interval between - ringTimeStepCount=1, & !<-- The Alarm rings for this many timesteps - sticky =.false., & !<-- Alarm does not ring until turned off - rc =rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - alarm_output_ring = startTime + output_hfmax + output_interval - else - nrg = (currtime-starttime-output_hfmax)/output_interval - alarm_output_ring = startTime + output_hfmax + (nrg+1_ESMF_KIND_I4) * output_interval + do i=2,nfh + output_fh(i) = (i-1)*nsout*dt_atmos/3600. + output_startfh + enddo endif - else - nrg = (currtime-starttime)/output_interval - alarm_output_ring = startTime + (nrg+1_ESMF_KIND_I4) * output_interval - if(iau_offset > 0) then - alarm_output_ring = startTime + IAU_offsetTI - if( currtime > alarm_output_ring ) then - alarm_output_ring = startTime + (nrg+1_ESMF_KIND_I4) * output_interval + elseif (nfhmax_hf > 0 ) then +!--- use high frequency output and low frequency for output forecast time + nfh = 0 + if( nfhout_hf>0 .and. nfhmax_hf>output_startfh) nfh = nint((nfhmax_hf-output_startfh)/nfhout_hf)+1 + nfh2 = 0 + if( nfhout>0 .and. nfhmax>nfhmax_hf) nfh2 = nint((nfhmax-nfhmax_hf)/nfhout) + if( nfh+nfh2 > 0) then + allocate(output_fh(nfh+nfh2)) + if( output_startfh == 0) then + output_fh(1) = dt_atmos/3600. + else + output_fh(1) = output_startfh + endif + do i=2,nfh + output_fh(i) = (i-1)*nfhout_hf + output_startfh + enddo + do i=1,nfh2 + output_fh(nfh+i) = nfhmax_hf + i*nfhout + enddo + endif + elseif (nfhout > 0 ) then +!--- use one output freqency + nfh = 0 + if( nfhout > 0 .and. nfhmax>output_startfh) nfh = nint((nfhmax-output_startfh)/nfhout) + 1 + if( nfh > 0 ) then + allocate(output_fh(nfh)) + if( output_startfh == 0) then + output_fh(1) = dt_atmos/3600. + else + output_fh(1) = output_startfh endif + do i=2,nfh + output_fh(i) = (i-1)*nfhout + output_startfh + enddo endif endif - - call ESMF_TimeIntervalSet(output_interval, h=nfhout, m=nfmout, & - s=nfsout, rc=rc) - alarm_output = ESMF_AlarmCreate(clock_fv3, name ='ALARM_OUTPUT', & - ringTime =alarm_output_ring, & !<-- Forecast/Restart start time (ESMF) - ringInterval =output_interval, & !<-- Time interval between - ringTimeStepCount=1, & !<-- The Alarm rings for this many timesteps - sticky =.false., & !<-- Alarm does not ring until turned off - rc =rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! !----------------------------------------------------------------------- !*** SET THE FIRST WRITE GROUP AS THE FIRST ONE TO ACT. @@ -713,6 +716,56 @@ subroutine InitializeAdvertise(gcomp, rc) ! !end quilting endif +! +!-- set up output forecast time if output_fh is specified + if (noutput_fh > 0 ) then +!--- use output_fh to sepcify output forecast time + loutput_fh = .true. + if(noutput_fh == 1) then + call ESMF_ConfigGetAttribute(CF,value=outputfh,label='output_fh:', rc=rc) + if(outputfh == -1) loutput_fh = .false. + endif + if( loutput_fh ) then + lfreq = .false. + if( allocated(output_fh)) deallocate(output_fh) + if(noutput_fh == 2) then + call ESMF_ConfigGetAttribute(CF,valueList=outputfh2,label='output_fh:', & + count=noutput_fh, rc=rc) + if(outputfh2(2) == -1) then + !--- output_hf is output frequency, the second item is -1 + lfreq = .true. + nfh = 0 + if( nfhmax>output_startfh) nfh = nint((nfhmax-output_startfh)/outputfh2(1)) + 1 + if( nfh > 0) then + allocate(output_fh(nfh)) + if( output_startfh == 0) then + output_fh(1) = dt_atmos/3600. + else + output_fh(1) = output_startfh + endif + do i=2,nfh + output_fh(i) = (i-1)*outputfh2(1) + output_startfh + enddo + endif + endif + endif + if( noutput_fh /= 2 .or. .not. lfreq ) then + allocate(output_fh(noutput_fh)) + output_fh = 0 + call ESMF_ConfigGetAttribute(CF,valueList=output_fh,label='output_fh:', & + count=noutput_fh, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if( output_startfh == 0) then + if(output_fh(1)==0) output_fh(1) = dt_atmos/3600. + else + do i=1,noutput_fh + output_fh(i) = output_startfh + output_fh(i) + enddo + endif + endif + endif ! end loutput_fh + endif + if(mype==0) print *,'output_fh=',output_fh(1:size(output_fh)) ! ! --- advertise Fields in importState and exportState ------------------- @@ -1003,8 +1056,8 @@ subroutine ModelAdvance_phase2(gcomp, rc) type(ESMF_TimeInterval) :: time_elapsed integer :: na, i, urc + integer :: nfseconds logical :: fcstpe - logical :: isAlarmEnabled, isAlarmRinging, lalarm character(len=*),parameter :: subname='(fv3_cap:ModelAdvance_phase2)' character(240) :: msgString @@ -1041,47 +1094,18 @@ subroutine ModelAdvance_phase2(gcomp, rc) time_elapsed = currtime - starttime na = nint(time_elapsed/timeStep) - - ! if(mype==0) print *,'in fv3_cap,in model run, advance2,na=',na + call ESMF_TimeIntervalGet(time_elapsed, s=nfseconds, rc=rc) +! + if(mype==0) print *,'n fv3_cap,in model run, advance,na=',na !------------------------------------------------------------------------------- -!*** if alarms ring, call data transfer and write grid comp run +!*** if it is output time, call data transfer and write grid comp run if( quilting ) then - lalarm = .false. - if (nfhmax_hf > 0) then - - if(currtime <= starttime+output_hfmax) then - isAlarmEnabled = ESMF_AlarmIsEnabled(alarm = ALARM_OUTPUT_HF, rc = RC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if(isAlarmEnabled) then - isAlarmRinging = ESMF_AlarmIsRinging(alarm = ALARM_OUTPUT_HF,rc = Rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (isAlarmRinging) LALARM = .true. - endif - else - isAlarmEnabled = ESMF_AlarmIsEnabled(alarm = ALARM_OUTPUT, rc = RC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if(isAlarmEnabled) then - isAlarmRinging = ESMF_AlarmIsRinging(alarm = ALARM_OUTPUT,rc = Rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (isAlarmRinging) LALARM = .true. - endif - endif - - endif + output: if (ANY(nint(output_fh(:)*3600.0) == nfseconds)) then ! - isAlarmEnabled = ESMF_AlarmIsEnabled(alarm = ALARM_OUTPUT, rc = RC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if(isAlarmEnabled) then - isAlarmRinging = ESMF_AlarmIsRinging(alarm = ALARM_OUTPUT,rc = Rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (isAlarmRinging) LALARM = .true. - endif - ! if (mype == 0 .or. mype == lead_wrttask(1)) print *,' aft fcst run lalarm=',lalarm, & - ! 'FBcount=',FBcount,'na=',na - - output: IF(lalarm .or. na==first_kdt ) then + if (mype == 0 .or. mype == lead_wrttask(1)) print *,' aft fcst run output time=',nfseconds, & + 'FBcount=',FBcount,'na=',na timerhi = MPI_Wtime() call ESMF_VMEpochEnter(epoch=ESMF_VMEpoch_Buffer, rc=rc) @@ -1111,15 +1135,9 @@ subroutine ModelAdvance_phase2(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - ! if (mype == 0 .or. mype == lead_wrttask(n_group)) print *,'aft wrtgridcomp run,na=',na, & - ! ' time=', timerh- timerhi - call ESMF_LogWrite('Model Advance: after wrtcomp run ', ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! if (mype == 0 .or. mype == lead_wrttask(n_group)) print *,'fv3_cap,aft model advance phase2,na=', & - !if (mype == 0 .or. mype == lead_wrttask(n_group)) print *,'fv3_cap,aft model advance phase2,na=', & - ! na,' time=', MPI_Wtime()- timewri if (n_group == write_groups) then n_group = 1 else diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index f79a4fb743..a027440589 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -43,18 +43,17 @@ module module_fcst_grid_comp addLsmask2grid use constants_mod, only: constants_init - use fms_mod, only: open_namelist_file, file_exist, check_nml_error, & + use fms_mod, only: open_namelist_file, file_exist, check_nml_error, & error_mesg, fms_init, fms_end, close_file, & write_version_number, uppercase - 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_mod, only: mpp_init, mpp_pe, mpp_root_pe, & + mpp_error, FATAL, WARNING + use mpp_mod, only: mpp_clock_id, mpp_clock_begin, mpp_clock_end use mpp_io_mod, only: mpp_open, mpp_close, MPP_NATIVE, MPP_RDONLY, MPP_DELETE - use mpp_domains_mod, only: mpp_get_global_domain, mpp_global_field, CORNER, domain2d - use mpp_domains_mod, only: mpp_get_compute_domains + use mpp_domains_mod, only: mpp_get_compute_domains, domain2D use memutils_mod, only: print_memuse_stats use sat_vapor_pres_mod, only: sat_vapor_pres_init @@ -71,7 +70,7 @@ module module_fcst_grid_comp ! use module_fv3_io_def, only: num_pes_fcst, num_files, filename_base, nbdlphys, & iau_offset - use module_fv3_config, only: dt_atmos, calendar, & + use module_fv3_config, only: dt_atmos, calendar, fcst_mpi_comm, fcst_ntasks, & quilting, calendar_type, & cplprint_flag, force_date_from_configure, & restart_endfcst @@ -178,11 +177,10 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) integer :: Run_length integer,dimension(6) :: date, date_end - integer :: mpi_comm_comp ! character(len=9) :: month integer :: initClock, unit, nfhour, total_inttime - integer :: mype, ntasks + integer :: mype character(3) cfhour character(4) dateSY character(2) dateSM,dateSD,dateSH,dateSN,dateSS @@ -200,9 +198,10 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) real(ESMF_KIND_R8),dimension(:,:), pointer :: glatPtr, glonPtr 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(domain2D) :: domain + type(time_type) :: iautime integer :: n, fcstNpes, tmpvar - logical :: single_restart, fexist + logical :: freq_restart, fexist integer, allocatable, dimension(:) :: isl, iel, jsl, jel integer, allocatable, dimension(:,:,:) :: deBlockList @@ -212,7 +211,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) integer :: nestRootPet, peListSize(1) integer, allocatable :: petMap(:) - integer :: num_restart_interval + integer :: num_restart_interval, restart_starttime real,dimension(:),allocatable :: restart_interval ! !----------------------------------------------------------------------- @@ -237,9 +236,9 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, 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=mpi_comm_comp, & - petCount=ntasks, rc=rc) - if (mype == 0) write(0,*)'in fcst comp init, ntasks=',ntasks + 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 ! CF = ESMF_ConfigCreate(rc=rc) call ESMF_ConfigLoadFile(config=CF ,filename='model_configure' ,rc=rc) @@ -257,7 +256,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) if(mype == 0) print *,'af nems config,restart_interval=',restart_interval ! - call fms_init(mpi_comm_comp) + call fms_init(fcst_mpi_comm) call mpp_init() initClock = mpp_clock_id( 'Initialization' ) call mpp_clock_begin (initClock) !nesting problem @@ -344,22 +343,33 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) 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, & 'Run_length=',Run_length + +! set up forecast time array that controls when to write out restart files frestart = 0 - single_restart = .false. - call get_time(atm_int_state%Time_end - atm_int_state%Time_atstart,total_inttime) + call get_time(atm_int_state%Time_end - atm_int_state%Time_init,total_inttime) +! set iau offset time + atm_int_state%Atm%iau_offset = iau_offset + if(iau_offset > 0 ) then + iautime = set_time(iau_offset * 3600, 0) + endif +! if the second item is -1, the first number is frequency + freq_restart = .false. if(num_restart_interval == 2) then - if(restart_interval(2)== -1) single_restart = .true. + if(restart_interval(2)== -1) freq_restart = .true. endif - if(single_restart) then - frestart(1) = restart_interval(1) * 3600 - elseif ( num_restart_interval == 1) then + if(freq_restart) then if(restart_interval(1) == 0) then frestart(1) = total_inttime else if(restart_interval(1) > 0) then tmpvar = restart_interval(1) * 3600 - frestart(1) = tmpvar atm_int_state%Time_step_restart = set_time (tmpvar, 0) - atm_int_state%Time_restart = atm_int_state%Time_atstart + atm_int_state%Time_step_restart + if(iau_offset > 0 ) then + atm_int_state%Time_restart = atm_int_state%Time_init + iautime + atm_int_state%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 + frestart(1) = tmpvar + endif i = 2 do while ( atm_int_state%Time_restart < atm_int_state%Time_end ) frestart(i) = frestart(i-1) + tmpvar @@ -367,19 +377,29 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) i = i + 1 enddo endif - else if(num_restart_interval > 1) then - do i=1,num_restart_interval - frestart(i) = restart_interval(i) * 3600 - enddo +! otherwise it is an array with forecast time at which the restart files will be written out + else if(num_restart_interval >= 1) then + if(restart_interval(1) == 0 ) then + frestart(1) = total_inttime + else + if(iau_offset > 0 ) then + restart_starttime = iau_offset *3600 + else + restart_starttime = 0 + endif + do i=1,num_restart_interval + frestart(i) = restart_interval(i) * 3600. + restart_starttime + enddo + endif endif +! if to write out restart at the end of forecast restart_endfcst = .false. 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 - atm_int_state%Atm%iau_offset = iau_offset ! !----- write time stamps (for start time and end time) ------ diff --git a/module_fv3_config.F90 b/module_fv3_config.F90 index eee900635d..53963b4889 100644 --- a/module_fv3_config.F90 +++ b/module_fv3_config.F90 @@ -15,6 +15,7 @@ module module_fv3_config ! integer :: nfhout, nfhout_hf, nsout, dt_atmos integer :: nfhmax_hf, first_kdt + integer :: fcst_mpi_comm, fcst_ntasks real :: nfhmax type(ESMF_Alarm) :: alarm_output_hf, alarm_output type(ESMF_TimeInterval) :: output_hfmax @@ -25,6 +26,7 @@ module module_fv3_config logical :: force_date_from_configure logical :: restart_endfcst ! + real,dimension(:),allocatable :: output_fh character(esmf_maxstr),dimension(:),allocatable :: filename_base character(17) :: calendar=' ' integer :: calendar_type = -99