diff --git a/DynCore_GridCompMod.F90 b/DynCore_GridCompMod.F90 index 8851e0f..8ef5946 100644 --- a/DynCore_GridCompMod.F90 +++ b/DynCore_GridCompMod.F90 @@ -22,8 +22,6 @@ module FVdycoreCubed_GridComp use MAPL_Constants, only: MAPL_VectorField ! pchakrab: TODO - need MAPL3 equivalent use MAPL_Constants, only: MAPL_UNDEFINED_REAL - use ESMFL_Mod, only: ESMFL_BundleGetPointerToData, MAPL_AreaMean - use MAPL_AbstractRegridderMod, only: AbstractRegridder ! pchakrab - TODO: need MAPL3 equivalent ! use MAPL_SunMod, only: MAPL_SunOrbit, MAPL_SunGetInsolation @@ -32,8 +30,8 @@ module FVdycoreCubed_GridComp use MAPL_RegridMethods, only: REGRID_METHOD_BILINEAR use MAPL_CFIOMod, only: MAPL_CFIORead use MAPL_FieldPointerUtilities, only: MAPL_FieldDestroy - use MAPL_MaxMinMod, only: MAPL_MaxMin - use MAPL_CommsMod, only: MAPL_AM_I_ROOT, MAPL_ArrayGather => ArrayGather + use mapl3g_Utilities, only: MAPL_MaxMin, MAPL_AreaMean + use mapl3g_Utilities_Comms_API, only: MAPL_Am_I_Root, MAPL_ArrayGather use FileIOSharedMod, only: WRITE_PARALLEL @@ -47,6 +45,7 @@ module FVdycoreCubed_GridComp use mapl3g_Geom_API, only: MAPL_GridGetCoordinates use mapl3g_State_API, only: MAPL_StateGetPointer use mapl3g_Field_API, only: MAPL_FieldCreate + use mapl3g_FieldBundle_API, only: MAPL_FieldBundleGetPointer use mapl3g_FieldBundle_API, only: MAPL_FieldBundleAdd use mapl3g_RestartModes, only: MAPL_RESTART_SKIP, MAPL_RESTART_REQUIRED @@ -341,10 +340,12 @@ Subroutine SetServices(gc, rc) !DESCRIPTION: Set services (register) for the FVCAM Dynamical Core GridComp !EOP - type(DynState), pointer :: self +#ifdef SKIP_TRACERS character(len=ESMF_MAXSTR) :: myTracer - integer :: ilev, itracer, status + integer :: ilev, itracer +#endif logical :: FV3_STANDALONE + integer :: status ! Wrap gridcomp's private state and store it in gc _SET_NAMED_PRIVATE_STATE(gc, DynState, PRIVATE_STATE) @@ -599,7 +600,8 @@ subroutine Run(gc, import, export, clock, rc) integer, intent(out) :: rc !EOP - integer :: status + integer :: status, comm + type(ESMF_VM) :: vm type(ESMF_FieldBundle) :: bundle, ana_bundle type(ESMF_Field) :: field, ana_field type(ESMF_Alarm) :: alarm @@ -615,10 +617,9 @@ subroutine Run(gc, import, export, clock, rc) integer :: NQ integer :: IM, JM, KM - integer :: NKE, NPHI integer :: NUMVARS integer :: ifirstxy, ilastxy, jfirstxy, jlastxy - integer :: kend, i, j, K, L, n + integer :: kend, i, j, K, n integer :: im_replay,jm_replay logical, parameter :: convt = .false. ! Until this is run with full physics logical :: is_shutoff, is_ringing @@ -758,7 +759,7 @@ subroutine Run(gc, import, export, clock, rc) ! type(MAPL_SunOrbit) :: ORBIT real(r4), allocatable :: lats(:,:), lons(:,:) - real(r4), allocatable :: ZTH(:,:), SLR(:,:) + ! real(r4), allocatable :: ZTH(:,:), SLR(:,:) - used in some commented code real :: rc_blend_p_above, rc_blend_p_below, sclinc integer :: rc_blend @@ -773,17 +774,23 @@ subroutine Run(gc, import, export, clock, rc) integer :: CONSV, FILL, nx_ana, ny_ana logical, save :: firstime = .true. - logical :: adjustTracers, tend, exclude, isPresent, doEnergetics, doTropvars + logical :: adjustTracers, exclude, doEnergetics, doTropvars logical :: FV3_STANDALONE - integer :: pos, nqt, itracer + integer :: pos, nqt +#ifdef SKIP_TRACERS + integer :: itracer +#endif type(ESMF_Alarm) :: predictorAlarm type(ESMF_Grid) :: bgrid - character(len=ESMF_MAXSTR) :: tmpstring, fieldname, myTracer + character(len=ESMF_MAXSTR) :: fieldname character(len=ESMF_MAXSTR), allocatable :: biggerlist(:) character(len=:), allocatable :: adjustTracerMode, xlist(:) real(kind=r8) :: t1, t2, dyn_run_timer class(logger_t), pointer :: logger + call ESMF_VMGetCurrent(vm, _RC) + call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) + call MAPL_GridCompGet(gc, grid=esmfgrid, hconfig=hconfig, logger=logger, _RC) call ESMF_GridValidate(esmfgrid, _RC) @@ -905,29 +912,6 @@ subroutine Run(gc, import, export, clock, rc) if (adjustTracers) then if (firstime) then firstime = .false. - ! get the list of excluded tracers from resource - n = 0 - ! call ESMF_ConfigFindLabel(cf, "EXCLUDE_ADVECTION_TRACERS_LIST:", isPresent=isPresent, _RC) - ! if(isPresent .or. (AdvCore_Advection >= 1)) then - ! tend = .false. - ! allocate(xlist(XLIST_MAX), stat=status) - ! VERIFY_(STATUS) - ! if (isPresent) then - ! do while (.not.tend) - ! call ESMF_ConfigGetAttribute(cf, value=tmpstring, default="", rc=status) !ALT: we don't check return status - ! if (tmpstring /= "") then - ! n = n + 1 - ! if (n > size(xlist)) then - ! allocate(biggerlist(2*n), _STAT) - ! biggerlist(1:n-1)=xlist - ! call move_alloc(from=biggerlist, to=xlist) - ! end if - ! xlist(n) = tmpstring - ! end if - ! call ESMF_ConfigNextLine(cf, tableEnd=tend, _RC) - ! enddo - ! endif - ! end if xlist = ESMF_HConfigAsStringSeq(hconfig, keyString="EXCLUDE_ADVECTION_TRACERS_LIST", stringLen=ESMF_MAXSTR, _RC) if (allocated(xlist)) n = size(xlist) @@ -1038,6 +1022,9 @@ subroutine Run(gc, import, export, clock, rc) if (.not. is_shutoff) then ! If requested, do Intermittent Replay + ! NOTE: pchakrab - need to double check with Bill, but the replay code is not going + ! to be here anymore + call MAPL_GridCompGetResource(gc, "REPLAY_MODE", ReplayMode, default="NoReplay", _RC) REPLAYING: if(adjustl(ReplayMode)=="Intermittent") then @@ -1395,7 +1382,7 @@ subroutine Run(gc, import, export, clock, rc) elsewhere qsum2 = MAPL_UNDEFINED_REAL end where - call MAPL_AreaMean(TRSUM1(n), qsum2, area, esmfgrid, _RC) + TRSUM1(n) = MAPL_AreaMean(qsum2, area, comm, _RC) enddo endif @@ -1443,7 +1430,7 @@ subroutine Run(gc, import, export, clock, rc) elsewhere qsum2 = MAPL_UNDEFINED_REAL end where - call MAPL_AreaMean(TRSUM2(n), qsum2, area, esmfgrid, _RC) + TRSUM2(n) = MAPL_AreaMean(qsum2, area, comm, _RC) enddo endif @@ -2025,10 +2012,17 @@ subroutine Run(gc, import, export, clock, rc) call FILLOUT3(export, 'V_AGRID', va , _RC) if (DEBUG_DYN) then - call MAPL_MaxMin('DYN: Q_AF_DYN ', qv) - call MAPL_MaxMin('DYN: T_AF_DYN ', tempxy) - call MAPL_MaxMin('DYN: U_AF_DYN ', ua) - call MAPL_MaxMin('DYN: V_AF_DYN ', va) + block + real :: maxmin(2) + maxmin = MAPL_MaxMin(qv, comm, _RC) + call logger%info("max/min(Q_AF_DYN): %f/%f", maxmin(1), maxmin(2)) + maxmin = MAPL_MaxMin(tempxy, comm, _RC) + call logger%info("max/min(T_AF_DYN): %f/%f", maxmin(1), maxmin(2)) + maxmin = MAPL_MaxMin(ua, comm, _RC) + call logger%info("max/min(U_AF_DYN): %f/%f", maxmin(1), maxmin(2)) + maxmin = MAPL_MaxMin(va, comm, _RC) + call logger%info("max/min(V_AF_DYN): %f/%f", maxmin(1), maxmin(2)) + end block endif ! Compute Diagnostic Dynamics Tendencies @@ -2771,7 +2765,7 @@ subroutine Run(gc, import, export, clock, rc) subroutine check_replay_time_(lring) logical :: lring - + integer :: REPLAY_REF_DATE, REPLAY_REF_TIME, REPLAY_REF_TGAP integer :: REF_TIME(6), REF_TGAP(6) type(ESMF_TimeInterval) :: RefTGap @@ -2878,12 +2872,12 @@ subroutine dump_n_splash_ ! U iwind=0 if( trim(uname).ne.'NULL' ) then - call ESMFL_BundleGetPointerToData(ana_bundle, trim(uname), XTMP3d, _RC) + call MAPL_FieldBundleGetPointer(ana_bundle, trim(uname), XTMP3d, _RC) iwind=iwind+1 endif ! V if( trim(vname).ne.'NULL' ) then - call ESMFL_BundleGetPointerToData(ana_bundle, trim(vname), YTMP3D, _RC) + call MAPL_FieldBundleGetPointer(ana_bundle, trim(vname), YTMP3D, _RC) iwind=iwind+1 endif @@ -2967,7 +2961,7 @@ subroutine dump_n_splash_ ! PE or PS if( trim(dpname).ne.'NULL' ) then - call ESMFL_BundleGetPointerToData(ana_bundle, trim(dpname), XTMP3d, _RC) + call MAPL_FieldBundleGetPointer(ana_bundle, trim(dpname), XTMP3d, _RC) call logger%info("Run::dump_n_splash_:: Replaying "//trim(dpname)) if ( iapproach == 1 ) then ! convert lat-lon delp to cubed and proceed allocate(cubeTEMP3D(size(vars%pe,1),size(vars%pe,2),km)) @@ -3005,7 +2999,7 @@ subroutine dump_n_splash_ enddo else if( trim(psname).ne.'NULL' ) then - call ESMFL_BundleGetPointerToData(ana_bundle, trim(psname), XTMP2D, _RC) + call MAPL_FieldBundleGetPointer(ana_bundle, trim(psname), XTMP2D, _RC) call logger%info("Run::dump_n_splash_:: Replaying "//trim(psname)) allocate(cubeTEMP3D(size(vars%pe,1),size(vars%pe,2),1)) allocate( aux3D(size(XTMP2d ,1),size(XTMP2d ,2),1)) @@ -3047,7 +3041,7 @@ subroutine dump_n_splash_ ! pchakrab - TODO: orbit?? ! ! O3 ! if( trim(o3name).ne.'NULL' ) then - ! call ESMFL_BundleGetPointerToData(ana_bundle, trim(o3name), XTMP3d, _RC) + ! call MAPL_FieldBundleGetPointer(ana_bundle, trim(o3name), XTMP3d, _RC) ! allocate(cubeTEMP3D(size(vars%pe,1),size(vars%pe,2),km)) ! call l2c%regrid(XTMP3d, cubeTEMP3D, _RC) @@ -3084,7 +3078,7 @@ subroutine dump_n_splash_ ! QV if( trim(qname).ne.'NULL' ) then - call ESMFL_BundleGetPointerToData(ana_bundle, trim(qname), XTMP3d, _RC) + call MAPL_FieldBundleGetPointer(ana_bundle, trim(qname), XTMP3d, _RC) allocate(cubeTEMP3D(size(vars%pe,1),size(vars%pe,2),km)) call l2c%regrid(XTMP3d, cubeTEMP3D, _RC) call logger%info("Run::dump_n_splash_:: Replaying "//trim(qname)) @@ -3103,7 +3097,7 @@ subroutine dump_n_splash_ ! PT if( trim(tname).ne.'NULL' ) then - call ESMFL_BundleGetPointerToData(ana_bundle, trim(tname), XTMP3d, _RC) + call MAPL_FieldBundleGetPointer(ana_bundle, trim(tname), XTMP3d, _RC) allocate(cubeTEMP3D(size(ana_thv,1),size(ana_thv,2),km)) call l2c%regrid(XTMP3d, cubeTEMP3D, _RC) call logger%info("Run::dump_n_splash_:: Replaying "//trim(tname)// '; treated as '//trim(tvar)) @@ -3190,12 +3184,12 @@ subroutine incremental_ ! U iwind=0 if( trim(uname).ne.'NULL' ) then - call ESMFL_BundleGetPointerToData(ana_bundle, trim(uname), TEMP3D, _RC) + call MAPL_FieldBundleGetPointer(ana_bundle, trim(uname), TEMP3D, _RC) iwind=iwind+1 endif ! V if( trim(vname).ne.'NULL' ) then - call ESMFL_BundleGetPointerToData(ana_bundle, trim(vname), VTMP3D, _RC) + call MAPL_FieldBundleGetPointer(ana_bundle, trim(vname), VTMP3D, _RC) iwind=iwind+1 endif @@ -3227,7 +3221,7 @@ subroutine incremental_ ! DELP if( trim(psname)=='NULL' .and. trim(dpname).ne.'NULL' ) then - call ESMFL_BundleGetPointerToData(ana_bundle, trim(dpname), TEMP3D, _RC) + call MAPL_FieldBundleGetPointer(ana_bundle, trim(dpname), TEMP3D, _RC) call logger%info("Replaying increment of "//trim(dpname)) allocate(cubeTEMP3D(size(vars%pe,1),size(vars%pe,2),km)) call l2c%regrid(TEMP3D, cubeTEMP3D, _RC) @@ -3252,7 +3246,7 @@ subroutine incremental_ ! PS if( trim(psname)/='NULL' .and. trim(dpname)=='NULL' ) then - call ESMFL_BundleGetPointerToData(ana_bundle, trim(psname), TEMP2D, _RC) + call MAPL_FieldBundleGetPointer(ana_bundle, trim(psname), TEMP2D, _RC) call logger%info("Replaying increment of %s", trim(psname)) allocate(cubeTEMP3D(size(vars%pe,1),size(vars%pe,2),1)) allocate( aux3D(size( TEMP2D,1),size( TEMP2D,2),1)) @@ -3280,7 +3274,7 @@ subroutine incremental_ ! pchakrab - TODO: orbit? ! ! O3 ! if( trim(o3name).ne.'NULL' ) then - ! call ESMFL_BundleGetPointerToData(ana_bundle, trim(o3name), TEMP3D, _RC) + ! call MAPL_FieldBundleGetPointer(ana_bundle, trim(o3name), TEMP3D, _RC) ! allocate(cubeTEMP3D(size(vars%pe,1),size(vars%pe,2),km)) ! call l2c%regrid(TEMP3D, cubeTEMP3D, _RC) @@ -3307,7 +3301,7 @@ subroutine incremental_ ! QV if( trim(qname).ne.'NULL' ) then - call ESMFL_BundleGetPointerToData(ana_bundle, trim(qname), TEMP3D, _RC) + call MAPL_FieldBundleGetPointer(ana_bundle, trim(qname), TEMP3D, _RC) allocate(cubeTEMP3D(size(vars%pe,1),size(vars%pe,2),km)) call l2c%regrid(TEMP3D, cubeTEMP3D, _RC) call logger%info("Replaying increment of "//trim(qname)) @@ -3329,7 +3323,7 @@ subroutine incremental_ ! STATUS=99 ! _VERIFY(STATUS) ! endif - call ESMFL_BundleGetPointerToData(ana_bundle, trim(tname), TEMP3D, _RC) + call MAPL_FieldBundleGetPointer(ana_bundle, trim(tname), TEMP3D, _RC) allocate(cubeTEMP3D(size(vars%pe,1),size(vars%pe,2),km)) call l2c%regrid(TEMP3D, cubeTEMP3D, _RC) call logger%info("Replaying increment of "//trim(tname)) @@ -3431,7 +3425,7 @@ subroutine state_remap_ call logger%info("Replay start remapping") ! - call ESMFL_BundleGetPointerToData(ana_bundle, 'phis', XTMP2D, _RC) + call MAPL_FieldBundleGetPointer(ana_bundle, 'phis', XTMP2D, _RC) allocate(cubeTEMP3D(size(vars%pe,1),size(vars%pe,2),1)) allocate( aux3D(size(XTMP2D ,1),size(XTMP2D ,2),1)) aux3d(:,:,1)=XTMP2D ! this is a trick since the 2d interface to the transform has not worked for me (RT) @@ -3449,7 +3443,7 @@ subroutine state_remap_ if (rank==3) then icnt=icnt+1 _ASSERT(icnt<=nq3d, "state_remap: number of tracers exceeds known value") - call ESMFL_BundleGetPointerToData(BUNDLE, NAME, ptr3dr4, _RC) + call MAPL_FieldBundleGetPointer(BUNDLE, NAME, ptr3dr4, _RC) ana_qq(:,:,:,icnt) = ptr3dr4 endif enddo @@ -3478,7 +3472,7 @@ subroutine state_remap_ if (rank==2) cycle if (rank==3) then icnt=icnt+1 - call ESMFL_BundleGetPointerToData(BUNDLE, NAME, ptr3dr4, _RC) + call MAPL_FieldBundleGetPointer(BUNDLE, NAME, ptr3dr4, _RC) ptr3dr4 = ana_qq(:,:,:,icnt) if(trim(NAME)=="Q") then if( qqq%is_r4 ) then @@ -3599,6 +3593,7 @@ subroutine PULL_Q(self, import, QQQ, iNXQ, InFieldName, rc) end do _RETURN(_SUCCESS) + _UNUSED_DUMMY(import) end subroutine PULL_Q !BOP @@ -3683,7 +3678,7 @@ subroutine RunAddIncs(gc, import, export, clock, rc) ! Retrieve the pointer to the internal state _GET_NAMED_PRIVATE_STATE(gc, DynState, PRIVATE_STATE, self) - + vars => self%vars ! direct handle to control variables grid => self%grid ! direct handle to grid dt = self%dt ! dynamics time step (large) @@ -3845,12 +3840,22 @@ subroutine RunAddIncs(gc, import, export, clock, rc) #endif if (DEBUG_DYN) then - call MAPL_MaxMin('DYN: Q_AF_INC ', qv) - call MAPL_MaxMin('DYN: T_AF_INC ', tempxy, pmax=TMAX, pmin=TMIN) - call MAPL_MaxMin('DYN: U_AF_INC ', ua) - call MAPL_MaxMin('DYN: V_AF_INC ', va) - if (TMIN <= 130.0_r8) call Write_Profile(grid, tempxy, 'TAFINC') - if (TMAX >= 333.0_r8) call Write_Profile(grid, tempxy, 'TAFINC') + block + type(ESMF_VM) :: vm + integer :: comm + real :: maxmin(2) + + call ESMF_VMGetCurrent(vm, _RC) + call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) + maxmin = MAPL_MaxMin(qv, comm, _RC) + call logger%info("max/min(Q_AF_INC): %f/%f", maxmin(1), maxmin(2)) + maxmin = MAPL_MaxMin(tempxy, comm, _RC) + call logger%info("max/min(T_AF_INC): %f/%f", tmax, tmin) + maxmin = MAPL_MaxMin(ua, comm, _RC) + call logger%info("max/min(U_AF_INC): %f/%f", maxmin(1), maxmin(2)) + maxmin = MAPL_MaxMin(va, comm, _RC) + call logger%info("max/min(V_AF_INC): %f/%f", maxmin(1), maxmin(2)) + end block endif call FILLOUT3(export, "DELP", dp, _RC) @@ -4229,6 +4234,7 @@ subroutine RunAddIncs(gc, import, export, clock, rc) end if ! .not. SW_DYNAMICS _RETURN(_SUCCESS) + _UNUSED_DUMMY(clock) end subroutine RunAddIncs subroutine ADD_INCS(esmfgrid, self, import, DT, is_weighted, rc) @@ -4256,13 +4262,11 @@ subroutine ADD_INCS(esmfgrid, self, import, DT, is_weighted, rc) integer :: II, JJ, I, J, L integer :: is, ie, js, je, km integer :: isd, ied, jsd, jed - real(r4), allocatable :: fvQOLD(:,:,:), QTEND(:,:,:) real(r4), pointer :: tend(:,:,:) real(r4), allocatable, dimension(:,:) :: lons, lats real(r8), allocatable :: DPNEW(:,:,:), DPOLD(:,:,:) real(r8), allocatable :: tend_ua(:,:,:), tend_va(:,:,:) real(r8), allocatable :: tend_un(:,:,:), tend_vn(:,:,:) - real(FVPRC), allocatable :: u_dt(:,:,:), v_dt(:,:,:), t_dt(:,:,:) real(FVPRC), allocatable :: Q(:,:,:,:), CVM(:,:,:) type(DynTracers) :: qqq ! Specific Humidity @@ -4272,7 +4276,6 @@ subroutine ADD_INCS(esmfgrid, self, import, DT, is_weighted, rc) real, parameter:: c_vap = MAPL_CPVAP !< 1846. real, parameter:: c_air = MAPL_CP real(FVPRC) :: fac - type(time_type) :: Time_Nudge integer :: status is_weighted_ = .true. @@ -4733,7 +4736,6 @@ subroutine Finalize(gc, import, export, clock, rc) type (DynState), pointer :: self integer :: status - class(logger_t), pointer :: logger ! Retrieve the pointer to the state _GET_NAMED_PRIVATE_STATE(gc, DynState, PRIVATE_STATE, self) @@ -4741,6 +4743,9 @@ subroutine Finalize(gc, import, export, clock, rc) call DynFinalize(self) _RETURN(_SUCCESS) + _UNUSED_DUMMY(import) + _UNUSED_DUMMY(export) + _UNUSED_DUMMY(clock) end subroutine FINALIZE subroutine get_slp ( km,ps,phis,slp,pe,pk,tv,H1000,H850,H500) @@ -4799,20 +4804,18 @@ subroutine get_slp ( km,ps,phis,slp,pe,pk,tv,H1000,H850,H500) return end subroutine get_slp - subroutine VertInterp(v2,v3,ple,pp,positive_definite,rc) - real(r4), intent(OUT) :: v2(:,:) - real(r8), intent(IN ) :: v3(:,:,:) - real(r8), intent(IN ) :: ple(:,:,:) - real , intent(IN ) :: pp - logical, optional, intent(IN ) :: positive_definite - integer, optional, intent(OUT) :: rc + subroutine VertInterp(v2, v3, ple, pp, positive_definite, rc) + real(r4), intent(out) :: v2(:,:) + real(r8), intent(in) :: v3(:,:,:) + real(r8), intent(in) :: ple(:,:,:) + real, intent(in) :: pp + logical, optional, intent(in) :: positive_definite + integer, optional, intent(out) :: rc real, dimension(size(v2,1),size(v2,2)) :: al,PT,PB integer km logical edge - character*(10) :: Iam='VertInterp' - km = size(ple,3)-1 edge = size(v3,3)==km+1 @@ -4918,7 +4921,7 @@ subroutine Coldstart(gc, import, export, clock, rc) logical :: ak_is_missing = .false. logical :: bk_is_missing = .false. logical :: FV3_STANDALONE - logical :: isPresent + ! logical :: isPresent - used in some code that has been commented out ! Tracer Stuff real(REAL4), pointer :: tracer(:,:,:) @@ -5391,7 +5394,8 @@ subroutine Coldstart(gc, import, export, clock, rc) DYN_COLDSTART=.true. _RETURN(_SUCCESS) - + _UNUSED_DUMMY(export) + _UNUSED_DUMMY(clock) end subroutine Coldstart #ifdef MY_SET_ETA